-- |
-- 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 = Int -> IO byteArray
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 = (gen -> (b, gen)) -> MonadPseudoRandom gen b
forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom ((gen -> (b, gen)) -> MonadPseudoRandom gen b)
-> (gen -> (b, gen)) -> MonadPseudoRandom gen b
forall a b. (a -> b) -> a -> b
$ \gen
g1 ->
        let (a
a, gen
g2) = MonadPseudoRandom gen a -> gen -> (a, gen)
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     = (gen -> (a, gen)) -> MonadPseudoRandom gen a
forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom ((gen -> (a, gen)) -> MonadPseudoRandom gen a)
-> (gen -> (a, gen)) -> MonadPseudoRandom gen a
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 = (gen -> (b, gen)) -> MonadPseudoRandom gen b
forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom ((gen -> (b, gen)) -> MonadPseudoRandom gen b)
-> (gen -> (b, gen)) -> MonadPseudoRandom gen b
forall a b. (a -> b) -> a -> b
$ \gen
g1 ->
        let (a -> b
f, gen
g2) = MonadPseudoRandom gen (a -> b) -> gen -> (a -> b, gen)
forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom MonadPseudoRandom gen (a -> b)
fm gen
g1
            (a
a, gen
g3) = MonadPseudoRandom gen a -> gen -> (a, gen)
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      = a -> MonadPseudoRandom gen a
forall a. a -> MonadPseudoRandom gen a
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 = (gen -> (b, gen)) -> MonadPseudoRandom gen b
forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom ((gen -> (b, gen)) -> MonadPseudoRandom gen b)
-> (gen -> (b, gen)) -> MonadPseudoRandom gen b
forall a b. (a -> b) -> a -> b
$ \gen
g1 ->
        let (a
a, gen
g2) = MonadPseudoRandom gen a -> gen -> (a, gen)
forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom MonadPseudoRandom gen a
m1 gen
g1
         in MonadPseudoRandom gen b -> gen -> (b, gen)
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 = (gen -> (byteArray, gen)) -> MonadPseudoRandom gen byteArray
forall gen a. (gen -> (a, gen)) -> MonadPseudoRandom gen a
MonadPseudoRandom (Int -> gen -> (byteArray, gen)
forall byteArray.
ByteArray byteArray =>
Int -> gen -> (byteArray, gen)
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 = MonadPseudoRandom gen a -> gen -> (a, gen)
forall gen a. MonadPseudoRandom gen a -> gen -> (a, gen)
runPseudoRandom MonadPseudoRandom gen a
m gen
gen