A start at DSA test case generation.

test-generator/DSA.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE PackageImports #-}
+module DSA(dsaTasks)
+ where
+
+import Codec.Crypto.DSA.Pure
+import Crypto.Hash(Digest, SHA256, hash)
+import "cryptonite" Crypto.Random(SystemDRG,DRG(..),getRandomBytes,withDRG)
+import "crypto-api" Crypto.Random(CryptoRandomGen(..))
+import Data.ByteArray(convert)
+import qualified Data.ByteString as BS
+import Data.ByteString.Lazy(ByteString)
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.Map.Strict as Map
+import Math(showX,showBin)
+import Task(Task(..),Test)
+import Utils(HashAlg(..),generateHash,showHash)
+
+import Debug.Trace
+
+instance CryptoRandomGen SystemDRG where
+  newGen _ = undefined
+  genSeedLength = undefined
+  genBytes l g = Right (randomBytesGenerate l g)
+  reseedInfo = undefined
+  reseedPeriod = undefined
+  genBytesWithEntropy l _ g = Right (randomBytesGenerate l g)
+  reseed = undefined
+  newGenIO = undefined
+
+dsaSizes :: [(ParameterSizes, Int)]
+dsaSizes = [(L1024_N160, 400),
+            (L2048_N224, 100),
+            (L2048_N256,  50),
+            (L3072_N256,  25)]
+
+dsaTasks :: [Task]
+dsaTasks = concatMap generateTask dsaSizes
+
+generateTask :: (ParameterSizes, Int) -> [Task]
+generateTask (s, c) = [signTest s c]
+
+signTest :: ParameterSizes -> Int -> Task
+signTest sz cnt = Task {
+    taskName = "DSA " ++ show sz ++ " signing",
+    taskFile = "../testdata/dsa/sign" ++ show sz ++ ".test",
+    taskTest = go,
+    taskCount = cnt
+  }
+ where
+  go :: Test
+  go (memory, drg0) =
+    case generateProvablePrimes sz drg0 sha256 Nothing of
+      Left _ -> trace "generate primes" $ goAdvance memory drg0
+      Right (p, q, _, drg1) -> trace "got primes" $
+        case generateUnverifiableGenerator p q of
+          Nothing -> trace "generate g" $ goAdvance memory drg1
+          Just g -> trace "got g" $
+            let params = Params p g q
+            in case generateKeyPairWithParams params drg1 of
+                 Left _ -> trace "generate key" $ goAdvance memory drg1
+                 Right (pub, priv, drg2) -> trace "got keys" $
+                   let (msg, drg3) = withDRG drg2 $ getRandomBytes =<< ((fromIntegral . BS.head) `fmap` getRandomBytes 1)
+                       (hashf, drg4) = withDRG drg3 generateHash
+                   in case signMessage' (translateHash hashf) kViaRFC6979 drg4 priv (BSL.fromStrict msg) of
+                        Left _ ->
+                          trace "sign failure" $ go (memory, drg4)
+                        Right (sig, drg5) -> trace "output!" $
+                          let res = Map.fromList [("p", showX p),
+                                                  ("q", showX q),
+                                                  ("g", showX g),
+                                                  ("y", showX (public_y pub)),
+                                                  ("x", showX (private_x priv)),
+                                                  ("m", showBin msg),
+                                                  ("h", showHash hashf),
+                                                  ("r", showX (sign_r sig)),
+                                                  ("s", showX (sign_s sig))]
+                          in (res, p, (memory, drg5))
+  --
+  goAdvance memory drg0 =
+    let (bstr, drg1) = randomBytesGenerate 37 drg0
+    in BS.null bstr `seq` go (memory, drg1)
+  --
+  translateHash Sha224 = Codec.Crypto.DSA.Pure.SHA224
+  translateHash Sha256 = Codec.Crypto.DSA.Pure.SHA256
+  translateHash Sha384 = Codec.Crypto.DSA.Pure.SHA384
+  translateHash Sha512 = Codec.Crypto.DSA.Pure.SHA512
+
+sha256 :: ByteString -> ByteString
+sha256 = BSL.fromStrict . convert' . hash . BSL.toStrict
+ where
+  convert' :: Digest SHA256 -> BS.ByteString
+  convert' = convert

test-generator/Database.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 module Database(
          Database,
          emptyDatabase,
@@ -5,7 +6,7 @@ module Database(
        )
  where
 
-import           Crypto.Random(DRG(..),SystemDRG)
+import "cryptonite" Crypto.Random(DRG(..),SystemDRG)
 import              Data.Bits(shiftL,testBit)
 import qualified    Data.ByteString as S
 import              Data.Map.Strict(Map)

test-generator/ECDSATesting.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 module ECDSATesting(
           ecdsaTasks
        )
@@ -9,7 +10,7 @@ import Crypto.PubKey.ECC.ECDSA(PrivateKey(..),PublicKey(..),Signature(..),signWi
 import Crypto.PubKey.ECC.Generate(generate)
 import Crypto.PubKey.ECC.Prim(scalarGenerate,pointAdd,pointNegate,pointDouble,pointBaseMul,pointMul,pointAddTwoMuls)
 import Crypto.PubKey.ECC.Types(Curve,CurveName(..),Point(..),common_curve,curveSizeBits,ecc_n,getCurveByName)
-import Crypto.Random(DRG(..),getRandomBytes,withDRG)
+import "cryptonite" Crypto.Random(DRG(..),getRandomBytes,withDRG)
 import qualified Data.ByteString as S
 import qualified Data.Map.Strict as Map
 import Math(showX,showBin)

test-generator/Main.hs

@@ -1,10 +1,12 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PackageImports #-}
 import Control.Concurrent(forkIO)
 import Control.Concurrent.Chan(Chan,newChan,readChan,writeChan)
 import Control.Concurrent.MVar(MVar,newMVar,modifyMVar)
 import Control.Exception(SomeException,catch)
 import Control.Monad(replicateM_,void)
-import Crypto.Random(SystemDRG,getSystemDRG)
+import "cryptonite" Crypto.Random(SystemDRG,getSystemDRG)
+import DSA(dsaTasks)
 import ECDSATesting(ecdsaTasks)
 import GHC.Conc(getNumCapabilities)
 import RFC6979(rfcTasks)
@@ -36,6 +38,6 @@ main = displayConsoleRegions $
     do 
        executors <- getNumCapabilities
        done <- newChan
-       tasks <- newMVar (ecdsaTasks ++ rfcTasks ++ rsaTasks)
+       tasks <- newMVar (dsaTasks ++ ecdsaTasks ++ rfcTasks ++ rsaTasks)
        replicateM_ executors (spawnExecutor tasks done)
        replicateM_ executors (void $ readChan done)

test-generator/RFC6979.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 module RFC6979
 --       (
 --         rfcTasks
@@ -7,7 +8,7 @@ module RFC6979
 import Crypto.Hash(SHA224(..),SHA256(..),SHA384(..),SHA512(..))
 import Crypto.MAC.HMAC(HMAC,hmac)
 import Crypto.Number.Generate(generateBetween)
-import Crypto.Random(getRandomBytes,withDRG)
+import "cryptonite" Crypto.Random(getRandomBytes,withDRG)
 import Data.Bits(shiftL,shiftR,(.&.))
 import qualified Data.ByteArray as B
 import qualified Data.ByteString as S

test-generator/RSA.hs

@@ -1,8 +1,9 @@
+{-# LANGUAGE PackageImports #-}
 module RSA(rsaTasks)
  where
 
 import Crypto.Hash(SHA224(..),SHA256(..),SHA384(..),SHA512(..))
-import Crypto.Random
+import "cryptonite" Crypto.Random
 import Crypto.PubKey.MaskGenFunction(mgf1)
 import Crypto.PubKey.RSA
 import Crypto.PubKey.RSA.PKCS15(sign)

test-generator/Task.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 module Task(
          Test,
          Task(..),
@@ -6,7 +7,7 @@ module Task(
  where
 
 import              Control.Monad(foldM, forM_)
-import           Crypto.Random(SystemDRG)
+import "cryptonite" Crypto.Random(SystemDRG)
 import qualified    Data.Map.Strict as Map
 import              Database
 import              System.Console.AsciiProgress

test-generator/Utils.hs

@@ -1,9 +1,10 @@
+{-# LANGUAGE PackageImports #-}
 module Utils(HashAlg(..), generateHash, runHash, showHash)
  where
 
 import Crypto.Hash(Digest,SHA224(..),SHA256(..),SHA384(..),SHA512(..),hash)
 import Crypto.Number.Generate(generateBetween)
-import Crypto.Random(MonadRandom)
+import "cryptonite" Crypto.Random(MonadRandom)
 import qualified Data.ByteArray as B
 import qualified Data.ByteString as S
 import Math(showX)

test-generator/test-generator.cabal

@@ -20,9 +20,9 @@ extra-source-files:  CHANGELOG.md
 
 executable gen-tests
   main-is:             Main.hs
-  other-modules:       Database, ECDSATesting, Math, RFC6979, RSA, Task, Utils
+  other-modules:       Database, DSA, ECDSATesting, Math, RFC6979, RSA, Task, Utils
   -- other-extensions:
-  build-depends:       base >=4.11 && < 4.14, ascii-progress, bytestring, containers, cryptonite, directory, filepath, integer-gmp, memory, random
+  build-depends:       base >=4.11 && < 4.14, ascii-progress, bytestring, containers, crypto-api, cryptonite, directory, DSA, filepath, integer-gmp, memory, random
   hs-source-dirs:      .
   default-language:    Haskell2010
   ghc-options:         -Wall -O2 -threaded -rtsopts -with-rtsopts=-N