diff --git a/Crypto/Random/Types.hs b/Crypto/Random/Types.hs index 3ad0c43..da547b0 100644 --- a/Crypto/Random/Types.hs +++ b/Crypto/Random/Types.hs @@ -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