{-# 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 Int
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 Int
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 Int
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 Int
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 Int
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 :: forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
ByteString -> Word64 -> Either GenError (GenAutoReseed a b)
newGenAutoReseed ByteString
bs Word64
rsInterval=
let (ByteString
b1,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 b
x) = b
x
in case (Either GenError a
g1, Either GenError b
g2) of
(Right a
a, Right 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 Word64
0 a
a b
b
(Left GenError
e, Either GenError b
_) -> GenError -> Either GenError (GenAutoReseed a b)
forall a b. a -> Either a b
Left GenError
e
(Either GenError a
_, Left 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 :: forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
Word64 -> IO (GenAutoReseed a b)
newGenAutoReseedIO 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 Word64
0 a
g1 b
g2
instance CryptoRandomGen HmacDRBG where
newGen :: ByteString -> Either GenError HmacDRBG
newGen 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 (Int
512 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
genBytes :: Int -> HmacDRBG -> Either GenError (ByteString, HmacDRBG)
genBytes Int
req 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
* Int
8) ByteString
B.empty
in case Maybe (ByteString, HmacDRBG)
res of
Maybe (ByteString, HmacDRBG)
Nothing -> GenError -> Either GenError (ByteString, HmacDRBG)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (ByteString
r,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 Int
req ByteString
ai 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
* Int
8) ByteString
ai
in case Maybe (ByteString, HmacDRBG)
res of
Maybe (ByteString, HmacDRBG)
Nothing -> GenError -> Either GenError (ByteString, HmacDRBG)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (ByteString
r,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 ByteString
ent 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 HmacDRBG
s = Word64 -> ReseedInfo
InXCalls (HmacDRBG -> Word64
forall d. State d -> Word64
M.counter HmacDRBG
s)
reseedPeriod :: HmacDRBG -> ReseedInfo
reseedPeriod HmacDRBG
_ = Word64 -> ReseedInfo
InXCalls Word64
M.reseedInterval
instance CryptoRandomGen HashDRBG where
newGen :: ByteString -> Either GenError HashDRBG
newGen 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
$ Int
512 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
genBytes :: Int -> HashDRBG -> Either GenError (ByteString, HashDRBG)
genBytes Int
req 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
* Int
8) ByteString
B.empty
in case Maybe (ByteString, HashDRBG)
res of
Maybe (ByteString, HashDRBG)
Nothing -> GenError -> Either GenError (ByteString, HashDRBG)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (ByteString
r,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 Int
req ByteString
ai 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
* Int
8) ByteString
ai
in case Maybe (ByteString, HashDRBG)
res of
Maybe (ByteString, HashDRBG)
Nothing -> GenError -> Either GenError (ByteString, HashDRBG)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (ByteString
r,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 ByteString
ent 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 HashDRBG
s = Word64 -> ReseedInfo
InXCalls (HashDRBG -> Word64
forall d. State d -> Word64
H.counter HashDRBG
s)
reseedPeriod :: HashDRBG -> ReseedInfo
reseedPeriod HashDRBG
_ = Word64 -> ReseedInfo
InXCalls Word64
H.reseedInterval
helper1 :: Tagged (GenAutoReseed a b) Int -> a
helper1 :: forall a b. 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 :: forall a b. 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
{ forall a b. GenAutoReseed a b -> Word64
garInterval :: {-# UNPACK #-} !Word64
, forall a b. GenAutoReseed a b -> Word64
garCounter :: {-# UNPACK #-} !Word64
, forall a b. GenAutoReseed a b -> a
garPrimeGen :: !a
, forall a b. GenAutoReseed a b -> b
garBackupGen :: !b
}
genBytesAutoReseed :: (CryptoRandomGen a, CryptoRandomGen b)
=> ByteLength
-> GenAutoReseed a b
-> Either GenError (B.ByteString, GenAutoReseed a b)
genBytesAutoReseed :: forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
Int
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
genBytesAutoReseed Int
req gar :: GenAutoReseed a b
gar@(GenAutoReseed Word64
rs Word64
cnt a
a 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 GenError
NeedReseed -> do
(a
a',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
(ByteString
res, 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 Word64
0 a
aNew b
b')
Left GenError
RequestedTooManyBytes -> do
let reqSmall :: Int
reqSmall = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
req Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
(ByteString
s1, 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
(ByteString
s2, 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 GenError
err -> GenError -> Either GenError (ByteString, GenAutoReseed a b)
forall a b. a -> Either a b
Left GenError
err
Right (ByteString
res,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',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 Word64
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 :: forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
a -> b -> Either GenError (a, b)
reseedWith a
x b
y = do
(ByteString
ent,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 :: forall a b.
(CryptoRandomGen a, CryptoRandomGen b) =>
Int
-> ByteString
-> GenAutoReseed a b
-> Either GenError (ByteString, GenAutoReseed a b)
genBytesWithEntropyAutoReseed Int
req ByteString
entropy gar :: GenAutoReseed a b
gar@(GenAutoReseed Word64
rs Word64
cnt a
a 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 GenError
NeedReseed -> do
(a
a',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
(ByteString
res, 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 Word64
0 a
aNew b
b')
Left GenError
RequestedTooManyBytes -> do
let reqSmall :: Int
reqSmall = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
req Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
(ByteString
s1, 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
(ByteString
s2, 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 GenError
err -> GenError -> Either GenError (ByteString, GenAutoReseed a b)
forall a b. a -> Either a b
Left GenError
err
Right (ByteString
res,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',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 Word64
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 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 (Word64
2Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
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 (Word64
2Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
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 ByteString
ent gen :: GenAutoReseed a b
gen@(GenAutoReseed Word64
rs Word64
_ a
a 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 (ByteString
e1,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
/= Int
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 Word64
0 a
a' b
b'
reseedPeriod :: GenAutoReseed a b -> ReseedInfo
reseedPeriod ~(GenAutoReseed Word64
rs Word64
_ a
ag 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
(ReseedInfo
Never, ReseedInfo
_) -> ReseedInfo
Never
(ReseedInfo
_, ReseedInfo
Never) -> ReseedInfo
Never
(ReseedInfo
NotSoon, ReseedInfo
_) -> ReseedInfo
NotSoon
(ReseedInfo
_, ReseedInfo
NotSoon) -> ReseedInfo
NotSoon
(ReseedInfo
_, InXCalls 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)
(ReseedInfo
_, InXBytes 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
<= Int
0 then Word64
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
- Word64
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 Word64
rs Word64
x a
ag 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
(ReseedInfo
NotSoon, ReseedInfo
_) -> ReseedInfo
NotSoon
(ReseedInfo
_, ReseedInfo
NotSoon) -> ReseedInfo
NotSoon
(ReseedInfo
Never, ReseedInfo
_) -> ReseedInfo
Never
(ReseedInfo
_, ReseedInfo
Never) -> ReseedInfo
Never
(ReseedInfo
_, InXBytes 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
<= Int
0 then Word64
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
- Word64
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
(ReseedInfo
_, InXCalls 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 :: forall a b c. 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 :: forall a b c. 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 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
(ByteString
b1,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 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 Int
req (GenXor a
a b
b) = do
(ByteString
r1, a
a') <- Int -> a -> Either GenError (ByteString, a)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
req a
a
(ByteString
r2, 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 Int
req ByteString
ent (GenXor a
a b
b) = do
(ByteString
r1, 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
(ByteString
r2, 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 ByteString
ent (GenXor a
a b
b) = do
let (ByteString
b1, 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 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 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 = Int
2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
20
bufferMaxDef :: Int
bufferMaxDef = Int
2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
22
newGenBuffered :: (CryptoRandomGen g) => Int -> Int -> B.ByteString -> Either GenError (GenBuffered g)
newGenBuffered :: forall g.
CryptoRandomGen g =>
Int -> Int -> ByteString -> Either GenError (GenBuffered g)
newGenBuffered Int
min Int
max ByteString
bs = do
g
g <- ByteString -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen ByteString
bs
(ByteString
rs,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 :: forall g. CryptoRandomGen g => Int -> Int -> IO (GenBuffered g)
newGenBufferedIO Int
min Int
max = do
g
g <- IO g
forall g. CryptoRandomGen g => IO g
newGenIO
let (Right !GenBuffered g
gBuf) = do
(ByteString
rs,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 :: forall c. 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 Int
req (GenBuffered Int
min Int
max Either (GenError, g) (ByteString, g)
g 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 (GenError
err,g
_) -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left GenError
err
Right (ByteString, g)
g -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left (String -> GenError
GenErrorOther String
"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 (GenError
err,g
_) -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left GenError
err
Right (ByteString
bo,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 GenError
err -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left GenError
err
Right (ByteString
b,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 (GenError
err,g
_) -> GenError -> Either GenError (ByteString, GenBuffered g)
forall a b. a -> Either a b
Left GenError
err
Right (ByteString
rnd, 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
> Int
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)
(ByteString
rs,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 String
"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 Int
req ByteString
ent 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
>>= \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 ByteString
ent (GenBuffered Int
min Int
max Either (GenError, g) (ByteString, g)
g ByteString
bs) = do
let (ByteString
rs, g
g') =
case Either (GenError, g) (ByteString, g)
g of
Left (GenError
_,g
g') -> (ByteString
B.empty, g
g')
Right (ByteString
rs, 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 Int
_ Int
_ Either (GenError, g) (ByteString, g)
g ByteString
_) = 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 Int
_ Int
_ Either (GenError, g) (ByteString, g)
g ByteString
_) = 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 :: forall x y g. Either x y -> g -> Either (x, g) y
wrapErr (Left x
x) g
g = (x, g) -> Either (x, g) y
forall a b. a -> Either a b
Left (x
x,g
g)
wrapErr (Right y
r) g
_ = 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 :: forall x g. Either x (ByteString, g) -> Either x (ByteString, g)
eval (Left x
x) = x -> Either x (ByteString, g)
forall a b. a -> Either a b
Left x
x
eval (Right (ByteString
g,g
bs)) = g
bs g -> Either x (ByteString, g) -> Either x (ByteString, g)
`seq` (ByteString
g ByteString -> Either x (ByteString, g) -> Either x (ByteString, g)
`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 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
Maybe (CtrDRBGWith x)
Nothing -> GenError -> Either GenError (CtrDRBGWith x)
forall a b. a -> Either a b
Left GenError
NotEnoughEntropy
Just 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
+ Int
7
e :: String
e = String
"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` Int
8)
case ByteString -> ByteString -> Maybe (CtrDRBGWith x)
forall a.
BlockCipher a =>
ByteString -> ByteString -> Maybe (State a)
CTR.instantiate ByteString
kd ByteString
B.empty of
Maybe (CtrDRBGWith x)
Nothing -> String -> IO (CtrDRBGWith x)
forall a. HasCallStack => String -> a
error String
e
Just 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 Tagged x Int
x 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 Int
req 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
Maybe (ByteString, CtrDRBGWith x)
Nothing -> GenError -> Either GenError (ByteString, CtrDRBGWith x)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just (ByteString
bs,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 ByteString
ent 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
Maybe (CtrDRBGWith x)
Nothing -> GenError -> Either GenError (CtrDRBGWith x)
forall a b. a -> Either a b
Left GenError
NeedReseed
Just 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 CtrDRBGWith x
_ = Word64 -> ReseedInfo
InXCalls Word64
CTR.reseedInterval
reseedInfo :: CtrDRBGWith x -> ReseedInfo
reseedInfo 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)