diff --git a/src/Tahoe/SDMF/Internal/Share.hs b/src/Tahoe/SDMF/Internal/Share.hs
index c33b4d8ab67b1e461ae11a291e6fd925cf176b00..f4587950a072be0798d3b09a37608e1dfdaf841e 100644
--- a/src/Tahoe/SDMF/Internal/Share.hs
+++ b/src/Tahoe/SDMF/Internal/Share.hs
@@ -1,21 +1,20 @@
 -- | Deal with details related to the structural layout of an SDMF share.
 module Tahoe.SDMF.Internal.Share where
 
-import Control.Monad (unless, when)
-import Control.Monad.IO.Class (MonadIO (liftIO))
+import Control.Monad (unless)
 import Crypto.Cipher.AES (AES128)
+import qualified Crypto.PubKey.RSA.Types as RSA
 import Crypto.Types (IV (IV, initializationVector))
-import qualified Crypto.Types.PubKey.RSA as RSA
 import Data.ASN1.BinaryEncoding (DER (DER))
 import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1')
 import Data.ASN1.Types (ASN1Object (fromASN1, toASN1))
-import Data.Binary (Binary (..), getWord8)
-import Data.Binary.Get (bytesRead, getByteString, getLazyByteString, getWord16be, getWord32be, getWord64be, isEmpty, isolate)
+import Data.Binary (Binary (..), Get, getWord8)
+import Data.Binary.Get (bytesRead, getByteString, getLazyByteString, getRemainingLazyByteString, getWord16be, getWord32be, getWord64be, isEmpty, isolate)
 import Data.Binary.Put (putByteString, putLazyByteString, putWord16be, putWord32be, putWord64be, putWord8)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
 import Data.Word (Word16, Word64, Word8)
-import Debug.Trace (trace)
+import Data.X509 (PubKey (PubKeyRSA))
 import Tahoe.CHK.Merkle (MerkleTree, leafHashes)
 
 hashSize :: Int
@@ -110,7 +109,7 @@ instance Binary Share where
         putLazyByteString shareData
         putByteString shareEncryptedPrivateKey
       where
-        verificationKeyBytes = LB.toStrict . encodeASN1 DER . flip toASN1 [] $ shareVerificationKey
+        verificationKeyBytes = LB.toStrict . encodeASN1 DER . flip toASN1 [] . PubKeyRSA $ shareVerificationKey
         blockHashTreeBytes = B.concat . leafHashes $ shareBlockHashTree
 
         -- TODO Compute these from all the putting.
@@ -139,8 +138,7 @@ instance Binary Share where
         eofOffset <- getWord64be
 
         pos <- bytesRead
-        verificationKeyBytes <- getByteString (fromIntegral signatureOffset - fromIntegral pos)
-        let Right (Right (shareVerificationKey, _)) = fmap fromASN1 . decodeASN1' DER $ verificationKeyBytes
+        shareVerificationKey <- isolate (fromIntegral signatureOffset - fromIntegral pos) getSubjectPublicKeyInfo
 
         pos <- bytesRead
         shareSignature <- getByteString (fromIntegral hashChainOffset - fromIntegral pos)
@@ -161,3 +159,13 @@ instance Binary Share where
         unless empty (fail "Expected end of input but there are more bytes")
 
         pure Share{..}
+
+{- | Read an X.509v3-encoded SubjectPublicKeyInfo structure carrying an ASN.1
+ DER encoded RSA public key.
+-}
+getSubjectPublicKeyInfo :: Get RSA.PublicKey
+getSubjectPublicKeyInfo = do
+    verificationKeyBytes <- getRemainingLazyByteString
+    let (Right asn1s) = decodeASN1' DER . LB.toStrict $ verificationKeyBytes
+    let (Right (PubKeyRSA pubKey, [])) = fromASN1 asn1s
+    pure pubKey
diff --git a/tahoe-ssk.cabal b/tahoe-ssk.cabal
index 2e446c3a5f59bb6dbb21fcf4e04e25d82b5cd733..e8e79204194a03efb6105a4378fcea6ea50ce25a 100644
--- a/tahoe-ssk.cabal
+++ b/tahoe-ssk.cabal
@@ -75,6 +75,7 @@ library
     , crypto-pubkey-types
     , cryptonite
     , RSA
+    , x509
 
   -- This dependency isn't ideal.  Move common bits out to
   -- another library.
@@ -90,10 +91,11 @@ library
 
 test-suite tahoe-ssk-test
   -- Import common warning flags.
-  import:           warnings
+  import:             warnings
 
   -- Base language which the package is written in.
-  default-language: Haskell2010
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
 
   -- Modules included in this executable, other than Main.
   -- other-modules:
@@ -102,13 +104,13 @@ test-suite tahoe-ssk-test
   -- other-extensions:
 
   -- The interface type and version of the test suite.
-  type:             exitcode-stdio-1.0
+  type:               exitcode-stdio-1.0
 
   -- Directories containing source files.
-  hs-source-dirs:   test
+  hs-source-dirs:     test
 
   -- The entrypoint to the test suite.
-  main-is:          Main.hs
+  main-is:            Main.hs
   other-modules:
     Generators
     Spec
@@ -129,6 +131,8 @@ test-suite tahoe-ssk-test
     , tahoe-ssk
     , tasty
     , tasty-hedgehog
+    , tasty-hunit
+    , x509
 
 -- A helper for generating RSA key pairs for use by the test suite.
 executable make-keypairs
diff --git a/test/Generators.hs b/test/Generators.hs
index ec6c92ee6c8ae03235334771e298489062c4c74c..916105480e795d564e32d12bbe54d0f7c64ded65 100644
--- a/test/Generators.hs
+++ b/test/Generators.hs
@@ -2,15 +2,15 @@ module Generators where
 
 import Crypto.Hash (HashAlgorithm (hashDigestSize))
 import Crypto.Hash.Algorithms (SHA256 (SHA256))
+import qualified Crypto.PubKey.RSA.Types as RSA
 import Crypto.Types (IV (..))
-import qualified Crypto.Types.PubKey.RSA as RSA
 import Data.ASN1.BinaryEncoding (DER (DER))
 import Data.ASN1.Encoding (ASN1Decoding (decodeASN1), ASN1Encoding (encodeASN1))
 import Data.ASN1.Types (ASN1Object (fromASN1, toASN1))
 import Data.Bifunctor (Bifunctor (first))
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
-import Data.Word (Word16)
+import Data.X509 (PrivKey (PrivKeyRSA))
 import GHC.IO.Unsafe (unsafePerformIO)
 import Hedgehog (MonadGen)
 import qualified Hedgehog.Gen as Gen
@@ -47,7 +47,7 @@ shares =
             <*> shareHashChains -- shareHashChain
             <*> merkleTrees (Range.singleton 1) -- shareBlockHashTree
             <*> (LB.fromStrict <$> Gen.bytes (Range.exponential 0 1024)) -- shareData
-            <*> (pure . LB.toStrict . toDER . RSA.toPrivateKey) keypair -- shareEncryptedPrivateKey
+            <*> (pure . LB.toStrict . toDER . PrivKeyRSA . RSA.toPrivateKey) keypair -- shareEncryptedPrivateKey
   where
     toDER = encodeASN1 DER . flip toASN1 []
 
@@ -73,7 +73,9 @@ rsaKeyPair bs = do
     let (Right kp) = do
             asn1s <- first show (decodeASN1 DER bs)
             (r, _) <- fromASN1 asn1s
-            pure r
+            case r of
+                PrivKeyRSA pk -> pure $ RSA.KeyPair pk
+                _ -> error "Expected RSA Private Key"
     kp
 
 merkleTrees :: MonadGen m => Range.Range Int -> m MerkleTree
diff --git a/test/Spec.hs b/test/Spec.hs
index e4b0f45056e208c9a4c8ec9361d4600baccce5ee..42290c2ceecf821de3c9865751784c9cf481f11e 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -11,7 +11,9 @@ import Data.Binary.Get (ByteOffset)
 import qualified Data.ByteString.Lazy as LB
 import Generators (shareHashChains, shares)
 import System.IO (hSetEncoding, stderr, stdout, utf8)
+import Tahoe.SDMF (Share)
 import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty.HUnit (assertEqual, testCase)
 import Test.Tasty.Hedgehog (testProperty)
 
 tests :: TestTree
@@ -26,6 +28,23 @@ tests =
             property $ do
                 share <- forAll shares
                 tripping share Binary.encode decode'
+        , testCase "known-correct serialized shares round-trip though Share" $ do
+            -- The files are in "bucket" format.  We need to extract the
+            -- "slot".  We do so by stripping a prefix and suffix.  To avoid
+            -- having to parse the prefix, we assert that the suffix is a
+            -- predictable size.
+            bucket <- LB.readFile "test/data/3of10.0"
+            let withoutPrefix = LB.drop (32 + 20 + 32 + 8 + 8 + 368) bucket
+                dataSize = LB.length withoutPrefix - 4
+                shareData = LB.take dataSize withoutPrefix
+                suffix = LB.drop dataSize withoutPrefix
+
+            -- Our assumption about the data we're working on...
+            assertEqual "Cannot account for extra leases" suffix "\0\0\0\0"
+
+            let decoded = decode' shareData
+            let encoded = (Binary.encode :: Share -> LB.ByteString) <$> decoded
+            assertEqual "original /= encoded" (Right shareData) encoded
         ]
   where
     decode' :: Binary.Binary b => LB.ByteString -> Either (LB.ByteString, ByteOffset, String) b
diff --git a/test/data/3of10.0 b/test/data/3of10.0
new file mode 100644
index 0000000000000000000000000000000000000000..5c79c79c0bdb7d9c5eef847ee1c3ac7483554df5
Binary files /dev/null and b/test/data/3of10.0 differ
diff --git a/test/data/3of10.1 b/test/data/3of10.1
new file mode 100644
index 0000000000000000000000000000000000000000..c90a0cd7ef73fee85d6322af0d8b35e4f27c5de8
Binary files /dev/null and b/test/data/3of10.1 differ
diff --git a/test/data/3of10.2 b/test/data/3of10.2
new file mode 100644
index 0000000000000000000000000000000000000000..dfa291410b8b50ca12be8fbe6f81a0bbc5397224
Binary files /dev/null and b/test/data/3of10.2 differ
diff --git a/test/data/3of10.3 b/test/data/3of10.3
new file mode 100644
index 0000000000000000000000000000000000000000..a859d241f7a674e8b37a96c27eead10f9979475e
Binary files /dev/null and b/test/data/3of10.3 differ
diff --git a/test/data/3of10.4 b/test/data/3of10.4
new file mode 100644
index 0000000000000000000000000000000000000000..9e5bd0bab2de7ba7bc12b27eba5e916305b0ffc0
Binary files /dev/null and b/test/data/3of10.4 differ
diff --git a/test/data/3of10.5 b/test/data/3of10.5
new file mode 100644
index 0000000000000000000000000000000000000000..c3b19a46d15cef77585f5cee446e0162d3812bc2
Binary files /dev/null and b/test/data/3of10.5 differ
diff --git a/test/data/3of10.6 b/test/data/3of10.6
new file mode 100644
index 0000000000000000000000000000000000000000..49236cdb012d8755108e9b86657c33a0eb26f4e7
Binary files /dev/null and b/test/data/3of10.6 differ
diff --git a/test/data/3of10.7 b/test/data/3of10.7
new file mode 100644
index 0000000000000000000000000000000000000000..5df7362382c60ec4191d84a31f20569d54e3cc63
Binary files /dev/null and b/test/data/3of10.7 differ
diff --git a/test/data/3of10.8 b/test/data/3of10.8
new file mode 100644
index 0000000000000000000000000000000000000000..32baa3014dc7fe9cc073fd459dce4f2418881016
Binary files /dev/null and b/test/data/3of10.8 differ
diff --git a/test/data/3of10.9 b/test/data/3of10.9
new file mode 100644
index 0000000000000000000000000000000000000000..fe23f068432473ce9706b970ca707157dfe3ae0f
Binary files /dev/null and b/test/data/3of10.9 differ