Start a test suite

Just a round-trip-through Binary test for now

make-keypairs/Main.hs

+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

make-keypairs/Main.hs~

+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

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)

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:
+    , 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

test/Generators.hs

+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)

test/Main.hs

 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