{-# LANGUAGE BangPatterns, MonomorphismRestriction #-}
module Crypto.Random.DRBG.Hash
( State, counter
, reseedInterval
, SeedLength (..)
, instantiate
, reseed
, generate
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Crypto.Random.DRBG.Types
import Crypto.Random.DRBG.HashDF
import Crypto.Classes
import Data.Serialize (encode)
import Data.Bits (shiftR, shiftL)
import Data.Tagged
import Data.Word (Word64)
class SeedLength h where
seedlen :: Tagged h Int
reseedInterval :: Word64
reseedInterval :: Word64
reseedInterval = Word64
2Word64 -> Integer -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
48
data State d = St
{ forall d. State d -> Word64
counter :: {-# UNPACK #-} !Word64
, forall d. State d -> ByteString
value :: B.ByteString
, forall d. State d -> ByteString
constant :: B.ByteString
, forall d. State d -> ByteString -> d
hsh :: L.ByteString -> d
}
instantiate :: (Hash c d, SeedLength d) => Entropy -> Nonce -> PersonalizationString -> State d
instantiate :: forall c d.
(Hash c d, SeedLength d) =>
ByteString -> ByteString -> ByteString -> State d
instantiate ByteString
entropyInput ByteString
nonce ByteString
perStr =
let seedMaterial :: ByteString
seedMaterial = [ByteString] -> ByteString
B.concat [ByteString
entropyInput, ByteString
nonce, ByteString
perStr]
slen :: Int
slen = Tagged d Int
forall h. SeedLength h => Tagged h Int
seedlen Tagged d Int -> d -> Int
forall a b. Tagged a b -> a -> b
.::. d
d
seed :: ByteString
seed = (ByteString -> d) -> ByteString -> Int -> ByteString
forall c d.
Hash c d =>
(ByteString -> d) -> ByteString -> Int -> ByteString
hash_df ByteString -> d
f ByteString
seedMaterial Int
slen
v :: ByteString
v = ByteString
seed
c :: ByteString
c = (ByteString -> d) -> ByteString -> Int -> ByteString
forall c d.
Hash c d =>
(ByteString -> d) -> ByteString -> Int -> ByteString
hash_df ByteString -> d
f (Word8 -> ByteString -> ByteString
B.cons Word8
0 ByteString
v) Int
slen
f :: ByteString -> d
f = ByteString -> d
forall ctx d. (Hash ctx d, Hash ctx d) => ByteString -> d
hash
d :: d
d = ByteString -> d
f ByteString
forall a. HasCallStack => a
undefined
in Word64 -> ByteString -> ByteString -> (ByteString -> d) -> State d
forall d.
Word64 -> ByteString -> ByteString -> (ByteString -> d) -> State d
St Word64
1 ByteString
v ByteString
c ByteString -> d
f
reseed :: (SeedLength d, Hash c d) => State d -> Entropy -> AdditionalInput -> State d
reseed :: forall d c.
(SeedLength d, Hash c d) =>
State d -> ByteString -> ByteString -> State d
reseed State d
st ByteString
ent ByteString
additionalInput =
let seedMaterial :: ByteString
seedMaterial = [ByteString] -> ByteString
B.concat [[Word8] -> ByteString
B.pack [Word8
1], State d -> ByteString
forall d. State d -> ByteString
value State d
st, ByteString
ent, ByteString
additionalInput]
seed :: ByteString
seed = (ByteString -> d) -> ByteString -> Int -> ByteString
forall c d.
Hash c d =>
(ByteString -> d) -> ByteString -> Int -> ByteString
hash_df ByteString -> d
f ByteString
seedMaterial (Tagged d Int
forall h. SeedLength h => Tagged h Int
seedlen Tagged d Int -> d -> Int
forall a b. Tagged a b -> a -> b
`for` d
d)
v :: ByteString
v = ByteString
seed
c :: ByteString
c = (ByteString -> d) -> ByteString -> Int -> ByteString
forall c d.
Hash c d =>
(ByteString -> d) -> ByteString -> Int -> ByteString
hash_df ByteString -> d
f (Word8 -> ByteString -> ByteString
B.cons Word8
0 ByteString
v) (Tagged d Int
forall h. SeedLength h => Tagged h Int
seedlen Tagged d Int -> d -> Int
forall a b. Tagged a b -> a -> b
`for` d
d)
f :: ByteString -> d
f = ByteString -> d
forall ctx d. (Hash ctx d, Hash ctx d) => ByteString -> d
hash
d :: d
d = ByteString -> d
f ByteString
forall a. HasCallStack => a
undefined
in Word64 -> ByteString -> ByteString -> (ByteString -> d) -> State d
forall d.
Word64 -> ByteString -> ByteString -> (ByteString -> d) -> State d
St Word64
1 ByteString
v ByteString
c ByteString -> d
f
generate :: (Hash c d, SeedLength d) => State d -> BitLen -> AdditionalInput -> Maybe (RandomBits, State d)
generate :: forall c d.
(Hash c d, SeedLength d) =>
State d -> Int -> ByteString -> Maybe (ByteString, State d)
generate State d
st Int
req ByteString
additionalInput =
if (State d -> Word64
forall d. State d -> Word64
counter State d
st Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
reseedInterval)
then Maybe (ByteString, State d)
forall a. Maybe a
Nothing
else (ByteString, State d) -> Maybe (ByteString, State d)
forall a. a -> Maybe a
Just (ByteString
retBits, State d
st { value :: ByteString
value = ByteString
v2, counter :: Word64
counter = Word64
cnt})
where
w :: ByteString
w = [ByteString] -> ByteString
hash [Word8 -> ByteString
B.singleton Word8
2, State d -> ByteString
forall d. State d -> ByteString
value State d
st, ByteString
additionalInput]
v1 :: ByteString
v1 = if ByteString -> Int
B.length ByteString
additionalInput Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then State d -> ByteString
forall d. State d -> ByteString
value State d
st else Int -> Integer -> ByteString
i2bs Int
slen (ByteString -> Integer
bs2i (State d -> ByteString
forall d. State d -> ByteString
value State d
st) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ ByteString -> Integer
bs2i ByteString
w)
retBits :: ByteString
retBits = d -> Int -> ByteString -> ByteString
forall c d.
(Hash c d, SeedLength d) =>
d -> Int -> ByteString -> ByteString
hashGen d
d Int
req ByteString
v1
h :: ByteString
h = [ByteString] -> ByteString
hash [Word8 -> ByteString -> ByteString
B.cons Word8
3 ByteString
v1]
v2 :: ByteString
v2 = Int -> Integer -> ByteString
i2bs Int
slen ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (State d -> Word64
forall d. State d -> Word64
counter State d
st) Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (ByteString -> Integer) -> [ByteString] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Integer
bs2i [ByteString
v1, ByteString
h, State d -> ByteString
forall d. State d -> ByteString
constant State d
st])
cnt :: Word64
cnt = State d -> Word64
forall d. State d -> Word64
counter State d
st Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
slen :: Int
slen = Tagged d Int
forall h. SeedLength h => Tagged h Int
seedlen Tagged d Int -> d -> Int
forall a b. Tagged a b -> a -> b
`for` d
d
hash :: [ByteString] -> ByteString
hash = d -> ByteString
forall a. Serialize a => a -> ByteString
encode (d -> ByteString)
-> ([ByteString] -> d) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> d
hashF (ByteString -> d)
-> ([ByteString] -> ByteString) -> [ByteString] -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks
d :: d
d = State d -> ByteString -> d
forall d. State d -> ByteString -> d
hsh State d
st ByteString
forall a. HasCallStack => a
undefined
hashF :: ByteString -> d
hashF = State d -> ByteString -> d
forall d. State d -> ByteString -> d
hsh State d
st
hashGen :: (Hash c d, SeedLength d) => d -> BitLen -> B.ByteString -> RandomBits
hashGen :: forall c d.
(Hash c d, SeedLength d) =>
d -> Int -> ByteString -> ByteString
hashGen d
d Int
r ByteString
val = Int -> ByteString -> ByteString
B.take Int
reqBytes (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> [ByteString]
getW ByteString
val Int
m
where
reqBytes :: Int
reqBytes = (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
m :: Int
m = (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
outlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
outlen
getW :: B.ByteString -> Int -> [B.ByteString]
getW :: ByteString -> Int -> [ByteString]
getW ByteString
_ Int
0 = []
getW ByteString
dat Int
i =
let wi :: ByteString
wi = d -> ByteString
forall a. Serialize a => a -> ByteString
encode (ByteString -> d
h ByteString
dat)
dat' :: ByteString
dat' = ByteString -> ByteString
incBS ByteString
dat
rest :: [ByteString]
rest = ByteString -> Int -> [ByteString]
getW ByteString
dat' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
in ByteString
wi ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
rest
slen :: Int
slen = Tagged d Int
forall h. SeedLength h => Tagged h Int
seedlen Tagged d Int -> d -> Int
forall a b. Tagged a b -> a -> b
`for` d
d
outlen :: Int
outlen = Tagged d Int
forall ctx d. Hash ctx d => Tagged d Int
outputLength Tagged d Int -> d -> Int
forall a b. Tagged a b -> a -> b
`for` d
d
h :: ByteString -> d
h = d -> ByteString -> d
forall c d. Hash c d => d -> ByteString -> d
hashFunc' d
d