{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

-- | Support for generation of cryptographically secure random
-- numbers, based on the DRBG package.
--
-- This is a convenience layer on top of DRBG, which allows you to
-- pull random values by means of the method 'random', while keeping
-- the state of the random number generator (RNG) inside a monad.  The
-- state is protected by an MVar, which means that concurrent
-- generation of random values from several threads works straight out
-- of the box.
--
-- The access to the RNG state is captured by a class.  By making
-- instances of this class, client code can enjoy RNG generation from
-- their own monads.
module Crypto.RNG
  ( -- * CryptoRNG class
    module Crypto.RNG.Class
    -- * Generation of strings and numbers
  , CryptoRNGState
  , newCryptoRNGState
  , newCryptoRNGStateSized
  , unsafeCryptoRNGState
  , randomBytesIO
  , randomIO
  , randomRIO
    -- * Monad transformer for carrying rng state
  , CryptoRNGT
  , mapCryptoRNGT
  , runCryptoRNGT
  , withCryptoRNGState
  ) where

import Control.Applicative
import Control.Concurrent
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Cont
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Crypto.Random
import Crypto.Random.DRBG
import Data.Bits
import Data.ByteString (ByteString)
import Data.Either
import Data.Hashable
import Data.Primitive.SmallArray
import qualified Data.ByteString as BS
import qualified System.Random as R

import Crypto.RNG.Class

-- | The random number generator state.
newtype CryptoRNGState = CryptoRNGState (SmallArray (MVar RNG))

-- | The random number generator.
newtype RNG = RNG (GenBuffered (GenAutoReseed HashDRBG HashDRBG))

instance R.RandomGen RNG where
  split :: RNG -> (RNG, RNG)
split = [Char] -> RNG -> (RNG, RNG)
forall a. HasCallStack => [Char] -> a
error [Char]
"split"
  genWord32 :: RNG -> (Word32, RNG)
genWord32 (RNG GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g) = case Int
-> GenBuffered (GenAutoReseed HashDRBG HashDRBG)
-> Either
     GenError
     (ByteString, GenBuffered (GenAutoReseed HashDRBG HashDRBG))
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
4 GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g of
    Left GenError
err       -> [Char] -> (Word32, RNG)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Word32, RNG)) -> [Char] -> (Word32, RNG)
forall a b. (a -> b) -> a -> b
$ [Char]
"genBytes failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ GenError -> [Char]
forall a. Show a => a -> [Char]
show GenError
err
    Right (ByteString
bs, GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g') -> (ByteString -> Word32
forall a. (Bits a, Integral a) => ByteString -> a
mkWord ByteString
bs, GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> RNG
RNG GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g')
  genWord64 :: RNG -> (Word64, RNG)
genWord64 (RNG GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g) = case Int
-> GenBuffered (GenAutoReseed HashDRBG HashDRBG)
-> Either
     GenError
     (ByteString, GenBuffered (GenAutoReseed HashDRBG HashDRBG))
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
8 GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g of
    Left GenError
err       -> [Char] -> (Word64, RNG)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Word64, RNG)) -> [Char] -> (Word64, RNG)
forall a b. (a -> b) -> a -> b
$ [Char]
"genBytes failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ GenError -> [Char]
forall a. Show a => a -> [Char]
show GenError
err
    Right (ByteString
bs, GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g') -> (ByteString -> Word64
forall a. (Bits a, Integral a) => ByteString -> a
mkWord ByteString
bs, GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> RNG
RNG GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g')

mkWord :: (Bits a, Integral a) => ByteString -> a
mkWord :: ByteString -> a
mkWord ByteString
bs = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\a
acc Word8
w -> a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
acc Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) a
0 ByteString
bs

-- | Work with one of the RNGs from the pool.
withRNG :: CryptoRNGState -> (RNG -> (a, RNG)) -> IO a
withRNG :: CryptoRNGState -> (RNG -> (a, RNG)) -> IO a
withRNG (CryptoRNGState SmallArray (MVar RNG)
pool) RNG -> (a, RNG)
f = IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
  Int
tid <- ThreadId -> Int
forall a. Hashable a => a -> Int
hash (ThreadId -> Int) -> IO ThreadId -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ThreadId
myThreadId
  let mrng :: MVar RNG
mrng = SmallArray (MVar RNG)
pool SmallArray (MVar RNG) -> Int -> MVar RNG
forall a. SmallArray a -> Int -> a
`indexSmallArray` (Int
tid Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` SmallArray (MVar RNG) -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (MVar RNG)
pool)
  MVar RNG -> (RNG -> IO (RNG, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar RNG
mrng ((RNG -> IO (RNG, a)) -> IO a) -> (RNG -> IO (RNG, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \RNG
rng -> do
    (a
a, RNG
newRng) <- (a, RNG) -> IO (a, RNG)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, RNG) -> IO (a, RNG)) -> (a, RNG) -> IO (a, RNG)
forall a b. (a -> b) -> a -> b
$ RNG -> (a, RNG)
f RNG
rng
    RNG
newRng RNG -> IO (RNG, a) -> IO (RNG, a)
`seq` (RNG, a) -> IO (RNG, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RNG
newRng, a
a)

----------------------------------------

-- | Create a new 'CryptoRNGState', based on system entropy.
newCryptoRNGState :: MonadIO m => m CryptoRNGState
newCryptoRNGState :: m CryptoRNGState
newCryptoRNGState = Int -> m CryptoRNGState
forall (m :: * -> *). MonadIO m => Int -> m CryptoRNGState
newCryptoRNGStateSized (Int -> m CryptoRNGState) -> m Int -> m CryptoRNGState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
getNumCapabilities

-- | Create a new 'CryptoRNGState', based on system entropy with the pool of a
-- specific size.
newCryptoRNGStateSized
  :: MonadIO m
  => Int -- ^ Pool size.
  -> m CryptoRNGState
newCryptoRNGStateSized :: Int -> m CryptoRNGState
newCryptoRNGStateSized Int
n = IO CryptoRNGState -> m CryptoRNGState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CryptoRNGState -> m CryptoRNGState)
-> IO CryptoRNGState -> m CryptoRNGState
forall a b. (a -> b) -> a -> b
$ do
  [MVar RNG]
pool <- Int -> IO (MVar RNG) -> IO [MVar RNG]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (IO (MVar RNG) -> IO [MVar RNG]) -> IO (MVar RNG) -> IO [MVar RNG]
forall a b. (a -> b) -> a -> b
$ RNG -> IO (MVar RNG)
forall a. a -> IO (MVar a)
newMVar (RNG -> IO (MVar RNG))
-> (GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> RNG)
-> GenBuffered (GenAutoReseed HashDRBG HashDRBG)
-> IO (MVar RNG)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> RNG
RNG (GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> IO (MVar RNG))
-> IO (GenBuffered (GenAutoReseed HashDRBG HashDRBG))
-> IO (MVar RNG)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (GenBuffered (GenAutoReseed HashDRBG HashDRBG))
forall g. CryptoRandomGen g => IO g
newGenIO
  CryptoRNGState -> IO CryptoRNGState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CryptoRNGState -> IO CryptoRNGState)
-> (SmallArray (MVar RNG) -> CryptoRNGState)
-> SmallArray (MVar RNG)
-> IO CryptoRNGState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmallArray (MVar RNG) -> CryptoRNGState
CryptoRNGState (SmallArray (MVar RNG) -> IO CryptoRNGState)
-> SmallArray (MVar RNG) -> IO CryptoRNGState
forall a b. (a -> b) -> a -> b
$ Int -> [MVar RNG] -> SmallArray (MVar RNG)
forall a. Int -> [a] -> SmallArray a
smallArrayFromListN Int
n [MVar RNG]
pool

-- | Create a new 'CryptoRNGState', based on a bytestring seed.
-- Should only be used for testing.
unsafeCryptoRNGState
  :: MonadIO m
  => [ByteString]
  -- ^ Seeds for each generator from the pool.
  -> m CryptoRNGState
unsafeCryptoRNGState :: [ByteString] -> m CryptoRNGState
unsafeCryptoRNGState [ByteString]
ss = IO CryptoRNGState -> m CryptoRNGState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CryptoRNGState -> m CryptoRNGState)
-> IO CryptoRNGState -> m CryptoRNGState
forall a b. (a -> b) -> a -> b
$ do
  case [Either GenError (GenBuffered (GenAutoReseed HashDRBG HashDRBG))]
-> ([GenError], [GenBuffered (GenAutoReseed HashDRBG HashDRBG)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either GenError (GenBuffered (GenAutoReseed HashDRBG HashDRBG))]
 -> ([GenError], [GenBuffered (GenAutoReseed HashDRBG HashDRBG)]))
-> [Either
      GenError (GenBuffered (GenAutoReseed HashDRBG HashDRBG))]
-> ([GenError], [GenBuffered (GenAutoReseed HashDRBG HashDRBG)])
forall a b. (a -> b) -> a -> b
$ (ByteString
 -> Either GenError (GenBuffered (GenAutoReseed HashDRBG HashDRBG)))
-> [ByteString]
-> [Either
      GenError (GenBuffered (GenAutoReseed HashDRBG HashDRBG))]
forall a b. (a -> b) -> [a] -> [b]
map ByteString
-> Either GenError (GenBuffered (GenAutoReseed HashDRBG HashDRBG))
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen [ByteString]
ss of
    ([], [GenBuffered (GenAutoReseed HashDRBG HashDRBG)]
gens) -> do
      [MVar RNG]
pool <- (GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> IO (MVar RNG))
-> [GenBuffered (GenAutoReseed HashDRBG HashDRBG)] -> IO [MVar RNG]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RNG -> IO (MVar RNG)
forall a. a -> IO (MVar a)
newMVar (RNG -> IO (MVar RNG))
-> (GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> RNG)
-> GenBuffered (GenAutoReseed HashDRBG HashDRBG)
-> IO (MVar RNG)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> RNG
RNG) [GenBuffered (GenAutoReseed HashDRBG HashDRBG)]
gens
      CryptoRNGState -> IO CryptoRNGState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CryptoRNGState -> IO CryptoRNGState)
-> (SmallArray (MVar RNG) -> CryptoRNGState)
-> SmallArray (MVar RNG)
-> IO CryptoRNGState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmallArray (MVar RNG) -> CryptoRNGState
CryptoRNGState (SmallArray (MVar RNG) -> IO CryptoRNGState)
-> SmallArray (MVar RNG) -> IO CryptoRNGState
forall a b. (a -> b) -> a -> b
$ [MVar RNG] -> SmallArray (MVar RNG)
forall a. [a] -> SmallArray a
smallArrayFromList [MVar RNG]
pool
    ([GenError]
errs, [GenBuffered (GenAutoReseed HashDRBG HashDRBG)]
_)  -> [Char] -> IO CryptoRNGState
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO CryptoRNGState) -> [Char] -> IO CryptoRNGState
forall a b. (a -> b) -> a -> b
$ [GenError] -> [Char]
forall a. Show a => a -> [Char]
show [GenError]
errs

-- | Generate given number of cryptographically secure random bytes.
randomBytesIO :: ByteLength -- ^ number of bytes to generate
              -> CryptoRNGState
              -> IO ByteString
randomBytesIO :: Int -> CryptoRNGState -> IO ByteString
randomBytesIO Int
n CryptoRNGState
pool = CryptoRNGState -> (RNG -> (ByteString, RNG)) -> IO ByteString
forall a. CryptoRNGState -> (RNG -> (a, RNG)) -> IO a
withRNG CryptoRNGState
pool ((RNG -> (ByteString, RNG)) -> IO ByteString)
-> (RNG -> (ByteString, RNG)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(RNG GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g) ->
  case Int
-> GenBuffered (GenAutoReseed HashDRBG HashDRBG)
-> Either
     GenError
     (ByteString, GenBuffered (GenAutoReseed HashDRBG HashDRBG))
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
n GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g of
    Left GenError
err       -> [Char] -> (ByteString, RNG)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (ByteString, RNG)) -> [Char] -> (ByteString, RNG)
forall a b. (a -> b) -> a -> b
$ [Char]
"genBytes failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ GenError -> [Char]
forall a. Show a => a -> [Char]
show GenError
err
    Right (ByteString
bs, GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g') -> (ByteString
bs, GenBuffered (GenAutoReseed HashDRBG HashDRBG) -> RNG
RNG GenBuffered (GenAutoReseed HashDRBG HashDRBG)
g')

randomIO :: R.Uniform a => CryptoRNGState -> IO a
randomIO :: CryptoRNGState -> IO a
randomIO CryptoRNGState
pool = CryptoRNGState -> (RNG -> (a, RNG)) -> IO a
forall a. CryptoRNGState -> (RNG -> (a, RNG)) -> IO a
withRNG CryptoRNGState
pool ((RNG -> (a, RNG)) -> IO a) -> (RNG -> (a, RNG)) -> IO a
forall a b. (a -> b) -> a -> b
$ \RNG
g -> RNG -> (a, RNG)
forall g a. (RandomGen g, Uniform a) => g -> (a, g)
R.uniform RNG
g

randomRIO :: R.UniformRange a => (a, a) -> CryptoRNGState -> IO a
randomRIO :: (a, a) -> CryptoRNGState -> IO a
randomRIO (a, a)
bounds CryptoRNGState
pool = CryptoRNGState -> (RNG -> (a, RNG)) -> IO a
forall a. CryptoRNGState -> (RNG -> (a, RNG)) -> IO a
withRNG CryptoRNGState
pool ((RNG -> (a, RNG)) -> IO a) -> (RNG -> (a, RNG)) -> IO a
forall a b. (a -> b) -> a -> b
$ \RNG
g -> (a, a) -> RNG -> (a, RNG)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
R.uniformR (a, a)
bounds RNG
g

type InnerCryptoRNGT = ReaderT CryptoRNGState

-- | Monad transformer with RNG state.
newtype CryptoRNGT m a = CryptoRNGT { CryptoRNGT m a -> InnerCryptoRNGT m a
unCryptoRNGT :: InnerCryptoRNGT m a }
  deriving ( Applicative (CryptoRNGT m)
CryptoRNGT m a
Applicative (CryptoRNGT m)
-> (forall a. CryptoRNGT m a)
-> (forall a. CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a)
-> (forall a. CryptoRNGT m a -> CryptoRNGT m [a])
-> (forall a. CryptoRNGT m a -> CryptoRNGT m [a])
-> Alternative (CryptoRNGT m)
CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
CryptoRNGT m a -> CryptoRNGT m [a]
CryptoRNGT m a -> CryptoRNGT m [a]
forall a. CryptoRNGT m a
forall a. CryptoRNGT m a -> CryptoRNGT m [a]
forall a. CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *). Alternative m => Applicative (CryptoRNGT m)
forall (m :: * -> *) a. Alternative m => CryptoRNGT m a
forall (m :: * -> *) a.
Alternative m =>
CryptoRNGT m a -> CryptoRNGT m [a]
forall (m :: * -> *) a.
Alternative m =>
CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
many :: CryptoRNGT m a -> CryptoRNGT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
CryptoRNGT m a -> CryptoRNGT m [a]
some :: CryptoRNGT m a -> CryptoRNGT m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
CryptoRNGT m a -> CryptoRNGT m [a]
<|> :: CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
empty :: CryptoRNGT m a
$cempty :: forall (m :: * -> *) a. Alternative m => CryptoRNGT m a
$cp1Alternative :: forall (m :: * -> *). Alternative m => Applicative (CryptoRNGT m)
Alternative, Functor (CryptoRNGT m)
a -> CryptoRNGT m a
Functor (CryptoRNGT m)
-> (forall a. a -> CryptoRNGT m a)
-> (forall a b.
    CryptoRNGT m (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b)
-> (forall a b c.
    (a -> b -> c)
    -> CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m c)
-> (forall a b. CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b)
-> (forall a b. CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m a)
-> Applicative (CryptoRNGT m)
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m a
CryptoRNGT m (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
(a -> b -> c) -> CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m c
forall a. a -> CryptoRNGT m a
forall a b. CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m a
forall a b. CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
forall a b.
CryptoRNGT m (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
forall a b c.
(a -> b -> c) -> CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (CryptoRNGT m)
forall (m :: * -> *) a. Applicative m => a -> CryptoRNGT m a
forall (m :: * -> *) a b.
Applicative m =>
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m a
forall (m :: * -> *) a b.
Applicative m =>
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
forall (m :: * -> *) a b.
Applicative m =>
CryptoRNGT m (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m c
<* :: CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m a
*> :: CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
liftA2 :: (a -> b -> c) -> CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m c
<*> :: CryptoRNGT m (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
CryptoRNGT m (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
pure :: a -> CryptoRNGT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> CryptoRNGT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (CryptoRNGT m)
Applicative, a -> CryptoRNGT m b -> CryptoRNGT m a
(a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
(forall a b. (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b)
-> (forall a b. a -> CryptoRNGT m b -> CryptoRNGT m a)
-> Functor (CryptoRNGT m)
forall a b. a -> CryptoRNGT m b -> CryptoRNGT m a
forall a b. (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
forall (m :: * -> *) a b.
Functor m =>
a -> CryptoRNGT m b -> CryptoRNGT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CryptoRNGT m b -> CryptoRNGT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> CryptoRNGT m b -> CryptoRNGT m a
fmap :: (a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CryptoRNGT m a -> CryptoRNGT m b
Functor, Applicative (CryptoRNGT m)
a -> CryptoRNGT m a
Applicative (CryptoRNGT m)
-> (forall a b.
    CryptoRNGT m a -> (a -> CryptoRNGT m b) -> CryptoRNGT m b)
-> (forall a b. CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b)
-> (forall a. a -> CryptoRNGT m a)
-> Monad (CryptoRNGT m)
CryptoRNGT m a -> (a -> CryptoRNGT m b) -> CryptoRNGT m b
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
forall a. a -> CryptoRNGT m a
forall a b. CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
forall a b.
CryptoRNGT m a -> (a -> CryptoRNGT m b) -> CryptoRNGT m b
forall (m :: * -> *). Monad m => Applicative (CryptoRNGT m)
forall (m :: * -> *) a. Monad m => a -> CryptoRNGT m a
forall (m :: * -> *) a b.
Monad m =>
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
forall (m :: * -> *) a b.
Monad m =>
CryptoRNGT m a -> (a -> CryptoRNGT m b) -> CryptoRNGT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> CryptoRNGT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> CryptoRNGT m a
>> :: CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CryptoRNGT m a -> CryptoRNGT m b -> CryptoRNGT m b
>>= :: CryptoRNGT m a -> (a -> CryptoRNGT m b) -> CryptoRNGT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CryptoRNGT m a -> (a -> CryptoRNGT m b) -> CryptoRNGT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (CryptoRNGT m)
Monad
           , MonadBase b, MonadThrow (CryptoRNGT m)
MonadThrow (CryptoRNGT m)
-> (forall e a.
    Exception e =>
    CryptoRNGT m a -> (e -> CryptoRNGT m a) -> CryptoRNGT m a)
-> MonadCatch (CryptoRNGT m)
CryptoRNGT m a -> (e -> CryptoRNGT m a) -> CryptoRNGT m a
forall e a.
Exception e =>
CryptoRNGT m a -> (e -> CryptoRNGT m a) -> CryptoRNGT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (CryptoRNGT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
CryptoRNGT m a -> (e -> CryptoRNGT m a) -> CryptoRNGT m a
catch :: CryptoRNGT m a -> (e -> CryptoRNGT m a) -> CryptoRNGT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
CryptoRNGT m a -> (e -> CryptoRNGT m a) -> CryptoRNGT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (CryptoRNGT m)
MonadCatch, MonadError e, Monad (CryptoRNGT m)
Monad (CryptoRNGT m)
-> (forall a. IO a -> CryptoRNGT m a) -> MonadIO (CryptoRNGT m)
IO a -> CryptoRNGT m a
forall a. IO a -> CryptoRNGT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (CryptoRNGT m)
forall (m :: * -> *) a. MonadIO m => IO a -> CryptoRNGT m a
liftIO :: IO a -> CryptoRNGT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> CryptoRNGT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (CryptoRNGT m)
MonadIO, MonadCatch (CryptoRNGT m)
MonadCatch (CryptoRNGT m)
-> (forall b.
    ((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
    -> CryptoRNGT m b)
-> (forall b.
    ((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
    -> CryptoRNGT m b)
-> (forall a b c.
    CryptoRNGT m a
    -> (a -> ExitCase b -> CryptoRNGT m c)
    -> (a -> CryptoRNGT m b)
    -> CryptoRNGT m (b, c))
-> MonadMask (CryptoRNGT m)
CryptoRNGT m a
-> (a -> ExitCase b -> CryptoRNGT m c)
-> (a -> CryptoRNGT m b)
-> CryptoRNGT m (b, c)
((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
-> CryptoRNGT m b
((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
-> CryptoRNGT m b
forall b.
((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
-> CryptoRNGT m b
forall a b c.
CryptoRNGT m a
-> (a -> ExitCase b -> CryptoRNGT m c)
-> (a -> CryptoRNGT m b)
-> CryptoRNGT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (CryptoRNGT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
-> CryptoRNGT m b
forall (m :: * -> *) a b c.
MonadMask m =>
CryptoRNGT m a
-> (a -> ExitCase b -> CryptoRNGT m c)
-> (a -> CryptoRNGT m b)
-> CryptoRNGT m (b, c)
generalBracket :: CryptoRNGT m a
-> (a -> ExitCase b -> CryptoRNGT m c)
-> (a -> CryptoRNGT m b)
-> CryptoRNGT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
CryptoRNGT m a
-> (a -> ExitCase b -> CryptoRNGT m c)
-> (a -> CryptoRNGT m b)
-> CryptoRNGT m (b, c)
uninterruptibleMask :: ((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
-> CryptoRNGT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
-> CryptoRNGT m b
mask :: ((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
-> CryptoRNGT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. CryptoRNGT m a -> CryptoRNGT m a) -> CryptoRNGT m b)
-> CryptoRNGT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (CryptoRNGT m)
MonadMask, Monad (CryptoRNGT m)
Alternative (CryptoRNGT m)
CryptoRNGT m a
Alternative (CryptoRNGT m)
-> Monad (CryptoRNGT m)
-> (forall a. CryptoRNGT m a)
-> (forall a. CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a)
-> MonadPlus (CryptoRNGT m)
CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
forall a. CryptoRNGT m a
forall a. CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (m :: * -> *). MonadPlus m => Monad (CryptoRNGT m)
forall (m :: * -> *). MonadPlus m => Alternative (CryptoRNGT m)
forall (m :: * -> *) a. MonadPlus m => CryptoRNGT m a
forall (m :: * -> *) a.
MonadPlus m =>
CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
mplus :: CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
CryptoRNGT m a -> CryptoRNGT m a -> CryptoRNGT m a
mzero :: CryptoRNGT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => CryptoRNGT m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (CryptoRNGT m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (CryptoRNGT m)
MonadPlus
           , Monad (CryptoRNGT m)
e -> CryptoRNGT m a
Monad (CryptoRNGT m)
-> (forall e a. Exception e => e -> CryptoRNGT m a)
-> MonadThrow (CryptoRNGT m)
forall e a. Exception e => e -> CryptoRNGT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (CryptoRNGT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> CryptoRNGT m a
throwM :: e -> CryptoRNGT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> CryptoRNGT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (CryptoRNGT m)
MonadThrow, m a -> CryptoRNGT m a
(forall (m :: * -> *) a. Monad m => m a -> CryptoRNGT m a)
-> MonadTrans CryptoRNGT
forall (m :: * -> *) a. Monad m => m a -> CryptoRNGT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> CryptoRNGT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> CryptoRNGT m a
MonadTrans, Monad (CryptoRNGT m)
Monad (CryptoRNGT m)
-> (forall a. [Char] -> CryptoRNGT m a) -> MonadFail (CryptoRNGT m)
[Char] -> CryptoRNGT m a
forall a. [Char] -> CryptoRNGT m a
forall (m :: * -> *).
Monad m -> (forall a. [Char] -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (CryptoRNGT m)
forall (m :: * -> *) a. MonadFail m => [Char] -> CryptoRNGT m a
fail :: [Char] -> CryptoRNGT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => [Char] -> CryptoRNGT m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (CryptoRNGT m)
MonadFail )

mapCryptoRNGT :: (m a -> n b) -> CryptoRNGT m a -> CryptoRNGT n b
mapCryptoRNGT :: (m a -> n b) -> CryptoRNGT m a -> CryptoRNGT n b
mapCryptoRNGT m a -> n b
f CryptoRNGT m a
m = (CryptoRNGState -> n b) -> CryptoRNGT n b
forall (m :: * -> *) a. (CryptoRNGState -> m a) -> CryptoRNGT m a
withCryptoRNGState ((CryptoRNGState -> n b) -> CryptoRNGT n b)
-> (CryptoRNGState -> n b) -> CryptoRNGT n b
forall a b. (a -> b) -> a -> b
$ \CryptoRNGState
s -> m a -> n b
f (CryptoRNGState -> CryptoRNGT m a -> m a
forall (m :: * -> *) a. CryptoRNGState -> CryptoRNGT m a -> m a
runCryptoRNGT CryptoRNGState
s CryptoRNGT m a
m)

runCryptoRNGT :: CryptoRNGState -> CryptoRNGT m a -> m a
runCryptoRNGT :: CryptoRNGState -> CryptoRNGT m a -> m a
runCryptoRNGT CryptoRNGState
pool CryptoRNGT m a
m = ReaderT CryptoRNGState m a -> CryptoRNGState -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (CryptoRNGT m a -> ReaderT CryptoRNGState m a
forall (m :: * -> *) a. CryptoRNGT m a -> InnerCryptoRNGT m a
unCryptoRNGT CryptoRNGT m a
m) CryptoRNGState
pool

withCryptoRNGState :: (CryptoRNGState -> m a) -> CryptoRNGT m a
withCryptoRNGState :: (CryptoRNGState -> m a) -> CryptoRNGT m a
withCryptoRNGState = InnerCryptoRNGT m a -> CryptoRNGT m a
forall (m :: * -> *) a. InnerCryptoRNGT m a -> CryptoRNGT m a
CryptoRNGT (InnerCryptoRNGT m a -> CryptoRNGT m a)
-> ((CryptoRNGState -> m a) -> InnerCryptoRNGT m a)
-> (CryptoRNGState -> m a)
-> CryptoRNGT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CryptoRNGState -> m a) -> InnerCryptoRNGT m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT

instance MonadTransControl CryptoRNGT where
  type StT CryptoRNGT a = StT InnerCryptoRNGT a
  liftWith :: (Run CryptoRNGT -> m a) -> CryptoRNGT m a
liftWith = (forall b. ReaderT CryptoRNGState m b -> CryptoRNGT m b)
-> (forall (m :: * -> *) a. CryptoRNGT m a -> InnerCryptoRNGT m a)
-> (RunDefault CryptoRNGT (ReaderT CryptoRNGState) -> m a)
-> CryptoRNGT m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *)
       (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith forall b. ReaderT CryptoRNGState m b -> CryptoRNGT m b
forall (m :: * -> *) a. InnerCryptoRNGT m a -> CryptoRNGT m a
CryptoRNGT forall (m :: * -> *) a. CryptoRNGT m a -> InnerCryptoRNGT m a
unCryptoRNGT
  restoreT :: m (StT CryptoRNGT a) -> CryptoRNGT m a
restoreT = (ReaderT CryptoRNGState m a -> CryptoRNGT m a)
-> m (StT (ReaderT CryptoRNGState) a) -> CryptoRNGT m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT ReaderT CryptoRNGState m a -> CryptoRNGT m a
forall (m :: * -> *) a. InnerCryptoRNGT m a -> CryptoRNGT m a
CryptoRNGT

instance MonadBaseControl b m => MonadBaseControl b (CryptoRNGT m) where
  type StM (CryptoRNGT m) a = ComposeSt CryptoRNGT m a
  liftBaseWith :: (RunInBase (CryptoRNGT m) b -> b a) -> CryptoRNGT m a
liftBaseWith = (RunInBase (CryptoRNGT m) b -> b a) -> CryptoRNGT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
  restoreM :: StM (CryptoRNGT m) a -> CryptoRNGT m a
restoreM     = StM (CryptoRNGT m) a -> CryptoRNGT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

instance {-# OVERLAPPABLE #-} MonadIO m => CryptoRNG (CryptoRNGT m) where
  randomBytes :: Int -> CryptoRNGT m ByteString
randomBytes Int
n  = InnerCryptoRNGT m CryptoRNGState -> CryptoRNGT m CryptoRNGState
forall (m :: * -> *) a. InnerCryptoRNGT m a -> CryptoRNGT m a
CryptoRNGT InnerCryptoRNGT m CryptoRNGState
forall r (m :: * -> *). MonadReader r m => m r
ask CryptoRNGT m CryptoRNGState
-> (CryptoRNGState -> CryptoRNGT m ByteString)
-> CryptoRNGT m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO ByteString -> CryptoRNGT m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> CryptoRNGT m ByteString)
-> (CryptoRNGState -> IO ByteString)
-> CryptoRNGState
-> CryptoRNGT m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CryptoRNGState -> IO ByteString
randomBytesIO Int
n
  random :: CryptoRNGT m a
random         = InnerCryptoRNGT m CryptoRNGState -> CryptoRNGT m CryptoRNGState
forall (m :: * -> *) a. InnerCryptoRNGT m a -> CryptoRNGT m a
CryptoRNGT InnerCryptoRNGT m CryptoRNGState
forall r (m :: * -> *). MonadReader r m => m r
ask CryptoRNGT m CryptoRNGState
-> (CryptoRNGState -> CryptoRNGT m a) -> CryptoRNGT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> CryptoRNGT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> CryptoRNGT m a)
-> (CryptoRNGState -> IO a) -> CryptoRNGState -> CryptoRNGT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoRNGState -> IO a
forall a. Uniform a => CryptoRNGState -> IO a
randomIO
  randomR :: (a, a) -> CryptoRNGT m a
randomR (a, a)
bounds = InnerCryptoRNGT m CryptoRNGState -> CryptoRNGT m CryptoRNGState
forall (m :: * -> *) a. InnerCryptoRNGT m a -> CryptoRNGT m a
CryptoRNGT InnerCryptoRNGT m CryptoRNGState
forall r (m :: * -> *). MonadReader r m => m r
ask CryptoRNGT m CryptoRNGState
-> (CryptoRNGState -> CryptoRNGT m a) -> CryptoRNGT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> CryptoRNGT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> CryptoRNGT m a)
-> (CryptoRNGState -> IO a) -> CryptoRNGState -> CryptoRNGT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> CryptoRNGState -> IO a
forall a. UniformRange a => (a, a) -> CryptoRNGState -> IO a
randomRIO (a, a)
bounds