{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module Crypto.Random.AESCtr
( AESRNG
, make
, makeSystem
) where
import Crypto.Random
import Crypto.Random.AESCtr.Internal
import Control.Arrow (second)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Byteable
import Data.Bits (xor, (.&.))
data AESRNG = AESRNG { AESRNG -> RNG
aesrngState :: !RNG
, AESRNG -> EntropyPool
aesrngEntropy :: EntropyPool
, AESRNG -> Int
aesrngThreshold :: !Int
, AESRNG -> ByteString
aesrngCache :: !ByteString }
instance Show AESRNG where
show :: AESRNG -> String
show _ = "aesrng[..]"
makeFrom :: EntropyPool -> B.ByteString -> AESRNG
makeFrom :: EntropyPool -> ByteString -> AESRNG
makeFrom entPool :: EntropyPool
entPool b :: ByteString
b = $WAESRNG :: RNG -> EntropyPool -> Int -> ByteString -> AESRNG
AESRNG
{ aesrngState :: RNG
aesrngState = RNG
rng
, aesrngEntropy :: EntropyPool
aesrngEntropy = EntropyPool
entPool
, aesrngThreshold :: Int
aesrngThreshold = 1024
, aesrngCache :: ByteString
aesrngCache = ByteString
B.empty }
where rng :: RNG
rng = ByteString -> RNG
makeRNG ByteString
b
make :: EntropyPool -> AESRNG
make :: EntropyPool -> AESRNG
make entPool :: EntropyPool
entPool = EntropyPool -> ByteString -> AESRNG
makeFrom EntropyPool
entPool ByteString
b
where !b :: ByteString
b = SecureMem -> ByteString
forall a. Byteable a => a -> ByteString
toBytes (SecureMem -> ByteString) -> SecureMem -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> EntropyPool -> SecureMem
grabEntropy 64 EntropyPool
entPool
makeSystem :: IO AESRNG
makeSystem :: IO AESRNG
makeSystem = EntropyPool -> AESRNG
make (EntropyPool -> AESRNG) -> IO EntropyPool -> IO AESRNG
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO EntropyPool
createEntropyPool
genRandomBytesState :: RNG -> Int -> (ByteString, RNG)
genRandomBytesState :: RNG -> Int -> (ByteString, RNG)
genRandomBytesState rng :: RNG
rng n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
chunkSize = RNG -> (ByteString, RNG)
genNextChunk RNG
rng
| Bool
otherwise = let (bs :: [ByteString]
bs, rng' :: RNG
rng') = Int -> [ByteString] -> RNG -> ([ByteString], RNG)
acc 0 [] RNG
rng
in ([ByteString] -> ByteString
B.concat [ByteString]
bs, RNG
rng')
where acc :: Int -> [ByteString] -> RNG -> ([ByteString], RNG)
acc l :: Int
l bs :: [ByteString]
bs g :: RNG
g
| Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
chunkSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = ([ByteString]
bs, RNG
g)
| Bool
otherwise = let (b :: ByteString
b, g' :: RNG
g') = RNG -> (ByteString, RNG)
genNextChunk RNG
g
in Int -> [ByteString] -> RNG -> ([ByteString], RNG)
acc (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (ByteString
bByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
bs) RNG
g'
genRanBytesNoCheck :: AESRNG -> Int -> (ByteString, AESRNG)
genRanBytesNoCheck :: AESRNG -> Int -> (ByteString, AESRNG)
genRanBytesNoCheck rng :: AESRNG
rng n :: Int
n
| ByteString -> Int
B.length (AESRNG -> ByteString
aesrngCache AESRNG
rng) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = let (b1 :: ByteString
b1,b2 :: ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n (AESRNG -> ByteString
aesrngCache AESRNG
rng)
in (ByteString
b1, AESRNG
rng { aesrngCache :: ByteString
aesrngCache = ByteString
b2 })
| Bool
otherwise =
let (b :: ByteString
b, rng' :: RNG
rng') = RNG -> Int -> (ByteString, RNG)
genRandomBytesState (AESRNG -> RNG
aesrngState AESRNG
rng) Int
n
(b1 :: ByteString
b1, b2 :: ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
b
in (ByteString
b1, AESRNG
rng { aesrngState :: RNG
aesrngState = RNG
rng', aesrngCache :: ByteString
aesrngCache = ByteString
b2 })
genRanBytes :: AESRNG -> Int -> (ByteString, AESRNG)
genRanBytes :: AESRNG -> Int -> (ByteString, AESRNG)
genRanBytes rng :: AESRNG
rng n :: Int
n = (AESRNG -> AESRNG) -> (ByteString, AESRNG) -> (ByteString, AESRNG)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second AESRNG -> AESRNG
reseedThreshold ((ByteString, AESRNG) -> (ByteString, AESRNG))
-> (ByteString, AESRNG) -> (ByteString, AESRNG)
forall a b. (a -> b) -> a -> b
$ AESRNG -> Int -> (ByteString, AESRNG)
genRanBytesNoCheck AESRNG
rng Int
n
reseedThreshold :: AESRNG -> AESRNG
reseedThreshold :: AESRNG -> AESRNG
reseedThreshold rng :: AESRNG
rng
| RNG -> Int
getNbChunksGenerated (AESRNG -> RNG
aesrngState AESRNG
rng) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lvl =
let newRngState :: RNG
newRngState = ByteString -> RNG
makeRNG (ByteString -> RNG) -> ByteString -> RNG
forall a b. (a -> b) -> a -> b
$ SecureMem -> ByteString
forall a. Byteable a => a -> ByteString
toBytes (SecureMem -> ByteString) -> SecureMem -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> EntropyPool -> SecureMem
grabEntropy 64 (AESRNG -> EntropyPool
aesrngEntropy AESRNG
rng)
in AESRNG
rng { aesrngState :: RNG
aesrngState = RNG
newRngState }
| Bool
otherwise = AESRNG
rng
where lvl :: Int
lvl = AESRNG -> Int
aesrngThreshold AESRNG
rng
instance CPRG AESRNG where
cprgCreate :: EntropyPool -> AESRNG
cprgCreate = EntropyPool -> AESRNG
make
cprgSetReseedThreshold :: Int -> AESRNG -> AESRNG
cprgSetReseedThreshold lvl :: Int
lvl rng :: AESRNG
rng = AESRNG -> AESRNG
reseedThreshold (AESRNG
rng { aesrngThreshold :: Int
aesrngThreshold = if Int
nbChunks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Int
nbChunks else 1 })
where nbChunks :: Int
nbChunks = Int
lvl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
chunkSize
cprgGenerate :: Int -> AESRNG -> (ByteString, AESRNG)
cprgGenerate len :: Int
len rng :: AESRNG
rng = AESRNG -> Int -> (ByteString, AESRNG)
genRanBytes AESRNG
rng Int
len
cprgGenerateWithEntropy :: Int -> AESRNG -> (ByteString, AESRNG)
cprgGenerateWithEntropy len :: Int
len rng :: AESRNG
rng =
let ent :: ByteString
ent = SecureMem -> ByteString
forall a. Byteable a => a -> ByteString
toBytes (SecureMem -> ByteString) -> SecureMem -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> EntropyPool -> SecureMem
grabEntropy Int
len (AESRNG -> EntropyPool
aesrngEntropy AESRNG
rng)
(bs :: ByteString
bs, rng' :: AESRNG
rng') = AESRNG -> Int -> (ByteString, AESRNG)
genRanBytes AESRNG
rng Int
len
in ([Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
B.zipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor ByteString
ent ByteString
bs, AESRNG
rng')
cprgFork :: AESRNG -> (AESRNG, AESRNG)
cprgFork rng :: AESRNG
rng = let (b :: ByteString
b,rng' :: AESRNG
rng') = AESRNG -> Int -> (ByteString, AESRNG)
genRanBytes AESRNG
rng 64
in (AESRNG
rng', EntropyPool -> ByteString -> AESRNG
makeFrom (AESRNG -> EntropyPool
aesrngEntropy AESRNG
rng) ByteString
b)