DRBG 0.1.1 → 0.1.2

raw patch · 7 files changed

+103/−101 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• Crypto/Random/DRBG.hs +71/−82
• Crypto/Random/DRBG/Hash.hs +1/−15
• Crypto/Random/DRBG/HashDF.hs +1/−2
• Crypto/Random/DRBG/Types.hs +1/−0
• Crypto/Random/DRBG/Util.hs +23/−0
• DRBG.cabal +2/−2

@@ -1,3 +1,7 @@+0.1.2+* Verify the seed length is sufficient when instantiating or reseeding HmacDRBG and HashDRBG+* Move GenSystemRandom out of DRBG (into crypto-api >= 0.3)+ New in 0.1.1  * Add HashDRBGWith and HmacDRBGWith

@@ -1,4 +1,4 @@-{-# LANGUAGE EmptyDataDecls, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE EmptyDataDecls, FlexibleInstances, TypeSynonymInstances, BangPatterns #-} {-|  Maintainer: Thomas.DuBuisson@gmail.com  Stability: beta@@ -26,7 +26,6 @@ a 'CryptoRandomGen' as desired.  @-    sysGen <- getGenSystemRandom     gen <- newGenIO :: IO (GenBuffered (GenAutoReseed (GenXor AesCntDRBG (HashDRBGWith SHA384)) HmacDRBG)) @ @@ -39,8 +38,6 @@ 	, GenXor 	, GenAutoReseed 	, GenBuffered-	, GenSystemRandom-	, getGenSystemRandom 	, module Crypto.Random 	) where @@ -104,7 +101,11 @@ 		(_, Left e) -> Left e  instance CryptoRandomGen HmacDRBG where-	newGen bs = Right $ M.instantiate bs B.empty B.empty+	newGen bs =+		let res = M.instantiate bs B.empty B.empty+		in if B.length bs < genSeedLength `for` res+			then Left NotEnoughEntropy+			else Right res 	genSeedLength = Tagged (512 `div` 8) 	genBytes req g = 		let res = M.generate g (req * 8) B.empty@@ -116,10 +117,18 @@ 		in case res of 			Nothing -> Left NeedReseed 			Just (r,s) -> Right (r, s)-	reseed ent g = Right $ M.reseed g ent B.empty+	reseed ent g =+		let res = M.reseed g ent B.empty+		in if B.length ent < genSeedLength `for` res+			then Left NotEnoughEntropy+			else Right res  instance CryptoRandomGen HashDRBG where-	newGen bs = Right $ H.instantiate bs B.empty B.empty+	newGen bs =+		let res = H.instantiate bs B.empty B.empty+		in if B.length bs < genSeedLength `for` res+			then Left NotEnoughEntropy+			else Right res 	genSeedLength = Tagged $ 512 `div` 8 	genBytes req g =  		let res = H.generate g (req * 8) B.empty@@ -131,7 +140,11 @@ 		in case res of 			Nothing -> Left NeedReseed 			Just (r,s) -> Right (r, s)-	reseed ent g = Right $ H.reseed g ent B.empty+	reseed ent g =+		let res = H.reseed g ent B.empty+		in if B.length ent < genSeedLength `for` res+			then Left NotEnoughEntropy+			else Right res  helper1 :: Tagged (GenAutoReseed a b) Int -> a helper1 = const undefined@@ -235,22 +248,35 @@  -- |@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.-data GenBuffered g = GenBuffered (Either (GenError, g) (B.ByteString, g)) {-# UNPACK #-} !B.ByteString+data GenBuffered g = GenBuffered Int Int (Either (GenError, g) (B.ByteString, g)) {-# UNPACK #-} !B.ByteString  proxyToGenBuffered :: Proxy g -> Proxy (Either GenError (GenBuffered g)) proxyToGenBuffered = const Proxy -bufferMinSize = 2^20-bufferMaxSize = 2^22+bufferMinDef = 2^20+bufferMaxDef = 2^22 +newGenBuffered :: (CryptoRandomGen g) => Int -> Int -> B.ByteString -> Either GenError (GenBuffered g)+newGenBuffered min max bs = do+        g <- newGen bs+        (rs,g') <- genBytes min g+        let new = wrapErr (genBytes min g') g'+        (let !_ = rs in ()) `par` return (GenBuffered min max new rs)++newGenBufferedIO :: CryptoRandomGen g => Int -> Int -> IO (GenBuffered g)+newGenBufferedIO min max = do+        g <- newGenIO+        let !(Right !gBuf) = do+                (rs,g') <- genBytes min g+                let new = wrapErr (genBytes min g') g'+                (let !_ = rs in ()) `par` return (GenBuffered min max new rs)+        return gBuf+ instance (CryptoRandomGen g) => CryptoRandomGen (GenBuffered g) where 	{-# SPECIALIZE instance CryptoRandomGen (GenBuffered HmacDRBG) #-} 	{-# SPECIALIZE instance CryptoRandomGen (GenBuffered HashDRBG) #-}-	newGen bs = do-		g <- newGen bs-		(rs,g') <- genBytes bufferMinSize g-		let new = wrapErr (genBytes bufferMinSize g') g'-		(let !_ = rs in ()) `par` return (GenBuffered new rs)+        newGen = newGenBuffered bufferMinDef bufferMaxDef+        newGenIO = newGenBufferedIO bufferMinDef bufferMaxDef 	genSeedLength = 		let a = help res 		    res = Tagged $ genSeedLength `for` a@@ -258,34 +284,36 @@ 	  where 	  help :: Tagged (GenBuffered g) c -> g 	  help = const undefined-	genBytes req gb@(GenBuffered g bs)-		| remSize >= bufferMinSize =  Right (B.take req bs, GenBuffered g (B.drop req bs))-		| B.length bs < bufferMinSize =-			case g of-				Left (err,_)  -> Left err-				Right g   -> Left (GenErrorOther "Buffering generator failed to buffer properly - unknown reason")-		| req > B.length bs = Left RequestedTooManyBytes-		| remSize < bufferMinSize =-			case g of-				Left (err,_) -> Left err-				Right (rnd, gen) ->-					let new = wrapErr (genBytes bufferMinSize gen) gen-					    (rs,rem) = B.splitAt req bs-					in (eval new) `par` Right (rs, GenBuffered new (B.append rem rnd))-		| otherwise = Left $ GenErrorOther "Buffering generator hit an impossible case.  Please inform DRBG maintainer"-	  where-	  remSize = B.length bs - req-	genBytesWithEntropy req ent g = reseed ent g >>= \gen -> genBytes req gen-	reseed ent (GenBuffered g bs) = do-		let (rs, g') =-		      case g of-			Left (_,g') -> (B.empty, g')-			Right (rs, g') -> (rs, g')-		g'' <- reseed ent g'-		let new = wrapErr (genBytes bufferMinSize g'') g''-		    bs' = B.take bufferMaxSize (B.append bs rs)-		return (GenBuffered new bs')+        genBytes req gb@(GenBuffered min max g bs)+                | remSize >= min =  Right (B.take req bs, GenBuffered min max g (B.drop req bs))+                | B.length bs < min =+                        case g of+                                Left (err,_)  -> Left err+                                Right g   -> Left (GenErrorOther "Buffering generator failed to buffer properly - unknown reason")+                | req > B.length bs = Left RequestedTooManyBytes+                | remSize < min =+                        case g of+                                Left (err,_) -> Left err+                                Right (rnd, gen) ->+                                        let new | B.length rnd > 0 = wrapErr (genBytes (max - (remSize + B.length rnd)) gen) gen+                                                | otherwise = Right (B.empty,gen)+                                            (rs,rem) = B.splitAt req bs+                                        in (eval new) `par` Right (rs, GenBuffered min max new (B.append rem rnd))+                | otherwise = Left $ GenErrorOther "Buffering generator hit an impossible case.  Please inform the Haskell crypto-api maintainer"+          where+          remSize = B.length bs - req+        genBytesWithEntropy req ent g = reseed ent g >>= \gen -> genBytes req gen+        reseed ent (GenBuffered min max g bs) = do+                let (rs, g') =+                      case g of+                        Left (_,g') -> (B.empty, g')+                        Right (rs, g') -> (rs, g')+                g'' <- reseed ent g'+                let new = wrapErr (genBytes (min-B.length bs') g'') g''+                    bs' = B.take max (B.append bs rs)+                return (GenBuffered min max new bs') + wrapErr :: Either x y -> g -> Either (x,g) y wrapErr (Left x) g = Left (x,g) wrapErr (Right r) _ = Right r@@ -294,45 +322,6 @@ eval :: Either x (B.ByteString, g) -> Either x (B.ByteString, g) eval (Left x) = Left x eval (Right (g,bs)) = bs `seq` (g `seq` (Right (g, bs)))---- |Not that it belongs here, or that it is technically correct as an instance of 'CryptoRandomGen', but simply because--- it's a reasonable engineering choice here is a 'GenSystemRandom' that streams the system randoms. Take note:--- ---  * It uses the default definition of 'genByteWithEntropy'------  * 'newGen' will always fail!  DO NOT USE 'newGenIO' for this generator!------  * 'reseed' will always fail!------  * the handle to the system random is never closed-data GenSystemRandom = GenSysRandom L.ByteString--getGenSystemRandom :: IO GenSystemRandom-getGenSystemRandom = do-	ch <- openHandle-	let getBS = unsafeInterleaveIO $ do-		bs <- hGetEntropy ch ((2^15) - 16)-		more <- getBS-		return (bs:more)-	liftM (GenSysRandom . L.fromChunks) getBS--instance CryptoRandomGen GenSystemRandom where-	newGen _ = Left $ GenErrorOther "SystemRandomGen isn't a semanticly correct generator.  Tell your developer to use 'Crypto.Random.DRBG.getGenSystemRandom' instead of 'Crypto.Random.newGen'"-	genSeedLength = Tagged 0-	genBytes req (GenSysRandom bs) =-		let reqI = fromIntegral req-		    rnd = L.take reqI bs-		    rest = L.drop reqI bs-		in if L.length rnd == reqI-			then Right (B.concat $ L.toChunks rnd, GenSysRandom rest)-			else Left $ GenErrorOther "Error obtaining enough bytes from system random for given request"-	reseed _ _ = Left $ GenErrorOther "SystemRandomGen isn't a semantically correct generator. Don't use 'WithEntropy'."--split :: CryptoRandomGen g => g -> Either GenError (g,g)-split g = do-	(ent,g') <- genBytes (genSeedLength `for` g) g-	new <- newGen ent-	return (g', new)  -- |zipWith xor + Pack -- As a result of rewrite rules, this should automatically be optimized (at compile time) 

@@ -17,6 +17,7 @@ import Data.Serialize (encode) import Data.Bits (shiftR, shiftL) import Data.Tagged+import Crypto.Random.DRBG.Util  class SeedLength h where   seedlen :: Tagged h Int@@ -90,18 +91,3 @@   slen = seedlen `for` d   outlen = outputLength `for` d   h = hashFunc' d--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)--bs2i :: B.ByteString -> Integer-bs2i bs = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 bs

@@ -6,8 +6,7 @@ import Data.Serialize (encode) import Data.Serialize.Put (runPut, putWord32be) import Data.Word (Word8, Word32)--type BitLen = Int+import Crypto.Random.DRBG.Types  -- Section 10.4.1, pg 65 hash_df :: Hash c d => (L.ByteString -> d) -> B.ByteString -> BitLen -> B.ByteString

@@ -3,6 +3,7 @@ import Data.ByteString as B import Data.ByteString.Lazy as L +type BitLen = Int type Entropy = B.ByteString type PersonalizationString = B.ByteString type Nonce = B.ByteString

@@ -0,0 +1,23 @@+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.1.1+version:	0.1.2 license:	BSD3 license-file:	LICENSE author:		Thomas DuBuisson <thomas.dubuisson@gmail.com>@@ -26,7 +26,7 @@   ghc-options: -O2   hs-source-dirs:   exposed-modules: Crypto.Random.DRBG.Hash, Crypto.Random.DRBG.HMAC, Crypto.Random.DRBG, Crypto.Random.DRBG.Types-  other-modules: Crypto.Random.DRBG.HashDF+  other-modules: Crypto.Random.DRBG.HashDF, Crypto.Random.DRBG.Util  Executable drbg_test   if !flag(test)