diff --git a/src/Tahoe/SDMF.hs b/src/Tahoe/SDMF.hs
index f497a4092a145910a65bb506a0a0e86a10dd8c7b..4a4430cd2e1d4e8a3c214dd6374cf864ecf07754 100644
--- a/src/Tahoe/SDMF.hs
+++ b/src/Tahoe/SDMF.hs
@@ -1,12 +1,20 @@
 -- | Expose the library's public interface.
 module Tahoe.SDMF (
-    Share (..),
-    Writer (..),
-    Reader (..),
-    encode,
-    decode,
+    module Tahoe.SDMF.Internal.Share,
+    module Tahoe.SDMF.Internal.Capability,
+    module Tahoe.SDMF.Internal.Encoding,
 ) where
 
-import Tahoe.SDMF.Internal.Capability
-import Tahoe.SDMF.Internal.Encoding
-import Tahoe.SDMF.Internal.Share
+import Tahoe.SDMF.Internal.Capability (
+    Reader (..),
+    Writer (..),
+ )
+import Tahoe.SDMF.Internal.Encoding (
+    decode,
+    encode,
+ )
+import Tahoe.SDMF.Internal.Share (
+    Reader (..),
+    Share (..),
+    Writer (..),
+ )
diff --git a/src/Tahoe/SDMF/Internal/Capability.hs b/src/Tahoe/SDMF/Internal/Capability.hs
index c028686e2739b0f352f9fd5c2c8e7a39f44aa88d..56d6ed1616af9478126c40404844e279d0ee43bd 100644
--- a/src/Tahoe/SDMF/Internal/Capability.hs
+++ b/src/Tahoe/SDMF/Internal/Capability.hs
@@ -1,45 +1,21 @@
+-- | Structured representations of SDMF capabilities.
 module Tahoe.SDMF.Internal.Capability where
 
-import Crypto.Cipher.AES128 (AESKey128)
-import Crypto.Classes (buildKey)
-import Crypto.Types (IV)
+import Prelude hiding (Read)
+
 import qualified Data.ByteString as B
-import Data.Serialize (encode)
-import Tahoe.CHK.Crypto (taggedHash, taggedPairHash)
+import Tahoe.SDMF.Internal.Keys (Read, Write)
 
+-- | A read capability for an SDMF object.
 data Reader = Reader
-    { readerReadKey :: B.ByteString
+    { readerReadKey :: Read
     , readerVerificationKeyHash :: B.ByteString
     }
+    deriving (Show)
 
+-- | A write capability for an SDMF object.
 data Writer = Writer
-    { writerWriteKey :: AESKey128
+    { writerWriteKey :: Write
     , writerReader :: Reader
     }
-
-deriveReader :: AESKey128 -> B.ByteString -> Reader
-deriveReader writeKey readerVerificationKeyHash = Reader{..}
-  where
-    readerReadKey = taggedHash readKeyLength mutableReadKeyTag (encode writeKey)
-
-readKeyLength :: Int
-readKeyLength = 32
-
-mutableReadKeyTag :: B.ByteString
-mutableReadKeyTag = "allmydata_mutable_writekey_to_readkey_v1"
-
-{- | Compute the encryption (and decryption) key used to convert the
- application payload plaintext to ciphertext and back again.
--}
-deriveEncryptionKey :: MonadFail m => Reader -> IV AESKey128 -> m AESKey128
-deriveEncryptionKey Reader{readerReadKey} iv = do
-    let k = buildKey $ taggedPairHash encryptionKeyLength mutableDataKeyTag readerReadKey (encode iv)
-    case k of
-        Nothing -> fail "Could not build AESKey128 when deriving encryption key"
-        Just key -> pure key
-
-mutableDataKeyTag :: B.ByteString
-mutableDataKeyTag = "allmydata_mutable_readkey_to_datakey_v1"
-
-encryptionKeyLength :: Int
-encryptionKeyLength = 16
+    deriving (Show)
diff --git a/src/Tahoe/SDMF/Internal/Keys.hs b/src/Tahoe/SDMF/Internal/Keys.hs
index e40d6fbefa909e638a689f7d802a3b7ee53bc1d4..29f38c6881086c25ab7b3467edd48298d9d77525 100644
--- a/src/Tahoe/SDMF/Internal/Keys.hs
+++ b/src/Tahoe/SDMF/Internal/Keys.hs
@@ -34,10 +34,15 @@ newtype Signature = Signature {unSignature :: RSA.PrivateKey}
     deriving newtype (Eq, Show)
 
 data Write = Write {unWrite :: AES128, writeKeyBytes :: ByteArray.ScrubbedBytes}
+
 instance Show Write where
     show (Write _ bs) = T.unpack $ T.concat ["<WriteKey ", encodeBase32Unpadded (ByteArray.convert bs), ">"]
 
 data Read = Read {unRead :: AES128, readKeyBytes :: ByteArray.ScrubbedBytes}
+
+instance Show Read where
+    show (Read _ bs) = T.unpack $ T.concat ["<ReadKey ", encodeBase32Unpadded (ByteArray.convert bs), ">"]
+
 newtype StorageIndex = StorageIndex {unStorageIndex :: B.ByteString}
 
 newtype WriteEnablerMaster = WriteEnablerMaster ByteArray.ScrubbedBytes