diff --git a/make-keypairs/Main.hs b/make-keypairs/Main.hs new file mode 100644 index 0000000000000000000000000000000000000000..c537ae4d3420c2c0ee42f80ac67c4d3cd281cd2b --- /dev/null +++ b/make-keypairs/Main.hs @@ -0,0 +1,27 @@ +module Main where + +import Codec.Crypto.RSA (generateKeyPair) +import Crypto.Random (CryptoRandomGen (newGenIO), SystemRandom) +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 + +-- | The size of the keys to generate. +bits :: Int +bits = 2048 + +-- | The number of keys to generate. +count :: Int +count = 5 + +main :: IO () +main = do + g <- newGenIO :: IO SystemRandom + mapM_ (genKey g) [0 .. count - 1] + +genKey :: (Show a, CryptoRandomGen c) => c -> a -> IO () +genKey g n = + let (_, priv, _) = generateKeyPair g bits + bytes = encodeASN1 DER (toASN1 priv []) + in LB.writeFile ("test/data/rsa-privkey-" <> show n <> ".der") bytes diff --git a/make-keypairs/Main.hs~ b/make-keypairs/Main.hs~ new file mode 100644 index 0000000000000000000000000000000000000000..d04d160e7a7c780d18d15eccde4b7069c393f653 --- /dev/null +++ b/make-keypairs/Main.hs~ @@ -0,0 +1,29 @@ +module Main where + +import Codec.Crypto.RSA (generateKeyPair) +import Crypto.Random (CryptoRandomGen (newGenIO), SystemRandom) +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 + +-- | The size of the keys to generate. +bits :: Int +bits = 2048 + +-- | The number of keys to generate. +count :: Int +count = 5 + +main :: IO () +main = do + g <- newGenIO :: IO SystemRandom + mapM_ (genKey g) [0 .. count - 1] + +genKey :: (Show a, CryptoRandomGen c) => c -> a -> IO () +genKey g n = + let + (_, priv, _) = generateKeyPair g bits + bytes = encodeASN1 DER (toASN1 priv []) + in + LB.writeFile ("key-" <> show n <> ".der") bytes diff --git a/src/Tahoe/SDMF/Internal/Share.hs b/src/Tahoe/SDMF/Internal/Share.hs index 392cdf44f22abcd9d6c29884e649d33614570f5d..9f87734ae23952f05e21f7b539086c9c0e9c6ec8 100644 --- a/src/Tahoe/SDMF/Internal/Share.hs +++ b/src/Tahoe/SDMF/Internal/Share.hs @@ -51,3 +51,4 @@ data Share = Share , -- | The encrypted 2048 bit "signature" RSA key. shareEncryptedPrivateKey :: B.ByteString } + deriving (Show) diff --git a/tahoe-ssk.cabal b/tahoe-ssk.cabal index 742d1498c010fcd77883e54260aaacd88909bb44..d318e7efb4657494ed2bcaeddd6291514b130338 100644 --- a/tahoe-ssk.cabal +++ b/tahoe-ssk.cabal @@ -100,8 +100,36 @@ test-suite tahoe-ssk-test -- The entrypoint to the test suite. main-is: Main.hs + other-modules: Generators -- Test dependencies. build-depends: - , base ^>=4.14.3.0 + , asn1-encoding + , asn1-types + , base ^>=4.14.3.0 + , binary + , bytestring + , crypto-api + , crypto-pubkey-types + , cryptonite + , hedgehog + , RSA + , tahoe-chk , tahoe-ssk + , tasty + , tasty-hedgehog + +-- A helper for generating RSA key pairs for use by the test suite. +executable make-keypairs + import: warnings + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: make-keypairs + build-depends: + , asn1-encoding + , asn1-types + , base + , bytestring + , crypto-api + , crypto-pubkey-types + , RSA diff --git a/test/Generators.hs b/test/Generators.hs new file mode 100644 index 0000000000000000000000000000000000000000..98bfba02a9a2fc4995592e2f839a3586af54a929 --- /dev/null +++ b/test/Generators.hs @@ -0,0 +1,90 @@ +module Generators where + +import Crypto.Hash (HashAlgorithm (hashDigestSize)) +import Crypto.Hash.Algorithms (SHA256 (SHA256)) +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 (Word8) +import GHC.IO.Unsafe (unsafePerformIO) +import Hedgehog (MonadGen) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Tahoe.CHK.Merkle (MerkleTree (..), makeTreePartial) +import Tahoe.SDMF (Share (..)) + +rootHashLength :: Int +rootHashLength = undefined + +ivLength :: Int +ivLength = undefined + +signatureLength :: Int +signatureLength = undefined + +{- | Generate SDMF shares. The contents of the share are not necessarily + semantically valid. +-} +shares :: MonadGen m => m Share +shares = + genRSAKeys >>= \keypair -> + Share + <$> Gen.word64 Range.exponentialBounded -- shareSequenceNumber + <*> Gen.bytes (Range.singleton rootHashLength) -- shareRootHash + <*> (IV <$> Gen.bytes (Range.singleton ivLength)) -- shareIV + <*> Gen.word8 Range.exponentialBounded -- shareTotalShares + <*> Gen.word8 Range.exponentialBounded -- shareRequiredShares + <*> Gen.word64 Range.exponentialBounded -- shareSegmentSize + <*> Gen.word64 Range.exponentialBounded -- shareDataLength + <*> pure (RSA.toPublicKey keypair) -- shareVerificationKey + <*> Gen.bytes (Range.singleton signatureLength) -- shareSignature + <*> shareHashChains -- shareHashChain + <*> merkleTrees (Range.singleton 1) -- shareBlockHashTree + <*> (LB.fromStrict <$> Gen.bytes (Range.exponential 0 1024)) -- shareData + <*> (pure . LB.toStrict . toDER . RSA.toPrivateKey) keypair -- sharePrivateKey + where + toDER = encodeASN1 DER . flip toASN1 [] + +{- | Build RSA key pairs. + + Because the specific bits of the key pair shouldn't make any difference to + any application logic, generating new RSA key pairs is expensive, and + generating new RSA key pairs in a way that makes sense in Hedgehog is + challenging, this implementation just knows a few RSA key pairs already and + will give back one of them. +-} +genRSAKeys :: MonadGen m => m RSA.KeyPair +genRSAKeys = Gen.element (map rsaKeyPair rsaKeyPairBytes) + +-- I'm not sure how to do IO in MonadGen so do the IO up front unsafely (but +-- hopefully not really unsafely). +rsaKeyPairBytes :: [LB.ByteString] +{-# NOINLINE rsaKeyPairBytes #-} +rsaKeyPairBytes = unsafePerformIO $ mapM (\n -> LB.readFile ("test/data/rsa-privkey-" <> show n <> ".der")) [0 .. 4 :: Int] + +rsaKeyPair :: LB.ByteString -> RSA.KeyPair +rsaKeyPair bs = do + let (Right kp) = do + asn1s <- first show (decodeASN1 DER bs) + (r, _) <- fromASN1 asn1s + pure r + kp + +merkleTrees :: MonadGen m => Range.Range Int -> m MerkleTree +merkleTrees r = makeTreePartial <$> Gen.list r genHash + +-- | Generate ByteStrings which could be sha256d digests. +genHash :: MonadGen m => m B.ByteString +genHash = Gen.bytes . Range.singleton . hashDigestSize $ SHA256 + +-- | Generate lists of two-tuples of share identifier and share root hash. +shareHashChains :: MonadGen m => m [(Word8, B.ByteString)] +shareHashChains = Gen.list range element + where + range = Range.exponential 1 5 + element = (,) <$> Gen.integral (Range.exponential 1 255) <*> Gen.bytes (Range.singleton 32) diff --git a/test/Main.hs b/test/Main.hs index 3e2059e31f5127521b263b051fc7247772685e1a..eceb1e6e6da4bdf73538c7727ce6568a602ca50b 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,4 +1,36 @@ module Main (main) where +import Hedgehog ( + Property, + forAll, + property, + tripping, + ) + +import qualified Data.Binary as Binary +import Generators (shares) +import System.IO (hSetEncoding, stderr, stdout, utf8) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.Hedgehog (testProperty) + +tests :: TestTree +tests = + testGroup + "SSK" + [ testProperty "round-trips through bytes" $ + property $ do + let decode' = ((\(_, _, sh) -> sh) <$>) . Binary.decodeOrFail + share <- forAll shares + tripping share Binary.encode decode' + pure () + ] + main :: IO () -main = putStrLn "Test suite not yet implemented." +main = do + -- Hedgehog writes some non-ASCII and the whole test process will die if + -- it can't be encoded. Increase the chances that all of the output can + -- be encoded by forcing the use of UTF-8 (overriding the LANG-based + -- choice normally made). + hSetEncoding stdout utf8 + hSetEncoding stderr utf8 + defaultMain tests diff --git a/test/data/rsa-privkey-0.der b/test/data/rsa-privkey-0.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab Binary files /dev/null and b/test/data/rsa-privkey-0.der differ diff --git a/test/data/rsa-privkey-1.der b/test/data/rsa-privkey-1.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab Binary files /dev/null and b/test/data/rsa-privkey-1.der differ diff --git a/test/data/rsa-privkey-2.der b/test/data/rsa-privkey-2.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab Binary files /dev/null and b/test/data/rsa-privkey-2.der differ diff --git a/test/data/rsa-privkey-3.der b/test/data/rsa-privkey-3.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab Binary files /dev/null and b/test/data/rsa-privkey-3.der differ diff --git a/test/data/rsa-privkey-4.der b/test/data/rsa-privkey-4.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab Binary files /dev/null and b/test/data/rsa-privkey-4.der differ