diff --git a/Benchmarks/Benchmarks.hs b/Benchmarks/Benchmarks.hs --- a/Benchmarks/Benchmarks.hs +++ b/Benchmarks/Benchmarks.hs @@ -4,14 +4,15 @@ import qualified Data.ByteString as B import Crypto.Random.AESCtr +import Crypto.Random import System.IO.Unsafe (unsafePerformIO) import Data.IORef -gen rng n = fst (genRandomBytes n rng) +gen rng n = fst (cprgGenerate n rng) gen2 rngref n = unsafePerformIO $ do rng <- readIORef rngref - let (b, rng2) = genRandomBytes n rng + let (b, rng2) = cprgGenerate n rng writeIORef rngref rng2 return b diff --git a/Crypto/Random/AESCtr.hs b/Crypto/Random/AESCtr.hs --- a/Crypto/Random/AESCtr.hs +++ b/Crypto/Random/AESCtr.hs @@ -13,128 +13,52 @@ -- aes (IV `xor` counter) -> 16 bytes output -- {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} module Crypto.Random.AESCtr ( AESRNG , make , makeSystem - , genRandomBytes ) where -import Control.Applicative ((<$>)) - -import Crypto.Random.API - +import Crypto.Random import System.Random (RandomGen(..)) -import System.Entropy (getEntropy) -import qualified Crypto.Cipher.AES as AES +import Crypto.Random.AESCtr.Internal +import Control.Arrow (second) import Data.ByteString (ByteString) import qualified Data.ByteString as B -import Data.Maybe (fromJust) -import Data.Word +import Data.Byteable import Data.Bits (xor, (.&.)) -#ifdef USE_CEREAL -import Data.Serialize -#else -import Foreign.Ptr - -#if __GLASGOW_HASKELL__ > 704 -import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) -#else -import Foreign.ForeignPtr (unsafeForeignPtrToPtr) -#endif - -import Foreign.Storable -import qualified Data.ByteString.Internal as B -#endif - -data Word128 = Word128 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 - -{-| An opaque object containing an AES CPRNG -} -data RNG = RNG - {-# UNPACK #-} !Word128 - {-# UNPACK #-} !Word128 - {-# UNPACK #-} !Word64 - {-# UNPACK #-} !AES.AES - -data AESRNG = AESRNG { aesrngState :: RNG - , aesrngCache :: ByteString } +data AESRNG = AESRNG { aesrngState :: RNG + , aesrngEntropy :: EntropyPool + , aesrngThreshold :: Int -- ^ in number of generated block + , aesrngCache :: ByteString } instance Show AESRNG where show _ = "aesrng[..]" --- using serialize to grab a w128 as a non-negligeable cost, --- the Bytestring pointer manipulation are much faster. -#if USE_CEREAL - -put128 :: Word128 -> ByteString -put128 (Word128 a b) = runPut (putWord64host a >> putWord64host b) - -get128 :: ByteString -> Word128 -get128 = either (\_ -> Word128 0 0) id . runGet (getWord64host >>= \a -> (getWord64host >>= \b -> return $ Word128 a b)) - -#else - -put128 :: Word128 -> ByteString -put128 (Word128 a b) = B.unsafeCreate 16 (write64 . castPtr) - where write64 :: Ptr Word64 -> IO () - write64 ptr = poke ptr a >> poke (ptr `plusPtr` 8) b - -get128 :: ByteString -> Word128 -get128 (B.PS ps s _) = B.inlinePerformIO $ do - let ptr = castPtr (unsafeForeignPtrToPtr ps `plusPtr` s) :: Ptr Word64 - a <- peek ptr - b <- peek (ptr `plusPtr` 8) - return $ Word128 a b -#endif - -xor128 :: Word128 -> Word128 -> Word128 -xor128 (Word128 a1 b1) (Word128 a2 b2) = Word128 (a1 `xor` a2) (b1 `xor` b2) - -add64 :: Word128 -> Word128 -add64 (Word128 a b) = if b >= (0xffffffffffffffff-63) then Word128 (a+1) (b+64) else Word128 a (b+64) - -makeParams :: ByteString -> (AES.AES, ByteString, ByteString) -makeParams b = (key, cnt, iv) - where - key = AES.initAES $ B.take 32 left2 - (cnt, left2) = B.splitAt 16 left1 - (iv, left1) = B.splitAt 16 b +makeFrom :: EntropyPool -> B.ByteString -> AESRNG +makeFrom entPool b = AESRNG + { aesrngState = rng + , aesrngEntropy = entPool + , aesrngThreshold = 1024 -- in blocks generated, so 1mb + , aesrngCache = B.empty } + where rng = RNG (get128 iv) (get128 cnt) 0 key + (key, cnt, iv) = makeParams b --- | make an AES RNG from a bytestring seed. the bytestring need to be at least 64 bytes. --- if the bytestring is longer, the extra bytes will be ignored and will not take part in --- the initialization. +-- | make an AES RNG from an EntropyPool. -- --- use `makeSystem` to not have to deal with the generator seed. -make :: B.ByteString -> Maybe AESRNG -make b - | B.length b < 64 = Nothing - | otherwise = Just $ AESRNG { aesrngState = rng, aesrngCache = B.empty } - where - rng = RNG (get128 iv) (get128 cnt) 0 key - (key, cnt, iv) = makeParams b - -chunkSize :: Int -chunkSize = 1024 - -genNextChunk :: RNG -> (ByteString, RNG) -genNextChunk (RNG iv counter sz key) = (chunk, newrng) - where - newrng = RNG (get128 chunk) (add64 counter) (sz+fromIntegral chunkSize) key - chunk = AES.genCTR key bytes 1024 - bytes = put128 (iv `xor128` counter) - -getRNGReseedLimit :: RNG -> Int -getRNGReseedLimit (RNG _ _ sz _) - | sz >= limit = 0 - | otherwise = fromIntegral (limit - sz) - where limit = 2^(24 :: Int) +-- use `makeSystem` to not have to deal with the entropy pool. +make :: EntropyPool -> AESRNG +make entPool = makeFrom entPool b + where !b = toBytes $ grabEntropy 64 entPool -- | Initialize a new AES RNG using the system entropy. +-- {-# DEPRECATED makeSystem "use cprgCreate with an entropy pool" #-} makeSystem :: IO AESRNG -makeSystem = fromJust . make <$> getEntropy 64 +makeSystem = make `fmap` createEntropyPool -- | get a Random number of bytes from the RNG. -- it generate randomness by block of chunkSize bytes and will returns @@ -144,30 +68,47 @@ | n <= chunkSize = genNextChunk rng | otherwise = let (bs, rng') = acc 0 [] rng in (B.concat bs, rng') - where - acc l bs g + where acc l bs g | l * chunkSize >= n = (bs, g) | otherwise = let (b, g') = genNextChunk g in acc (l+1) (b:bs) g' -genRanBytes :: AESRNG -> Int -> (ByteString, AESRNG) -genRanBytes rng n +genRanBytesNoCheck :: AESRNG -> Int -> (ByteString, AESRNG) +genRanBytesNoCheck rng n | B.length (aesrngCache rng) >= n = let (b1,b2) = B.splitAt n (aesrngCache rng) in (b1, rng { aesrngCache = b2 }) | otherwise = - let (b, rng') = genRandomBytesState (aesrngState rng) n - (b1, b2) = B.splitAt n b - in (b1, rng { aesrngState = rng', aesrngCache = b2 }) + let (b, rng') = genRandomBytesState (aesrngState rng) n + (b1, b2) = B.splitAt n b + in (b1, rng { aesrngState = rng', aesrngCache = b2 }) -reseedState :: ByteString -> RNG -> RNG -reseedState b rng@(RNG _ cnt1 _ _) = RNG (get128 r16 `xor128` get128 iv2) (cnt1 `xor128` get128 cnt2) 0 key2 - where (r16, _) = genNextChunk rng - (key2, cnt2, iv2) = makeParams b +-- | generate a random set of bytes +genRanBytes :: AESRNG -> Int -> (ByteString, AESRNG) +genRanBytes rng n = second reseedThreshold $ genRanBytesNoCheck rng n +reseedThreshold :: AESRNG -> AESRNG +reseedThreshold rng + | getNbChunksGenerated (aesrngState rng) >= lvl = + let ent = toBytes $ grabEntropy 64 (aesrngEntropy rng) + in rng { aesrngState = reseedState ent (aesrngState rng) } + | otherwise = rng + where + lvl = aesrngThreshold rng + reseedState :: ByteString -> RNG -> RNG + reseedState b g@(RNG _ cnt1 _ _) = RNG (get128 r16 `xor128` get128 iv2) (cnt1 `xor128` get128 cnt2) 0 key2 + where (r16, _) = genNextChunk g + (key2, cnt2, iv2) = makeParams b + instance CPRG AESRNG where - cprgGenBytes len rng = genRanBytes rng len - cprgSupplyEntropy entropy rng = rng { aesrngState = reseedState entropy (aesrngState rng) } - cprgNeedReseed rng = ReseedInBytes $ fromIntegral $ getRNGReseedLimit (aesrngState rng) + cprgCreate = make + cprgSetReseedThreshold lvl rng = reseedThreshold (rng { aesrngThreshold = lvl }) + cprgGenerate len rng = genRanBytes rng len + cprgGenerateWithEntropy len rng = + let ent = toBytes $ grabEntropy len (aesrngEntropy rng) + (bs, rng') = genRanBytes rng len + in (B.pack $ B.zipWith xor ent bs, rng') + cprgFork rng = let (b,rng') = genRanBytes rng 64 + in (rng', makeFrom (aesrngEntropy rng) b) instance RandomGen AESRNG where next rng = @@ -176,8 +117,6 @@ let n = fromIntegral (a .&. 0x7fffffff) in (n, rng') split rng = - let (bs, rng') = genRanBytes rng 64 in - case make bs of - Nothing -> error "assert" - Just rng'' -> (rng', rng'') + let rng' = make (aesrngEntropy rng) + in (rng, rng') genRange _ = (0, 0x7fffffff) diff --git a/Crypto/Random/AESCtr/Internal.hs b/Crypto/Random/AESCtr/Internal.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/AESCtr/Internal.hs @@ -0,0 +1,80 @@ +-- | +-- Module : Crypto.Random.AESCtr.Internal +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : stable +-- Portability : unknown +-- +{-# LANGUAGE CPP #-} +module Crypto.Random.AESCtr.Internal where + +import qualified Crypto.Cipher.AES as AES + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B + +import Data.Word +import Data.Bits (xor) + +import Foreign.Ptr +#if __GLASGOW_HASKELL__ > 704 +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) +#else +import Foreign.ForeignPtr (unsafeForeignPtrToPtr) +#endif + +import Foreign.Storable +import qualified Data.ByteString.Internal as B + +data Word128 = Word128 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + +{-| An opaque object containing an AES CPRNG -} +data RNG = RNG + {-# UNPACK #-} !Word128 -- iv + {-# UNPACK #-} !Word128 -- cnt + {-# UNPACK #-} !Int -- number of chunks generated since reseed + {-# UNPACK #-} !AES.AES -- AES context + +getNbChunksGenerated :: RNG -> Int +getNbChunksGenerated (RNG _ _ c _) = c + +put128 :: Word128 -> ByteString +put128 (Word128 a b) = B.unsafeCreate 16 (write64 . castPtr) + where write64 :: Ptr Word64 -> IO () + write64 ptr = poke ptr a >> poke (ptr `plusPtr` 8) b + +get128 :: ByteString -> Word128 +get128 (B.PS ps s _) = B.inlinePerformIO $ do + let ptr = castPtr (unsafeForeignPtrToPtr ps `plusPtr` s) :: Ptr Word64 + a <- peek ptr + b <- peek (ptr `plusPtr` 8) + return $ Word128 a b + +xor128 :: Word128 -> Word128 -> Word128 +xor128 (Word128 a1 b1) (Word128 a2 b2) = Word128 (a1 `xor` a2) (b1 `xor` b2) + +add64 :: Word128 -> Word128 +add64 (Word128 a b) = if nb < 64 then Word128 (a+1) nb else Word128 a nb + where nb = b + 64 + +{- +withBsPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a +withBsPtr (B.PS ps s _) f = withForeignPtr ps $ \ptr -> f (ptr `plusPtr` s) +-} + +makeParams :: ByteString -> (AES.AES, ByteString, ByteString) +makeParams b = (key, cnt, iv) + where + key = AES.initAES $ B.take 32 left2 + (cnt, left2) = B.splitAt 16 left1 + (iv, left1) = B.splitAt 16 b + +chunkSize :: Int +chunkSize = 1024 + +genNextChunk :: RNG -> (ByteString, RNG) +genNextChunk (RNG iv counter nbChunks key) = (chunk, newrng) + where + newrng = RNG (get128 chunk) (add64 counter) (nbChunks+1) key + chunk = AES.genCTR key bytes chunkSize + bytes = put128 (iv `xor128` counter) diff --git a/cprng-aes.cabal b/cprng-aes.cabal --- a/cprng-aes.cabal +++ b/cprng-aes.cabal @@ -1,5 +1,5 @@ Name: cprng-aes -Version: 0.4.0 +Version: 0.5.0 Description: Simple crypto pseudo-random-number-generator with really good randomness property. . @@ -30,23 +30,17 @@ Homepage: http://github.com/vincenthz/hs-cprng-aes data-files: README.md -Flag cereal - Description: Use cereal - Default: False - Library Build-Depends: base >= 3 && < 5 , bytestring + , byteable , random - , crypto-random-api >= 0.2 && < 0.3 - , entropy >= 0.2 + , crypto-random >= 0.0 && < 0.1 Exposed-modules: Crypto.Random.AESCtr + Other-modules: Crypto.Random.AESCtr.Internal ghc-options: -Wall Build-Depends: cipher-aes >= 0.2 && < 0.3 - if flag(cereal) - Build-Depends: cereal >= 0.3.0 && < 0.4.0 - cpp-options: -DUSE_CEREAL Benchmark bench-cprng-aes hs-source-dirs: Benchmarks @@ -54,6 +48,7 @@ type: exitcode-stdio-1.0 Build-depends: base >= 4 && < 5 , bytestring + , crypto-random , cprng-aes , criterion , mtl