File: API.hs

package info (click to toggle)
haskell-crypto-random-api 0.2.0-12
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 60 kB
  • sloc: haskell: 69; makefile: 2
file content (135 lines) | stat: -rw-r--r-- 5,480 bytes parent folder | download | duplicates (5)
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
-- |
-- Module      : Crypto.Random.API
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good

module Crypto.Random.API
    ( CPRG(..)
    , ReseedPolicy(..)
    , genRandomBytes
    , genRandomBytes'
    , withRandomBytes
    , getSystemEntropy
    -- * System Random generator
    , SystemRandom
    , getSystemRandomGen
    ) where

import Control.Applicative
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import qualified System.Entropy as SE
import System.IO.Unsafe (unsafeInterleaveIO)
import Data.Word

-- | This is the reseed policy requested by the CPRG
data ReseedPolicy =
      NeverReseed          -- ^ there is no need to reseed as either
                           -- the RG doesn't supports it, it's done automatically
                           -- or pratically the reseeding period exceed a Word64 type.
    | ReseedInBytes Word64 -- ^ the RG need to be reseed in the number
                           -- of bytes joined to the type. it should be done before
                           -- the number reached 0, otherwise an user of the RG
                           -- might request too many bytes and get repeated random bytes.
    deriving (Show,Eq)

-- | A class of Cryptographic Secure Random generator.
--
-- The main difference with the generic haskell RNG is that
-- it return bytes instead of integer.
--
-- It is quite similar to the CryptoRandomGen class in crypto-api
-- except that error are not returned to the user. Instead
-- the user is suppose to handle reseeding by using the NeedReseed
-- and SupplyEntropy methods. For other type of errors, the user
-- is expected to generate bytes with the parameters bounds explicity
-- defined here.
-- 
-- The CPRG need to be able to generate up to 2^20 bytes in one call,
--
class CPRG g where
    -- | Provide a way to query the CPRG to calculate when new entropy
    -- is required to be supplied so the CPRG doesn't repeat output, and
    -- break assumptions. This returns the number of bytes before
    -- which supply entropy should have been called.
    cprgNeedReseed    :: g -> ReseedPolicy

    -- | Supply entropy to the CPRG, that can be used now or later
    -- to reseed the CPRG. This should be used in conjunction to
    -- NeedReseed to know when to supply entropy.
    cprgSupplyEntropy :: ByteString -> g -> g

    -- | Generate bytes using the CPRG and the number specified.
    --
    -- For user of the API, it's recommended to use genRandomBytes
    -- instead of this method directly. the CPRG need to be able
    -- to supply at minimum 2^20 bytes at a time.
    cprgGenBytes      :: Int -> g -> (ByteString, g)

-- | Generate bytes using the cprg in parameter.
--
-- If the number of bytes requested is really high,
-- it's preferable to use 'genRandomBytes' for better memory efficiency.
genRandomBytes :: CPRG g => Int -- ^ number of bytes to return
                         -> g   -- ^ CPRG to use
                         -> (ByteString, g)
genRandomBytes len rng = (\(lbs,g) -> (B.concat lbs, g)) $ genRandomBytes' len rng

-- | Generate bytes using the cprg in parameter.
--
-- This is not tail recursive and an excessive len (>= 2^29) parameter would
-- result in stack overflow.
genRandomBytes' :: CPRG g => Int -- ^ number of bytes to return
                          -> g   -- ^ CPRG to use
                          -> ([ByteString], g)
genRandomBytes' len rng
    | len < 0    = error "genBytes: cannot request negative amount of bytes."
    | otherwise  = loop rng len
            where loop g len
                    | len == 0  = ([], g)
                    | otherwise = let itBytes  = min (2^20) len
                                      (bs, g') = cprgGenBytes itBytes g
                                      (l, g'') = genRandomBytes' (len-itBytes) g'
                                   in (bs:l, g'')

-- | this is equivalent to using Control.Arrow 'first' with 'genRandomBytes'.
--
-- namely it generate @len bytes and map the bytes to the function @f
withRandomBytes :: CPRG g => g -> Int -> (ByteString -> a) -> (a, g)
withRandomBytes rng len f = (f bs, rng')
    where (bs, rng') = genRandomBytes len rng

-- | Return system entropy using the entropy package 'getEntropy'
getSystemEntropy :: Int -> IO ByteString
getSystemEntropy = SE.getEntropy

-- | This is a simple generator that pull bytes from the system entropy
-- directly. Its randomness and security properties are absolutely
-- depends on the underlaying system implementation.
data SystemRandom = SystemRandom [B.ByteString]

-- | Get a random number generator based on the standard system entropy source
getSystemRandomGen :: IO SystemRandom
getSystemRandomGen = do
    ch <- SE.openHandle
    let getBS = unsafeInterleaveIO $ do
        bs   <- SE.hGetEntropy ch 8192
        more <- getBS
        return (bs:more)
    SystemRandom <$> getBS

instance CPRG SystemRandom where
   cprgNeedReseed      _ = NeverReseed
   cprgSupplyEntropy _ g = g
   cprgGenBytes n (SystemRandom l) = (B.concat l1, SystemRandom l2)
        where (l1, l2) = lbsSplitAt n l
              lbsSplitAt rBytes (x:xs)
                | xLen >= rBytes =
                    let (b1,b2) = B.splitAt rBytes x
                     in  ([b1], b2:xs)
                | otherwise =
                    let (l1,l2) = lbsSplitAt (rBytes-xLen) xs
                     in (x:l1,l2)
                where xLen = B.length x