Fix key derivations through "datakey"

* Add direct tests for signature key serialization/deserialization
* Fix the RSA Private Key serializer to use PKCS8 like Tahoe-LAFS expects.
* Fix the key generator to emit keys in this format.
* Fix the key generator to generate 2048 bit keys.
* Fix the derivation functions to make the key values internally consistent.

make-keypairs/Main.hs

 module Main where
 
 import qualified Crypto.PubKey.RSA as RSA
-import Data.ASN1.BinaryEncoding (DER (DER))
-import Data.ASN1.Encoding (ASN1Encoding (encodeASN1))
-import Data.ASN1.Types (ASN1Object (toASN1))
-import qualified Data.ByteString.Lazy as LB
-import Data.X509 (PrivKey (PrivKeyRSA))
+import qualified Data.ByteString as B
+import Tahoe.SDMF.Internal.Keys (signatureKeyToBytes)
+import Tahoe.SDMF.Keys (Signature (..))
 
 -- | The size of the keys to generate.
 bits :: Int
@@ -21,8 +19,12 @@ main = do
 
 genKey :: Show a => a -> IO ()
 genKey n = do
-    (_, priv) <- RSA.generate bits e
-    let bytes = encodeASN1 DER (toASN1 (PrivKeyRSA priv) [])
-    LB.writeFile ("test/data/rsa-privkey-" <> show n <> ".der") bytes
+    print "Generating RSA key..."
+    (_, priv) <- RSA.generate (bits `div` 8) e
+    print $ "Serializing key " <> show n
+    let bytes = signatureKeyToBytes (Signature priv)
+    print $ "Generated them (" <> show (B.length bytes) <> " bytes)"
+    B.writeFile ("test/data/rsa-privkey-" <> show n <> ".der") bytes
+    print "Wrote them to the file."
   where
     e = 0x10001

src/Tahoe/SDMF/Internal/Keys.hs

@@ -3,14 +3,16 @@ module Tahoe.SDMF.Internal.Keys where
 
 import Prelude hiding (Read)
 
+import Control.Monad (when)
 import Crypto.Cipher.AES (AES128)
 import Crypto.Cipher.Types (Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed))
 import Crypto.Error (maybeCryptoError)
 import qualified Crypto.PubKey.RSA as RSA
 import Crypto.Random (MonadRandom)
 import Data.ASN1.BinaryEncoding (DER (DER))
-import Data.ASN1.Encoding (ASN1Encoding (encodeASN1))
-import Data.ASN1.Types (ASN1Object (toASN1))
+import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1')
+import Data.ASN1.Types (ASN1 (End, IntVal, Null, OID, OctetString, Start), ASN1ConstructionType (Sequence), ASN1Object (fromASN1, toASN1))
+import Data.Bifunctor (Bifunctor (first))
 import qualified Data.ByteArray as ByteArray
 import qualified Data.ByteString as B
 import Data.ByteString.Base32 (encodeBase32Unpadded)
@@ -20,14 +22,19 @@ import Data.X509 (PrivKey (PrivKeyRSA), PubKey (PubKeyRSA))
 import Tahoe.CHK.Crypto (taggedHash, taggedPairHash)
 import Tahoe.CHK.Server (StorageServerID)
 
-newtype KeyPair = KeyPair {toPrivateKey :: RSA.PrivateKey}
+newtype KeyPair = KeyPair {toPrivateKey :: RSA.PrivateKey} deriving newtype (Show)
 
 toPublicKey :: KeyPair -> RSA.PublicKey
 toPublicKey = RSA.private_pub . toPrivateKey
 
 newtype Verification = Verification {unVerification :: RSA.PublicKey}
 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}
 newtype StorageIndex = StorageIndex {unStorageIndex :: B.ByteString}
 
@@ -74,10 +81,10 @@ mutableWriteKeyTag = "allmydata_mutable_privkey_to_writekey_v1"
 -- | Compute the read key for a given write key for an SDMF share.
 deriveReadKey :: Write -> Maybe Read
 deriveReadKey w =
-    Read <$> key <*> pure sbs
+    Read <$> key <*> pure (ByteArray.convert sbs)
   where
-    sbs = writeKeyBytes w
-    key = maybeCryptoError . cipherInit . taggedHash keyLength mutableReadKeyTag . ByteArray.convert $ sbs
+    sbs = taggedHash keyLength mutableReadKeyTag . ByteArray.convert . writeKeyBytes $ w
+    key = maybeCryptoError . cipherInit $ sbs
 
 mutableReadKeyTag :: B.ByteString
 mutableReadKeyTag = "allmydata_mutable_writekey_to_readkey_v1"
@@ -85,10 +92,10 @@ mutableReadKeyTag = "allmydata_mutable_writekey_to_readkey_v1"
 -- | Compute the data encryption/decryption key for a given read key for an SDMF share.
 deriveDataKey :: SDMF_IV -> Read -> Maybe Data
 deriveDataKey (SDMF_IV iv) r =
-    Data <$> key <*> pure sbs
+    Data <$> key <*> pure (ByteArray.convert sbs)
   where
-    sbs = readKeyBytes r
-    key = maybeCryptoError . cipherInit . taggedPairHash keyLength mutableDataKeyTag (B.pack . ByteArray.unpack $ iv) . ByteArray.convert $ sbs
+    sbs = B.take keyLength . taggedPairHash keyLength mutableDataKeyTag (B.pack . ByteArray.unpack $ iv) . ByteArray.convert . readKeyBytes $ r
+    key = maybeCryptoError . cipherInit $ sbs
 
 mutableDataKeyTag :: B.ByteString
 mutableDataKeyTag = "allmydata_mutable_readkey_to_datakey_v1"
@@ -108,4 +115,49 @@ verificationKeyToBytes = LB.toStrict . encodeASN1 DER . flip toASN1 [] . PubKeyR
  PublicKey.
 -}
 signatureKeyToBytes :: Signature -> B.ByteString
-signatureKeyToBytes = LB.toStrict . encodeASN1 DER . flip toASN1 [] . PrivKeyRSA . unSignature
+signatureKeyToBytes = LB.toStrict . encodeASN1 DER . toPKCS8
+  where
+    -- The ASN1Object instance for PrivKeyRSA can interpret an x509
+    -- "Private-Key Information" (aka PKCS8; see RFC 5208, section 5)
+    -- structure but it _produces_ some other format.  We must have exactly
+    -- this format.
+    --
+    -- XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+    --
+    -- RFC 5208 says:
+    --
+    --    privateKey is an octet string whose contents are the value of the
+    --    private key.  The interpretation of the contents is defined in the
+    --    registration of the private-key algorithm.  For an RSA private key,
+    --    for example, the contents are a BER encoding of a value of type
+    --    RSAPrivateKey.
+    --
+    -- The ASN.1 BER encoding for a given structure is *not guaranteed to be
+    -- unique*.  This means that in general there is no guarantee of a unique
+    -- bytes representation of a signature key in this scheme so *key
+    -- derivations are not unique*.  If any two implementations disagree on
+    -- this encoding (which BER allows them to do) they will not interoperate.
+    toPKCS8 (Signature privKey) =
+        [ Start Sequence
+        , IntVal 0
+        , Start Sequence
+        , OID [1, 2, 840, 113549, 1, 1, 1]
+        , Null
+        , End Sequence
+        , -- Our ASN.1 encoder doesn't even pretend to support BER.  Use DER!
+          -- It results in the same bytes as Tahoe-LAFS is working with so ...
+          -- Maybe we're lucky or maybe Tahoe-LAFS isn't actually following
+          -- the spec.
+          OctetString (LB.toStrict . encodeASN1 DER . toASN1 (PrivKeyRSA privKey) $ [])
+        , End Sequence
+        ]
+
+-- | Decode a private key from the Tahoe-LAFS canonical bytes representation.
+signatureKeyFromBytes :: B.ByteString -> Either String Signature
+signatureKeyFromBytes bs = do
+    asn1s <- first show $ decodeASN1' DER bs
+    (key, extra) <- fromASN1 asn1s
+    when (extra /= []) (Left $ "left over data: " <> show extra)
+    case key of
+        (PrivKeyRSA privKey) -> Right $ Signature privKey
+        _ -> Left ("Expect RSA private key, found " <> show key)

tahoe-ssk.cabal

@@ -149,4 +149,5 @@ executable make-keypairs
     , base
     , bytestring
     , cryptonite
+    , tahoe-ssk
     , x509

test/Spec.hs

@@ -9,7 +9,6 @@ import Hedgehog (
 import Crypto.Cipher.Types (makeIV)
 import Data.ASN1.BinaryEncoding (DER (DER))
 import Data.ASN1.Encoding (decodeASN1')
-import Data.ASN1.Types (ASN1Object (fromASN1))
 import qualified Data.Binary as Binary
 import Data.Binary.Get (ByteOffset)
 import qualified Data.ByteArray as ByteArray
@@ -17,10 +16,10 @@ import qualified Data.ByteString as B
 import Data.ByteString.Base32 (encodeBase32Unpadded)
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.Text as T
-import Data.X509 (PrivKey (PrivKeyRSA))
-import Generators (shareHashChains, shares)
+import Generators (genRSAKeys, shareHashChains, shares)
 import System.IO (hSetEncoding, stderr, stdout, utf8)
 import Tahoe.SDMF (Share)
+import Tahoe.SDMF.Internal.Keys (signatureKeyFromBytes, signatureKeyToBytes)
 import qualified Tahoe.SDMF.Keys as Keys
 import Test.Tasty (TestTree, defaultMain, testGroup)
 import Test.Tasty.HUnit (assertEqual, testCase)
@@ -38,23 +37,62 @@ tests =
             property $ do
                 hashChain <- forAll shareHashChains
                 tripping hashChain Binary.encode decode'
+        , testProperty "Signatures round-trip through signatureKeyToBytes . signatureKeyFromBytes" $
+            property $ do
+                key <- forAll genRSAKeys
+                tripping (Keys.Signature . Keys.toPrivateKey $ key) signatureKeyToBytes signatureKeyFromBytes
+        , testCase "Signature byte-serializations round-trip through signatureKeyFromBytes . signatureKeyToBytes" $ do
+            let keyPaths =
+                    [ -- Check ours
+                      "test/data/rsa-privkey-0.der"
+                    , "test/data/rsa-privkey-1.der"
+                    , "test/data/rsa-privkey-2.der"
+                    , "test/data/rsa-privkey-3.der"
+                    , "test/data/rsa-privkey-4.der"
+                    , -- And one from Tahoe-LAFS
+                      "test/data/tahoe-lafs-generated-rsa-privkey.der"
+                    ]
+                checkSignatureRoundTrip p =
+                    B.readFile p >>= \original ->
+                        let (Right sigKey) = signatureKeyFromBytes original
+                            serialized = signatureKeyToBytes sigKey
+                         in do
+                                -- They should decode to the same structure.  This
+                                -- has the advantage of representing differences a
+                                -- little more transparently than the next
+                                -- assertion.
+                                assertEqual
+                                    "decodeASN1 original /= decodeASN1 serialized"
+                                    (decodeASN1' DER original)
+                                    (decodeASN1' DER serialized)
+                                -- Also check the raw bytes in case there
+                                -- are different representations of the
+                                -- structure possible.  The raw bytes
+                                -- matter because we hash them in key
+                                -- derivations.
+                                assertEqual "original /= serialized" original serialized
+            -- Check them all
+            mapM_ checkSignatureRoundTrip keyPaths
         , testCase "derived keys equal known-correct values" $
             -- The path is relative to the root of the package, which is where
             -- at least some test runners will run the test process.  If
             B.readFile "test/data/rsa-privkey-0.der" >>= \privBytes ->
-                let (Just iv) = Keys.SDMF_IV <$> makeIV (B.replicate 16 0x42)
-                    expectedWriteKey = ("ae6e6cgcllhty4z5l4dp5v7gee" :: T.Text)
-                    expectedReadKey = ("rbx5xh5rztefvazy7sq32sw34y" :: T.Text)
-                    expectedDataKey = ("4ay4y6itvk7cvynpyok3qmxf5y" :: T.Text)
+                let -- Load the test key.
+                    (Right sigKey) = signatureKeyFromBytes privBytes
+
+                    -- Hard-code the expected result.
+                    expectedWriteKey = ("v7iymuxkc5yv2fomi3xwbjdd4e" :: T.Text)
+                    expectedReadKey = ("6ir6husgx6ubro3tbimmzskqri" :: T.Text)
+                    expectedDataKey = ("bbj67exlrkfcaqutwlgwvukbfe" :: T.Text)
 
-                    (Right asn1s) = decodeASN1' DER privBytes
-                    (Right (PrivKeyRSA privKey, [])) = fromASN1 asn1s
-                    (Just w@(Keys.Write _ derivedWriteKey)) = Keys.deriveWriteKey (Keys.Signature privKey)
+                    -- Derive all the keys.
+                    (Just iv) = Keys.SDMF_IV <$> makeIV (B.replicate 16 0x42)
+                    (Just w@(Keys.Write _ derivedWriteKey)) = Keys.deriveWriteKey sigKey
                     (Just r@(Keys.Read _ derivedReadKey)) = Keys.deriveReadKey w
                     (Just d@(Keys.Data _ derivedDataKey)) = Keys.deriveDataKey iv r
 
-                    -- Format a key as text for convenient comparison to
-                    -- expected value.
+                    -- A helper to format a key as text for convenient
+                    -- comparison to expected value.
                     fmtKey = T.toLower . encodeBase32Unpadded . ByteArray.convert
                  in do
                         -- In general it might make more sense to convert expected