{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, BangPatterns, ScopedTypeVariables #-}
module Crypto.Random.DRBG
(
HmacDRBG, HashDRBG, CtrDRBG
, HmacDRBGWith, HashDRBGWith, CtrDRBGWith
, GenXor(..)
, GenBuffered
, GenAutoReseed
, newGenAutoReseed, newGenAutoReseedIO
, module Crypto.Random
, module Crypto.Types
) where
import qualified Crypto.Random.DRBG.HMAC as M
import qualified Crypto.Random.DRBG.Hash as H
import qualified Crypto.Random.DRBG.CTR as CTR
import Crypto.Util
import Crypto.Classes
import Crypto.Random
import Crypto.Hash.CryptoAPI
import Crypto.Cipher.AES128 (AESKey128)
import Crypto.Types
import System.Entropy
import qualified Data.ByteString as B
import Data.Tagged
import Control.Parallel
import Control.Monad.Error ()
import Data.Word
instance H.SeedLength SHA512 where
seedlen :: Tagged SHA512 Int
seedlen = Int -> Tagged SHA512 Int
forall k (s :: k) b. b -> Tagged s b
Tagged 888
instance H.SeedLength SHA384 where
seedlen :: Tagged SHA384 Int
seedlen = Int -> Tagged SHA384 Int
forall k (s :: k) b. b -> Tagged s b
Tagged 888
instance H.SeedLength SHA256 where
seedlen :: Tagged SHA256 Int
seedlen = Int -> Tagged SHA256 Int
forall k (s :: k) b. b -> Tagged s b
Tagged 440
instance H.SeedLength SHA224 where
seedlen :: Tagged SHA224 Int
seedlen = Int -> Tagged SHA224 Int
forall k (s :: k) b. b -> Tagged s b
Tagged 440
instance H.SeedLength SHA1 where
seedlen :: Tagged SHA1 Int
seedlen = Int -> Tagged SHA1 Int
forall k (s :: k) b. b -> Tagged s b
Tagged 440
type HmacDRBGWith = M.State
type HashDRBGWith = H.State
type CtrDRBGWith = CTR.State
type HmacDRBG = M.State SHA512
type HashDRBG = H.State SHA512
type CtrDRBG = CTR.State AESKey128
newGenAutoReseed :: (CryptoRandomGen a, CryptoRandomGen b) => B.ByteString -> Word64 -> Either GenError (GenAutoReseed a b)
newGenAutoReseed :: ByteString -> Word64 -> Either GenError (GenAutoReseed a b)
newGenAutoReseed bs :: ByteString
bs rsInterval :: Word64
rsInterval=
let (b1 :: ByteString
b1,b2 :: ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` Either GenError a -> a
forall a b. Either a b -> b
fromRight Either GenError a
g1) ByteString
bs
g1 :: Either GenError a
g1 = ByteString -> Either GenError a
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen ByteString
b1
g2 :: Either GenError b
g2 = ByteString -> Either GenError b
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen ByteString
b2
fromRight :: Either a b -> b
fromRight ~(Right x :: b
x) = b
x
in case (Either GenError a
g1, Either GenError b
g2) of
(Right a :: a
a, Right b :: b
b) -> GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall a b. b -> Either a b
Right (GenAutoReseed a b -> Either GenError (GenAutoReseed a b))
-> GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
rsInterval 0 a
a b
b
(Left e :: GenError
e, _) -> GenError -> Either GenError (GenAutoReseed a b)
forall a b. a -> Either a b
Left GenError
e
(_, Left e :: GenError
e) -> GenError -> Either GenError (GenAutoReseed a b)
forall a b. a -> Either a b
Left GenError
e
newGenAutoReseedIO :: (CryptoRandomGen a, CryptoRandomGen b) => Word64 -> IO (GenAutoReseed a b)
newGenAutoReseedIO :: Word64 -> IO (GenAutoReseed a b)
newGenAutoReseedIO i :: Word64
i = do
a
g1 <- IO a
forall g. CryptoRandomGen g => IO g
newGenIO
b
g2 <- IO b
forall g. CryptoRandomGen g => IO g
newGenIO
GenAutoReseed a b -> IO (GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenAutoReseed a b -> IO (GenAutoReseed a b))
-> GenAutoReseed a b -> IO (GenAutoReseed a b)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
i 0 a
g1 b
g2
instance CryptoRandomGen HmacDRBG where
newGen :: ByteString -> Either GenError HmacDRBG
newGen bs :: ByteString
bs =
let res :: HmacDRBG
res = ByteString -> ByteString -> ByteString -> HmacDRBG
forall c d.
Hash c d =>
ByteString -> ByteString -> ByteString -> State d
M.instantiate ByteString
bs ByteString
B.empty ByteString
B.empty
in if ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tagged HmacDRBG Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged HmacDRBG Int -> HmacDRBG -> Int
forall a b. Tagged a b -> a -> b
`for` HmacDRBG
res
then GenError -> Either GenError HmacDRBG
forall a b. a -> Either a b
Left GenError
NotEnoughEntropy
else HmacDRBG -> Either GenError HmacDRBG
forall a b. b -> Either a b
Right HmacDRBG
res
genSeedLength :: Tagged HmacDRBG Int
genSeedLength = Int -> Tagged HmacDRBG Int
forall k (s :: k) b. b -> Tagged s b
Tagged (512 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 8)
genBytes :: Int -> HmacDRBG -> Either GenError (ByteString, HmacDRBG)
genBytes req :: Int
req g :: HmacDRBG
g =
let res :: Maybe (ByteString, HmacDRBG)
res = HmacDRBG -> Int -> ByteString -> Maybe (ByteString, HmacDRBG)
forall c d.
Hash c d =>
State d -> Int -> ByteString -> Maybe (ByteString, State d)
M.generate HmacDRBG
g (Int
req Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) ByteString
B.empty
in case Maybe (ByteString, HmacDRBG)
res of
Nothing -> GenError -> Either GenError (ByteString, HmacDRBG)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (r :: ByteString
r,s :: HmacDRBG
s) -> (ByteString, HmacDRBG) -> Either GenError (ByteString, HmacDRBG)
forall a b. b -> Either a b
Right (ByteString
r, HmacDRBG
s)
genBytesWithEntropy :: Int
-> ByteString -> HmacDRBG -> Either GenError (ByteString, HmacDRBG)
genBytesWithEntropy req :: Int
req ai :: ByteString
ai g :: HmacDRBG
g =
let res :: Maybe (ByteString, HmacDRBG)
res = HmacDRBG -> Int -> ByteString -> Maybe (ByteString, HmacDRBG)
forall c d.
Hash c d =>
State d -> Int -> ByteString -> Maybe (ByteString, State d)
M.generate HmacDRBG
g (Int
req Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) ByteString
ai
in case Maybe (ByteString, HmacDRBG)
res of
Nothing -> GenError -> Either GenError (ByteString, HmacDRBG)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (r :: ByteString
r,s :: HmacDRBG
s) -> (ByteString, HmacDRBG) -> Either GenError (ByteString, HmacDRBG)
forall a b. b -> Either a b
Right (ByteString
r, HmacDRBG
s)
reseed :: ByteString -> HmacDRBG -> Either GenError HmacDRBG
reseed ent :: ByteString
ent g :: HmacDRBG
g =
let res :: HmacDRBG
res = HmacDRBG -> ByteString -> ByteString -> HmacDRBG
forall c d.
Hash c d =>
State d -> ByteString -> ByteString -> State d
M.reseed HmacDRBG
g ByteString
ent ByteString
B.empty
in if ByteString -> Int
B.length ByteString
ent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tagged HmacDRBG Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged HmacDRBG Int -> HmacDRBG -> Int
forall a b. Tagged a b -> a -> b
`for` HmacDRBG
res
then GenError -> Either GenError HmacDRBG
forall a b. a -> Either a b
Left GenError
NotEnoughEntropy
else HmacDRBG -> Either GenError HmacDRBG
forall a b. b -> Either a b
Right HmacDRBG
res
reseedInfo :: HmacDRBG -> ReseedInfo
reseedInfo s :: HmacDRBG
s = Word64 -> ReseedInfo
InXCalls (HmacDRBG -> Word64
forall d. State d -> Word64
M.counter HmacDRBG
s)
reseedPeriod :: HmacDRBG -> ReseedInfo
reseedPeriod _ = Word64 -> ReseedInfo
InXCalls Word64
M.reseedInterval
instance CryptoRandomGen HashDRBG where
newGen :: ByteString -> Either GenError HashDRBG
newGen bs :: ByteString
bs =
let res :: HashDRBG
res = ByteString -> ByteString -> ByteString -> HashDRBG
forall c d.
(Hash c d, SeedLength d) =>
ByteString -> ByteString -> ByteString -> State d
H.instantiate ByteString
bs ByteString
B.empty ByteString
B.empty
in if ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tagged HashDRBG Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged HashDRBG Int -> HashDRBG -> Int
forall a b. Tagged a b -> a -> b
`for` HashDRBG
res
then GenError -> Either GenError HashDRBG
forall a b. a -> Either a b
Left GenError
NotEnoughEntropy
else HashDRBG -> Either GenError HashDRBG
forall a b. b -> Either a b
Right HashDRBG
res
genSeedLength :: Tagged HashDRBG Int
genSeedLength = Int -> Tagged HashDRBG Int
forall k (s :: k) b. b -> Tagged s b
Tagged (Int -> Tagged HashDRBG Int) -> Int -> Tagged HashDRBG Int
forall a b. (a -> b) -> a -> b
$ 512 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 8
genBytes :: Int -> HashDRBG -> Either GenError (ByteString, HashDRBG)
genBytes req :: Int
req g :: HashDRBG
g =
let res :: Maybe (ByteString, HashDRBG)
res = HashDRBG -> Int -> ByteString -> Maybe (ByteString, HashDRBG)
forall c d.
(Hash c d, SeedLength d) =>
State d -> Int -> ByteString -> Maybe (ByteString, State d)
H.generate HashDRBG
g (Int
req Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) ByteString
B.empty
in case Maybe (ByteString, HashDRBG)
res of
Nothing -> GenError -> Either GenError (ByteString, HashDRBG)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (r :: ByteString
r,s :: HashDRBG
s) -> (ByteString, HashDRBG) -> Either GenError (ByteString, HashDRBG)
forall a b. b -> Either a b
Right (ByteString
r, HashDRBG
s)
genBytesWithEntropy :: Int
-> ByteString -> HashDRBG -> Either GenError (ByteString, HashDRBG)
genBytesWithEntropy req :: Int
req ai :: ByteString
ai g :: HashDRBG
g =
let res :: Maybe (ByteString, HashDRBG)
res = HashDRBG -> Int -> ByteString -> Maybe (ByteString, HashDRBG)
forall c d.
(Hash c d, SeedLength d) =>
State d -> Int -> ByteString -> Maybe (ByteString, State d)
H.generate HashDRBG
g (Int
req Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) ByteString
ai
in case Maybe (ByteString, HashDRBG)
res of
Nothing -> GenError -> Either GenError (ByteString, HashDRBG)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (r :: ByteString
r,s :: HashDRBG
s) -> (ByteString, HashDRBG) -> Either GenError (ByteString, HashDRBG)
forall a b. b -> Either a b
Right (ByteString
r, HashDRBG
s)
reseed :: ByteString -> HashDRBG -> Either GenError HashDRBG
reseed ent :: ByteString
ent g :: HashDRBG
g =
let res :: HashDRBG
res = HashDRBG -> ByteString -> ByteString -> HashDRBG
forall d c.
(SeedLength d, Hash c d) =>
State d -> ByteString -> ByteString -> State d
H.reseed HashDRBG
g ByteString
ent ByteString
B.empty
in if ByteString -> Int
B.length ByteString
ent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tagged HashDRBG Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged HashDRBG Int -> HashDRBG -> Int
forall a b. Tagged a b -> a -> b
`for` HashDRBG
res
then GenError -> Either GenError HashDRBG
forall a b. a -> Either a b
Left GenError
NotEnoughEntropy
else HashDRBG -> Either GenError HashDRBG
forall a b. b -> Either a b
Right HashDRBG
res
reseedInfo :: HashDRBG -> ReseedInfo
reseedInfo s :: HashDRBG
s = Word64 -> ReseedInfo
InXCalls (HashDRBG -> Word64
forall d. State d -> Word64
H.counter HashDRBG
s)
reseedPeriod :: HashDRBG -> ReseedInfo
reseedPeriod _ = Word64 -> ReseedInfo
InXCalls Word64
H.reseedInterval
helper1 :: Tagged (GenAutoReseed a b) Int -> a
helper1 :: Tagged (GenAutoReseed a b) Int -> a
helper1 = a -> Tagged (GenAutoReseed a b) Int -> a
forall a b. a -> b -> a
const a
forall a. HasCallStack => a
undefined
helper2 :: Tagged (GenAutoReseed a b) Int -> b
helper2 :: Tagged (GenAutoReseed a b) Int -> b
helper2 = b -> Tagged (GenAutoReseed a b) Int -> b
forall a b. a -> b -> a
const b
forall a. HasCallStack => a
undefined
data GenAutoReseed a b = GenAutoReseed
{ GenAutoReseed a b -> Word64
garInterval :: {-# UNPACK #-} !Word64
, GenAutoReseed a b -> Word64
garCounter :: {-# UNPACK #-} !Word64
, GenAutoReseed a b -> a
garPrimeGen :: !a
, GenAutoReseed a b -> b
garBackupGen :: !b
}
genBytesAutoReseed :: (CryptoRandomGen a, CryptoRandomGen b)
=> ByteLength
-> GenAutoReseed a b
-> Either GenError (B.ByteString, GenAutoReseed a b)
genBytesAutoReseed :: Int
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
genBytesAutoReseed req :: Int
req gar :: GenAutoReseed a b
gar@(GenAutoReseed rs :: Word64
rs cnt :: Word64
cnt a :: a
a b :: b
b) =
case Int -> a -> Either GenError (ByteString, a)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
req a
a of
Left NeedReseed -> do
(a' :: a
a',b' :: b
b') <- a
a a -> b -> Either GenError (a, b)
forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
a -> b -> Either GenError (a, b)
`reseedWith` b
b
(res :: ByteString
res, aNew :: a
aNew) <- Int -> a -> Either GenError (ByteString, a)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
req a
a'
(ByteString, GenAutoReseed a b)
-> Either GenError (ByteString, GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
res,Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
rs 0 a
aNew b
b')
Left RequestedTooManyBytes -> do
let reqSmall :: Int
reqSmall = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
req Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2)
(s1 :: ByteString
s1, gar1 :: GenAutoReseed a b
gar1) <- Int
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
reqSmall GenAutoReseed a b
gar
(s2 :: ByteString
s2, gar2 :: GenAutoReseed a b
gar2) <- Int
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
reqSmall GenAutoReseed a b
gar1
(ByteString, GenAutoReseed a b)
-> Either GenError (ByteString, GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ByteString -> ByteString
B.take Int
req (ByteString -> ByteString -> ByteString
B.append ByteString
s1 ByteString
s2), GenAutoReseed a b
gar2)
Left err :: GenError
err -> GenError -> Either GenError (ByteString, GenAutoReseed a b)
forall a b. a -> Either a b
Left GenError
err
Right (res :: ByteString
res,aNew :: a
aNew) -> do
GenAutoReseed a b
gNew <- if (Word64
cnt Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
req) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
rs
then do
(a' :: a
a',b' :: b
b') <- a
a a -> b -> Either GenError (a, b)
forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
a -> b -> Either GenError (a, b)
`reseedWith` b
b
GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
rs 0 a
a' b
b')
else GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenAutoReseed a b -> Either GenError (GenAutoReseed a b))
-> GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
rs (Word64
cnt Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
req) a
aNew b
b
(ByteString, GenAutoReseed a b)
-> Either GenError (ByteString, GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
res, GenAutoReseed a b
gNew)
reseedWith :: (CryptoRandomGen a, CryptoRandomGen b)
=> a -> b -> Either GenError (a,b)
reseedWith :: a -> b -> Either GenError (a, b)
reseedWith x :: a
x y :: b
y = do
(ent :: ByteString
ent,y2 :: b
y2) <- Int -> b -> Either GenError (ByteString, b)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes (Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` a
x) b
y
a
x2 <- ByteString -> a -> Either GenError a
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
reseed ByteString
ent a
x
(a, b) -> Either GenError (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x2,b
y2)
genBytesWithEntropyAutoReseed
:: (CryptoRandomGen a, CryptoRandomGen b)
=> ByteLength
-> B.ByteString
-> GenAutoReseed a b
-> Either GenError (B.ByteString, GenAutoReseed a b)
genBytesWithEntropyAutoReseed :: Int
-> ByteString
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
genBytesWithEntropyAutoReseed req :: Int
req entropy :: ByteString
entropy gar :: GenAutoReseed a b
gar@(GenAutoReseed rs :: Word64
rs cnt :: Word64
cnt a :: a
a b :: b
b) =
case Int -> ByteString -> a -> Either GenError (ByteString, a)
forall g.
CryptoRandomGen g =>
Int -> ByteString -> g -> Either GenError (ByteString, g)
genBytesWithEntropy Int
req ByteString
entropy a
a of
Left NeedReseed -> do
(a' :: a
a',b' :: b
b') <- a
a a -> b -> Either GenError (a, b)
forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
a -> b -> Either GenError (a, b)
`reseedWith` b
b
(res :: ByteString
res, aNew :: a
aNew) <- Int -> ByteString -> a -> Either GenError (ByteString, a)
forall g.
CryptoRandomGen g =>
Int -> ByteString -> g -> Either GenError (ByteString, g)
genBytesWithEntropy Int
req ByteString
entropy a
a'
(ByteString, GenAutoReseed a b)
-> Either GenError (ByteString, GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
res, Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
rs 0 a
aNew b
b')
Left RequestedTooManyBytes -> do
let reqSmall :: Int
reqSmall = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
req Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2)
(s1 :: ByteString
s1, gar1 :: GenAutoReseed a b
gar1) <- Int
-> ByteString
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
forall g.
CryptoRandomGen g =>
Int -> ByteString -> g -> Either GenError (ByteString, g)
genBytesWithEntropy Int
reqSmall ByteString
entropy GenAutoReseed a b
gar
(s2 :: ByteString
s2, gar2 :: GenAutoReseed a b
gar2) <- Int
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
reqSmall GenAutoReseed a b
gar1
(ByteString, GenAutoReseed a b)
-> Either GenError (ByteString, GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ByteString -> ByteString
B.take Int
req (ByteString -> ByteString -> ByteString
B.append ByteString
s1 ByteString
s2), GenAutoReseed a b
gar2)
Left err :: GenError
err -> GenError -> Either GenError (ByteString, GenAutoReseed a b)
forall a b. a -> Either a b
Left GenError
err
Right (res :: ByteString
res,aNew :: a
aNew) -> do
GenAutoReseed a b
gNew <- if (Word64
cnt Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
req) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
rs
then do
(a' :: a
a',b' :: b
b') <- a
a a -> b -> Either GenError (a, b)
forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
a -> b -> Either GenError (a, b)
`reseedWith` b
b
GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
rs 0 a
a' b
b')
else GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenAutoReseed a b -> Either GenError (GenAutoReseed a b))
-> GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
rs (Word64
cnt Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
req) a
aNew b
b
(ByteString, GenAutoReseed a b)
-> Either GenError (ByteString, GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
res, GenAutoReseed a b
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 :: ByteString -> Either GenError (GenAutoReseed a b)
newGen bs :: ByteString
bs = ByteString -> Word64 -> Either GenError (GenAutoReseed a b)
forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
ByteString -> Word64 -> Either GenError (GenAutoReseed a b)
newGenAutoReseed ByteString
bs (2Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(19::Int))
newGenIO :: IO (GenAutoReseed a b)
newGenIO = Word64 -> IO (GenAutoReseed a b)
forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
Word64 -> IO (GenAutoReseed a b)
newGenAutoReseedIO (2Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(19::Int))
genSeedLength :: Tagged (GenAutoReseed a b) Int
genSeedLength =
let a :: a
a = Tagged (GenAutoReseed a b) Int -> a
forall a b. Tagged (GenAutoReseed a b) Int -> a
helper1 Tagged (GenAutoReseed a b) Int
res
b :: b
b = Tagged (GenAutoReseed a b) Int -> b
forall a b. Tagged (GenAutoReseed a b) Int -> b
helper2 Tagged (GenAutoReseed a b) Int
res
res :: Tagged (GenAutoReseed a b) Int
res = Int -> Tagged (GenAutoReseed a b) Int
forall k (s :: k) b. b -> Tagged s b
Tagged (Int -> Tagged (GenAutoReseed a b) Int)
-> Int -> Tagged (GenAutoReseed a b) Int
forall a b. (a -> b) -> a -> b
$ Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tagged b Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged b Int -> b -> Int
forall a b. Tagged a b -> a -> b
`for` b
b
in Tagged (GenAutoReseed a b) Int
res
genBytes :: Int
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
genBytes = Int
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
Int
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
genBytesAutoReseed
genBytesWithEntropy :: Int
-> ByteString
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
genBytesWithEntropy = Int
-> ByteString
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
Int
-> ByteString
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
genBytesWithEntropyAutoReseed
reseed :: ByteString
-> GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
reseed ent :: ByteString
ent gen :: GenAutoReseed a b
gen@(GenAutoReseed rs :: Word64
rs _ a :: a
a b :: b
b)
| Tagged (GenAutoReseed a b) Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged (GenAutoReseed a b) Int -> GenAutoReseed a b -> Int
forall a b. Tagged a b -> a -> b
`for` GenAutoReseed a b
gen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
B.length ByteString
ent = GenError -> Either GenError (GenAutoReseed a b)
forall a b. a -> Either a b
Left GenError
NotEnoughEntropy
| Bool
otherwise = do
let (e1 :: ByteString
e1,e2 :: ByteString
e2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` a
a) ByteString
ent
a
a' <- ByteString -> a -> Either GenError a
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
reseed ByteString
e1 a
a
b
b' <- if ByteString -> Int
B.length ByteString
e2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
then ByteString -> b -> Either GenError b
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
reseed ByteString
e2 b
b
else b -> Either GenError b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenAutoReseed a b -> Either GenError (GenAutoReseed a b))
-> GenAutoReseed a b -> Either GenError (GenAutoReseed a b)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> a -> b -> GenAutoReseed a b
forall a b. Word64 -> Word64 -> a -> b -> GenAutoReseed a b
GenAutoReseed Word64
rs 0 a
a' b
b'
reseedPeriod :: GenAutoReseed a b -> ReseedInfo
reseedPeriod ~(GenAutoReseed rs :: Word64
rs _ ag :: a
ag bg :: b
bg) =
case (a -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedPeriod a
ag, b -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedPeriod b
bg) of
(Never, _) -> ReseedInfo
Never
(_, Never) -> ReseedInfo
Never
(NotSoon, _) -> ReseedInfo
NotSoon
(_, NotSoon) -> ReseedInfo
NotSoon
(_, InXCalls b :: Word64
b) ->
if Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
rs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>
Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. a -> a -> a
`asTypeOf` Word64
b)
then ReseedInfo
NotSoon
else Word64 -> ReseedInfo
InXBytes (Word64
rs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
b)
(_, InXBytes b :: Word64
b) ->
let s :: Int
s = Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` a
ag
nr :: Word64
nr = if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then 1 else (Word64
b Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- 1
in Word64 -> ReseedInfo
InXBytes (Word64 -> ReseedInfo) -> Word64 -> ReseedInfo
forall a b. (a -> b) -> a -> b
$ Word64
rs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
nr
reseedInfo :: GenAutoReseed a b -> ReseedInfo
reseedInfo (GenAutoReseed rs :: Word64
rs x :: Word64
x ag :: a
ag bg :: b
bg) =
case (a -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedInfo a
ag, b -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedInfo b
bg) of
(NotSoon, _) -> ReseedInfo
NotSoon
(_, NotSoon) -> ReseedInfo
NotSoon
(Never, _) -> ReseedInfo
Never
(_, Never) -> ReseedInfo
Never
(_, InXBytes b :: Word64
b) ->
let s :: Int
s = Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` a
ag
nr :: Word64
nr = if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then 1 else (Word64
b Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- 1
in Word64 -> ReseedInfo
InXBytes (Word64 -> ReseedInfo) -> Word64 -> ReseedInfo
forall a b. (a -> b) -> a -> b
$ Word64
rs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
rs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
nr
(_, InXCalls b :: Word64
b) ->
if Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
rs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>
Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. a -> a -> a
`asTypeOf` Word64
b)
then ReseedInfo
NotSoon
else Word64 -> ReseedInfo
InXBytes (Word64
rs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
rs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
b)
data GenXor a b = GenXor !a !b
helperXor1 :: Tagged (GenXor a b) c -> a
helperXor1 :: Tagged (GenXor a b) c -> a
helperXor1 = a -> Tagged (GenXor a b) c -> a
forall a b. a -> b -> a
const a
forall a. HasCallStack => a
undefined
helperXor2 :: Tagged (GenXor a b) c -> b
helperXor2 :: Tagged (GenXor a b) c -> b
helperXor2 = b -> Tagged (GenXor a b) c -> b
forall a b. a -> b -> a
const b
forall a. HasCallStack => a
undefined
instance (CryptoRandomGen a, CryptoRandomGen b) => CryptoRandomGen (GenXor a b) where
{-# SPECIALIZE instance CryptoRandomGen (GenXor HmacDRBG HmacDRBG) #-}
{-# SPECIALIZE instance CryptoRandomGen (GenXor HashDRBG HmacDRBG) #-}
{-# SPECIALIZE instance CryptoRandomGen (GenXor HmacDRBG HashDRBG) #-}
{-# SPECIALIZE instance CryptoRandomGen (GenXor HashDRBG HashDRBG) #-}
newGen :: ByteString -> Either GenError (GenXor a b)
newGen bs :: ByteString
bs = do
let g1 :: Either GenError a
g1 = ByteString -> Either GenError a
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen ByteString
b1
g2 :: Either GenError b
g2 = ByteString -> Either GenError b
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen ByteString
b2
(b1 :: ByteString
b1,b2 :: ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` Either GenError a -> a
forall a b. Either a b -> b
fromRight Either GenError a
g1) ByteString
bs
fromRight :: Either a b -> b
fromRight (Right x :: b
x) = b
x
a
a <- Either GenError a
g1
b
b <- Either GenError b
g2
GenXor a b -> Either GenError (GenXor a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> GenXor a b
forall a b. a -> b -> GenXor a b
GenXor a
a b
b)
newGenIO :: IO (GenXor a b)
newGenIO = do
a
a <- IO a
forall g. CryptoRandomGen g => IO g
newGenIO
b
b <- IO b
forall g. CryptoRandomGen g => IO g
newGenIO
GenXor a b -> IO (GenXor a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> GenXor a b
forall a b. a -> b -> GenXor a b
GenXor a
a b
b)
genSeedLength :: Tagged (GenXor a b) Int
genSeedLength =
let a :: a
a = Tagged (GenXor a b) Int -> a
forall a b c. Tagged (GenXor a b) c -> a
helperXor1 Tagged (GenXor a b) Int
res
b :: b
b = Tagged (GenXor a b) Int -> b
forall a b c. Tagged (GenXor a b) c -> b
helperXor2 Tagged (GenXor a b) Int
res
res :: Tagged (GenXor a b) Int
res = Int -> Tagged (GenXor a b) Int
forall k (s :: k) b. b -> Tagged s b
Tagged (Int -> Tagged (GenXor a b) Int) -> Int -> Tagged (GenXor a b) Int
forall a b. (a -> b) -> a -> b
$ (Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` a
a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Tagged b Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged b Int -> b -> Int
forall a b. Tagged a b -> a -> b
`for` b
b)
in Tagged (GenXor a b) Int
res
genBytes :: Int -> GenXor a b -> Either GenError (ByteString, GenXor a b)
genBytes req :: Int
req (GenXor a :: a
a b :: b
b) = do
(r1 :: ByteString
r1, a' :: a
a') <- Int -> a -> Either GenError (ByteString, a)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
req a
a
(r2 :: ByteString
r2, b' :: b
b') <- Int -> b -> Either GenError (ByteString, b)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
req b
b
(ByteString, GenXor a b)
-> Either GenError (ByteString, GenXor a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
zwp' ByteString
r1 ByteString
r2, a -> b -> GenXor a b
forall a b. a -> b -> GenXor a b
GenXor a
a' b
b')
genBytesWithEntropy :: Int
-> ByteString
-> GenXor a b
-> Either GenError (ByteString, GenXor a b)
genBytesWithEntropy req :: Int
req ent :: ByteString
ent (GenXor a :: a
a b :: b
b) = do
(r1 :: ByteString
r1, a' :: a
a') <- Int -> ByteString -> a -> Either GenError (ByteString, a)
forall g.
CryptoRandomGen g =>
Int -> ByteString -> g -> Either GenError (ByteString, g)
genBytesWithEntropy Int
req ByteString
ent a
a
(r2 :: ByteString
r2, b' :: b
b') <- Int -> ByteString -> b -> Either GenError (ByteString, b)
forall g.
CryptoRandomGen g =>
Int -> ByteString -> g -> Either GenError (ByteString, g)
genBytesWithEntropy Int
req ByteString
ent b
b
(ByteString, GenXor a b)
-> Either GenError (ByteString, GenXor a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
zwp' ByteString
r1 ByteString
r2, a -> b -> GenXor a b
forall a b. a -> b -> GenXor a b
GenXor a
a' b
b')
reseed :: ByteString -> GenXor a b -> Either GenError (GenXor a b)
reseed ent :: ByteString
ent (GenXor a :: a
a b :: b
b) = do
let (b1 :: ByteString
b1, b2 :: ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Tagged a Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged a Int -> a -> Int
forall a b. Tagged a b -> a -> b
`for` a
a) ByteString
ent
a
a' <- ByteString -> a -> Either GenError a
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
reseed ByteString
b1 a
a
b
b' <- ByteString -> b -> Either GenError b
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
reseed ByteString
b2 b
b
GenXor a b -> Either GenError (GenXor a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> GenXor a b
forall a b. a -> b -> GenXor a b
GenXor a
a' b
b')
reseedPeriod :: GenXor a b -> ReseedInfo
reseedPeriod ~(GenXor a :: a
a b :: b
b) = ReseedInfo -> ReseedInfo -> ReseedInfo
forall a. Ord a => a -> a -> a
min (a -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedPeriod a
a) (b -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedPeriod b
b)
reseedInfo :: GenXor a b -> ReseedInfo
reseedInfo ~(GenXor a :: a
a b :: b
b) = ReseedInfo -> ReseedInfo -> ReseedInfo
forall a. Ord a => a -> a -> a
min (a -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedInfo a
a) (b -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedInfo b
b)
data GenBuffered g = GenBuffered Int Int (Either (GenError, g) (B.ByteString, g)) {-# UNPACK #-} !B.ByteString
bufferMinDef, bufferMaxDef :: Int
bufferMinDef :: Int
bufferMinDef = 2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^20
bufferMaxDef :: Int
bufferMaxDef = 2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^22
newGenBuffered :: (CryptoRandomGen g) => Int -> Int -> B.ByteString -> Either GenError (GenBuffered g)
newGenBuffered :: Int -> Int -> ByteString -> Either GenError (GenBuffered g)
newGenBuffered min :: Int
min max :: Int
max bs :: ByteString
bs = do
g
g <- ByteString -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen ByteString
bs
(rs :: ByteString
rs,g' :: g
g') <- Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
min g
g
let new :: Either (GenError, g) (ByteString, g)
new = Either GenError (ByteString, g)
-> g -> Either (GenError, g) (ByteString, g)
forall x y g. Either x y -> g -> Either (x, g) y
wrapErr (Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
min g
g') g
g'
ByteString
rs ByteString
-> Either GenError (GenBuffered g)
-> Either GenError (GenBuffered g)
forall a b. a -> b -> b
`par` GenBuffered g -> Either GenError (GenBuffered g)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
forall g.
Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
GenBuffered Int
min Int
max Either (GenError, g) (ByteString, g)
new ByteString
rs)
newGenBufferedIO :: CryptoRandomGen g => Int -> Int -> IO (GenBuffered g)
newGenBufferedIO :: Int -> Int -> IO (GenBuffered g)
newGenBufferedIO min :: Int
min max :: Int
max = do
g
g <- IO g
forall g. CryptoRandomGen g => IO g
newGenIO
let (Right !GenBuffered g
gBuf) = do
(rs :: ByteString
rs,g' :: g
g') <- Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
min g
g
let new :: Either (GenError, g) (ByteString, g)
new = Either GenError (ByteString, g)
-> g -> Either (GenError, g) (ByteString, g)
forall x y g. Either x y -> g -> Either (x, g) y
wrapErr (Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
min g
g') g
g'
ByteString
rs ByteString
-> Either GenError (GenBuffered g)
-> Either GenError (GenBuffered g)
forall a b. a -> b -> b
`par` GenBuffered g -> Either GenError (GenBuffered g)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
forall g.
Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
GenBuffered Int
min Int
max Either (GenError, g) (ByteString, g)
new ByteString
rs)
GenBuffered g -> IO (GenBuffered g)
forall (m :: * -> *) a. Monad m => a -> m a
return GenBuffered g
gBuf
instance (CryptoRandomGen g) => CryptoRandomGen (GenBuffered g) where
{-# SPECIALIZE instance CryptoRandomGen (GenBuffered HmacDRBG) #-}
{-# SPECIALIZE instance CryptoRandomGen (GenBuffered HashDRBG) #-}
{-# SPECIALIZE instance CryptoRandomGen (GenBuffered CtrDRBG) #-}
newGen :: ByteString -> Either GenError (GenBuffered g)
newGen = Int -> Int -> ByteString -> Either GenError (GenBuffered g)
forall g.
CryptoRandomGen g =>
Int -> Int -> ByteString -> Either GenError (GenBuffered g)
newGenBuffered Int
bufferMinDef Int
bufferMaxDef
newGenIO :: IO (GenBuffered g)
newGenIO = Int -> Int -> IO (GenBuffered g)
forall g. CryptoRandomGen g => Int -> Int -> IO (GenBuffered g)
newGenBufferedIO Int
bufferMinDef Int
bufferMaxDef
genSeedLength :: Tagged (GenBuffered g) Int
genSeedLength =
let a :: g
a = Tagged (GenBuffered g) Int -> g
forall c. Tagged (GenBuffered g) c -> g
help Tagged (GenBuffered g) Int
res
res :: Tagged (GenBuffered g) Int
res = Int -> Tagged (GenBuffered g) Int
forall k (s :: k) b. b -> Tagged s b
Tagged (Int -> Tagged (GenBuffered g) Int)
-> Int -> Tagged (GenBuffered g) Int
forall a b. (a -> b) -> a -> b
$ Tagged g Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged g Int -> g -> Int
forall a b. Tagged a b -> a -> b
`for` g
a
in Tagged (GenBuffered g) Int
res
where
help :: Tagged (GenBuffered g) c -> g
help :: Tagged (GenBuffered g) c -> g
help = g -> Tagged (GenBuffered g) c -> g
forall a b. a -> b -> a
const g
forall a. HasCallStack => a
undefined
genBytes :: Int -> GenBuffered g -> Either GenError (ByteString, GenBuffered g)
genBytes req :: Int
req (GenBuffered min :: Int
min max :: Int
max g :: Either (GenError, g) (ByteString, g)
g bs :: ByteString
bs)
| Int
remSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
min = (ByteString, GenBuffered g)
-> Either GenError (ByteString, GenBuffered g)
forall a b. b -> Either a b
Right (Int -> ByteString -> ByteString
B.take Int
req ByteString
bs, Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
forall g.
Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
GenBuffered Int
min Int
max Either (GenError, g) (ByteString, g)
g (Int -> ByteString -> ByteString
B.drop Int
req ByteString
bs))
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min =
case Either (GenError, g) (ByteString, g)
g of
Left (err :: GenError
err,_) -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left GenError
err
Right g :: (ByteString, g)
g -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left (String -> GenError
GenErrorOther "Buffering generator failed to buffer properly - unknown reason")
| Int
req Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
B.length ByteString
bs =
case Either (GenError, g) (ByteString, g)
g of
Left (err :: GenError
err,_) -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left GenError
err
Right (bo :: ByteString
bo,g2 :: g
g2) ->
case Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
req g
g2 of
Left err :: GenError
err -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left GenError
err
Right (b :: ByteString
b,g3 :: g
g3) ->
(ByteString, GenBuffered g)
-> Either GenError (ByteString, GenBuffered g)
forall a b. b -> Either a b
Right (ByteString
b, Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
forall g.
Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
GenBuffered Int
min Int
max ((ByteString, g) -> Either (GenError, g) (ByteString, g)
forall a b. b -> Either a b
Right (ByteString
bo,g
g3)) ByteString
bs)
| Int
remSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min =
case Either (GenError, g) (ByteString, g)
g of
Left (err :: GenError
err,_) -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left GenError
err
Right (rnd :: ByteString
rnd, gen :: g
gen) ->
let new :: Either (GenError, g) (ByteString, g)
new | ByteString -> Int
B.length ByteString
rnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Either GenError (ByteString, g)
-> g -> Either (GenError, g) (ByteString, g)
forall x y g. Either x y -> g -> Either (x, g) y
wrapErr (Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes (Int
max Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
remSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
rnd)) g
gen) g
gen
| Bool
otherwise = (ByteString, g) -> Either (GenError, g) (ByteString, g)
forall a b. b -> Either a b
Right (ByteString
B.empty,g
gen)
(rs :: ByteString
rs,rem :: ByteString
rem) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
req ByteString
bs
in Either (GenError, g) (ByteString, g)
-> Either (GenError, g) (ByteString, g)
forall x g. Either x (ByteString, g) -> Either x (ByteString, g)
eval Either (GenError, g) (ByteString, g)
new Either (GenError, g) (ByteString, g)
-> Either GenError (ByteString, GenBuffered g)
-> Either GenError (ByteString, GenBuffered g)
forall a b. a -> b -> b
`par` (ByteString, GenBuffered g)
-> Either GenError (ByteString, GenBuffered g)
forall a b. b -> Either a b
Right (ByteString
rs, Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
forall g.
Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
GenBuffered Int
min Int
max Either (GenError, g) (ByteString, g)
new (ByteString -> ByteString -> ByteString
B.append ByteString
rem ByteString
rnd))
| Bool
otherwise = GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left (GenError -> Either GenError (ByteString, GenBuffered g))
-> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. (a -> b) -> a -> b
$ String -> GenError
GenErrorOther "Buffering generator hit an impossible case. Please inform the Haskell crypto-api maintainer"
where
remSize :: Int
remSize = ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
req
genBytesWithEntropy :: Int
-> ByteString
-> GenBuffered g
-> Either GenError (ByteString, GenBuffered g)
genBytesWithEntropy req :: Int
req ent :: ByteString
ent g :: GenBuffered g
g = ByteString -> GenBuffered g -> Either GenError (GenBuffered g)
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
reseed ByteString
ent GenBuffered g
g Either GenError (GenBuffered g)
-> (GenBuffered g -> Either GenError (ByteString, GenBuffered g))
-> Either GenError (ByteString, GenBuffered g)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \gen :: GenBuffered g
gen -> Int -> GenBuffered g -> Either GenError (ByteString, GenBuffered g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
req GenBuffered g
gen
reseed :: ByteString -> GenBuffered g -> Either GenError (GenBuffered g)
reseed ent :: ByteString
ent (GenBuffered min :: Int
min max :: Int
max g :: Either (GenError, g) (ByteString, g)
g bs :: ByteString
bs) = do
let (rs :: ByteString
rs, g' :: g
g') =
case Either (GenError, g) (ByteString, g)
g of
Left (_,g' :: g
g') -> (ByteString
B.empty, g
g')
Right (rs :: ByteString
rs, g' :: g
g') -> (ByteString
rs, g
g')
g
g'' <- ByteString -> g -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
reseed ByteString
ent g
g'
let new :: Either (GenError, g) (ByteString, g)
new = Either GenError (ByteString, g)
-> g -> Either (GenError, g) (ByteString, g)
forall x y g. Either x y -> g -> Either (x, g) y
wrapErr (Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes (Int
min Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs') g
g'') g
g''
bs' :: ByteString
bs' = Int -> ByteString -> ByteString
B.take Int
max (ByteString -> ByteString -> ByteString
B.append ByteString
bs ByteString
rs)
GenBuffered g -> Either GenError (GenBuffered g)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
forall g.
Int
-> Int
-> Either (GenError, g) (ByteString, g)
-> ByteString
-> GenBuffered g
GenBuffered Int
min Int
max Either (GenError, g) (ByteString, g)
new ByteString
bs')
reseedPeriod :: GenBuffered g -> ReseedInfo
reseedPeriod ~(GenBuffered _ _ g :: Either (GenError, g) (ByteString, g)
g _) = g -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedPeriod (g -> ReseedInfo)
-> (Either (GenError, g) (ByteString, g) -> g)
-> Either (GenError, g) (ByteString, g)
-> ReseedInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GenError, g) -> g)
-> ((ByteString, g) -> g)
-> Either (GenError, g) (ByteString, g)
-> g
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GenError, g) -> g
forall a b. (a, b) -> b
snd (ByteString, g) -> g
forall a b. (a, b) -> b
snd (Either (GenError, g) (ByteString, g) -> ReseedInfo)
-> Either (GenError, g) (ByteString, g) -> ReseedInfo
forall a b. (a -> b) -> a -> b
$ Either (GenError, g) (ByteString, g)
g
reseedInfo :: GenBuffered g -> ReseedInfo
reseedInfo ~(GenBuffered _ _ g :: Either (GenError, g) (ByteString, g)
g _) = g -> ReseedInfo
forall g. CryptoRandomGen g => g -> ReseedInfo
reseedInfo (g -> ReseedInfo)
-> (Either (GenError, g) (ByteString, g) -> g)
-> Either (GenError, g) (ByteString, g)
-> ReseedInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GenError, g) -> g)
-> ((ByteString, g) -> g)
-> Either (GenError, g) (ByteString, g)
-> g
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GenError, g) -> g
forall a b. (a, b) -> b
snd (ByteString, g) -> g
forall a b. (a, b) -> b
snd (Either (GenError, g) (ByteString, g) -> ReseedInfo)
-> Either (GenError, g) (ByteString, g) -> ReseedInfo
forall a b. (a -> b) -> a -> b
$ Either (GenError, g) (ByteString, g)
g
wrapErr :: Either x y -> g -> Either (x,g) y
wrapErr :: Either x y -> g -> Either (x, g) y
wrapErr (Left x :: x
x) g :: g
g = (x, g) -> Either (x, g) y
forall a b. a -> Either a b
Left (x
x,g
g)
wrapErr (Right r :: y
r) _ = y -> Either (x, g) y
forall a b. b -> Either a b
Right y
r
eval :: Either x (B.ByteString, g) -> Either x (B.ByteString, g)
eval :: Either x (ByteString, g) -> Either x (ByteString, g)
eval (Left x :: x
x) = x -> Either x (ByteString, g)
forall a b. a -> Either a b
Left x
x
eval (Right (g :: ByteString
g,bs :: g
bs)) = g
bs g -> Either x (ByteString, g) -> Either x (ByteString, g)
forall a b. a -> b -> b
`seq` (ByteString
g ByteString -> Either x (ByteString, g) -> Either x (ByteString, g)
forall a b. a -> b -> b
`seq` (ByteString, g) -> Either x (ByteString, g)
forall a b. b -> Either a b
Right (ByteString
g, g
bs))
instance BlockCipher x => CryptoRandomGen (CtrDRBGWith x) where
newGen :: ByteString -> Either GenError (CtrDRBGWith x)
newGen bytes :: ByteString
bytes =
case ByteString -> ByteString -> Maybe (CtrDRBGWith x)
forall a.
BlockCipher a =>
ByteString -> ByteString -> Maybe (State a)
CTR.instantiate ByteString
bytes ByteString
B.empty of
Nothing -> GenError -> Either GenError (CtrDRBGWith x)
forall a b. a -> Either a b
Left GenError
NotEnoughEntropy
Just st :: CtrDRBGWith x
st -> CtrDRBGWith x -> Either GenError (CtrDRBGWith x)
forall a b. b -> Either a b
Right CtrDRBGWith x
st
newGenIO :: IO (CtrDRBGWith x)
newGenIO = do
let k :: x
k = x
forall a. HasCallStack => a
undefined :: x
b :: Int
b = (Tagged x Int
forall k. BlockCipher k => Tagged k Int
keyLength Tagged x Int -> x -> Int
forall a b. Tagged a b -> a -> b
`for` x
k) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Tagged x Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged x Int -> x -> Int
forall a b. Tagged a b -> a -> b
`for` x
k) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7
e :: String
e = "Unable to generate enough entropy to instantiate CTR DRBG"
ByteString
kd <- Int -> IO ByteString
getEntropy (Int
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 8)
case ByteString -> ByteString -> Maybe (CtrDRBGWith x)
forall a.
BlockCipher a =>
ByteString -> ByteString -> Maybe (State a)
CTR.instantiate ByteString
kd ByteString
B.empty of
Nothing -> String -> IO (CtrDRBGWith x)
forall a. HasCallStack => String -> a
error String
e
Just st :: CtrDRBGWith x
st -> CtrDRBGWith x -> IO (CtrDRBGWith x)
forall (m :: * -> *) a. Monad m => a -> m a
return CtrDRBGWith x
st
genSeedLength :: Tagged (CtrDRBGWith x) Int
genSeedLength =
let rt :: Tagged x Int -> Tagged x Int -> Tagged (CtrDRBGWith x) Int
rt :: Tagged x Int -> Tagged x Int -> Tagged (CtrDRBGWith x) Int
rt x :: Tagged x Int
x y :: Tagged x Int
y = Int -> Tagged (CtrDRBGWith x) Int
forall k (s :: k) b. b -> Tagged s b
Tagged (Int -> Tagged (CtrDRBGWith x) Int)
-> Int -> Tagged (CtrDRBGWith x) Int
forall a b. (a -> b) -> a -> b
$
let k :: Int
k = Tagged x Int -> Int
forall k (s :: k) b. Tagged s b -> b
unTagged Tagged x Int
x
b :: Int
b = Tagged x Int -> Int
forall k (s :: k) b. Tagged s b -> b
unTagged Tagged x Int
y
in Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b
in Tagged x Int -> Tagged x Int -> Tagged (CtrDRBGWith x) Int
rt Tagged x Int
forall k. BlockCipher k => Tagged k Int
keyLengthBytes Tagged x Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes
genBytes :: Int -> CtrDRBGWith x -> Either GenError (ByteString, CtrDRBGWith x)
genBytes req :: Int
req st :: CtrDRBGWith x
st =
case CtrDRBGWith x
-> Int -> ByteString -> Maybe (ByteString, CtrDRBGWith x)
forall a.
BlockCipher a =>
State a -> Int -> ByteString -> Maybe (ByteString, State a)
CTR.generate CtrDRBGWith x
st Int
req ByteString
B.empty of
Nothing -> GenError -> Either GenError (ByteString, CtrDRBGWith x)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (bs :: ByteString
bs,new :: CtrDRBGWith x
new) -> (ByteString, CtrDRBGWith x)
-> Either GenError (ByteString, CtrDRBGWith x)
forall a b. b -> Either a b
Right (ByteString
bs,CtrDRBGWith x
new)
reseed :: ByteString -> CtrDRBGWith x -> Either GenError (CtrDRBGWith x)
reseed ent :: ByteString
ent st :: CtrDRBGWith x
st =
case CtrDRBGWith x -> ByteString -> ByteString -> Maybe (CtrDRBGWith x)
forall a.
BlockCipher a =>
State a -> ByteString -> ByteString -> Maybe (State a)
CTR.reseed CtrDRBGWith x
st ByteString
ent ByteString
B.empty of
Nothing -> GenError -> Either GenError (CtrDRBGWith x)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just s :: CtrDRBGWith x
s -> CtrDRBGWith x -> Either GenError (CtrDRBGWith x)
forall a b. b -> Either a b
Right CtrDRBGWith x
s
reseedPeriod :: CtrDRBGWith x -> ReseedInfo
reseedPeriod _ = Word64 -> ReseedInfo
InXCalls Word64
CTR.reseedInterval
reseedInfo :: CtrDRBGWith x -> ReseedInfo
reseedInfo st :: CtrDRBGWith x
st = Word64 -> ReseedInfo
InXCalls (Word64
CTR.reseedInterval Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- CtrDRBGWith x -> Word64
forall a. State a -> Word64
CTR.getCounter CtrDRBGWith x
st)