-- |
-- Module      :  Crypto.Random.HmacDrbg
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- NIST standardized number-theoretically secure random number generator.
-- https://csrc.nist.gov/csrc/media/events/random-number-generation-workshop-2004/documents/hashblockcipherdrbg.pdf
--
-- XXX: This algorithm requires reseed after 2^48 iterations.
--
-- > Inspired by https://github.com/TomMD/DRBG and https://github.com/indutny/hmac-drbg.
--

module Crypto.Random.HmacDrbg
    (
      HmacDrbg
    , initialize
    ) where


import           Crypto.Hash     (HashAlgorithm, digestFromByteString,
                                  hashDigestSize)
import           Crypto.MAC.HMAC (HMAC (..), hmac)
import           Crypto.Random   (DRG (..))
import           Data.ByteArray  (ByteArray, convert, singleton)
import qualified Data.ByteArray  as BA (null, take)
import qualified Data.ByteString as B (replicate)
import           Data.Maybe      (fromJust)
import           Data.Word       (Word8)

-- | HMAC Deterministic Random Bytes Generator.
newtype HmacDrbg a = HmacDrbg (HMAC a, HMAC a)
    deriving HmacDrbg a -> HmacDrbg a -> Bool
(HmacDrbg a -> HmacDrbg a -> Bool)
-> (HmacDrbg a -> HmacDrbg a -> Bool) -> Eq (HmacDrbg a)
forall a. HmacDrbg a -> HmacDrbg a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HmacDrbg a -> HmacDrbg a -> Bool
$c/= :: forall a. HmacDrbg a -> HmacDrbg a -> Bool
== :: HmacDrbg a -> HmacDrbg a -> Bool
$c== :: forall a. HmacDrbg a -> HmacDrbg a -> Bool
Eq

instance HashAlgorithm a => DRG (HmacDrbg a) where
    randomBytesGenerate :: Int -> HmacDrbg a -> (byteArray, HmacDrbg a)
randomBytesGenerate = Int -> HmacDrbg a -> (byteArray, HmacDrbg a)
forall a output.
(HashAlgorithm a, ByteArray output) =>
Int -> HmacDrbg a -> (output, HmacDrbg a)
generate

update :: (ByteArray bin, HashAlgorithm a)
       => bin
       -> HmacDrbg a
       -> HmacDrbg a
update :: bin -> HmacDrbg a -> HmacDrbg a
update bin
input | bin -> Bool
forall a. ByteArrayAccess a => a -> Bool
BA.null bin
input = Word8 -> HmacDrbg a -> HmacDrbg a
forall a. HashAlgorithm a => Word8 -> HmacDrbg a -> HmacDrbg a
go Word8
0x00
             | Bool
otherwise = Word8 -> HmacDrbg a -> HmacDrbg a
forall a. HashAlgorithm a => Word8 -> HmacDrbg a -> HmacDrbg a
go Word8
0x01 (HmacDrbg a -> HmacDrbg a)
-> (HmacDrbg a -> HmacDrbg a) -> HmacDrbg a -> HmacDrbg a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> HmacDrbg a -> HmacDrbg a
forall a. HashAlgorithm a => Word8 -> HmacDrbg a -> HmacDrbg a
go Word8
0x00
  where
    go :: HashAlgorithm a => Word8 -> HmacDrbg a -> HmacDrbg a
    go :: Word8 -> HmacDrbg a -> HmacDrbg a
go Word8
c (HmacDrbg (HMAC a
k, HMAC a
v)) = let k' :: HMAC a
k' = HMAC a -> bin -> HMAC a
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac HMAC a
k (HMAC a -> bin
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert HMAC a
v bin -> bin -> bin
forall a. Semigroup a => a -> a -> a
<> Word8 -> bin
forall a. ByteArray a => Word8 -> a
singleton Word8
c bin -> bin -> bin
forall a. Semigroup a => a -> a -> a
<> bin
input)
                                 v' :: HMAC a
v' = HMAC a -> HMAC a -> HMAC a
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac HMAC a
k' HMAC a
v
                             in (HMAC a, HMAC a) -> HmacDrbg a
forall a. (HMAC a, HMAC a) -> HmacDrbg a
HmacDrbg (HMAC a
k', HMAC a
v')

-- | Initialize HMAC-DRBG by seed.
initialize :: (ByteArray seed, HashAlgorithm a)
           => seed
           -> HmacDrbg a
initialize :: seed -> HmacDrbg a
initialize = (seed -> HmacDrbg a -> HmacDrbg a)
-> HmacDrbg a -> seed -> HmacDrbg a
forall a b c. (a -> b -> c) -> b -> a -> c
flip seed -> HmacDrbg a -> HmacDrbg a
forall bin a.
(ByteArray bin, HashAlgorithm a) =>
bin -> HmacDrbg a -> HmacDrbg a
update (HmacDrbg a -> seed -> HmacDrbg a)
-> HmacDrbg a -> seed -> HmacDrbg a
forall a b. (a -> b) -> a -> b
$ (HMAC a, HMAC a) -> HmacDrbg a
forall a. (HMAC a, HMAC a) -> HmacDrbg a
HmacDrbg (a -> Word8 -> HMAC a
forall a. HashAlgorithm a => a -> Word8 -> HMAC a
hmac0 a
forall a. HasCallStack => a
undefined Word8
0x00, a -> Word8 -> HMAC a
forall a. HashAlgorithm a => a -> Word8 -> HMAC a
hmac0 a
forall a. HasCallStack => a
undefined Word8
0x01)
  where
    hmac0 :: HashAlgorithm a => a -> Word8 -> HMAC a
    hmac0 :: a -> Word8 -> HMAC a
hmac0 a
a = Digest a -> HMAC a
forall a. Digest a -> HMAC a
HMAC (Digest a -> HMAC a) -> (Word8 -> Digest a) -> Word8 -> HMAC a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Digest a) -> Digest a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Digest a) -> Digest a)
-> (Word8 -> Maybe (Digest a)) -> Word8 -> Digest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Digest a)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString (ByteString -> Maybe (Digest a))
-> (Word8 -> ByteString) -> Word8 -> Maybe (Digest a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ByteString
B.replicate (a -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize a
a)

generate :: (HashAlgorithm a, ByteArray output) => Int -> HmacDrbg a -> (output, HmacDrbg a)
generate :: Int -> HmacDrbg a -> (output, HmacDrbg a)
generate Int
reqBytes (HmacDrbg (HMAC a
k, HMAC a
v)) = (output
output, (HMAC a, HMAC a) -> HmacDrbg a
forall a. (HMAC a, HMAC a) -> HmacDrbg a
HmacDrbg (HMAC a
k, HMAC a
vFinal))
  where
    getV :: (a, b) -> (HMAC a, b)
getV (a
u, b
rest) = let v' :: HMAC a
v' = HMAC a -> a -> HMAC a
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac HMAC a
k a
u in (HMAC a
v', b
rest b -> b -> b
forall a. Semigroup a => a -> a -> a
<> HMAC a -> b
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert HMAC a
v')
    (HMAC a
vFinal, output
output) = Int -> output -> output
forall bs. ByteArray bs => Int -> bs -> bs
BA.take Int
reqBytes (output -> output) -> (HMAC a, output) -> (HMAC a, output)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HMAC a, output) -> (HMAC a, output))
-> (HMAC a, output) -> [(HMAC a, output)]
forall a. (a -> a) -> a -> [a]
iterate (HMAC a, output) -> (HMAC a, output)
forall b a a.
(ByteArray b, ByteArrayAccess a, HashAlgorithm a) =>
(a, b) -> (HMAC a, b)
getV (HMAC a
v, output
forall a. Monoid a => a
mempty) [(HMAC a, output)] -> Int -> (HMAC a, output)
forall a. [a] -> Int -> a
!! Int
reqBytes