add a simple random abstraction
This commit is contained in:
parent
3b6c72e242
commit
a4d3dc4d10
@ -5,13 +5,49 @@
|
||||
-- Stability : experimental
|
||||
-- Portability : Good
|
||||
--
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module Crypto.Random.Types
|
||||
( Random(..)
|
||||
(
|
||||
MonadRandom(..)
|
||||
, DRG(..)
|
||||
, withDRG
|
||||
) where
|
||||
|
||||
import Data.Byteable
|
||||
import Data.SecureMem
|
||||
import Control.Applicative
|
||||
import Crypto.Random.Entropy
|
||||
import Crypto.Internal.ByteArray
|
||||
|
||||
newtype Random = Random SecureMem
|
||||
deriving (Eq, Byteable)
|
||||
class Monad m => MonadRandom m where
|
||||
getRandomBytes :: ByteArray byteArray => Int -> m byteArray
|
||||
|
||||
class DRG gen where
|
||||
randomBytesGenerate :: ByteArray byteArray => Int -> gen -> (byteArray, gen)
|
||||
|
||||
instance MonadRandom IO where
|
||||
getRandomBytes = getEntropy
|
||||
|
||||
newtype MonadPseudoRandom gen a = MonadPseudoRandom
|
||||
{ runPseudoRandom :: gen -> (a, gen)
|
||||
}
|
||||
|
||||
instance DRG gen => Functor (MonadPseudoRandom gen) where
|
||||
fmap f m = MonadPseudoRandom $ \g1 ->
|
||||
let (a, g2) = runPseudoRandom m g1 in (f a, g2)
|
||||
|
||||
instance DRG gen => Applicative (MonadPseudoRandom gen) where
|
||||
pure a = MonadPseudoRandom $ \g -> (a, g)
|
||||
(<*>) fm m = MonadPseudoRandom $ \g1 ->
|
||||
let (f, g2) = runPseudoRandom fm g1
|
||||
(a, g3) = runPseudoRandom m g2
|
||||
in (f a, g3)
|
||||
|
||||
instance DRG gen => Monad (MonadPseudoRandom gen) where
|
||||
return a = MonadPseudoRandom $ \g -> (a, g)
|
||||
(>>=) m1 m2 = MonadPseudoRandom $ \g1 ->
|
||||
let (a, g2) = runPseudoRandom m1 g1
|
||||
in runPseudoRandom (m2 a) g2
|
||||
|
||||
instance DRG gen => MonadRandom (MonadPseudoRandom gen) where
|
||||
getRandomBytes n = MonadPseudoRandom (randomBytesGenerate n)
|
||||
|
||||
withDRG :: DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
|
||||
withDRG gen m = runPseudoRandom m gen
|
||||
|
||||
Loading…
Reference in New Issue
Block a user