From c5e9d4be2583f152c6a97000e38f57cc18734e19 Mon Sep 17 00:00:00 2001 From: Adam Wick Date: Fri, 18 Jan 2019 21:53:52 -0800 Subject: [PATCH] Add test generation for RFC 6979 k value generation. --- test-generator/Main.hs | 3 +- test-generator/Math.hs | 12 +++- test-generator/RFC6979.hs | 112 ++++++++++++++++++++++++++++++++++++++ test-generator/Utils.hs | 34 ++++++++++++ 4 files changed, 158 insertions(+), 3 deletions(-) create mode 100644 test-generator/RFC6979.hs create mode 100644 test-generator/Utils.hs diff --git a/test-generator/Main.hs b/test-generator/Main.hs index d868b9c..6048dd9 100644 --- a/test-generator/Main.hs +++ b/test-generator/Main.hs @@ -7,6 +7,7 @@ import Control.Monad(replicateM_,void) import Crypto.Random(SystemDRG,getSystemDRG) import ECDSATesting(ecdsaTasks) import GHC.Conc(getNumCapabilities) +import RFC6979(rfcTasks) import System.Console.AsciiProgress import Task(Task, runTask) @@ -34,6 +35,6 @@ main = displayConsoleRegions $ do executors <- getNumCapabilities done <- newChan - tasks <- newMVar (ecdsaTasks) + tasks <- newMVar (ecdsaTasks ++ rfcTasks) replicateM_ executors (spawnExecutor tasks done) replicateM_ executors (void $ readChan done) \ No newline at end of file diff --git a/test-generator/Math.hs b/test-generator/Math.hs index ba33bc4..1d68831 100644 --- a/test-generator/Math.hs +++ b/test-generator/Math.hs @@ -5,11 +5,12 @@ module Math( , modulate, modulate' , isqrt , divmod - , showX, showB + , showX, showB, showBin ) where -import Data.Bits(shiftL,shiftR) +import Data.Bits(shiftL,shiftR,(.&.)) +import qualified Data.ByteString as S import GHC.Integer.GMP.Internals(recipModInteger) import Numeric(showHex) @@ -106,6 +107,13 @@ showB :: Bool -> String showB False = "0" showB True = "1" +showBin :: S.ByteString -> String +showBin bstr = + case S.uncons bstr of + Nothing -> "" + Just (x,rest) -> + showX (x `shiftR` 4) ++ showX (x .&. 0xF) ++ showBin rest + isqrt :: Int -> Integer -> Integer isqrt bits val = final where diff --git a/test-generator/RFC6979.hs b/test-generator/RFC6979.hs new file mode 100644 index 0000000..0d0ba6c --- /dev/null +++ b/test-generator/RFC6979.hs @@ -0,0 +1,112 @@ +module RFC6979 +-- ( +-- rfcTasks +-- ) + where + +import Crypto.Hash(SHA224(..),SHA256(..),SHA384(..),SHA512(..)) +import Crypto.MAC.HMAC(HMAC,hmac) +import Crypto.Number.Generate(generateBetween) +import Crypto.Random(getRandomBytes,withDRG) +import Data.Bits(shiftL,shiftR,(.&.)) +import qualified Data.ByteArray as B +import qualified Data.ByteString as S +import Data.Char(toUpper) +import qualified Data.Map.Strict as Map +import Math(showBin,showX) +import Task(Task(..)) +import Utils(HashAlg(..), runHash) + + +runHMAC :: HashAlg -> S.ByteString -> S.ByteString -> S.ByteString +runHMAC Sha224 key msg = S.pack (B.unpack (hmac key msg :: HMAC SHA224)) +runHMAC Sha256 key msg = S.pack (B.unpack (hmac key msg :: HMAC SHA256)) +runHMAC Sha384 key msg = S.pack (B.unpack (hmac key msg :: HMAC SHA384)) +runHMAC Sha512 key msg = S.pack (B.unpack (hmac key msg :: HMAC SHA512)) + +generateKStream :: HashAlg -> S.ByteString -> Integer -> Integer -> Int -> [Integer] +generateKStream alg m x q qlen = nextK bigK2 bigV2 + where + h1 = runHash alg m + bigV0 = S.replicate (S.length h1) 0x01 + bigK0 = S.replicate (S.length h1) 0x00 + seed1 = S.concat [bigV0, S.singleton 0x00, int2octets qlen x, bits2octets qlen q h1] + bigK1 = runHMAC alg bigK0 seed1 + bigV1 = runHMAC alg bigK1 bigV0 + seed2 = S.concat [bigV1, S.singleton 0x01, int2octets qlen x, bits2octets qlen q h1] + bigK2 = runHMAC alg bigK1 seed2 + bigV2 = runHMAC alg bigK2 bigV1 + -- + nextK bigK bigV = + let (bigV', bigT) = buildT bigK bigV S.empty + k = bits2int qlen bigT + bigK' = runHMAC alg bigK (bigV' `S.append` S.singleton 0) + bigV'' = runHMAC alg bigK' bigV' + in if k < q then (k : nextK bigK' bigV'') else nextK bigK' bigV'' + buildT bigK bigV bigT + | S.length bigT * 8 >= qlen = (bigV, bigT) + | otherwise = + let bigV' = runHMAC alg bigK bigV + in buildT bigK bigV' (bigT `S.append` bigV') + +bits2int :: Int -> S.ByteString -> Integer +bits2int qlen bstr = reduce (go bstr 0) + where + reduce x = + let vlen = S.length bstr * 8 + in if vlen > qlen + then x `shiftR` (vlen - qlen) + else x + -- + go x acc = + case S.uncons x of + Nothing -> acc + Just (v, rest) -> + go rest ((acc `shiftL` 8) + fromIntegral v) + +int2octets :: Int -> Integer -> S.ByteString +int2octets lenBits x = + S.pack (pad (rlen `div` 8) (reverse (go x))) + where + rlen = 8 * ((lenBits + 7) `div` 8) + pad target ls + | length ls > target = drop (length ls - target) ls + | length ls < target = pad target (0 : ls) + | otherwise = ls + -- + go 0 = [] + go v = (fromIntegral (v .&. 0xFF)) : go (v `shiftR` 8) + +bits2octets :: Int -> Integer -> S.ByteString -> S.ByteString +bits2octets qlen q bstr = + let z1 = bits2int qlen bstr + z2 = if z1 > q then z1 - q else z1 + in int2octets qlen z2 + +rfc6979Test :: HashAlg -> Task +rfc6979Test alg = Task { + taskName = name ++ " RFC 6979 deterministic k-generation", + taskFile = "../testdata/rfc6979/" ++ name ++ ".test", + taskTest = go, + taskCount = 1000 +} + where + name = map toUpper (show alg) + go (memory0, drg0) = + let (qlen, drg1) = withDRG drg0 $ generateBetween 160 521 + (key, drg2) = withDRG drg1 $ generateBetween 1 ((2 ^ qlen) - 1) + (q, drg3) = withDRG drg2 $ generateBetween 1 ((2 ^ qlen) - 1) + (dataSize, drg4) = withDRG drg3 $ generateBetween 1 1024 + (msg, drg5) = withDRG drg4 $ getRandomBytes (fromIntegral dataSize) + h1 = runHash alg msg + ks = generateKStream alg msg key q (fromIntegral qlen) + res = Map.fromList [("q", showX q), ("l", showX qlen), + ("x", showX key), ("h", showBin h1), + ("k", showX (ks !! 0)), + ("y", showX (ks !! 1)), + ("z", showX (ks !! 2))] + in (res, qlen, (memory0, drg5)) + +rfcTasks :: [Task] +rfcTasks = [rfc6979Test Sha224, rfc6979Test Sha256, + rfc6979Test Sha384, rfc6979Test Sha512] \ No newline at end of file diff --git a/test-generator/Utils.hs b/test-generator/Utils.hs new file mode 100644 index 0000000..e75d118 --- /dev/null +++ b/test-generator/Utils.hs @@ -0,0 +1,34 @@ +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 qualified Data.ByteArray as B +import qualified Data.ByteString as S +import Math(showX) + +data HashAlg = Sha224 | Sha256 | Sha384 | Sha512 + deriving (Eq, Show) + +runHash :: HashAlg -> S.ByteString -> S.ByteString +runHash Sha224 x = S.pack (B.unpack (hash x :: Digest SHA224)) +runHash Sha256 x = S.pack (B.unpack (hash x :: Digest SHA256)) +runHash Sha384 x = S.pack (B.unpack (hash x :: Digest SHA384)) +runHash Sha512 x = S.pack (B.unpack (hash x :: Digest SHA512)) + +showHash :: HashAlg -> String +showHash Sha224 = showX (224 :: Int) +showHash Sha256 = showX (256 :: Int) +showHash Sha384 = showX (384 :: Int) +showHash Sha512 = showX (512 :: Int) + +generateHash :: MonadRandom m => m HashAlg +generateHash = + do x <- generateBetween 0 3 + case x of + 0 -> return Sha224 + 1 -> return Sha256 + 2 -> return Sha384 + 3 -> return Sha512 + _ -> fail "Incompatible random number"