monadcryptorandom-0.3: A monad for using CryptoRandomGen

Portabilityportable
Stabilitybeta
MaintainerThomas.DuBuisson@gmail.com

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 whereSource

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

Methods

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

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

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

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

class (ContainsGenError e, MonadError e m) => MonadCryptoRandom e m whereSource

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

data CRandT g e m a Source

CRandT is the transformer suggested for MonadCryptoRandom.

Instances

(Monad m, Error e) => MonadError e (CRandT g e m) 
(ContainsGenError e, Error e, Monad m, CryptoRandomGen g) => MonadCryptoRandom e (CRandT g e m) 
Error e => MonadTrans (CRandT g e) 
(Monad m, Error e) => Monad (CRandT g e m) 
(MonadIO m, Error e) => MonadIO (CRandT g e m) 

type CRand g e = CRandT g e IdentitySource

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