1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
{-# 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 = 2^48
-- Section 10.1.1.1, pg 35
data State d = St
{ counter :: {-# UNPACK #-} !Word64 -- Number of RBG requests since last reseed
-- start admin info
, value :: B.ByteString -- seedlen bits
, constant :: B.ByteString -- seedlen bits
, hsh :: L.ByteString -> d
}
-- section 10.1.1.2 pg 36
instantiate :: (Hash c d, SeedLength d) => Entropy -> Nonce -> PersonalizationString -> State d
instantiate entropyInput nonce perStr =
let seedMaterial = B.concat [entropyInput, nonce, perStr]
slen = seedlen .::. d
seed = hash_df f seedMaterial slen
v = seed
c = hash_df f (B.cons 0 v) slen
f = hash
d = f undefined
in St 1 v c f
-- section 10.1.1.3 pg 37
reseed :: (SeedLength d, Hash c d) => State d -> Entropy -> AdditionalInput -> State d
reseed st ent additionalInput =
let seedMaterial = B.concat [B.pack [1], value st, ent, additionalInput]
seed = hash_df f seedMaterial (seedlen `for` d)
v = seed
c = hash_df f (B.cons 0 v) (seedlen `for` d)
f = hash
d = f undefined
in St 1 v c 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 st req additionalInput =
if (counter st > reseedInterval)
then Nothing
else Just (retBits, st { value = v2, counter = cnt})
where
w = hash [B.singleton 2, value st, additionalInput]
v1 = if B.length additionalInput == 0 then value st else i2bs slen (bs2i (value st) + bs2i w)
retBits = hashGen d req v1
h = hash [B.cons 3 v1]
-- TODO determine if Integer is needed here and move to Word64 if possible
v2 = i2bs slen (sum $ fromIntegral (counter st) : map bs2i [v1, h, constant st])
cnt = counter st + 1
slen = seedlen `for` d
hash = encode . hashF . L.fromChunks
d = hsh st undefined
hashF = hsh st
-- 10.1.1.4, pg 39
hashGen :: (Hash c d, SeedLength d) => d -> BitLen -> B.ByteString -> RandomBits
hashGen d r val = B.take reqBytes . B.concat $ getW val m
where
reqBytes = (r + 7) `div` 8
m = (r + (outlen - 1)) `div` outlen
getW :: B.ByteString -> Int -> [B.ByteString]
getW _ 0 = []
getW dat i =
let wi = encode (h dat)
dat' = incBS dat
rest = getW dat' (i-1)
in wi : rest
slen = seedlen `for` d
outlen = outputLength `for` d
h = hashFunc' d
|
