DRBG 0.5.1 → 0.5.2
raw patch · 3 files changed
+107/−74 lines, 3 filesdep ~cipher-aes128dep ~crypto-api
Dependency ranges changed: cipher-aes128, crypto-api
Files
- Crypto/Random/DRBG.hs +103/−69
- DRBG.cabal +3/−3
- Test/KAT.hs +1/−2
Crypto/Random/DRBG.hs view
@@ -78,7 +78,7 @@ import Crypto.Classes import Crypto.Random import Crypto.Hash.CryptoAPI-import Crypto.Cipher.AES128 (AESKey)+import Crypto.Cipher.AES128 (AESKey128) import Crypto.Types import System.Entropy import qualified Data.ByteString as B@@ -121,7 +121,7 @@ type HashDRBG = H.State SHA512 -- |An Alias for a Counter DRBG generator using AES 128.-type CtrDRBG = CTR.State AESKey+type CtrDRBG = CTR.State AESKey128 -- |@newGenAutoReseed bs i@ creates a new 'GenAutoReseed' with a custom interval -- of @i@ bytes using the provided entropy in @bs@.@@ -143,7 +143,7 @@ let (b1,b2) = B.splitAt (genSeedLength `for` fromRight g1) bs g1 = newGen b1 g2 = newGen b2- fromRight (Right x) = x+ fromRight ~(Right x) = x in case (g1, g2) of (Right a, Right b) -> Right $ GenAutoReseed rsInterval 0 a b (Left e, _) -> Left e@@ -235,52 +235,84 @@ -- @2^15 * (2^b / a')@ bytes. For the common values of @a' = 128@ and @2^b = 2^48@ this -- means reseeding every 2^56 byte. For the example numbers this translates to -- about 200 years of continually generating random values at a rate of 10MB/s.-data GenAutoReseed a b = GenAutoReseed {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 !a !b+data GenAutoReseed a b = GenAutoReseed+ { garInterval :: {-# UNPACK #-} !Word64+ , garCounter :: {-# UNPACK #-} !Word64+ , garPrimeGen :: !a+ , garBackupGen :: !b+ } +genBytesAutoReseed :: (CryptoRandomGen a, CryptoRandomGen b)+ => ByteLength+ -> GenAutoReseed a b+ -> Either GenError (B.ByteString, GenAutoReseed a b)+genBytesAutoReseed req gar@(GenAutoReseed rs cnt a b) =+ case genBytes req a of+ Left NeedReseed -> do+ (a',b') <- a `reseedWith` b+ (res, aNew) <- genBytes req a'+ return (res,GenAutoReseed rs 0 aNew b')+ Left RequestedTooManyBytes -> do+ let reqSmall = 1 + (req `div` 2)+ (s1, gar1) <- genBytes reqSmall gar+ (s2, gar2) <- genBytes reqSmall gar1+ return (B.take req (B.append s1 s2), gar2)+ Left err -> Left err+ Right (res,aNew) -> do+ gNew <- if (cnt + fromIntegral req) > rs+ then do+ (a',b') <- a `reseedWith` b+ return (GenAutoReseed rs 0 a' b')+ else return $ GenAutoReseed rs (cnt + fromIntegral req) aNew b+ return (res, gNew)++reseedWith :: (CryptoRandomGen a, CryptoRandomGen b)+ => a -> b -> Either GenError (a,b)+reseedWith x y = do+ (ent,y2) <- genBytes (genSeedLength `for` x) y+ x2 <- reseed ent x+ return (x2,y2)++genBytesWithEntropyAutoReseed+ :: (CryptoRandomGen a, CryptoRandomGen b)+ => ByteLength+ -> B.ByteString+ -> GenAutoReseed a b+ -> Either GenError (B.ByteString, GenAutoReseed a b)+genBytesWithEntropyAutoReseed req entropy gar@(GenAutoReseed rs cnt a b) =+ case genBytesWithEntropy req entropy a of+ Left NeedReseed -> do+ (a',b') <- a `reseedWith` b+ (res, aNew) <- genBytesWithEntropy req entropy a'+ return (res, GenAutoReseed rs 0 aNew b')+ Left RequestedTooManyBytes -> do+ let reqSmall = 1 + (req `div` 2)+ (s1, gar1) <- genBytesWithEntropy reqSmall entropy gar+ (s2, gar2) <- genBytes reqSmall gar1+ return (B.take req (B.append s1 s2), gar2)+ Left err -> Left err+ Right (res,aNew) -> do+ gNew <- if (cnt + fromIntegral req) > rs+ then do+ (a',b') <- a `reseedWith` b+ return (GenAutoReseed rs 0 a' b')+ else return $ GenAutoReseed rs (cnt + fromIntegral req) aNew b+ return (res, gNew)+ instance (CryptoRandomGen a, CryptoRandomGen b) => CryptoRandomGen (GenAutoReseed a b) where {-# SPECIALIZE instance CryptoRandomGen (GenAutoReseed HmacDRBG HmacDRBG) #-} {-# SPECIALIZE instance CryptoRandomGen (GenAutoReseed HashDRBG HashDRBG) #-} {-# SPECIALIZE instance CryptoRandomGen (GenAutoReseed HashDRBG HmacDRBG) #-} {-# SPECIALIZE instance CryptoRandomGen (GenAutoReseed HmacDRBG HashDRBG) #-}- newGen bs = newGenAutoReseed bs (2^15)- newGenIO = newGenAutoReseedIO (2^15)+ newGen bs = newGenAutoReseed bs (2^(19::Int))+ newGenIO = newGenAutoReseedIO (2^(19::Int)) genSeedLength =- let a = helper1 res- b = helper2 res- res = Tagged $ genSeedLength `for` a + genSeedLength `for` b- in res- genBytes req (GenAutoReseed rs cnt a b) =- case genBytes req a of- Left NeedReseed -> do- (ent,b') <- genBytes (genSeedLength `for` a) b- a' <- reseed ent a- (res, aNew) <- genBytes req a'- return (res,GenAutoReseed rs 0 aNew b')- Left err -> Left err- Right (res,aNew) -> do- gNew <- if (cnt + fromIntegral req) > rs- then do - (ent,b') <- genBytes (genSeedLength `for` a) b- a' <- reseed ent aNew- return (GenAutoReseed rs 0 a' b')- else return $ GenAutoReseed rs (cnt + fromIntegral req) aNew b- return (res, gNew)- genBytesWithEntropy req entropy (GenAutoReseed rs cnt a b) =- case genBytesWithEntropy req entropy a of- Left NeedReseed -> do- (ent,b') <- genBytes (genSeedLength `for` a) b- a' <- reseed ent a- (res, aNew) <- genBytesWithEntropy req entropy a'- return (res, GenAutoReseed rs 0 aNew b')- Left err -> Left err- Right (res,aNew) -> do- gNew <- if (cnt + fromIntegral req) > rs- then do - (ent,b') <- genBytes (genSeedLength `for` a) b- a' <- reseed ent aNew- return (GenAutoReseed rs 0 a' b')- else return $ GenAutoReseed rs (cnt + fromIntegral req) aNew b- return (res, gNew)+ let a = helper1 res+ b = helper2 res+ res = Tagged $ genSeedLength `for` a + genSeedLength `for` b+ in res+ genBytes = genBytesAutoReseed+ genBytesWithEntropy = genBytesWithEntropyAutoReseed reseed ent gen@(GenAutoReseed rs _ a b) | genSeedLength `for` gen > B.length ent = Left NotEnoughEntropy | otherwise = do@@ -291,34 +323,36 @@ else return b return $ GenAutoReseed rs 0 a' b' reseedPeriod ~(GenAutoReseed rs _ ag bg) =- case (reseedPeriod ag, reseedPeriod bg) of- (Never, _) -> Never- (_, Never) -> Never- (NotSoon, _) -> NotSoon- (_, NotSoon) -> NotSoon- (_, InXCalls b) ->- if fromIntegral rs * fromIntegral b > fromIntegral (maxBound `asTypeOf` b)- then NotSoon- else InXBytes (rs * b)- (_, InXBytes b) ->- let s = genSeedLength `for` ag- nr = if s <= 0 then 1 else (b `div` fromIntegral s) - 1- in InXBytes $ rs * nr+ case (reseedPeriod ag, reseedPeriod bg) of+ (Never, _) -> Never+ (_, Never) -> Never+ (NotSoon, _) -> NotSoon+ (_, NotSoon) -> NotSoon+ (_, InXCalls b) ->+ if fromIntegral rs * fromIntegral b >+ fromIntegral (maxBound `asTypeOf` b)+ then NotSoon+ else InXBytes (rs * b)+ (_, InXBytes b) ->+ let s = genSeedLength `for` ag+ nr = if s <= 0 then 1 else (b `div` fromIntegral s) - 1+ in InXBytes $ rs * nr reseedInfo (GenAutoReseed rs x ag bg) =- -- Attempt to provide a lower bound on the next reseed- case (reseedInfo ag, reseedInfo bg) of- (NotSoon, _) -> NotSoon- (_, NotSoon) -> NotSoon- (Never, _) -> Never- (_, Never) -> Never- (_, InXBytes b) ->- let s = genSeedLength `for` ag- nr = if s <= 0 then 1 else ((b `div` fromIntegral s) - 1)- in InXBytes $ rs - x + rs * nr- (_, InXCalls b) -> - if fromIntegral rs * fromIntegral b > fromIntegral (maxBound `asTypeOf` b)- then NotSoon- else InXBytes (rs - x + rs * b)+ -- Attempt to provide a lower bound on the next reseed+ case (reseedInfo ag, reseedInfo bg) of+ (NotSoon, _) -> NotSoon+ (_, NotSoon) -> NotSoon+ (Never, _) -> Never+ (_, Never) -> Never+ (_, InXBytes b) ->+ let s = genSeedLength `for` ag+ nr = if s <= 0 then 1 else (b `div` fromIntegral s) - 1+ in InXBytes $ rs - x + rs * nr+ (_, InXCalls b) -> + if fromIntegral rs * fromIntegral b >+ fromIntegral (maxBound `asTypeOf` b)+ then NotSoon+ else InXBytes (rs - x + rs * b) -- |@g :: GenXor a b@ generates bytes with sub-generators a and b -- and exclusive-or's the outputs to produce the resulting bytes.
DRBG.cabal view
@@ -1,5 +1,5 @@ name: DRBG-version: 0.5.1+version: 0.5.2 license: BSD3 license-file: LICENSE author: Thomas DuBuisson <thomas.dubuisson@gmail.com>@@ -23,8 +23,8 @@ Library Build-Depends: base >= 4.0 && < 5, cereal >= 0.2, bytestring, prettyclass, tagged >= 0.2,- crypto-api >= 0.12.1, cryptohash-cryptoapi >= 0.1,- parallel, mtl >= 2.0, cipher-aes128 >= 0.3.2, entropy+ crypto-api >= 0.13, cryptohash-cryptoapi >= 0.1,+ parallel, mtl >= 2.0, cipher-aes128 >= 0.6, entropy ghc-options: -O2 hs-source-dirs: exposed-modules: Crypto.Random.DRBG.Hash,
Test/KAT.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE EmptyDataDecls, MultiParamTypeClasses #-}+{-# LANGUAGE PackageImports #-} import qualified Crypto.Random.DRBG.Hash as H import qualified Crypto.Random.DRBG.HMAC as M import qualified Crypto.Random.DRBG.CTR as CTR@@ -94,8 +95,6 @@ olen = B.length (hx ret) in r1 return (testCase name $ assertEqual name (hexStringToBS ret) f)-- -- Test the SHA-256 HMACs (other hash implementations will be tested once crypthash uses the crypto-api classes) nistTests_HMAC :: IO [Test]