-- |
-- Module      : Crypto.Random.Types
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
--
module Crypto.Random.Types
    (
      MonadRandom(..)
    , MonadPseudoRandom
    , DRG(..)
    , withDRG
    ) where

import Crypto.Random.Entropy
import Crypto.Internal.ByteArray

-- | A monad constraint that allows to generate random bytes
class Monad m => MonadRandom m where
    getRandomBytes :: ByteArray byteArray => Int -> m byteArray

-- | A Deterministic Random Generator (DRG) class
class DRG gen where
    -- | Generate N bytes of randomness from a DRG
    randomBytesGenerate :: ByteArray byteArray => Int -> gen -> (byteArray, gen)

instance MonadRandom IO where
    getRandomBytes :: forall byteArray. ByteArray byteArray => Int -> IO byteArray
getRandomBytes = forall byteArray. ByteArray byteArray => Int -> IO byteArray
getEntropy

-- | A simple Monad class very similar to a State Monad
-- with the state being a DRG.
newtype MonadPseudoRandom gen a = MonadPseudoRandom
    { forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom :: gen -> (a, gen)
    }

instance DRG gen => Functor (MonadPseudoRandom gen) where
    fmap :: forall a b.
(a -> b) -> MonadPseudoRandom gen a -> MonadPseudoRandom gen b
fmap a -> b
f MonadPseudoRandom gen a
m = forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom forall a b. (a -> b) -> a -> b
$ \gen
g1 ->
        let (a
a, gen
g2) = forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom MonadPseudoRandom gen a
m gen
g1 in (a -> b
f a
a, gen
g2)

instance DRG gen => Applicative (MonadPseudoRandom gen) where
    pure :: forall a. a -> MonadPseudoRandom gen a
pure a
a     = forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom forall a b. (a -> b) -> a -> b
$ \gen
g -> (a
a, gen
g)
    <*> :: forall a b.
MonadPseudoRandom gen (a -> b)
-> MonadPseudoRandom gen a -> MonadPseudoRandom gen b
(<*>) MonadPseudoRandom gen (a -> b)
fm MonadPseudoRandom gen a
m = forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom forall a b. (a -> b) -> a -> b
$ \gen
g1 ->
        let (a -> b
f, gen
g2) = forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom MonadPseudoRandom gen (a -> b)
fm gen
g1
            (a
a, gen
g3) = forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom MonadPseudoRandom gen a
m gen
g2
         in (a -> b
f a
a, gen
g3)

instance DRG gen => Monad (MonadPseudoRandom gen) where
    return :: forall a. a -> MonadPseudoRandom gen a
return      = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    >>= :: forall a b.
MonadPseudoRandom gen a
-> (a -> MonadPseudoRandom gen b) -> MonadPseudoRandom gen b
(>>=) MonadPseudoRandom gen a
m1 a -> MonadPseudoRandom gen b
m2 = forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom forall a b. (a -> b) -> a -> b
$ \gen
g1 ->
        let (a
a, gen
g2) = forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom MonadPseudoRandom gen a
m1 gen
g1
         in forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom (a -> MonadPseudoRandom gen b
m2 a
a) gen
g2

instance DRG gen => MonadRandom (MonadPseudoRandom gen) where
    getRandomBytes :: forall byteArray.
ByteArray byteArray =>
Int -> MonadPseudoRandom gen byteArray
getRandomBytes Int
n = forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom (forall gen byteArray.
(DRG gen, ByteArray byteArray) =>
Int -> gen -> (byteArray, gen)
randomBytesGenerate Int
n)

-- | Run a pure computation with a Deterministic Random Generator
-- in the 'MonadPseudoRandom'
withDRG :: DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG :: forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG gen
gen MonadPseudoRandom gen a
m = forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom MonadPseudoRandom gen a
m gen
gen