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