From 7768651e125c8d85e4c0bf582726c158f6ae3297 Mon Sep 17 00:00:00 2001 From: Jean-Paul Calderone <exarkun@twistedmatrix.com> Date: Tue, 9 May 2023 11:32:11 -0400 Subject: [PATCH] Start a test suite Just a round-trip-through Binary test for now --- make-keypairs/Main.hs | 27 ++++++++++ make-keypairs/Main.hs~ | 29 ++++++++++ src/Tahoe/SDMF/Internal/Share.hs | 1 + tahoe-ssk.cabal | 30 ++++++++++- test/Generators.hs | 90 +++++++++++++++++++++++++++++++ test/Main.hs | 34 +++++++++++- test/data/rsa-privkey-0.der | Bin 0 -> 806 bytes test/data/rsa-privkey-1.der | Bin 0 -> 806 bytes test/data/rsa-privkey-2.der | Bin 0 -> 806 bytes test/data/rsa-privkey-3.der | Bin 0 -> 806 bytes test/data/rsa-privkey-4.der | Bin 0 -> 806 bytes 11 files changed, 209 insertions(+), 2 deletions(-) create mode 100644 make-keypairs/Main.hs create mode 100644 make-keypairs/Main.hs~ create mode 100644 test/Generators.hs create mode 100644 test/data/rsa-privkey-0.der create mode 100644 test/data/rsa-privkey-1.der create mode 100644 test/data/rsa-privkey-2.der create mode 100644 test/data/rsa-privkey-3.der create mode 100644 test/data/rsa-privkey-4.der diff --git a/make-keypairs/Main.hs b/make-keypairs/Main.hs new file mode 100644 index 0000000..c537ae4 --- /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 0000000..d04d160 --- /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 392cdf4..9f87734 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 742d149..d318e7e 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 0000000..98bfba0 --- /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 3e2059e..eceb1e6 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 GIT binary patch literal 806 zcmV+>1KIpAf&(G~0RRGm0RaHK=q`79=%QG_z(lg4Dsw15L$^dtyk8BpKxZ6#Q0Soz zN{`SKG);)Zab>;SdzJ-v2TCdqMrS!O<`FS$xP+lzu`%rPH68jplmsEDoE@%YiI9%l zhml)K`>7iqBi>xisDWth_Lui25-#?7Yk#%J%c<2aMn(KL_&(W70)Ofwdy+&PN!;5C zaWH7D$RoyE=B+TZ_kH9cijZX^n@!Gq4Wv|-_ONy6*)m|E?}b!V`|w>D^~`H{JNCWx zGFGs3XjSg*34a>E@3wADAv2|QQm<;}DSgoO3yVY{Gu)y(DJVc?j#6pm3s4?}=eHX4 zYzx4<KR#_ZjBX5EMAIt*0|5X50)hbmPgdZyGrZ#Zjj{6RXF?I}lx&w<E1vTCDST%V z5=77cTspO#`R-w+5EtKAS908TT_A<1mMB4xM*+^X$Z68zhljdlKU_}3+avaTKzW%7 zww44<%d6{y!9imy&4bwwcO1`!M|5i})gz1V-$<zOs{ujE6i!uiartCK6#4GRsfHG# z7WxR6L@wf*gG?#)88&&f=A@oWI`Y5FH=*K1O4h(Mr?<;9sG_Y&VB;{;1affKJmjpF zGeg2q{3t2|dSg8<z_CAkxs%`TOu#jJS@T|oQa(tbNW19oQUdjN+WaYGcoqu)M8MHd z0xP^teyhi@EW`)cn7Qa)x^kQe0)c@5>#0dWrGSt(L+IVVr;(^9=K`Q7!8B99EQT-B z{XL^}I3>ks>Te?W9z9at53N&jMGlV_Ff)etY?CcTdi2Rz3k|WoyS@XVVVGT8r7j6< z0ay=F7Bh+J*X~+dg2MO7iL_zQtY>xOf+X7O?}V9>r|+KcmXo}rALG`!>Y7gn0)c@5 z%{Av9XdXH}gkp{q3@_B5r9ZIO^8z;4RP5>iw_gL&wH(;TMW2HT<dqs)%6DMu8E)RY zdn9xsWr~6gtc0$K>u6Cs21O;DV}khd{e>|qvc3lYBk6XLN!{!L<_3S?1<(-^a+2kg kv&no{leEP`2w(d8L^RyRkHleU-kI&a0s#O50RRF406!pt<p2Nx literal 0 HcmV?d00001 diff --git a/test/data/rsa-privkey-1.der b/test/data/rsa-privkey-1.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab GIT binary patch literal 806 zcmV+>1KIpAf&(G~0RRGm0RaHK=q`79=%QG_z(lg4Dsw15L$^dtyk8BpKxZ6#Q0Soz zN{`SKG);)Zab>;SdzJ-v2TCdqMrS!O<`FS$xP+lzu`%rPH68jplmsEDoE@%YiI9%l zhml)K`>7iqBi>xisDWth_Lui25-#?7Yk#%J%c<2aMn(KL_&(W70)Ofwdy+&PN!;5C zaWH7D$RoyE=B+TZ_kH9cijZX^n@!Gq4Wv|-_ONy6*)m|E?}b!V`|w>D^~`H{JNCWx zGFGs3XjSg*34a>E@3wADAv2|QQm<;}DSgoO3yVY{Gu)y(DJVc?j#6pm3s4?}=eHX4 zYzx4<KR#_ZjBX5EMAIt*0|5X50)hbmPgdZyGrZ#Zjj{6RXF?I}lx&w<E1vTCDST%V z5=77cTspO#`R-w+5EtKAS908TT_A<1mMB4xM*+^X$Z68zhljdlKU_}3+avaTKzW%7 zww44<%d6{y!9imy&4bwwcO1`!M|5i})gz1V-$<zOs{ujE6i!uiartCK6#4GRsfHG# z7WxR6L@wf*gG?#)88&&f=A@oWI`Y5FH=*K1O4h(Mr?<;9sG_Y&VB;{;1affKJmjpF zGeg2q{3t2|dSg8<z_CAkxs%`TOu#jJS@T|oQa(tbNW19oQUdjN+WaYGcoqu)M8MHd z0xP^teyhi@EW`)cn7Qa)x^kQe0)c@5>#0dWrGSt(L+IVVr;(^9=K`Q7!8B99EQT-B z{XL^}I3>ks>Te?W9z9at53N&jMGlV_Ff)etY?CcTdi2Rz3k|WoyS@XVVVGT8r7j6< z0ay=F7Bh+J*X~+dg2MO7iL_zQtY>xOf+X7O?}V9>r|+KcmXo}rALG`!>Y7gn0)c@5 z%{Av9XdXH}gkp{q3@_B5r9ZIO^8z;4RP5>iw_gL&wH(;TMW2HT<dqs)%6DMu8E)RY zdn9xsWr~6gtc0$K>u6Cs21O;DV}khd{e>|qvc3lYBk6XLN!{!L<_3S?1<(-^a+2kg kv&no{leEP`2w(d8L^RyRkHleU-kI&a0s#O50RRF406!pt<p2Nx literal 0 HcmV?d00001 diff --git a/test/data/rsa-privkey-2.der b/test/data/rsa-privkey-2.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab GIT binary patch literal 806 zcmV+>1KIpAf&(G~0RRGm0RaHK=q`79=%QG_z(lg4Dsw15L$^dtyk8BpKxZ6#Q0Soz zN{`SKG);)Zab>;SdzJ-v2TCdqMrS!O<`FS$xP+lzu`%rPH68jplmsEDoE@%YiI9%l zhml)K`>7iqBi>xisDWth_Lui25-#?7Yk#%J%c<2aMn(KL_&(W70)Ofwdy+&PN!;5C zaWH7D$RoyE=B+TZ_kH9cijZX^n@!Gq4Wv|-_ONy6*)m|E?}b!V`|w>D^~`H{JNCWx zGFGs3XjSg*34a>E@3wADAv2|QQm<;}DSgoO3yVY{Gu)y(DJVc?j#6pm3s4?}=eHX4 zYzx4<KR#_ZjBX5EMAIt*0|5X50)hbmPgdZyGrZ#Zjj{6RXF?I}lx&w<E1vTCDST%V z5=77cTspO#`R-w+5EtKAS908TT_A<1mMB4xM*+^X$Z68zhljdlKU_}3+avaTKzW%7 zww44<%d6{y!9imy&4bwwcO1`!M|5i})gz1V-$<zOs{ujE6i!uiartCK6#4GRsfHG# z7WxR6L@wf*gG?#)88&&f=A@oWI`Y5FH=*K1O4h(Mr?<;9sG_Y&VB;{;1affKJmjpF zGeg2q{3t2|dSg8<z_CAkxs%`TOu#jJS@T|oQa(tbNW19oQUdjN+WaYGcoqu)M8MHd z0xP^teyhi@EW`)cn7Qa)x^kQe0)c@5>#0dWrGSt(L+IVVr;(^9=K`Q7!8B99EQT-B z{XL^}I3>ks>Te?W9z9at53N&jMGlV_Ff)etY?CcTdi2Rz3k|WoyS@XVVVGT8r7j6< z0ay=F7Bh+J*X~+dg2MO7iL_zQtY>xOf+X7O?}V9>r|+KcmXo}rALG`!>Y7gn0)c@5 z%{Av9XdXH}gkp{q3@_B5r9ZIO^8z;4RP5>iw_gL&wH(;TMW2HT<dqs)%6DMu8E)RY zdn9xsWr~6gtc0$K>u6Cs21O;DV}khd{e>|qvc3lYBk6XLN!{!L<_3S?1<(-^a+2kg kv&no{leEP`2w(d8L^RyRkHleU-kI&a0s#O50RRF406!pt<p2Nx literal 0 HcmV?d00001 diff --git a/test/data/rsa-privkey-3.der b/test/data/rsa-privkey-3.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab GIT binary patch literal 806 zcmV+>1KIpAf&(G~0RRGm0RaHK=q`79=%QG_z(lg4Dsw15L$^dtyk8BpKxZ6#Q0Soz zN{`SKG);)Zab>;SdzJ-v2TCdqMrS!O<`FS$xP+lzu`%rPH68jplmsEDoE@%YiI9%l zhml)K`>7iqBi>xisDWth_Lui25-#?7Yk#%J%c<2aMn(KL_&(W70)Ofwdy+&PN!;5C zaWH7D$RoyE=B+TZ_kH9cijZX^n@!Gq4Wv|-_ONy6*)m|E?}b!V`|w>D^~`H{JNCWx zGFGs3XjSg*34a>E@3wADAv2|QQm<;}DSgoO3yVY{Gu)y(DJVc?j#6pm3s4?}=eHX4 zYzx4<KR#_ZjBX5EMAIt*0|5X50)hbmPgdZyGrZ#Zjj{6RXF?I}lx&w<E1vTCDST%V z5=77cTspO#`R-w+5EtKAS908TT_A<1mMB4xM*+^X$Z68zhljdlKU_}3+avaTKzW%7 zww44<%d6{y!9imy&4bwwcO1`!M|5i})gz1V-$<zOs{ujE6i!uiartCK6#4GRsfHG# z7WxR6L@wf*gG?#)88&&f=A@oWI`Y5FH=*K1O4h(Mr?<;9sG_Y&VB;{;1affKJmjpF zGeg2q{3t2|dSg8<z_CAkxs%`TOu#jJS@T|oQa(tbNW19oQUdjN+WaYGcoqu)M8MHd z0xP^teyhi@EW`)cn7Qa)x^kQe0)c@5>#0dWrGSt(L+IVVr;(^9=K`Q7!8B99EQT-B z{XL^}I3>ks>Te?W9z9at53N&jMGlV_Ff)etY?CcTdi2Rz3k|WoyS@XVVVGT8r7j6< z0ay=F7Bh+J*X~+dg2MO7iL_zQtY>xOf+X7O?}V9>r|+KcmXo}rALG`!>Y7gn0)c@5 z%{Av9XdXH}gkp{q3@_B5r9ZIO^8z;4RP5>iw_gL&wH(;TMW2HT<dqs)%6DMu8E)RY zdn9xsWr~6gtc0$K>u6Cs21O;DV}khd{e>|qvc3lYBk6XLN!{!L<_3S?1<(-^a+2kg kv&no{leEP`2w(d8L^RyRkHleU-kI&a0s#O50RRF406!pt<p2Nx literal 0 HcmV?d00001 diff --git a/test/data/rsa-privkey-4.der b/test/data/rsa-privkey-4.der new file mode 100644 index 0000000000000000000000000000000000000000..ad64c6304d32d06ba74f9a9234de2cd14a6820ab GIT binary patch literal 806 zcmV+>1KIpAf&(G~0RRGm0RaHK=q`79=%QG_z(lg4Dsw15L$^dtyk8BpKxZ6#Q0Soz zN{`SKG);)Zab>;SdzJ-v2TCdqMrS!O<`FS$xP+lzu`%rPH68jplmsEDoE@%YiI9%l zhml)K`>7iqBi>xisDWth_Lui25-#?7Yk#%J%c<2aMn(KL_&(W70)Ofwdy+&PN!;5C zaWH7D$RoyE=B+TZ_kH9cijZX^n@!Gq4Wv|-_ONy6*)m|E?}b!V`|w>D^~`H{JNCWx zGFGs3XjSg*34a>E@3wADAv2|QQm<;}DSgoO3yVY{Gu)y(DJVc?j#6pm3s4?}=eHX4 zYzx4<KR#_ZjBX5EMAIt*0|5X50)hbmPgdZyGrZ#Zjj{6RXF?I}lx&w<E1vTCDST%V z5=77cTspO#`R-w+5EtKAS908TT_A<1mMB4xM*+^X$Z68zhljdlKU_}3+avaTKzW%7 zww44<%d6{y!9imy&4bwwcO1`!M|5i})gz1V-$<zOs{ujE6i!uiartCK6#4GRsfHG# z7WxR6L@wf*gG?#)88&&f=A@oWI`Y5FH=*K1O4h(Mr?<;9sG_Y&VB;{;1affKJmjpF zGeg2q{3t2|dSg8<z_CAkxs%`TOu#jJS@T|oQa(tbNW19oQUdjN+WaYGcoqu)M8MHd z0xP^teyhi@EW`)cn7Qa)x^kQe0)c@5>#0dWrGSt(L+IVVr;(^9=K`Q7!8B99EQT-B z{XL^}I3>ks>Te?W9z9at53N&jMGlV_Ff)etY?CcTdi2Rz3k|WoyS@XVVVGT8r7j6< z0ay=F7Bh+J*X~+dg2MO7iL_zQtY>xOf+X7O?}V9>r|+KcmXo}rALG`!>Y7gn0)c@5 z%{Av9XdXH}gkp{q3@_B5r9ZIO^8z;4RP5>iw_gL&wH(;TMW2HT<dqs)%6DMu8E)RY zdn9xsWr~6gtc0$K>u6Cs21O;DV}khd{e>|qvc3lYBk6XLN!{!L<_3S?1<(-^a+2kg kv&no{leEP`2w(d8L^RyRkHleU-kI&a0s#O50RRF406!pt<p2Nx literal 0 HcmV?d00001 -- GitLab