-- |
-- 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.Internal.ByteArray
import Crypto.Random.Entropy
import Crypto.Random.SysDRG (sysDRGBytes)

-- | A monad constraint that allows to generate random bytes
--
-- Everything in this library that draws a key, a nonce or a signature's
-- randomness draws it through this class, and cannot tell a strong source
-- from a weak one.  The two instances below are the ones to reach for:
-- @IO@ reads the system entropy source, and @MonadPseudoRandom@ runs a
-- 'DRG' seeded from it.
--
-- An instance of your own is held to the same standard.  A generator that
-- another party can predict, or that repeats, yields keys and signatures
-- that give away what they are meant to keep -- so the deliberately
-- repeatable instance that makes a test reproducible is not one to ship
-- with.
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)

-- | Through the generator of 'Crypto.Random.SysDRG': a ChaCha20 generator
-- per operating system thread, reseeded from the system.  Where that
-- cannot be seeded -- a system with no @getrandom(2)@ or @getentropy(3)@,
-- which includes Windows for now -- this is the system entropy source
-- directly, as it was before the generator existed.
instance MonadRandom IO where
    getRandomBytes :: forall byteArray. ByteArray byteArray => Int -> IO byteArray
getRandomBytes Int
n = Int -> IO (Maybe byteArray)
forall byteArray.
ByteArray byteArray =>
Int -> IO (Maybe byteArray)
sysDRGBytes Int
n IO (Maybe byteArray)
-> (Maybe byteArray -> IO byteArray) -> IO byteArray
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO byteArray
-> (byteArray -> IO byteArray) -> Maybe byteArray -> IO byteArray
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> IO byteArray
forall byteArray. ByteArray byteArray => Int -> IO byteArray
getEntropy Int
n) byteArray -> IO byteArray
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | 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 t'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