{-# LANGUAGE KindSignatures
, RankNTypes
, TypeSynonymInstances
, FlexibleInstances
, MagicHash
, TypeFamilies
, MultiParamTypeClasses
, CPP
, DerivingStrategies
, FunctionalDependencies
, GeneralizedNewtypeDeriving
#-}
module Botan.RNG
(
RNG(..)
, RNGType(..)
, newRNG
, systemRNG
, getRandomBytesRNG
, unsafeGetRandomBytesRNG
, addEntropyRNG
, reseedRNG
, reseedRNGFrom
, MonadRandomIO(..)
, getRandomBytes
, getSystemRandomBytes
, reseed
, reseedFrom
, addEntropy
, RandomIO(..)
, runRandomIO
, RandomT(..)
, runRandomT
) where
import Control.Concurrent.MVar
import Data.Bifunctor
import Data.Tuple
import qualified Data.ByteString as ByteString
import qualified Botan.Low.RNG as Low
import Control.Monad.Reader
import Botan.Prelude
import System.Random.Stateful
data RNGType
= System
| Autoseeded
| RDRand
deriving (RNGType -> RNGType -> Bool
(RNGType -> RNGType -> Bool)
-> (RNGType -> RNGType -> Bool) -> Eq RNGType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RNGType -> RNGType -> Bool
== :: RNGType -> RNGType -> Bool
$c/= :: RNGType -> RNGType -> Bool
/= :: RNGType -> RNGType -> Bool
Eq, Int -> RNGType -> ShowS
[RNGType] -> ShowS
RNGType -> String
(Int -> RNGType -> ShowS)
-> (RNGType -> String) -> ([RNGType] -> ShowS) -> Show RNGType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RNGType -> ShowS
showsPrec :: Int -> RNGType -> ShowS
$cshow :: RNGType -> String
show :: RNGType -> String
$cshowList :: [RNGType] -> ShowS
showList :: [RNGType] -> ShowS
Show)
type RNGName = Low.RNGType
rngName :: RNGType -> RNGName
rngName :: RNGType -> RNGName
rngName RNGType
System = RNGName
Low.SystemRNG
rngName RNGType
Autoseeded = RNGName
Low.UserRNG
rngName RNGType
RDRand = RNGName
Low.RDRandRNG
type RNG = Low.RNG
#if defined(HS_BOTAN_HAS_RANDOM)
instance (MonadIO m) => StatefulGen RNG m where
uniformWord32 :: RNG -> m Word32
uniformWord32 :: RNG -> m Word32
uniformWord32 RNG
rng = RNGName -> Word32
forall i. (Bits i, Integral i) => RNGName -> i
packIntegral (RNGName -> Word32) -> m RNGName -> m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RNG -> m RNGName
forall (m :: * -> *). MonadIO m => Int -> RNG -> m RNGName
getRandomBytesRNG Int
4 RNG
rng
packIntegral :: (Bits i, Integral i) => ByteString -> i
packIntegral :: forall i. (Bits i, Integral i) => RNGName -> i
packIntegral = (i -> Word8 -> i) -> i -> RNGName -> i
forall a. (a -> Word8 -> a) -> a -> RNGName -> a
ByteString.foldl i -> Word8 -> i
forall i w.
(Bits i, Integral i, FiniteBits w, Integral w) =>
i -> w -> i
packIntegralWord i
0
packIntegralWord :: (Bits i, Integral i, FiniteBits w, Integral w) => i -> w -> i
packIntegralWord :: forall i w.
(Bits i, Integral i, FiniteBits w, Integral w) =>
i -> w -> i
packIntegralWord i
i w
w = i -> Int -> i
forall a. Bits a => a -> Int -> a
shiftL i
i (w -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize w
w) i -> i -> i
forall a. Bits a => a -> a -> a
.|. w -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral w
w
#endif
newRNG :: (MonadIO m) => RNGType -> m RNG
newRNG :: forall (m :: * -> *). MonadIO m => RNGType -> m RNG
newRNG RNGType
rngtyp = IO RNG -> m RNG
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RNG -> m RNG) -> IO RNG -> m RNG
forall a b. (a -> b) -> a -> b
$ RNGName -> IO RNG
Low.rngInit (RNGType -> RNGName
rngName RNGType
rngtyp)
systemRNG :: RNG
systemRNG :: RNG
systemRNG = IO RNG -> RNG
forall a. IO a -> a
unsafePerformIO (IO RNG -> RNG) -> IO RNG -> RNG
forall a b. (a -> b) -> a -> b
$ RNGType -> IO RNG
forall (m :: * -> *). MonadIO m => RNGType -> m RNG
newRNG RNGType
System
{-# NOINLINE systemRNG #-}
getRandomBytesRNG
:: (MonadIO m)
=> Int
-> RNG
-> m ByteString
getRandomBytesRNG :: forall (m :: * -> *). MonadIO m => Int -> RNG -> m RNGName
getRandomBytesRNG Int
n RNG
rng = IO RNGName -> m RNGName
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RNGName -> m RNGName) -> IO RNGName -> m RNGName
forall a b. (a -> b) -> a -> b
$ RNG -> Int -> IO RNGName
Low.rngGet RNG
rng Int
n
unsafeGetRandomBytesRNG
:: Int
-> RNG
-> ByteString
unsafeGetRandomBytesRNG :: Int -> RNG -> RNGName
unsafeGetRandomBytesRNG Int
n RNG
rng = IO RNGName -> RNGName
forall a. IO a -> a
unsafePerformIO (IO RNGName -> RNGName) -> IO RNGName -> RNGName
forall a b. (a -> b) -> a -> b
$ Int -> RNG -> IO RNGName
forall (m :: * -> *). MonadIO m => Int -> RNG -> m RNGName
getRandomBytesRNG Int
n RNG
rng
{-# NOINLINE unsafeGetRandomBytesRNG #-}
getSystemRandomBytes
:: (MonadIO m)
=> Int
-> m ByteString
getSystemRandomBytes :: forall (m :: * -> *). MonadIO m => Int -> m RNGName
getSystemRandomBytes = IO RNGName -> m RNGName
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RNGName -> m RNGName)
-> (Int -> IO RNGName) -> Int -> m RNGName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO RNGName
Low.systemRNGGet
reseedRNG
:: (MonadIO m)
=> Int
-> RNG
-> m ()
reseedRNG :: forall (m :: * -> *). MonadIO m => Int -> RNG -> m ()
reseedRNG Int
n RNG
rng = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ RNG -> Int -> IO ()
Low.rngReseed RNG
rng Int
n
reseedRNGFrom
:: (MonadIO m)
=> Int
-> RNG
-> RNG
-> m ()
reseedRNGFrom :: forall (m :: * -> *). MonadIO m => Int -> RNG -> RNG -> m ()
reseedRNGFrom Int
n RNG
src RNG
rng = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ RNG -> RNG -> Int -> IO ()
Low.rngReseedFromRNG RNG
rng RNG
src Int
n
addEntropyRNG
:: (MonadIO m)
=> ByteString
-> RNG
-> m ()
addEntropyRNG :: forall (m :: * -> *). MonadIO m => RNGName -> RNG -> m ()
addEntropyRNG RNGName
entropy RNG
gen = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ RNG -> RNGName -> IO ()
Low.rngAddEntropy RNG
gen RNGName
entropy
class MonadIO m => MonadRandomIO m where
getRNG :: m RNG
type RandomT m = ReaderT RNG m
instance MonadRandomIO IO where
getRNG :: IO RNG
getRNG = RNG -> IO RNG
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RNG
systemRNG
instance (MonadIO m) => MonadRandomIO (ReaderT RNG m) where
getRNG :: ReaderT RNG m RNG
getRNG = ReaderT RNG m RNG
forall r (m :: * -> *). MonadReader r m => m r
ask
runRandomT :: (MonadIO m) => RandomT m a -> RNG -> m a
runRandomT :: forall (m :: * -> *) a. MonadIO m => RandomT m a -> RNG -> m a
runRandomT = ReaderT RNG m a -> RNG -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
type RandomIO = ReaderT RNG IO
runRandomIO :: RandomIO a -> RNG -> IO a
runRandomIO :: forall a. RandomIO a -> RNG -> IO a
runRandomIO = RandomT IO a -> RNG -> IO a
forall (m :: * -> *) a. MonadIO m => RandomT m a -> RNG -> m a
runRandomT
getRandomBytes :: MonadRandomIO m => Int -> m ByteString
getRandomBytes :: forall (m :: * -> *). MonadRandomIO m => Int -> m RNGName
getRandomBytes Int
n = m RNG
forall (m :: * -> *). MonadRandomIO m => m RNG
getRNG m RNG -> (RNG -> m RNGName) -> m RNGName
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> RNG -> m RNGName
forall (m :: * -> *). MonadIO m => Int -> RNG -> m RNGName
getRandomBytesRNG Int
n
reseed :: MonadRandomIO m => Int -> m ()
reseed :: forall (m :: * -> *). MonadRandomIO m => Int -> m ()
reseed Int
n = m RNG
forall (m :: * -> *). MonadRandomIO m => m RNG
getRNG m RNG -> (RNG -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> RNG -> m ()
forall (m :: * -> *). MonadIO m => Int -> RNG -> m ()
reseedRNG Int
n
reseedFrom
:: (MonadRandomIO m)
=> Int
-> RNG
-> m ()
reseedFrom :: forall (m :: * -> *). MonadRandomIO m => Int -> RNG -> m ()
reseedFrom Int
n RNG
src = m RNG
forall (m :: * -> *). MonadRandomIO m => m RNG
getRNG m RNG -> (RNG -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> RNG -> RNG -> m ()
forall (m :: * -> *). MonadIO m => Int -> RNG -> RNG -> m ()
reseedRNGFrom Int
n RNG
src
addEntropy
:: (MonadRandomIO m)
=> ByteString
-> m ()
addEntropy :: forall (m :: * -> *). MonadRandomIO m => RNGName -> m ()
addEntropy RNGName
entropy = m RNG
forall (m :: * -> *). MonadRandomIO m => m RNG
getRNG m RNG -> (RNG -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RNGName -> RNG -> m ()
forall (m :: * -> *). MonadIO m => RNGName -> RNG -> m ()
addEntropyRNG RNGName
entropy
instance RNG' RNG where
generateRandomBytes' :: Int -> RNG -> IO ByteString
generateRandomBytes' :: Int -> RNG -> IO RNGName
generateRandomBytes' = Int -> RNG -> IO RNGName
forall (m :: * -> *). MonadIO m => Int -> RNG -> m RNGName
getRandomBytesRNG
addEntropyRNG' :: ByteString -> RNG -> IO ()
addEntropyRNG' :: RNGName -> RNG -> IO ()
addEntropyRNG' = RNGName -> RNG -> IO ()
forall (m :: * -> *). MonadIO m => RNGName -> RNG -> m ()
addEntropyRNG
class RNG' gen where
generateRandomBytes' :: Int -> gen -> IO ByteString
addEntropyRNG' :: ByteString -> gen -> IO ()
addRandomEntropy' :: (RNG' seed) => Int -> seed -> gen -> IO ()
addRandomEntropy' Int
nbytes seed
seed gen
gen = do
RNGName
entropy <- Int -> seed -> IO RNGName
forall gen. RNG' gen => Int -> gen -> IO RNGName
generateRandomBytes' Int
nbytes seed
seed
RNGName -> gen -> IO ()
forall gen. RNG' gen => RNGName -> gen -> IO ()
addEntropyRNG' RNGName
entropy gen
gen
addPseudoRandomEntropy' :: (PRNG' seed) => Int -> seed -> gen -> IO seed
addPseudoRandomEntropy' Int
nbytes seed
seed gen
gen = do
RNGName -> gen -> IO ()
forall gen. RNG' gen => RNGName -> gen -> IO ()
addEntropyRNG' RNGName
entropy gen
gen
seed -> IO seed
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return seed
seed'
where
(RNGName
entropy, seed
seed') = Int -> seed -> (RNGName, seed)
forall gen. PRNG' gen => Int -> gen -> (RNGName, gen)
generatePseudoRandomBytes' Int
nbytes seed
seed
class PRNG' gen where
generatePseudoRandomBytes' :: Int -> gen -> (ByteString, gen)
reseedEntropy' :: ByteString -> gen -> gen
reseedRandom' :: (RNG' seed) => Int -> seed -> gen -> IO gen
reseedRandom' Int
nbytes seed
seed gen
gen = do
RNGName
entropy <- Int -> seed -> IO RNGName
forall gen. RNG' gen => Int -> gen -> IO RNGName
generateRandomBytes' Int
nbytes seed
seed
gen -> IO gen
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RNGName -> gen -> gen
forall gen. PRNG' gen => RNGName -> gen -> gen
reseedEntropy' RNGName
entropy gen
gen)
reseedPseudoRandom' :: (PRNG' seed) => Int -> seed -> gen -> (seed, gen)
reseedPseudoRandom' Int
nbytes seed
seed gen
gen = (seed
seed', gen
gen') where
(RNGName
entropy, seed
seed') = Int -> seed -> (RNGName, seed)
forall gen. PRNG' gen => Int -> gen -> (RNGName, gen)
generatePseudoRandomBytes' Int
nbytes seed
seed
gen' :: gen
gen' = RNGName -> gen -> gen
forall gen. PRNG' gen => RNGName -> gen -> gen
reseedEntropy' RNGName
entropy gen
gen
newtype CSPRNG' gen
= MkCSPRNG'
{ forall gen. CSPRNG' gen -> MVar gen
runCSPRNG' :: MVar gen
}
modifyCSPRNG' :: CSPRNG' gen -> (gen -> IO (gen, a)) -> IO a
modifyCSPRNG' :: forall gen a. CSPRNG' gen -> (gen -> IO (gen, a)) -> IO a
modifyCSPRNG' (MkCSPRNG' MVar gen
mgen) = MVar gen -> (gen -> IO (gen, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar gen
mgen
modifyCSPRNG_' :: CSPRNG' gen -> (gen -> IO gen) -> IO ()
modifyCSPRNG_' :: forall gen. CSPRNG' gen -> (gen -> IO gen) -> IO ()
modifyCSPRNG_' (MkCSPRNG' MVar gen
mgen) = MVar gen -> (gen -> IO gen) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar gen
mgen
instance (PRNG' gen) => RNG' (CSPRNG' gen) where
generateRandomBytes' :: Int -> CSPRNG' gen -> IO ByteString
generateRandomBytes' :: Int -> CSPRNG' gen -> IO RNGName
generateRandomBytes' Int
nbytes CSPRNG' gen
csprng = CSPRNG' gen -> (gen -> IO (gen, RNGName)) -> IO RNGName
forall gen a. CSPRNG' gen -> (gen -> IO (gen, a)) -> IO a
modifyCSPRNG' CSPRNG' gen
csprng ((gen -> IO (gen, RNGName)) -> IO RNGName)
-> (gen -> IO (gen, RNGName)) -> IO RNGName
forall a b. (a -> b) -> a -> b
$ \ gen
gen -> do
(gen, RNGName) -> IO (gen, RNGName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((gen, RNGName) -> IO (gen, RNGName))
-> (gen, RNGName) -> IO (gen, RNGName)
forall a b. (a -> b) -> a -> b
$ (RNGName, gen) -> (gen, RNGName)
forall a b. (a, b) -> (b, a)
swap ((RNGName, gen) -> (gen, RNGName))
-> (RNGName, gen) -> (gen, RNGName)
forall a b. (a -> b) -> a -> b
$ Int -> gen -> (RNGName, gen)
forall gen. PRNG' gen => Int -> gen -> (RNGName, gen)
generatePseudoRandomBytes' Int
nbytes gen
gen
addEntropyRNG' :: ByteString -> CSPRNG' gen -> IO ()
addEntropyRNG' :: RNGName -> CSPRNG' gen -> IO ()
addEntropyRNG' RNGName
entropy CSPRNG' gen
csprng = CSPRNG' gen -> (gen -> IO gen) -> IO ()
forall gen. CSPRNG' gen -> (gen -> IO gen) -> IO ()
modifyCSPRNG_' CSPRNG' gen
csprng ((gen -> IO gen) -> IO ()) -> (gen -> IO gen) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ gen
gen -> do
gen -> IO gen
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RNGName -> gen -> gen
forall gen. PRNG' gen => RNGName -> gen -> gen
reseedEntropy' RNGName
entropy gen
gen)
class PRNG' gen => Seedable' gen where
type Seed' gen
seed :: Seed' gen -> gen -> gen
freezeSeed :: gen -> Seed' gen
thawSeed :: Seed' gen -> gen