diff --git a/src/Tahoe/SDMF/Internal/Encrypting.hs b/src/Tahoe/SDMF/Internal/Encrypting.hs
index e0e402ce32bb98bcac15dc45a2e872ab7ad63ab7..27ff29ae1fabb783d9cd33d34e52a1bb45402d32 100644
--- a/src/Tahoe/SDMF/Internal/Encrypting.hs
+++ b/src/Tahoe/SDMF/Internal/Encrypting.hs
@@ -1,11 +1,11 @@
 module Tahoe.SDMF.Internal.Encrypting where
 
-import Crypto.Cipher.Types (ctrCombine)
+import Crypto.Cipher.Types (ctrCombine, nullIV)
 import qualified Data.ByteString.Lazy as LB
 import qualified Tahoe.SDMF.Internal.Keys as Keys
 
-encrypt :: Keys.Data -> Keys.SDMF_IV -> LB.ByteString -> LB.ByteString
-encrypt Keys.Data{unData} (Keys.SDMF_IV iv) = LB.fromStrict . ctrCombine unData iv . LB.toStrict
+encrypt :: Keys.Data -> LB.ByteString -> LB.ByteString
+encrypt Keys.Data{unData} = LB.fromStrict . ctrCombine unData nullIV . LB.toStrict
 
-decrypt :: Keys.Data -> Keys.SDMF_IV -> LB.ByteString -> LB.ByteString
+decrypt :: Keys.Data -> LB.ByteString -> LB.ByteString
 decrypt = encrypt
diff --git a/src/Tahoe/SDMF/Internal/Keys.hs b/src/Tahoe/SDMF/Internal/Keys.hs
index 2617bb4efe65ad2bc5ab7bc8423bbe47647f4b76..47484f0909e5edb9faa3bbfdb68164406bdc58ba 100644
--- a/src/Tahoe/SDMF/Internal/Keys.hs
+++ b/src/Tahoe/SDMF/Internal/Keys.hs
@@ -8,7 +8,7 @@ import Prelude hiding (Read)
 
 import Control.Monad (when)
 import Crypto.Cipher.AES (AES128)
-import Crypto.Cipher.Types (BlockCipher (ctrCombine), Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed), makeIV, nullIV)
+import Crypto.Cipher.Types (BlockCipher (ctrCombine), Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed), nullIV)
 import Crypto.Error (CryptoFailable (CryptoPassed), maybeCryptoError)
 import qualified Crypto.PubKey.RSA as RSA
 import Crypto.Random (MonadRandom)
@@ -49,7 +49,7 @@ data Write = Write {unWrite :: AES128, writeKeyBytes :: ByteArray.ScrubbedBytes}
 instance Binary Write where
     put = putByteString . ByteArray.convert . writeKeyBytes
     get = do
-        writeKeyBytes <- ByteArray.convert <$> getByteString 16
+        writeKeyBytes <- ByteArray.convert <$> getByteString keyLength
         let (CryptoPassed unWrite) = cipherInit writeKeyBytes
         pure Write{..}
 
@@ -58,8 +58,17 @@ instance Show Write where
 
 data Read = Read {unRead :: AES128, readKeyBytes :: ByteArray.ScrubbedBytes}
 
+instance Binary Read where
+    put = putByteString . ByteArray.convert . readKeyBytes
+    get = do
+        readKeyBytes <- ByteArray.convert <$> getByteString keyLength
+        let (CryptoPassed unRead) = cipherInit readKeyBytes
+        pure Read{..}
+
 instance Show Read where
     show (Read _ bs) = T.unpack $ T.concat ["<ReadKey ", encodeBase32Unpadded (ByteArray.convert bs), ">"]
+instance Eq Read where
+    (Read _ left) == (Read _ right) = left == right
 
 newtype StorageIndex = StorageIndex {unStorageIndex :: B.ByteString}
 
@@ -68,6 +77,16 @@ newtype WriteEnablerMaster = WriteEnablerMaster ByteArray.ScrubbedBytes
 newtype WriteEnabler = WriteEnabler ByteArray.ScrubbedBytes
 
 data Data = Data {unData :: AES128, dataKeyBytes :: ByteArray.ScrubbedBytes}
+instance Show Data where
+    show (Data _ bs) = T.unpack $ T.concat ["<DataKey ", encodeBase32Unpadded (ByteArray.convert bs), ">"]
+instance Eq Data where
+    (Data _ left) == (Data _ right) = left == right
+instance Binary Data where
+    put = putByteString . ByteArray.convert . dataKeyBytes
+    get = do
+        dataKeyBytes <- ByteArray.convert <$> getByteString keyLength
+        let (CryptoPassed unData) = cipherInit dataKeyBytes
+        pure Data{..}
 
 newtype SDMF_IV = SDMF_IV (IV AES128)
     deriving (Eq)
diff --git a/test/Spec.hs b/test/Spec.hs
index 7f2bd9f947888afcc65427d2db54a5dd99282516..7ecb548f2570dbcc038b88b058167760969df668 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -171,7 +171,7 @@ tests =
                             readKey <- Keys.deriveReadKey writeKey
                             Keys.deriveDataKey iv readKey
                     plaintext <- forAll $ LB.fromStrict <$> Gen.bytes (Range.exponential 1 1024)
-                    tripping plaintext (Tahoe.SDMF.encrypt dataKey iv) (Just . Tahoe.SDMF.decrypt dataKey iv)
+                    tripping plaintext (Tahoe.SDMF.encrypt dataKey) (Just . Tahoe.SDMF.decrypt dataKey)
         , testCase "Recover plaintext from a known-correct slot" $ do
             s0 <- liftIO $ Binary.decode <$> (LB.readFile "test/data/3of10.0" >>= readShareFromBucket)
             s6 <- liftIO $ Binary.decode <$> (LB.readFile "test/data/3of10.6" >>= readShareFromBucket)
@@ -182,11 +182,21 @@ tests =
                 readerVerificationKeyHash = "junk"
                 reader = Tahoe.SDMF.Reader{..}
             ciphertext <- Tahoe.SDMF.decode reader [(0, s0), (6, s6), (9, s9)]
-            let (Just dataKey) = Keys.deriveDataKey (Tahoe.SDMF.shareIV s0) readerReadKey
-                plaintext = Tahoe.SDMF.decrypt dataKey (Tahoe.SDMF.shareIV s0) ciphertext
+            let (Right expectedCiphertext) = LB.fromStrict <$> decodeBase32Unpadded "6gutkha6qd4g3lxahth2dw2wjekadwoxvmazrnfq5u5j6a7quu5qy6nz3dvosx2gisdjshdtd5xphqvqjco5pq73qi"
+                (Right (Just expectedIV)) = fmap (fmap Keys.SDMF_IV . makeIV) . decodeBase32Unpadded $ "xkczackg4djsvtx5brgy4z3pse"
+                (Right expectedReadKey) = Binary.decode . LB.fromStrict <$> decodeBase32Unpadded "g4fimjxgdpwrvpfguyz5a6hvz4"
+                (Right expectedDataKey) = Binary.decode . LB.fromStrict <$> decodeBase32Unpadded "crblibtnjacos5xwjpxb2d5hla"
+                expectedPlaintext = "abcdefghijklmnopqrstuvwxyzZYXWVUTSRQPONMLKJIJHGRFCBA1357"
 
-            print plaintext
-            pure ()
+                (Just dataKey) = Keys.deriveDataKey (Tahoe.SDMF.shareIV s0) readerReadKey
+                recoveredPlaintext = Tahoe.SDMF.decrypt dataKey ciphertext
+
+            assertEqual "read key: expected /= derived" expectedReadKey readerReadKey
+            assertEqual "data key: expected /= derived" expectedDataKey dataKey
+            assertEqual "iv: expected /= loaded" expectedIV (Tahoe.SDMF.shareIV s0)
+            assertEqual "ciphertext: expected /= decoded" expectedCiphertext ciphertext
+
+            assertEqual "expected /= recovered" expectedPlaintext recoveredPlaintext
         ]
 
 readShareFromBucket :: MonadFail m => LB.ByteString -> m LB.ByteString