-- | Generation of random numbers via "Crypto.RNG.Unsafe".
module Effectful.Crypto.RNG.Unsafe
  ( -- * Effect
    RNG(..)
  , CryptoRNG(..)

    -- ** Handlers
  , runRNG

    -- * Instantiation of the initial RNG state
  , RNGState
  , newRNGState
  ) where

import Crypto.RNG.Unsafe
import Effectful
import Effectful.Dispatch.Dynamic
import qualified System.Random as R

import Effectful.Crypto.RNG.Effect

-- | Generate random numbers, starting with a given initial 'RNGState'.
--
-- /Note:/ random numbers generated by this interpreter are not
-- cryptographically secure and should only be used for testing purposes.
runRNG :: IOE :> es => RNGState -> Eff (RNG : es) a -> Eff es a
runRNG :: RNGState -> Eff (RNG : es) a -> Eff es a
runRNG RNGState
rng = EffectHandler RNG es -> Eff (RNG : es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler RNG es -> Eff (RNG : es) a -> Eff es a)
-> EffectHandler RNG es -> Eff (RNG : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs es
_ -> \case
  RandomBytes n  -> RNGState -> (StdGen -> (ByteString, StdGen)) -> Eff es ByteString
forall (m :: Type -> Type) a.
MonadIO m =>
RNGState -> (StdGen -> (a, StdGen)) -> m a
withRNG RNGState
rng ((StdGen -> (ByteString, StdGen)) -> Eff es ByteString)
-> (StdGen -> (ByteString, StdGen)) -> Eff es ByteString
forall a b. (a -> b) -> a -> b
$ \StdGen
g -> Int -> StdGen -> (ByteString, StdGen)
forall g. RandomGen g => Int -> g -> (ByteString, g)
R.genByteString Int
n StdGen
g
  RNG (Eff localEs) a
Random         -> RNGState -> (StdGen -> (a, StdGen)) -> Eff es a
forall (m :: Type -> Type) a.
MonadIO m =>
RNGState -> (StdGen -> (a, StdGen)) -> m a
withRNG RNGState
rng ((StdGen -> (a, StdGen)) -> Eff es a)
-> (StdGen -> (a, StdGen)) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \StdGen
g -> StdGen -> (a, StdGen)
forall g a. (RandomGen g, Uniform a) => g -> (a, g)
R.uniform StdGen
g
  RandomR bounds -> RNGState -> (StdGen -> (a, StdGen)) -> Eff es a
forall (m :: Type -> Type) a.
MonadIO m =>
RNGState -> (StdGen -> (a, StdGen)) -> m a
withRNG RNGState
rng ((StdGen -> (a, StdGen)) -> Eff es a)
-> (StdGen -> (a, StdGen)) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \StdGen
g -> (a, a) -> StdGen -> (a, StdGen)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
R.uniformR (a, a)
bounds StdGen
g