{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable, CPP,
             BangPatterns #-}
{-|
 Maintainer: Thomas.DuBuisson@gmail.com
 Stability: beta
 Portability: portable 


 This module is for instantiating cryptographicly strong
determinitic random bit generators (DRBGs, aka PRNGs) For the simple
use case of using the system random number generator
('System.Entropy') to seed the DRBG:

@   g <- newGenIO
@

 Users needing to provide their own entropy can call 'newGen' directly
 
@    entropy <- getEntropy nrBytes
    let generator = newGen entropy
@

-}

module Crypto.Random
       ( -- * Basic Interface
         CryptoRandomGen(..)
       , GenError (..)
       , ReseedInfo (..)
         -- * Helper functions and expanded interface
       , splitGen
       , throwLeft
         -- * Instances
       , SystemRandom
       ) where

import Control.Monad (liftM)
import Control.Exception
import Crypto.Types
import Crypto.Util
import Data.Bits (xor, setBit, shiftR, shiftL, (.&.))
import Data.Data
import Data.List (foldl')
import Data.Tagged
import Data.Typeable
import Data.Word
import System.Entropy
import System.IO.Unsafe(unsafeInterleaveIO)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Foreign.ForeignPtr as FP

#if MIN_VERSION_tagged(0,2,0)
import Data.Proxy
#endif

-- |Generator failures should always return the appropriate GenError.
-- Note 'GenError' in an instance of exception but wether or not an
-- exception is thrown depends on if the selected generator (read:
-- if you don't want execptions from code that uses 'throw' then
-- pass in a generator that never has an error for the used functions)
data GenError =
          GenErrorOther String  -- ^ Misc
        | RequestedTooManyBytes -- ^ Requested more bytes than a
                                -- single pass can generate (The
                                -- maximum request is generator
                                -- dependent)
        | RangeInvalid          -- ^ When using @genInteger g (l,h)@
                                -- and @logBase 2 (h - l) > (maxBound
                                -- :: Int)@.
        | NeedReseed            -- ^ Some generators cease operation
                                -- after too high a count without a
                                -- reseed (ex: NIST SP 800-90)
        | NotEnoughEntropy      -- ^ For instantiating new generators
                                -- (or reseeding)
        | NeedsInfiniteSeed     -- ^ This generator can not be
                                -- instantiated or reseeded with a
                                -- finite seed (ex: 'SystemRandom')
  deriving (GenError -> GenError -> Bool
(GenError -> GenError -> Bool)
-> (GenError -> GenError -> Bool) -> Eq GenError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenError -> GenError -> Bool
== :: GenError -> GenError -> Bool
$c/= :: GenError -> GenError -> Bool
/= :: GenError -> GenError -> Bool
Eq, Eq GenError
Eq GenError =>
(GenError -> GenError -> Ordering)
-> (GenError -> GenError -> Bool)
-> (GenError -> GenError -> Bool)
-> (GenError -> GenError -> Bool)
-> (GenError -> GenError -> Bool)
-> (GenError -> GenError -> GenError)
-> (GenError -> GenError -> GenError)
-> Ord GenError
GenError -> GenError -> Bool
GenError -> GenError -> Ordering
GenError -> GenError -> GenError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GenError -> GenError -> Ordering
compare :: GenError -> GenError -> Ordering
$c< :: GenError -> GenError -> Bool
< :: GenError -> GenError -> Bool
$c<= :: GenError -> GenError -> Bool
<= :: GenError -> GenError -> Bool
$c> :: GenError -> GenError -> Bool
> :: GenError -> GenError -> Bool
$c>= :: GenError -> GenError -> Bool
>= :: GenError -> GenError -> Bool
$cmax :: GenError -> GenError -> GenError
max :: GenError -> GenError -> GenError
$cmin :: GenError -> GenError -> GenError
min :: GenError -> GenError -> GenError
Ord, Int -> GenError -> ShowS
[GenError] -> ShowS
GenError -> String
(Int -> GenError -> ShowS)
-> (GenError -> String) -> ([GenError] -> ShowS) -> Show GenError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenError -> ShowS
showsPrec :: Int -> GenError -> ShowS
$cshow :: GenError -> String
show :: GenError -> String
$cshowList :: [GenError] -> ShowS
showList :: [GenError] -> ShowS
Show, ReadPrec [GenError]
ReadPrec GenError
Int -> ReadS GenError
ReadS [GenError]
(Int -> ReadS GenError)
-> ReadS [GenError]
-> ReadPrec GenError
-> ReadPrec [GenError]
-> Read GenError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GenError
readsPrec :: Int -> ReadS GenError
$creadList :: ReadS [GenError]
readList :: ReadS [GenError]
$creadPrec :: ReadPrec GenError
readPrec :: ReadPrec GenError
$creadListPrec :: ReadPrec [GenError]
readListPrec :: ReadPrec [GenError]
Read, Typeable GenError
Typeable GenError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GenError -> c GenError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GenError)
-> (GenError -> Constr)
-> (GenError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GenError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenError))
-> ((forall b. Data b => b -> b) -> GenError -> GenError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GenError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GenError -> r)
-> (forall u. (forall d. Data d => d -> u) -> GenError -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> GenError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GenError -> m GenError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GenError -> m GenError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GenError -> m GenError)
-> Data GenError
GenError -> Constr
GenError -> DataType
(forall b. Data b => b -> b) -> GenError -> GenError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GenError -> u
forall u. (forall d. Data d => d -> u) -> GenError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GenError -> m GenError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenError -> m GenError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenError -> c GenError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenError -> c GenError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenError -> c GenError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenError
$ctoConstr :: GenError -> Constr
toConstr :: GenError -> Constr
$cdataTypeOf :: GenError -> DataType
dataTypeOf :: GenError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenError)
$cgmapT :: (forall b. Data b => b -> b) -> GenError -> GenError
gmapT :: (forall b. Data b => b -> b) -> GenError -> GenError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GenError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> GenError -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GenError -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GenError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GenError -> m GenError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GenError -> m GenError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenError -> m GenError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenError -> m GenError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenError -> m GenError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenError -> m GenError
Data, Typeable)

data ReseedInfo
    = InXBytes {-# UNPACK #-} !Word64   -- ^ Generator needs reseeded in X bytes
    | InXCalls {-# UNPACK #-} !Word64   -- ^ Generator needs reseeded in X calls
    | NotSoon                           -- ^ The bound is over 2^64 bytes or calls
    | Never                             -- ^ This generator never reseeds (ex: 'SystemRandom')
  deriving (ReseedInfo -> ReseedInfo -> Bool
(ReseedInfo -> ReseedInfo -> Bool)
-> (ReseedInfo -> ReseedInfo -> Bool) -> Eq ReseedInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReseedInfo -> ReseedInfo -> Bool
== :: ReseedInfo -> ReseedInfo -> Bool
$c/= :: ReseedInfo -> ReseedInfo -> Bool
/= :: ReseedInfo -> ReseedInfo -> Bool
Eq, Eq ReseedInfo
Eq ReseedInfo =>
(ReseedInfo -> ReseedInfo -> Ordering)
-> (ReseedInfo -> ReseedInfo -> Bool)
-> (ReseedInfo -> ReseedInfo -> Bool)
-> (ReseedInfo -> ReseedInfo -> Bool)
-> (ReseedInfo -> ReseedInfo -> Bool)
-> (ReseedInfo -> ReseedInfo -> ReseedInfo)
-> (ReseedInfo -> ReseedInfo -> ReseedInfo)
-> Ord ReseedInfo
ReseedInfo -> ReseedInfo -> Bool
ReseedInfo -> ReseedInfo -> Ordering
ReseedInfo -> ReseedInfo -> ReseedInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ReseedInfo -> ReseedInfo -> Ordering
compare :: ReseedInfo -> ReseedInfo -> Ordering
$c< :: ReseedInfo -> ReseedInfo -> Bool
< :: ReseedInfo -> ReseedInfo -> Bool
$c<= :: ReseedInfo -> ReseedInfo -> Bool
<= :: ReseedInfo -> ReseedInfo -> Bool
$c> :: ReseedInfo -> ReseedInfo -> Bool
> :: ReseedInfo -> ReseedInfo -> Bool
$c>= :: ReseedInfo -> ReseedInfo -> Bool
>= :: ReseedInfo -> ReseedInfo -> Bool
$cmax :: ReseedInfo -> ReseedInfo -> ReseedInfo
max :: ReseedInfo -> ReseedInfo -> ReseedInfo
$cmin :: ReseedInfo -> ReseedInfo -> ReseedInfo
min :: ReseedInfo -> ReseedInfo -> ReseedInfo
Ord, Int -> ReseedInfo -> ShowS
[ReseedInfo] -> ShowS
ReseedInfo -> String
(Int -> ReseedInfo -> ShowS)
-> (ReseedInfo -> String)
-> ([ReseedInfo] -> ShowS)
-> Show ReseedInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReseedInfo -> ShowS
showsPrec :: Int -> ReseedInfo -> ShowS
$cshow :: ReseedInfo -> String
show :: ReseedInfo -> String
$cshowList :: [ReseedInfo] -> ShowS
showList :: [ReseedInfo] -> ShowS
Show, ReadPrec [ReseedInfo]
ReadPrec ReseedInfo
Int -> ReadS ReseedInfo
ReadS [ReseedInfo]
(Int -> ReadS ReseedInfo)
-> ReadS [ReseedInfo]
-> ReadPrec ReseedInfo
-> ReadPrec [ReseedInfo]
-> Read ReseedInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ReseedInfo
readsPrec :: Int -> ReadS ReseedInfo
$creadList :: ReadS [ReseedInfo]
readList :: ReadS [ReseedInfo]
$creadPrec :: ReadPrec ReseedInfo
readPrec :: ReadPrec ReseedInfo
$creadListPrec :: ReadPrec [ReseedInfo]
readListPrec :: ReadPrec [ReseedInfo]
Read, Typeable ReseedInfo
Typeable ReseedInfo =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ReseedInfo -> c ReseedInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ReseedInfo)
-> (ReseedInfo -> Constr)
-> (ReseedInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ReseedInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ReseedInfo))
-> ((forall b. Data b => b -> b) -> ReseedInfo -> ReseedInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> ReseedInfo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ReseedInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo)
-> Data ReseedInfo
ReseedInfo -> Constr
ReseedInfo -> DataType
(forall b. Data b => b -> b) -> ReseedInfo -> ReseedInfo
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ReseedInfo -> u
forall u. (forall d. Data d => d -> u) -> ReseedInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReseedInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReseedInfo -> c ReseedInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReseedInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ReseedInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReseedInfo -> c ReseedInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReseedInfo -> c ReseedInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReseedInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReseedInfo
$ctoConstr :: ReseedInfo -> Constr
toConstr :: ReseedInfo -> Constr
$cdataTypeOf :: ReseedInfo -> DataType
dataTypeOf :: ReseedInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReseedInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReseedInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ReseedInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ReseedInfo)
$cgmapT :: (forall b. Data b => b -> b) -> ReseedInfo -> ReseedInfo
gmapT :: (forall b. Data b => b -> b) -> ReseedInfo -> ReseedInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReseedInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ReseedInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ReseedInfo -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ReseedInfo -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ReseedInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ReseedInfo -> m ReseedInfo
Data, Typeable)

instance Exception GenError

-- |A class of random bit generators that allows for the possibility
-- of failure, reseeding, providing entropy at the same time as
-- requesting bytes
--
-- Minimum complete definition: `newGen`, `genSeedLength`, `genBytes`,
-- `reseed`, `reseedInfo`, `reseedPeriod`.
class CryptoRandomGen g where
        -- |Instantiate a new random bit generator.  The provided
        -- bytestring should be of length >= genSeedLength.  If the
        -- bytestring is shorter then the call may fail (suggested
        -- error: `NotEnoughEntropy`).  If the bytestring is of
        -- sufficent length the call should always succeed.
        newGen :: B.ByteString -> Either GenError g

        -- |Length of input entropy necessary to instantiate or reseed
        -- a generator
        genSeedLength :: Tagged g ByteLength

        -- | @genBytes len g@ generates a random ByteString of length
        -- @len@ and new generator.  The "MonadCryptoRandom" package
        -- has routines useful for converting the ByteString to
        -- commonly needed values (but "cereal" or other
        -- deserialization libraries would also work).
        --
        -- This routine can fail if the generator has gone too long
        -- without a reseed (usually this is in the ball-park of 2^48
        -- requests).  Suggested error in this cases is `NeedReseed`
        genBytes        :: ByteLength -> g -> Either GenError (B.ByteString, g)

        -- | Indicates how soon a reseed is needed
        reseedInfo :: g -> ReseedInfo

        -- | Indicates the period between reseeds (constant for most generators).
        reseedPeriod :: g -> ReseedInfo

        -- |@genBytesWithEntropy g i entropy@ generates @i@ random
        -- bytes and use the additional input @entropy@ in the
        -- generation of the requested data to increase the confidence
        -- our generated data is a secure random stream.
        --
        -- Some generators use @entropy@ to perturb the state of the
        -- generator, meaning:
        --
        -- @
        --     (_,g2') <- genBytesWithEntropy len g1 ent
        --     (_,g2 ) <- genBytes len g1
        --     g2 /= g2'
        -- @
        --
        -- But this is not required.
        --
        -- Default:
        -- 
        -- @
        --     genBytesWithEntropy g bytes entropy = xor entropy (genBytes g bytes)
        -- @
        genBytesWithEntropy     :: ByteLength -> B.ByteString -> g -> Either GenError (B.ByteString, g)
        genBytesWithEntropy Int
len ByteString
entropy g
g =
                let res :: Either GenError (ByteString, g)
res = Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
len g
g
                in case Either GenError (ByteString, g)
res of
                        Left GenError
err -> GenError -> Either GenError (ByteString, g)
forall a b. a -> Either a b
Left GenError
err
                        Right (ByteString
bs,g
g') ->
                                let entropy' :: ByteString
entropy' = ByteString -> ByteString -> ByteString
B.append ByteString
entropy (Int -> Word8 -> ByteString
B.replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
entropy) Word8
0)
                                in (ByteString, g) -> Either GenError (ByteString, g)
forall a b. b -> Either a b
Right (ByteString -> ByteString -> ByteString
zwp' ByteString
entropy' ByteString
bs, g
g')

        -- |If the generator has produced too many random bytes on its
        -- existing seed it will return `NeedReseed`.  In that case,
        -- reseed the generator using this function and a new
        -- high-entropy seed of length >= `genSeedLength`.  Using
        -- bytestrings that are too short can result in an error
        -- (`NotEnoughEntropy`).
        reseed          :: B.ByteString -> g -> Either GenError g

        -- |By default this uses "System.Entropy" to obtain
        -- entropy for `newGen`.
        -- WARNING: The default implementation opens a file handle which will never be closed!
        newGenIO :: IO g
        newGenIO = Integer -> IO g
forall {t} {b}. (Eq t, Num t, CryptoRandomGen b) => t -> IO b
go Integer
0
          where
          go :: t -> IO b
go t
1000 = GenError -> IO b
forall a e. Exception e => e -> a
throw (GenError -> IO b) -> GenError -> IO b
forall a b. (a -> b) -> a -> b
$ String -> GenError
GenErrorOther (String -> GenError) -> String -> GenError
forall a b. (a -> b) -> a -> b
$ 
                          String
"The generator instance requested by" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                          String
"newGenIO never instantiates (1000 tries). " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                          String
"It must be broken."
          go t
i = do
                let p :: Proxy t
p = Proxy t
forall {k} (t :: k). Proxy t
Proxy
                    getTypedGen :: (CryptoRandomGen g) => Proxy g -> IO (Either GenError g)
                    getTypedGen :: forall g. CryptoRandomGen g => Proxy g -> IO (Either GenError g)
getTypedGen Proxy g
pr = (ByteString -> Either GenError g)
-> IO ByteString -> IO (Either GenError g)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen (Int -> IO ByteString
getEntropy (Int -> IO ByteString) -> Int -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Tagged g Int -> Proxy g -> Int
forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged g Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Proxy g
pr)
                Either GenError b
res <- Proxy b -> IO (Either GenError b)
forall g. CryptoRandomGen g => Proxy g -> IO (Either GenError g)
getTypedGen Proxy b
forall {t}. Proxy t
p
                case Either GenError b
res of
                        Left GenError
_ -> t -> IO b
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)
                        Right b
g -> b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
g b -> Proxy b -> b
forall a (proxy :: * -> *). a -> proxy a -> a
`asProxyTypeOf` Proxy b
forall {t}. Proxy t
p)

-- | Get a random number generator based on the standard system entropy source
--   WARNING: This function opens a file handle which will never be closed!
getSystemGen :: IO SystemRandom
getSystemGen :: IO SystemRandom
getSystemGen = do
        CryptHandle
ch <- IO CryptHandle
openHandle
        let getBS :: IO [ByteString]
getBS = IO [ByteString] -> IO [ByteString]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [ByteString] -> IO [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ do
                ByteString
bs <- CryptHandle -> Int -> IO ByteString
hGetEntropy CryptHandle
ch ((Int
2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
15) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16)
                [ByteString]
more <- IO [ByteString]
getBS
                [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
more)
        ([ByteString] -> SystemRandom)
-> IO [ByteString] -> IO SystemRandom
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> SystemRandom
SysRandom (ByteString -> SystemRandom)
-> ([ByteString] -> ByteString) -> [ByteString] -> SystemRandom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks) IO [ByteString]
getBS

-- |Not that it is technically correct as an instance of
-- 'CryptoRandomGen', but simply because it's a reasonable engineering
-- choice here is a CryptoRandomGen which streams the system
-- randoms. Take note:
-- 
--  * It uses the default definition of 'genByteWithEntropy'
--
--  * 'newGen' will always fail!
--
--  * 'reseed' will always fail!
--
--  * the handle to the system random is never closed
--
data SystemRandom = SysRandom L.ByteString

instance CryptoRandomGen SystemRandom where
  newGen :: ByteString -> Either GenError SystemRandom
newGen ByteString
_ = GenError -> Either GenError SystemRandom
forall a b. a -> Either a b
Left GenError
NeedsInfiniteSeed
  genSeedLength :: Tagged SystemRandom Int
genSeedLength = Int -> Tagged SystemRandom Int
forall {k} (s :: k) b. b -> Tagged s b
Tagged Int
forall a. Bounded a => a
maxBound
  genBytes :: Int -> SystemRandom -> Either GenError (ByteString, SystemRandom)
genBytes Int
req (SysRandom ByteString
bs) =
    let reqI :: Int64
reqI = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
req
        rnd :: ByteString
rnd  = Int64 -> ByteString -> ByteString
L.take Int64
reqI ByteString
bs
        rest :: ByteString
rest = Int64 -> ByteString -> ByteString
L.drop Int64
reqI ByteString
bs
    in if ByteString -> Int64
L.length ByteString
rnd Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
reqI
        then (ByteString, SystemRandom)
-> Either GenError (ByteString, SystemRandom)
forall a b. b -> Either a b
Right ([ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
rnd, ByteString -> SystemRandom
SysRandom ByteString
rest)
        else GenError -> Either GenError (ByteString, SystemRandom)
forall a b. a -> Either a b
Left GenError
RequestedTooManyBytes
  reseed :: ByteString -> SystemRandom -> Either GenError SystemRandom
reseed ByteString
_ SystemRandom
_ = GenError -> Either GenError SystemRandom
forall a b. a -> Either a b
Left GenError
NeedsInfiniteSeed
  newGenIO :: IO SystemRandom
newGenIO = IO SystemRandom
getSystemGen
  reseedInfo :: SystemRandom -> ReseedInfo
reseedInfo SystemRandom
_ = ReseedInfo
Never
  reseedPeriod :: SystemRandom -> ReseedInfo
reseedPeriod SystemRandom
_ = ReseedInfo
Never

-- | While the safety and wisdom of a splitting function depends on the
-- properties of the generator being split, several arguments from
-- informed people indicate such a function is safe for NIST SP 800-90
-- generators.  (see libraries\@haskell.org discussion around Sept, Oct
-- 2010).  You can find implementations of such generators in the 'DRBG'
-- package.
splitGen :: CryptoRandomGen g => g -> Either GenError (g,g)
splitGen :: forall g. CryptoRandomGen g => g -> Either GenError (g, g)
splitGen g
g =
  let e :: Either GenError (ByteString, g)
e = Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes (Tagged g Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Tagged g Int -> g -> Int
forall a b. Tagged a b -> a -> b
`for` g
g) g
g
  in case Either GenError (ByteString, g)
e of
    Left GenError
e -> GenError -> Either GenError (g, g)
forall a b. a -> Either a b
Left GenError
e
    Right (ByteString
ent,g
g') -> 
       case ByteString -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen ByteString
ent of
                Right g
new -> (g, g) -> Either GenError (g, g)
forall a b. b -> Either a b
Right (g
g',g
new)
                Left GenError
e -> GenError -> Either GenError (g, g)
forall a b. a -> Either a b
Left GenError
e