Fix DSA test generation.

This commit is contained in:
2019-03-07 16:26:46 -07:00
parent 9d2e56ad06
commit 40254014d3
9 changed files with 5250 additions and 26 deletions

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

View File

@@ -6,15 +6,23 @@ module Database(
)
where
import "cryptonite" Crypto.Random(DRG(..),SystemDRG)
import "crypto-api" Crypto.Random(CryptoRandomGen(..),SystemRandom)
import "cryptonite" Crypto.Random(DRG(..))
import Data.ByteArray(convert)
import Data.Bits(shiftL,testBit)
import qualified Data.ByteString as S
import Data.Map.Strict(Map)
import qualified Data.Map.Strict as Map
type Database = (Map String [Integer], SystemDRG)
type Database = (Map String [Integer], SystemRandom)
emptyDatabase :: SystemDRG -> Database
instance DRG SystemRandom where
randomBytesGenerate x g =
case genBytes x g of
Left e -> error ("Data generation error: " ++ show e)
Right (res, g') -> (convert res, g')
emptyDatabase :: SystemRandom -> Database
emptyDatabase g0 = (Map.empty, g0)
generateNum :: Database -> String -> Int -> (Integer, Database)

View File

@@ -5,7 +5,7 @@ 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 "cryptonite" Crypto.Random(SystemDRG,getSystemDRG)
import "crypto-api" Crypto.Random(CryptoRandomGen(..),SystemRandom)
import DSA(dsaTasks)
import ECDSATesting(ecdsaTasks)
import GHC.Conc(getNumCapabilities)
@@ -14,7 +14,7 @@ import RSA(rsaTasks)
import System.Console.AsciiProgress
import Task(Task, runTask)
taskExecutor :: MVar [Task] -> Chan () -> SystemDRG -> IO SystemDRG
taskExecutor :: MVar [Task] -> Chan () -> SystemRandom -> IO SystemRandom
taskExecutor taskList done gen =
do mnext <- modifyMVar taskList (\case
[] -> return ([], Nothing)
@@ -27,7 +27,7 @@ taskExecutor taskList done gen =
spawnExecutor :: MVar [Task] -> Chan () -> IO ()
spawnExecutor tasks done =
do gen <- getSystemDRG
do gen <- newGenIO
void (forkIO (catch (void (taskExecutor tasks done gen)) handler))
where
handler :: SomeException -> IO ()

View File

@@ -3,7 +3,8 @@ module RSA(rsaTasks)
where
import Crypto.Hash(SHA224(..),SHA256(..),SHA384(..),SHA512(..))
import "cryptonite" Crypto.Random
import "cryptonite" Crypto.Random(MonadRandom,MonadPseudoRandom,getRandomBytes,withDRG)
import "crypto-api" Crypto.Random(SystemRandom)
import Crypto.PubKey.MaskGenFunction(mgf1)
import Crypto.PubKey.RSA
import Crypto.PubKey.RSA.PKCS15(sign)
@@ -61,7 +62,7 @@ signTest sz cnt = Task {
("m", showBin msg),
("s", showBin sig)], n)
withDRG' :: Database -> MonadPseudoRandom SystemDRG (Map String String, Integer) ->
withDRG' :: Database -> MonadPseudoRandom SystemRandom (Map String String, Integer) ->
(Map String String, Integer, Database)
withDRG' (memory, drg) action =
let ((res, n), drg') = withDRG drg action

View File

@@ -7,7 +7,7 @@ module Task(
where
import Control.Monad(foldM, forM_)
import "cryptonite" Crypto.Random(SystemDRG)
import "crypto-api" Crypto.Random(SystemRandom)
import qualified Data.Map.Strict as Map
import Database
import System.Console.AsciiProgress
@@ -24,7 +24,7 @@ data Task = Task {
taskCount :: Int
}
runTask :: SystemDRG -> Task -> IO SystemDRG
runTask :: SystemRandom -> Task -> IO SystemRandom
runTask gen task =
do createDirectoryIfMissing True (takeDirectory (taskFile task))
alreadyDone <- doesFileExist (taskFile task)