Fix DSA test generation.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user