← Back to branch summary

~ubuntu-branches/ubuntu/vivid/haskell-crypto-api/vivid

« back to all changes in this revision

Viewing changes to Crypto/Random.hs

  • Committer: Package Import Robot
  • Author(s): Clint Adams
  • Date: 2011-08-26 19:59:39 UTC
  • mfrom: (2.1.2 sid)
  • Revision ID: package-import@ubuntu.com-20110826195939-8v3gmibtsdq004gb
New upstream release.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Crypto/Random.hs
22
22
-}
23
23
 
24
24
module Crypto.Random
25
 
        ( -- * Basic Interface
26
 
          CryptoRandomGen(..)
27
 
        , GenError (..)
28
 
          -- * Helper functions and expanded interface
29
 
        , splitGen
30
 
          -- * Instances
31
 
        , SystemRandom
32
 
        ) where
 
25
       ( -- * Basic Interface
 
26
         CryptoRandomGen(..)
 
27
       , GenError (..)
 
28
         -- * Helper functions and expanded interface
 
29
       , splitGen
 
30
         -- * Instances
 
31
       , SystemRandom
 
32
       ) where
33
33
 
34
 
import System.Crypto.Random
 
34
import Control.Monad (liftM)
35
35
import Crypto.Types
36
 
import Control.Monad (liftM)
37
 
import qualified Data.ByteString as B
38
 
import qualified Data.ByteString.Lazy as L
39
 
import Data.Tagged
40
36
import Data.Bits (xor, setBit, shiftR, shiftL, (.&.))
41
37
import Data.List (foldl')
 
38
import Data.Tagged
 
39
import System.Entropy
42
40
import System.IO.Unsafe(unsafeInterleaveIO)
 
41
import qualified Data.ByteString as B
 
42
import qualified Data.ByteString.Lazy as L
43
43
import qualified Foreign.ForeignPtr as FP
44
44
 
45
45
#if MIN_VERSION_tagged(0,2,0)
46
46
import Data.Proxy
47
47
#endif
48
48
 
 
49
-- |Generator failures should always return the appropriate GenError.
49
50
data GenError =
50
51
          GenErrorOther String  -- ^ Misc
51
 
        | RequestedTooManyBytes -- ^ Requested more bytes than a single pass can generate (The maximum request is generator dependent)
52
 
        | RangeInvalid          -- ^ When using @genInteger g (l,h)@ and @logBase 2 (h - l) > (maxBound :: Int)@.
53
 
        | NeedReseed            -- ^ Some generators cease operation after too high a count without a reseed (ex: NIST SP 800-90)
54
 
        | NotEnoughEntropy      -- ^ For instantiating new generators (or reseeding)
55
 
        | NeedsInfiniteSeed     -- ^ This generator can not be instantiated or reseeded with a finite seed (ex: 'SystemRandom')
 
52
        | RequestedTooManyBytes -- ^ Requested more bytes than a
 
53
                                -- single pass can generate (The
 
54
                                -- maximum request is generator
 
55
                                -- dependent)
 
56
        | RangeInvalid          -- ^ When using @genInteger g (l,h)@
 
57
                                -- and @logBase 2 (h - l) > (maxBound
 
58
                                -- :: Int)@.
 
59
        | NeedReseed            -- ^ Some generators cease operation
 
60
                                -- after too high a count without a
 
61
                                -- reseed (ex: NIST SP 800-90)
 
62
        | NotEnoughEntropy      -- ^ For instantiating new generators
 
63
                                -- (or reseeding)
 
64
        | NeedsInfiniteSeed     -- ^ This generator can not be
 
65
                                -- instantiated or reseeded with a
 
66
                                -- finite seed (ex: 'SystemRandom')
56
67
  deriving (Eq, Ord, Show)
57
68
 
58
69
-- |A class of random bit generators that allows for the possibility
128
138
        newGenIO :: IO g
129
139
        newGenIO = go 0
130
140
          where
131
 
          go 1000 = error "The generator instance requested by newGenIO never instantiates (1000 tries).  It must be broken."
 
141
          go 1000 = error $ "The generator instance requested by" ++
 
142
                          "newGenIO never instantiates (1000 tries). " ++
 
143
                          "It must be broken."
132
144
          go i = do
133
145
                let p = Proxy
134
146
                    getTypedGen :: (CryptoRandomGen g) => Proxy g -> IO (Either GenError g)
164
176
data SystemRandom = SysRandom L.ByteString
165
177
 
166
178
instance CryptoRandomGen SystemRandom where
167
 
        newGen _ = Left NeedsInfiniteSeed
168
 
        genSeedLength = Tagged maxBound
169
 
        genBytes req (SysRandom bs) =
170
 
                let reqI = fromIntegral req
171
 
                    rnd = L.take reqI bs
172
 
                    rest = L.drop reqI bs
173
 
                in if L.length rnd == reqI
174
 
                        then Right (B.concat $ L.toChunks rnd, SysRandom rest)
175
 
                        else Left $ GenErrorOther "Error obtaining enough bytes from system random for given request"
176
 
        reseed _ _ = Left NeedsInfiniteSeed
177
 
        newGenIO = getSystemGen
 
179
  newGen _ = Left NeedsInfiniteSeed
 
180
  genSeedLength = Tagged maxBound
 
181
  genBytes req (SysRandom bs) =
 
182
    let reqI = fromIntegral req
 
183
        rnd = L.take reqI bs
 
184
        rest = L.drop reqI bs
 
185
    in if L.length rnd == reqI
 
186
        then Right (B.concat $ L.toChunks rnd, SysRandom rest)
 
187
        else Left $ GenErrorOther "Error obtaining enough bytes \
 
188
                                 \from system random for given request"
 
189
  reseed _ _ = Left NeedsInfiniteSeed
 
190
  newGenIO = getSystemGen
178
191
 
179
192
-- | While the safety and wisdom of a splitting function depends on the
180
193
-- properties of the generator being split, several arguments from
182
195
-- generators.  (see libraries\@haskell.org discussion around Sept, Oct
183
196
-- 2010)
184
197
splitGen :: CryptoRandomGen g => g -> Either GenError (g,g)
185
 
splitGen g = do
186
 
        let e = genBytes (genSeedLength `for` g) g
187
 
        case e of
 
198
splitGen g =
 
199
  let e = genBytes (genSeedLength `for` g) g
 
200
  in case e of
 
201
    Left e -> Left e
 
202
    Right (ent,g') -> 
 
203
       case newGen ent of
 
204
                Right new -> Right (g',new)
188
205
                Left e -> Left e
189
 
                Right (ent,g') -> 
190
 
                        case newGen ent of
191
 
                                Right new -> Right (g',new)
192
 
                                Left e -> Left e
193
206
 
194
207
-- |Obtain a tagged value for a particular instantiated type.
195
208
for :: Tagged a b -> a -> b