monadcryptorandom-0.7.2.1: A monad for using CryptoRandomGen
MaintainerThomas.DuBuisson@gmail.com
Stabilitybeta
Portabilityportable
Safe HaskellSafe-Inferred
LanguageHaskell98

Control.Monad.CryptoRandom

Description

Much like the MonadRandom package (Control.Monad.Random), this module provides plumbing for the CryptoRandomGen generators.

Synopsis

Documentation

class CRandom a where Source #

CRandom a is much like the Random class from the System.Random module in the "random" package. The main difference is CRandom builds on "crypto-api"'s CryptoRandomGen, so it allows explicit failure.

crandomR (low,high) g as typically instantiated will generate a value between [low, high] inclusively, swapping the pair if high < low.

Provided instances for crandom g generates randoms between the bounds and between +/- 2^256 for Integer.

The crandomR function has degraded (theoretically unbounded, probabilistically decent) performance the closer your range size (high - low) is to 2^n (from the top).

Minimal complete definition

crandom

Methods

crandom :: CryptoRandomGen g => g -> Either GenError (a, g) Source #

crandoms :: CryptoRandomGen g => g -> [a] Source #

Instances

Instances details
CRandom Int16 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Int32 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Int64 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Int8 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Word16 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Word32 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Word64 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Word8 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Bool Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandom Int Source # 
Instance details

Defined in Control.Monad.CryptoRandom

class CRandomR a where Source #

Minimal complete definition

crandomR

Methods

crandomR :: CryptoRandomGen g => (a, a) -> g -> Either GenError (a, g) Source #

crandomRs :: CryptoRandomGen g => (a, a) -> g -> [a] Source #

Instances

Instances details
CRandomR Int16 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandomR Int32 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandomR Int64 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandomR Int8 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

crandomR :: CryptoRandomGen g => (Int8, Int8) -> g -> Either GenError (Int8, g) Source #

crandomRs :: CryptoRandomGen g => (Int8, Int8) -> g -> [Int8] Source #

CRandomR Word16 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandomR Word32 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandomR Word64 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandomR Word8 Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandomR Integer Source # 
Instance details

Defined in Control.Monad.CryptoRandom

CRandomR Int Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

crandomR :: CryptoRandomGen g => (Int, Int) -> g -> Either GenError (Int, g) Source #

crandomRs :: CryptoRandomGen g => (Int, Int) -> g -> [Int] Source #

class (ContainsGenError e, MonadError e m) => MonadCRandom e m where Source #

MonadCRandom m represents a monad that can produce random values (or fail with a GenError). It is suggested you use the CRandT transformer in your monad stack.

Instances

Instances details
MonadCRandom e m => MonadCRandom e (ReaderT r m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

MonadCRandom e m => MonadCRandom e (StateT s m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

MonadCRandom e m => MonadCRandom e (StateT s m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

(Monoid w, MonadCRandom e m) => MonadCRandom e (WriterT w m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

(Monoid w, MonadCRandom e m) => MonadCRandom e (WriterT w m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

(ContainsGenError e, Monad m, CryptoRandomGen g) => MonadCRandom e (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

(Monoid w, MonadCRandom e m) => MonadCRandom e (RWST r w s m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

(Monoid w, MonadCRandom e m) => MonadCRandom e (RWST r w s m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

class (ContainsGenError e, MonadError e m) => MonadCRandomR e m where Source #

Methods

getCRandomR :: CRandomR a => (a, a) -> m a Source #

Instances

Instances details
MonadCRandomR e m => MonadCRandomR e (ReaderT r m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> ReaderT r m a Source #

MonadCRandomR e m => MonadCRandomR e (StateT s m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> StateT s m a Source #

MonadCRandomR e m => MonadCRandomR e (StateT s m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> StateT s m a Source #

(MonadCRandomR e m, Monoid w) => MonadCRandomR e (WriterT w m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> WriterT w m a Source #

(MonadCRandomR e m, Monoid w) => MonadCRandomR e (WriterT w m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> WriterT w m a Source #

(ContainsGenError e, Monad m, CryptoRandomGen g) => MonadCRandomR e (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> CRandT g e m a Source #

(MonadCRandomR e m, Monoid w) => MonadCRandomR e (RWST r w s m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> RWST r w s m a Source #

(MonadCRandomR e m, Monoid w) => MonadCRandomR e (RWST r w s m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> RWST r w s m a Source #

newtype CRandT g e m a Source #

CRandT is the transformer suggested for MonadCRandom.

Constructors

CRandT 

Fields

Instances

Instances details
(ContainsGenError e, Monad m, CryptoRandomGen g) => MonadCRandom e (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

(ContainsGenError e, Monad m, CryptoRandomGen g) => MonadCRandomR e (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

getCRandomR :: CRandomR a => (a, a) -> CRandT g e m a Source #

Monad m => MonadError e (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

throwError :: e -> CRandT g e m a Source #

catchError :: CRandT g e m a -> (e -> CRandT g e m a) -> CRandT g e m a Source #

MonadReader r m => MonadReader r (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

ask :: CRandT g e m r Source #

local :: (r -> r) -> CRandT g e m a -> CRandT g e m a Source #

reader :: (r -> a) -> CRandT g e m a Source #

MonadState s m => MonadState s (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

get :: CRandT g e m s Source #

put :: s -> CRandT g e m () Source #

state :: (s -> (a, s)) -> CRandT g e m a Source #

MonadWriter w m => MonadWriter w (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

writer :: (a, w) -> CRandT g e m a Source #

tell :: w -> CRandT g e m () Source #

listen :: CRandT g e m a -> CRandT g e m (a, w) Source #

pass :: CRandT g e m (a, w -> w) -> CRandT g e m a Source #

MonadTrans (CRandT g e) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

lift :: Monad m => m a -> CRandT g e m a Source #

MonadFix m => MonadFix (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

mfix :: (a -> CRandT g e m a) -> CRandT g e m a Source #

MonadIO m => MonadIO (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

liftIO :: IO a -> CRandT g e m a Source #

Monad m => Applicative (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

pure :: a -> CRandT g e m a Source #

(<*>) :: CRandT g e m (a -> b) -> CRandT g e m a -> CRandT g e m b Source #

liftA2 :: (a -> b -> c) -> CRandT g e m a -> CRandT g e m b -> CRandT g e m c Source #

(*>) :: CRandT g e m a -> CRandT g e m b -> CRandT g e m b Source #

(<*) :: CRandT g e m a -> CRandT g e m b -> CRandT g e m a Source #

Functor m => Functor (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

fmap :: (a -> b) -> CRandT g e m a -> CRandT g e m b Source #

(<$) :: a -> CRandT g e m b -> CRandT g e m a Source #

Monad m => Monad (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

(>>=) :: CRandT g e m a -> (a -> CRandT g e m b) -> CRandT g e m b Source #

(>>) :: CRandT g e m a -> CRandT g e m b -> CRandT g e m b Source #

return :: a -> CRandT g e m a Source #

MonadCatch m => MonadCatch (CRandT g e m) Source #

Catches exceptions from the base monad.

Since: 0.7.1

Instance details

Defined in Control.Monad.CryptoRandom

Methods

catch :: Exception e0 => CRandT g e m a -> (e0 -> CRandT g e m a) -> CRandT g e m a Source #

MonadThrow m => MonadThrow (CRandT g e m) Source #

Throws exceptions into the base monad.

Since: 0.7.1

Instance details

Defined in Control.Monad.CryptoRandom

Methods

throwM :: Exception e0 => e0 -> CRandT g e m a Source #

MonadCont m => MonadCont (CRandT g e m) Source # 
Instance details

Defined in Control.Monad.CryptoRandom

Methods

callCC :: ((a -> CRandT g e m b) -> CRandT g e m a) -> CRandT g e m a Source #

type CRand g e = CRandT g e Identity Source #

Simple users of generators can use CRand for quick and easy generation of randoms. See below for a simple use of newGenIO (from "crypto-api"), getCRandom, getBytes, and runCRandom.

getRandPair = do
  int <- getCRandom
  bytes <- getBytes 100
  return (int, bytes)

func = do
  g <- newGenIO
  case runCRand getRandPair g of
    Right ((int,bytes), g') -> useRandomVals (int,bytes)
    Left x -> handleGenError x

runCRandT :: ContainsGenError e => CRandT g e m a -> g -> m (Either e (a, g)) Source #

evalCRandT :: (ContainsGenError e, Monad m) => CRandT g e m a -> g -> m (Either e a) Source #

runCRand :: ContainsGenError e => CRand g e a -> g -> Either e (a, g) Source #

liftCRand :: (g -> Either e (a, g)) -> CRand g e a Source #

liftCRandT :: Monad m => (g -> Either e (a, g)) -> CRandT g e m a Source #

data GenError Source #

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)

Constructors

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)

Instances

Instances details
Data GenError 
Instance details

Defined in Crypto.Random

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> GenError -> c GenError Source #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c GenError Source #

toConstr :: GenError -> Constr Source #

dataTypeOf :: GenError -> DataType Source #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c GenError) Source #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenError) Source #

gmapT :: (forall b. Data b => b -> b) -> GenError -> GenError Source #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> GenError -> r Source #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> GenError -> r Source #

gmapQ :: (forall d. Data d => d -> u) -> GenError -> [u] Source #

gmapQi :: Int -> (forall d. Data d => d -> u) -> GenError -> u Source #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> GenError -> m GenError Source #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> GenError -> m GenError Source #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> GenError -> m GenError Source #

Exception GenError 
Instance details

Defined in Crypto.Random

Read GenError 
Instance details

Defined in Crypto.Random

Show GenError 
Instance details

Defined in Crypto.Random

Eq GenError 
Instance details

Defined in Crypto.Random

Ord GenError 
Instance details

Defined in Crypto.Random

ContainsGenError GenError Source # 
Instance details

Defined in Control.Monad.CryptoRandom

class CryptoRandomGen g where Source #

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.

Minimal complete definition

newGen, genSeedLength, genBytes, reseedInfo, reseedPeriod, reseed

Methods

newGen :: ByteString -> Either GenError g Source #

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.

genSeedLength :: Tagged g ByteLength Source #

Length of input entropy necessary to instantiate or reseed a generator

genBytes :: ByteLength -> g -> Either GenError (ByteString, g) Source #

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

reseedInfo :: g -> ReseedInfo Source #

Indicates how soon a reseed is needed

reseedPeriod :: g -> ReseedInfo Source #

Indicates the period between reseeds (constant for most generators).

genBytesWithEntropy :: ByteLength -> ByteString -> g -> Either GenError (ByteString, g) Source #

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)

reseed :: ByteString -> g -> Either GenError g Source #

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).

newGenIO :: IO g Source #

By default this uses System.Entropy to obtain entropy for newGen. WARNING: The default implementation opens a file handle which will never be closed!