acw/simple_crypto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix DSA test generation.

Browse Source
This commit is contained in:
Adam Wick
2019-03-07 16:26:46 -07:00
parent 9d2e56ad06
commit 40254014d3
9 changed files with 5250 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
test-generator/DSA.hs
View File

@@ -4,15 +4,13 @@ module DSA(dsaTasks)
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(..), SystemRandom)
import "cryptonite" Crypto.Random(DRG(..),getRandomBytes,withDRG)
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 System.IO.Unsafe(unsafePerformIO)
import Task(Task(..),Test)
import Utils(HashAlg(..),generateHash,showHash)
@@ -30,32 +28,38 @@ dsaTasks = concatMap generateTask dsaSizes
generateTask :: (ParameterSizes, Int) -> [Task]
generateTask (s, c) = [signTest s c]
showParam :: ParameterSizes -> String
showParam L1024_N160 = "L1024N160"
showParam L2048_N224 = "L2048N224"
showParam L2048_N256 = "L2048N256"
showParam L3072_N256 = "L3072N256"
signTest :: ParameterSizes -> Int -> Task
signTest sz cnt = Task {
taskName = "DSA " ++ show sz ++ " signing",
taskFile = "../testdata/dsa/sign" ++ show sz ++ ".test",
taskFile = "../testdata/dsa/sign" ++ showParam sz ++ ".test",
taskTest = go,
taskCount = cnt
}
where
go :: Test
go (memory, drg0) =
case generateProbablePrimes sz (unsafePerformIO (newGenIO :: IO SystemRandom)) sha256 Nothing of
case generateProbablePrimes sz drg0 sha256 Nothing of
Left _ -> trace "generate primes" $ goAdvance memory drg0
Right (p, q, _, gen1) ->
Right (p, q, _, drg1) ->
case generateUnverifiableGenerator p q of
Nothing -> trace "generate g" $ goAdvance memory drg0
Nothing -> trace "generate g" $ goAdvance memory drg1
Just g ->
let params = Params p g q
in case generateKeyPairWithParams params gen1 of
Left _ -> trace "generate key" $ goAdvance memory drg0
Right (pub, priv, gen1) ->
let (msg, drg1) = withDRG drg0 $ getRandomBytes =<< ((fromIntegral . BS.head) `fmap` getRandomBytes 1)
(hashf, drg2) = withDRG drg1 generateHash
in case signMessage' (translateHash hashf) kViaRFC6979 gen1 priv (BSL.fromStrict msg) of
in case generateKeyPairWithParams params drg1 of
Left _ -> trace "generate key" $ goAdvance memory drg1
Right (pub, priv, drg2) ->
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, drg2)
Right (sig, _) ->
trace "sign failure" $ go (memory, drg4)
Right (sig, drg5) ->
let res = Map.fromList [("p", showX p),
("q", showX q),
("g", showX g),
@@ -65,7 +69,7 @@ signTest sz cnt = Task {
("h", showHash hashf),
("r", showX (sign_r sig)),
("s", showX (sign_s sig))]
in (res, p, (memory, drg2))
in (res, p, (memory, drg5))
--
goAdvance memory drg0 =
let (bstr, drg1) = randomBytesGenerate 37 drg0