← Back to branch summary

~ubuntu-branches/ubuntu/wily/haskell-drbg/wily-proposed

« back to all changes in this revision

Viewing changes to Crypto/Random/DRBG/HMAC.hs

  • Committer: Package Import Robot
  • Author(s): Joachim Breitner
  • Date: 2014-12-21 23:38:10 UTC
  • Revision ID: package-import@ubuntu.com-20141221233810-3447ygvw42zw8wzn
Tags: upstream-0.5.3
Import upstream version 0.5.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
Crypto/Random/DRBG/HMAC.hs
 
1
{-# LANGUAGE BangPatterns #-}
 
2
module Crypto.Random.DRBG.HMAC
 
3
        ( State, counter
 
4
        , reseedInterval
 
5
        , instantiate
 
6
        , reseed
 
7
        , generate) where
 
8
 
 
9
import qualified Data.ByteString as B
 
10
import qualified Data.ByteString.Lazy as L
 
11
import Data.Serialize (encode, Serialize(..))
 
12
import Data.Serialize.Put
 
13
import Data.Serialize.Builder (toByteString)
 
14
import Data.Tagged (proxy)
 
15
import Data.Word (Word64)
 
16
import Crypto.Classes
 
17
import Crypto.HMAC
 
18
import Crypto.Types
 
19
import Crypto.Random.DRBG.Types
 
20
 
 
21
type Key = B.ByteString
 
22
type Value = B.ByteString
 
23
 
 
24
data State d = St
 
25
        { counter               :: {-# UNPACK #-} !Word64
 
26
        -- Start admin info
 
27
        , value                 :: !Value
 
28
        , key                   :: !Key
 
29
        }
 
30
 
 
31
-- This is available with the right type in the tagged package starting from
 
32
-- version 0.7, but ending with GHC version 7.8. Sigh.
 
33
asProxyTypeOf :: d -> state d -> d
 
34
asProxyTypeOf = const
 
35
 
 
36
reseedInterval :: Word64
 
37
reseedInterval = 2^48
 
38
 
 
39
fc = L.fromChunks . \s -> [s]
 
40
 
 
41
update :: (Hash c d) => State d -> L.ByteString -> State d
 
42
update st input = st { value = newV , key = newK }
 
43
  where
 
44
  hm k = hmac (MacKey k)
 
45
  k    = key st
 
46
  v    = value st
 
47
  k'   = encode $ (hm k (L.concat [fc v, L.singleton 0, input]) `asProxyTypeOf` st)
 
48
  v'   = encode $ (hm k' (fc v) `asProxyTypeOf` st)
 
49
  (newK, newV) =
 
50
    if L.length input == 0
 
51
      then (k',v')
 
52
      else let k'' = encode $ hm k' (L.concat [fc v', L.singleton 1, input]) `asProxyTypeOf` st
 
53
           in (k'', encode $ hm k'' (fc v') `asProxyTypeOf` st)
 
54
 
 
55
instantiate :: (Hash c d) => Entropy -> Nonce -> PersonalizationString -> State d
 
56
instantiate ent nonce perStr = st
 
57
  where
 
58
  seedMaterial = L.fromChunks [ent, nonce, perStr]
 
59
  k = B.replicate olen 0
 
60
  v = B.replicate olen 1
 
61
  st = update (St 1 v k) seedMaterial
 
62
  olen = (outputLength `proxy` st) `div` 8
 
63
 
 
64
reseed :: (Hash c d) => State d -> Entropy -> AdditionalInput -> State d
 
65
reseed st ent ai = (update st (L.fromChunks [ent, ai])) { counter = 1 }
 
66
 
 
67
generate :: (Hash c d) => State d -> BitLength -> AdditionalInput -> Maybe (RandomBits, State d)
 
68
generate st req additionalInput =
 
69
        if(counter st > reseedInterval)
 
70
                then Nothing
 
71
                else Just (randBitsFinal, stFinal { counter = 1 + counter st})
 
72
  where
 
73
  st' = if B.length additionalInput == 0
 
74
                then st
 
75
                else update st (fc additionalInput)
 
76
  reqBytes = (req+7) `div` 8
 
77
  iterations = (reqBytes + (outlen - 1)) `div` outlen
 
78
 
 
79
  -- getV is the main cost.  HMACing and storing 'iterations' bytestrings at
 
80
  -- ~64 bytes each is a real waste.  Some pre-allocation and unsafe functions
 
81
  -- exported from Crypto.HMAC could cut this down, but it really isn't worth
 
82
  -- giving CPR to such a bad idea as using ByteString for crypto computations
 
83
  getV :: Value -> Int -> (Value, [B.ByteString])
 
84
  getV !u 0 = (u, [])
 
85
  getV !u i = 
 
86
        let !vNew = hmac' (MacKey kFinal) u `asProxyTypeOf` st
 
87
            !encV = encode vNew
 
88
            (uFinal, rest) = getV encV (i - 1)
 
89
        in (uFinal, encV:rest)
 
90
  (vFinal, randBitsList) = getV (value st') iterations
 
91
  randBitsFinal = B.take reqBytes $ B.concat randBitsList
 
92
  kFinal = key st'
 
93
  stFinal = update (st' { key = kFinal, value = vFinal} `asTypeOf` st) (fc additionalInput)
 
94
  outlen = (outputLength `proxy` st) `div` 8