DRBG 0.3 → 0.3.2

raw patch · 6 files changed

+136/−117 lines, 6 filesdep +cryptohash-cryptoapidep −cryptohashdep ~crypto-apiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: cryptohash-cryptoapi

Dependencies removed: cryptohash

Dependency ranges changed: crypto-api

API changes (from Hackage documentation)

Files

• Crypto/Random/DRBG.hs +65/−31
• Crypto/Random/DRBG/HMAC.hs +23/−21
• Crypto/Random/DRBG/Hash.hs +39/−37
• Crypto/Random/DRBG/HashDF.hs +1/−1
• Crypto/Random/DRBG/Util.hs +0/−23
• DRBG.cabal +8/−4

@@ -75,15 +75,11 @@  import qualified Crypto.Random.DRBG.HMAC as M import qualified Crypto.Random.DRBG.Hash as H-import Crypto.Random.DRBG.Util+import Crypto.Util import Crypto.Classes-import Crypto.Modes import Crypto.Random-import Crypto.Hash.SHA512 (SHA512)-import Crypto.Hash.SHA384 (SHA384)-import Crypto.Hash.SHA256 (SHA256)-import Crypto.Hash.SHA224 (SHA224)-import Crypto.Hash.SHA1 (SHA1)+import Crypto.Modes (zeroIV)+import Crypto.Hash.CryptoAPI import Crypto.Cipher.AES128 (AESKey) import Crypto.Types import System.Entropy@@ -142,14 +138,14 @@ --  -- Will last for @2^48 * 2^41@ bytes of randomly generated data.  That's -- 2^49 terabytes of random values (128 byte reseeds every 2^48 bytes generated).-newGenAutoReseed :: (CryptoRandomGen a, CryptoRandomGen b) => B.ByteString -> Int -> Either GenError (GenAutoReseed a b)+newGenAutoReseed :: (CryptoRandomGen a, CryptoRandomGen b) => B.ByteString -> Word64 -> Either GenError (GenAutoReseed a b) newGenAutoReseed bs rsInterval=         let (b1,b2) = B.splitAt (genSeedLength `for` fromRight g1) bs             g1 = newGen b1             g2 = newGen b2             fromRight (Right x) = x         in case (g1, g2) of-                (Right a, Right b) -> Right $ GenAutoReseed a b rsInterval 0+                (Right a, Right b) -> Right $ GenAutoReseed rsInterval 0 a b                 (Left e, _) -> Left e                 (_, Left e) -> Left e @@ -157,11 +153,11 @@ -- interval of @i@ bytes, using the system random number generator as a seed. -- -- See 'newGenAutoReseed'.-newGenAutoReseedIO :: (CryptoRandomGen a, CryptoRandomGen b) => Int -> IO (GenAutoReseed a b)+newGenAutoReseedIO :: (CryptoRandomGen a, CryptoRandomGen b) => Word64 -> IO (GenAutoReseed a b) newGenAutoReseedIO i   = do         g1 <- newGenIO         g2 <- newGenIO-        return $ GenAutoReseed g1 g2 i 0+        return $ GenAutoReseed i 0 g1 g2  seed :: CryptoRandomGen g => Proxy g -> Int seed x = proxy genSeedLength x@@ -192,6 +188,9 @@                         then Left NotEnoughEntropy                         else Right res +        reseedInfo s = InXCalls (M.counter s)+        reseedPeriod _ = InXCalls M.reseedInterval+ instance CryptoRandomGen HashDRBG where         newGen bs =                 let res = H.instantiate bs B.empty B.empty@@ -214,6 +213,8 @@                 in if B.length ent < genSeedLength `for` res                         then Left NotEnoughEntropy                         else Right res+        reseedInfo s = InXCalls (H.counter s)+        reseedPeriod _ = InXCalls H.reseedInterval  helper1 :: Tagged (GenAutoReseed a b) Int -> a helper1 = const undefined@@ -240,7 +241,7 @@ -- @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 !a !b !Int !Int+data GenAutoReseed a b = GenAutoReseed {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 !a !b  instance (CryptoRandomGen a, CryptoRandomGen b) => CryptoRandomGen (GenAutoReseed a b) where         {-# SPECIALIZE instance CryptoRandomGen (GenAutoReseed HmacDRBG HmacDRBG) #-}@@ -254,39 +255,39 @@                     b = helper2 res                     res = Tagged $ genSeedLength `for` a + genSeedLength `for` b                 in res-        genBytes req (GenAutoReseed a b rs cnt) =+        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 aNew b' rs 0)+                                return (res,GenAutoReseed rs 0 aNew b')                         Left err -> Left err                         Right (res,aNew) -> do-                          gNew <- if (cnt + req) > rs+                          gNew <- if (cnt + fromIntegral req) > rs                                         then do                                            (ent,b') <- genBytes (genSeedLength `for` a) b                                           a'  <- reseed ent aNew-                                          return (GenAutoReseed a' b' rs 0)-                                        else return $ GenAutoReseed aNew b rs (cnt + req)+                                          return (GenAutoReseed rs 0 a' b')+                                        else return $ GenAutoReseed rs (cnt + fromIntegral req) aNew b                           return (res, gNew)-        genBytesWithEntropy req entropy (GenAutoReseed a b rs cnt) = do+        genBytesWithEntropy req entropy (GenAutoReseed rs cnt a b) = do                 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 aNew b' rs 0)+                                return (res, GenAutoReseed rs 0 aNew b')                         Left err -> Left err                         Right (res,aNew) -> do-                          gNew <- if (cnt + req) > rs+                          gNew <- if (cnt + fromIntegral req) > rs                                         then do                                            (ent,b') <- genBytes (genSeedLength `for` a) b                                           a'  <- reseed ent aNew-                                          return (GenAutoReseed a' b' rs 0)-                                        else return $ GenAutoReseed aNew b rs (cnt + req)+                                          return (GenAutoReseed rs 0 a' b')+                                        else return $ GenAutoReseed rs (cnt + fromIntegral req) aNew b                           return (res, gNew)-        reseed ent gen@(GenAutoReseed a b rs _) +        reseed ent gen@(GenAutoReseed rs _ a b)            | genSeedLength `for` gen > B.length ent = Left NotEnoughEntropy           | otherwise = do                 let (e1,e2) = B.splitAt (genSeedLength `for` a) ent@@ -294,7 +295,36 @@                 b' <- if B.length e2 /= 0                         then reseed e2 b                         else return b-                return $ GenAutoReseed a' b' rs 0+                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+        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)  -- |@g :: GenXor a b@ generates bytes with sub-generators a and b  -- and exclusive-or's the outputs to produce the resulting bytes.@@ -340,6 +370,8 @@                 a' <- reseed b1 a                 b' <- reseed b2 b                 return (GenXor a' b')+        reseedPeriod ~(GenXor a b) = min (reseedPeriod a) (reseedPeriod b)+        reseedInfo   ~(GenXor a b) = min (reseedInfo a) (reseedInfo b)  -- |@g :: GenBuffered a@ is a generator of type @a@ that attempts to -- maintain a buffer of random values size >= 1MB and <= 5MB at any time.@@ -407,6 +439,8 @@                 let new = wrapErr (genBytes (min-B.length bs') g'') g''                     bs' = B.take max (B.append bs rs)                 return (GenBuffered min max new bs')+        reseedPeriod ~(GenBuffered _ _ g _) = reseedPeriod . either snd snd $ g+        reseedInfo ~(GenBuffered _ _ g _) = reseedInfo . either snd snd $ g  wrapErr :: Either x y -> g -> Either (x,g) y wrapErr (Left x) g = Left (x,g)@@ -422,6 +456,10 @@  -- |@GenCounter k@ is a cryptographic BlockCipher with key @k@ -- being used in 'ctr' mode to generate random bytes.+--+-- Notice this is the only generator in the package that does not follow+-- SP800-90.  It is a rather hap-hazard construction.  Use at your own risk+-- and patch at your own leisure. data GenCounter a = GenCounter {-# UNPACK #-} !Word64 a (IV a)  instance BlockCipher x => CryptoRandomGen (GenCounter x) where@@ -445,13 +483,15 @@   genBytes req (GenCounter rs k counter) =         let bs = B.replicate (req' * blkSz) 0             blkSz = blockSizeBytes `for` k-            (rnd,iv) = ctr' incIV k counter bs+            (rnd,iv) = ctr k counter bs             req' = (req + blkSz - 1) `div` blkSz         in if rs >= 2^48                 then Left NeedReseed                 else Right (B.take req rnd, GenCounter (rs+1) k iv)    reseed bs (GenCounter _ k _) = newGen (xorExtendBS (encode k) bs)+  reseedPeriod (GenCounter cnt _ _) = InXCalls (2^48)+  reseedInfo (GenCounter nr _ _) = InXCalls (2^48 - nr)  xorExtendBS a b = res    where@@ -462,9 +502,3 @@    bl = B.length b    rem | bl > al = B.drop al b        | otherwise = B.drop bl a----- |zipWith xor + Pack--- As a result of rewrite rules, this should automatically be optimized (at compile time) --- to use the bytestring libraries 'zipWith'' function.-zwp' a = B.pack . B.zipWith xor a

@@ -1,16 +1,17 @@ {-# LANGUAGE BangPatterns #-} module Crypto.Random.DRBG.HMAC-	( State-	, reseedInterval-	, instantiate-	, reseed-	, generate) where+        ( State, counter+        , reseedInterval+        , instantiate+        , reseed+        , generate) where  import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Serialize (encode, Serialize(..)) import Data.Serialize.Put import Data.Serialize.Builder (toByteString)+import Data.Word (Word64) import Crypto.Classes import Crypto.HMAC import Crypto.Types@@ -20,13 +21,14 @@ type Value = B.ByteString  data State d = St-	{ value			:: !Value-	, key			:: !Key-	, counter		:: !Integer-	-- Start admin info-	, hashAlg		:: L.ByteString -> d-	}+        { counter               :: {-# UNPACK #-} !Word64+        -- Start admin info+        , value                 :: !Value+        , key                   :: !Key+        , hashAlg               :: L.ByteString -> d+        } +reseedInterval :: Word64 reseedInterval = 2^48  fc = L.fromChunks . \s -> [s]@@ -52,7 +54,7 @@   seedMaterial = L.fromChunks [ent, nonce, perStr]   k = B.replicate olen 0   v = B.replicate olen 1-  st =  update (St v k 1 hash) seedMaterial+  st =  update (St 1 v k hash) seedMaterial   d  = hashAlg st undefined   olen = (outputLength .::. d) `div` 8 @@ -61,14 +63,14 @@  generate :: (Hash c d) => State d -> BitLength -> AdditionalInput -> Maybe (RandomBits, State d) generate st req additionalInput =-	if(counter st > reseedInterval)-		then Nothing-		else Just (randBitsFinal, stFinal { counter = 1 + counter st})+        if(counter st > reseedInterval)+                then Nothing+                else Just (randBitsFinal, stFinal { counter = 1 + counter st})   where   d = hashAlg st undefined   st' = if B.length additionalInput == 0-		then st-		else update st (fc additionalInput)+                then st+                else update st (fc additionalInput)   reqBytes = (req+7) `div` 8   iterations = (reqBytes + (outlen - 1)) `div` outlen @@ -79,10 +81,10 @@   getV :: Value -> Int -> (Value, [B.ByteString])   getV !u 0 = (u, [])   getV !u i = -	let !vNew = hmac' (MacKey kFinal) u `asTypeOf` d-	    !encV = encode vNew-	    (uFinal, rest) = getV encV (i - 1)-	in (uFinal, encV:rest)+        let !vNew = hmac' (MacKey kFinal) u `asTypeOf` d+            !encV = encode vNew+            (uFinal, rest) = getV encV (i - 1)+        in (uFinal, encV:rest)   (vFinal, randBitsList) = getV (value st') iterations   randBitsFinal = B.take reqBytes $ B.concat randBitsList   kFinal = key st'

@@ -1,12 +1,12 @@ {-# LANGUAGE BangPatterns, MonomorphismRestriction #-} module Crypto.Random.DRBG.Hash-	( State-	, reseedInterval-	, SeedLength (..)-	, instantiate-	, reseed-	, generate-	) where+        ( State, counter+        , reseedInterval+        , SeedLength (..)+        , instantiate+        , reseed+        , generate+        ) where -- NIST SP 800-90   import qualified Data.ByteString as B@@ -17,58 +17,60 @@ import Data.Serialize (encode) import Data.Bits (shiftR, shiftL) import Data.Tagged-import Crypto.Random.DRBG.Util+import Data.Word (Word64)  class SeedLength h where   seedlen :: Tagged h Int +reseedInterval :: Word64 reseedInterval = 2^48  -- Section 10.1.1.1, pg 35 data State d = St-	{ value			:: B.ByteString -- seedlen bits-	, constant		:: B.ByteString -- seedlen bits-	, counter		:: Integer      -- Number of RBG requests since last reseed-	-- start admin info-	, hsh			:: L.ByteString -> d-	}+        { counter               :: {-# UNPACK #-} !Word64       -- Number of RBG requests since last reseed+        -- start admin info+        , value                 :: B.ByteString -- seedlen bits+        , constant              :: B.ByteString -- seedlen bits+        , hsh                   :: L.ByteString -> d+        }  -- section 10.1.1.2 pg 36 instantiate :: (Hash c d, SeedLength d) => Entropy -> Nonce -> PersonalizationString -> State d instantiate entropyInput nonce perStr =-	let seedMaterial = B.concat [entropyInput, nonce, perStr]-	    slen = seedlen .::. d-	    seed = hash_df f seedMaterial slen-	    v = seed-	    c = hash_df f (B.cons 0 v) slen-	    f = hash-	    d = f undefined-	in St v c 1 f+        let seedMaterial = B.concat [entropyInput, nonce, perStr]+            slen = seedlen .::. d+            seed = hash_df f seedMaterial slen+            v = seed+            c = hash_df f (B.cons 0 v) slen+            f = hash+            d = f undefined+        in St 1 v c f  -- section 10.1.1.3 pg 37 reseed :: (SeedLength d, Hash c d) => State d -> Entropy -> AdditionalInput -> State d reseed st ent additionalInput =-	let seedMaterial = B.concat [B.pack [1], value st, ent, additionalInput]-	    seed = hash_df f seedMaterial (seedlen `for` d)-	    v = seed-	    c = hash_df f (B.cons 0 v) (seedlen `for` d)-	    f = hash-	    d = f undefined-	in St v c 1 f+        let seedMaterial = B.concat [B.pack [1], value st, ent, additionalInput]+            seed = hash_df f seedMaterial (seedlen `for` d)+            v = seed+            c = hash_df f (B.cons 0 v) (seedlen `for` d)+            f = hash+            d = f undefined+        in St 1 v c f  -- section 10.1.1.4 pg 38 -- Nothing indicates a need to reseed generate :: (Hash c d, SeedLength d) => State d -> BitLen -> AdditionalInput -> Maybe (RandomBits, State d) generate st req additionalInput =-	if (counter st > reseedInterval)-		then Nothing-		else Just (retBits, st { value = v2, counter = cnt})+        if (counter st > reseedInterval)+                then Nothing+                else Just (retBits, st { value = v2, counter = cnt})   where   w = hash [B.singleton 2, value st, additionalInput]   v1 = if B.length additionalInput == 0 then value st else i2bs slen (bs2i (value st) + bs2i w)   retBits = hashGen d req v1   h = hash [B.cons 3 v1]-  v2 = i2bs slen (sum $ counter st : map bs2i [v1, h, constant st])+  -- TODO determine if Integer is needed here and move to Word64 if possible+  v2 = i2bs slen (sum $ fromIntegral (counter st) : map bs2i [v1, h, constant st])   cnt = counter st + 1   slen = seedlen `for` d   hash = encode . hashF .  L.fromChunks@@ -84,10 +86,10 @@   getW :: B.ByteString -> Int -> [B.ByteString]   getW _ 0 = []   getW dat i =-	let wi = encode (h dat)-	    dat' = incBS dat-	    rest = getW dat' (i-1)-	in wi : rest+        let wi = encode (h dat)+            dat' = incBS dat+            rest = getW dat' (i-1)+        in wi : rest   slen = seedlen `for` d   outlen = outputLength `for` d   h = hashFunc' d

@@ -16,7 +16,7 @@   outlen = outputLength  .::. (hashF undefined)   hash = encode . hashF . L.fromChunks . \x -> [x]   getT tmp cnt-	| B.length tmp >= reqBytes = tmp+        | B.length tmp >= reqBytes = tmp         | otherwise = let new = hash (B.concat [B.singleton cnt, reqBitsBS, str]) in getT (B.append tmp new) (cnt + 1)   len = (if reqBits `rem` outlen == 0 then reqBits `div` outlen else (reqBits + outlen) `div` outlen)   reqBitsBS = runPut $ putWord32be (fromIntegral reqBits :: Word32)

@@ -1,23 +0,0 @@-module Crypto.Random.DRBG.Util where--import qualified Data.ByteString as B-import Crypto.Random.DRBG.Types-import Data.Bits (shiftL, shiftR)--{-# INLINE incBS #-}-incBS :: B.ByteString -> B.ByteString-incBS bs = B.concat (go bs (B.length bs - 1))-  where-  go bs i-        | B.length bs == 0     = []-        | B.index bs i == 0xFF = (go (B.init bs) (i-1)) ++ [B.singleton 0]-        | otherwise            = [B.init bs] ++ [B.singleton $ (B.index bs i) + 1]---- Appendix B-i2bs :: BitLen -> Integer -> B.ByteString-i2bs l i = B.unfoldr (\l' -> if l' < 0 then Nothing else Just (fromIntegral (i `shiftR` l'), l' - 8)) (l-8)-{-# INLINE i2bs #-}--bs2i :: B.ByteString -> Integer-bs2i bs = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 bs-{-# INLINE bs2i #-}

@@ -1,5 +1,5 @@ name:           DRBG-version:        0.3+version:        0.3.2 license:        BSD3 license-file:   LICENSE author:         Thomas DuBuisson <thomas.dubuisson@gmail.com>@@ -23,7 +23,7 @@ Library   Build-Depends: base >= 4.0 && < 5, cereal >= 0.2,                  bytestring, prettyclass, tagged >= 0.2,-                 crypto-api >= 0.6, cryptohash >= 0.6.1, parallel, mtl >= 2.0,+                 crypto-api >= 0.12, cryptohash-cryptoapi >= 0.1, parallel, mtl >= 2.0,                  cipher-aes128, entropy   ghc-options: -O2   hs-source-dirs:@@ -31,12 +31,16 @@                    Crypto.Random.DRBG.HMAC,                    Crypto.Random.DRBG,                    Crypto.Random.DRBG.Types-  other-modules: Crypto.Random.DRBG.HashDF Crypto.Random.DRBG.Util+  other-modules: Crypto.Random.DRBG.HashDF  Executable drbg_test   if !flag(test)     buildable: False   main-is: Test/KAT.hs   if flag(test)-    build-depends: base, QuickCheck, crypto-api, bytestring, binary, cereal, cryptohash, crypto-api-tests, HUnit, test-framework, test-framework-hunit+    build-depends: base, QuickCheck, crypto-api, bytestring, binary, cereal, cryptohash-cryptoapi, crypto-api-tests, HUnit, test-framework, test-framework-hunit   other-modules: Paths_DRBG++source-repository head+  type:         git+  location:     https://github.com/TomMD/cipher-aes128