    {-# LANGUAGE BangPatterns, MonomorphismRestriction #-}
    module Crypto.Random.DRBG.Hash
            ( State, counter
            , reseedInterval
            , SeedLength (..)
            , instantiate
            , reseed
            , generate
            ) where
    -- NIST SP 800-90

    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 = 2Word64 -> Integer -> Word64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^48

    -- Section 10.1.1.1, pg 35
    data State d = St
            { State d -> Word64
    counter               :: {-# UNPACK #-} !Word64       -- Number of RBG requests since last reseed
            -- start admin info
            , State d -> ByteString
    value                 :: B.ByteString -- seedlen bits
            , State d -> ByteString
    constant              :: B.ByteString -- seedlen bits
            , State d -> ByteString -> d
    hsh                   :: L.ByteString -> d
            }

    -- section 10.1.1.2 pg 36
    instantiate :: (Hash c d, SeedLength d) => Entropy -> Nonce -> PersonalizationString -> State d
    instantiate :: ByteString -> ByteString -> ByteString -> State d
    instantiate entropyInput :: ByteString
    entropyInput nonce :: ByteString
    nonce perStr :: 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 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 1 ByteString
    v ByteString
    c ByteString -> d
    f

    -- section 10.1.1.3 pg 37
    reseed :: (SeedLength d, Hash c d) => State d -> Entropy -> AdditionalInput -> State d
    reseed :: State d -> ByteString -> ByteString -> State d
    reseed st :: State d
    st ent :: ByteString
    ent additionalInput :: ByteString
    additionalInput =
            let seedMaterial :: ByteString
    seedMaterial = [ByteString] -> ByteString
    B.concat [[Word8] -> ByteString
    B.pack [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 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 1 ByteString
    v ByteString
    c ByteString -> d
    f

    -- section 10.1.1.4 pg 38
    -- Nothing indicates a need to reseed
    generate :: (Hash c d, SeedLength d) => State d -> BitLen -> AdditionalInput -> Maybe (RandomBits, State d)
    generate :: State d -> Int -> ByteString -> Maybe (ByteString, State d)
    generate st :: State d
    st req :: Int
    req additionalInput :: 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 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
    == 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 3 ByteString
    v1]
      -- TODO determine if Integer is needed here and move to Word64 if possible
      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
    + 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

    -- 10.1.1.4, pg 39
    hashGen :: (Hash c d, SeedLength d) => d -> BitLen -> B.ByteString -> RandomBits
    hashGen :: d -> Int -> ByteString -> ByteString
    hashGen d :: d
    d r :: Int
    r val :: 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
    + 7) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` 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
    - 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 _ 0 = []
      getW dat :: ByteString
    dat i :: 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
    -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