{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, FlexibleContexts
, GeneralizedNewtypeDeriving, MultiParamTypeClasses, UndecidableInstances #-}
module Control.Monad.CryptoRandom
( CRandom(..)
, CRandomR(..)
, MonadCRandom(..)
, MonadCRandomR(..)
, ContainsGenError(..)
, CRandT(..)
, CRand
, runCRandT
, evalCRandT
, runCRand
, evalCRand
, newGenCRand
, liftCRand
, liftCRandT
, module Crypto.Random
) where
import Control.Applicative
import Control.Arrow (right, left, first)
import Control.Monad (liftM)
import qualified Control.Monad.Catch as C (MonadThrow(..), MonadCatch(..))
import Control.Monad.Cont
import Control.Monad.Trans.Except
import Control.Monad.Error.Class
import Control.Monad.IO.Class
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Monad.RWS.Lazy as Lazy
import Control.Monad.RWS.Strict as Strict
import Control.Monad.State.Lazy as Lazy
import Control.Monad.State.Strict as Strict
import Control.Monad.Writer.Class
import Control.Monad.Writer.Lazy as Lazy
import Control.Monad.Writer.Strict as Strict
import Crypto.Random (CryptoRandomGen(..), GenError(..))
import Data.Bits (xor, setBit, shiftR, shiftL, (.&.))
import Data.Int
import Data.List (foldl')
import Data.Word
import Data.Proxy
import Data.Tagged
import qualified Data.ByteString as B
class (ContainsGenError e, MonadError e m) => MonadCRandom e m where
getCRandom :: CRandom a => m a
getBytes :: Int -> m B.ByteString
getBytesWithEntropy :: Int -> B.ByteString -> m B.ByteString
doReseed :: B.ByteString -> m ()
instance MonadCRandom e m => MonadCRandom e (Lazy.StateT s m) where
getCRandom :: forall a. CRandom a => StateT s m a
getCRandom = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall e (m :: * -> *) a. (MonadCRandom e m, CRandom a) => m a
getCRandom
{-# INLINE getCRandom #-}
getBytes :: Int -> StateT s m ByteString
getBytes = m ByteString -> StateT s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> StateT s m ByteString)
-> (Int -> m ByteString) -> Int -> StateT s m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall e (m :: * -> *). MonadCRandom e m => Int -> m ByteString
getBytes
{-# INLINE getBytes #-}
getBytesWithEntropy :: Int -> ByteString -> StateT s m ByteString
getBytesWithEntropy Int
i = m ByteString -> StateT s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> StateT s m ByteString)
-> (ByteString -> m ByteString)
-> ByteString
-> StateT s m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> m ByteString
forall e (m :: * -> *).
MonadCRandom e m =>
Int -> ByteString -> m ByteString
getBytesWithEntropy Int
i
{-# INLINE getBytesWithEntropy #-}
doReseed :: ByteString -> StateT s m ()
doReseed = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (ByteString -> m ()) -> ByteString -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall e (m :: * -> *). MonadCRandom e m => ByteString -> m ()
doReseed
{-# INLINE doReseed #-}
instance MonadCRandom e m => MonadCRandom e (Strict.StateT s m) where
getCRandom :: forall a. CRandom a => StateT s m a
getCRandom = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall e (m :: * -> *) a. (MonadCRandom e m, CRandom a) => m a
getCRandom
{-# INLINE getCRandom #-}
getBytes :: Int -> StateT s m ByteString
getBytes = m ByteString -> StateT s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> StateT s m ByteString)
-> (Int -> m ByteString) -> Int -> StateT s m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall e (m :: * -> *). MonadCRandom e m => Int -> m ByteString
getBytes
{-# INLINE getBytes #-}
getBytesWithEntropy :: Int -> ByteString -> StateT s m ByteString
getBytesWithEntropy Int
i = m ByteString -> StateT s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> StateT s m ByteString)
-> (ByteString -> m ByteString)
-> ByteString
-> StateT s m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> m ByteString
forall e (m :: * -> *).
MonadCRandom e m =>
Int -> ByteString -> m ByteString
getBytesWithEntropy Int
i
{-# INLINE getBytesWithEntropy #-}
doReseed :: ByteString -> StateT s m ()
doReseed = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (ByteString -> m ()) -> ByteString -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall e (m :: * -> *). MonadCRandom e m => ByteString -> m ()
doReseed
{-# INLINE doReseed #-}
instance (Monoid w, MonadCRandom e m) => MonadCRandom e (Strict.WriterT w m) where
getCRandom :: forall a. CRandom a => WriterT w m a
getCRandom = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall e (m :: * -> *) a. (MonadCRandom e m, CRandom a) => m a
getCRandom
{-# INLINE getCRandom #-}
getBytes :: Int -> WriterT w m ByteString
getBytes = m ByteString -> WriterT w m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> WriterT w m ByteString)
-> (Int -> m ByteString) -> Int -> WriterT w m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall e (m :: * -> *). MonadCRandom e m => Int -> m ByteString
getBytes
{-# INLINE getBytes #-}
getBytesWithEntropy :: Int -> ByteString -> WriterT w m ByteString
getBytesWithEntropy Int
i = m ByteString -> WriterT w m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> WriterT w m ByteString)
-> (ByteString -> m ByteString)
-> ByteString
-> WriterT w m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> m ByteString
forall e (m :: * -> *).
MonadCRandom e m =>
Int -> ByteString -> m ByteString
getBytesWithEntropy Int
i
{-# INLINE getBytesWithEntropy #-}
doReseed :: ByteString -> WriterT w m ()
doReseed = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ())
-> (ByteString -> m ()) -> ByteString -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall e (m :: * -> *). MonadCRandom e m => ByteString -> m ()
doReseed
{-# INLINE doReseed #-}
instance (Monoid w, MonadCRandom e m) => MonadCRandom e (Lazy.WriterT w m) where
getCRandom :: forall a. CRandom a => WriterT w m a
getCRandom = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall e (m :: * -> *) a. (MonadCRandom e m, CRandom a) => m a
getCRandom
{-# INLINE getCRandom #-}
getBytes :: Int -> WriterT w m ByteString
getBytes = m ByteString -> WriterT w m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> WriterT w m ByteString)
-> (Int -> m ByteString) -> Int -> WriterT w m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall e (m :: * -> *). MonadCRandom e m => Int -> m ByteString
getBytes
{-# INLINE getBytes #-}
getBytesWithEntropy :: Int -> ByteString -> WriterT w m ByteString
getBytesWithEntropy Int
i = m ByteString -> WriterT w m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> WriterT w m ByteString)
-> (ByteString -> m ByteString)
-> ByteString
-> WriterT w m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> m ByteString
forall e (m :: * -> *).
MonadCRandom e m =>
Int -> ByteString -> m ByteString
getBytesWithEntropy Int
i
{-# INLINE getBytesWithEntropy #-}
doReseed :: ByteString -> WriterT w m ()
doReseed = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ())
-> (ByteString -> m ()) -> ByteString -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall e (m :: * -> *). MonadCRandom e m => ByteString -> m ()
doReseed
{-# INLINE doReseed #-}
instance MonadCRandom e m => MonadCRandom e (ReaderT r m) where
getCRandom :: forall a. CRandom a => ReaderT r m a
getCRandom = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall e (m :: * -> *) a. (MonadCRandom e m, CRandom a) => m a
getCRandom
{-# INLINE getCRandom #-}
getBytes :: Int -> ReaderT r m ByteString
getBytes = m ByteString -> ReaderT r m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ReaderT r m ByteString)
-> (Int -> m ByteString) -> Int -> ReaderT r m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall e (m :: * -> *). MonadCRandom e m => Int -> m ByteString
getBytes
{-# INLINE getBytes #-}
getBytesWithEntropy :: Int -> ByteString -> ReaderT r m ByteString
getBytesWithEntropy Int
i = m ByteString -> ReaderT r m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ReaderT r m ByteString)
-> (ByteString -> m ByteString)
-> ByteString
-> ReaderT r m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> m ByteString
forall e (m :: * -> *).
MonadCRandom e m =>
Int -> ByteString -> m ByteString
getBytesWithEntropy Int
i
{-# INLINE getBytesWithEntropy #-}
doReseed :: ByteString -> ReaderT r m ()
doReseed = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (ByteString -> m ()) -> ByteString -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall e (m :: * -> *). MonadCRandom e m => ByteString -> m ()
doReseed
{-# INLINE doReseed #-}
instance (Monoid w, MonadCRandom e m) => MonadCRandom e (Strict.RWST r w s m) where
getCRandom :: forall a. CRandom a => RWST r w s m a
getCRandom = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall e (m :: * -> *) a. (MonadCRandom e m, CRandom a) => m a
getCRandom
{-# INLINE getCRandom #-}
getBytes :: Int -> RWST r w s m ByteString
getBytes = m ByteString -> RWST r w s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> RWST r w s m ByteString)
-> (Int -> m ByteString) -> Int -> RWST r w s m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall e (m :: * -> *). MonadCRandom e m => Int -> m ByteString
getBytes
{-# INLINE getBytes #-}
getBytesWithEntropy :: Int -> ByteString -> RWST r w s m ByteString
getBytesWithEntropy Int
i = m ByteString -> RWST r w s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> RWST r w s m ByteString)
-> (ByteString -> m ByteString)
-> ByteString
-> RWST r w s m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> m ByteString
forall e (m :: * -> *).
MonadCRandom e m =>
Int -> ByteString -> m ByteString
getBytesWithEntropy Int
i
{-# INLINE getBytesWithEntropy #-}
doReseed :: ByteString -> RWST r w s m ()
doReseed = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ())
-> (ByteString -> m ()) -> ByteString -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall e (m :: * -> *). MonadCRandom e m => ByteString -> m ()
doReseed
{-# INLINE doReseed #-}
instance (Monoid w, MonadCRandom e m) => MonadCRandom e (Lazy.RWST r w s m) where
getCRandom :: forall a. CRandom a => RWST r w s m a
getCRandom = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall e (m :: * -> *) a. (MonadCRandom e m, CRandom a) => m a
getCRandom
{-# INLINE getCRandom #-}
getBytes :: Int -> RWST r w s m ByteString
getBytes = m ByteString -> RWST r w s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> RWST r w s m ByteString)
-> (Int -> m ByteString) -> Int -> RWST r w s m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ByteString
forall e (m :: * -> *). MonadCRandom e m => Int -> m ByteString
getBytes
{-# INLINE getBytes #-}
getBytesWithEntropy :: Int -> ByteString -> RWST r w s m ByteString
getBytesWithEntropy Int
i = m ByteString -> RWST r w s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> RWST r w s m ByteString)
-> (ByteString -> m ByteString)
-> ByteString
-> RWST r w s m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> m ByteString
forall e (m :: * -> *).
MonadCRandom e m =>
Int -> ByteString -> m ByteString
getBytesWithEntropy Int
i
{-# INLINE getBytesWithEntropy #-}
doReseed :: ByteString -> RWST r w s m ()
doReseed = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ())
-> (ByteString -> m ()) -> ByteString -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ()
forall e (m :: * -> *). MonadCRandom e m => ByteString -> m ()
doReseed
{-# INLINE doReseed #-}
newGenCRand :: (CryptoRandomGen g, MonadCRandom GenError m, Functor m) => m g
newGenCRand :: forall g (m :: * -> *).
(CryptoRandomGen g, MonadCRandom GenError m, Functor m) =>
m g
newGenCRand = Integer -> m g
forall {t} {m :: * -> *} {a}.
(Eq t, Num t, CryptoRandomGen a, MonadCRandom GenError m) =>
t -> m a
go Integer
0
where
go :: t -> m a
go t
1000 = GenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> GenError
GenErrorOther String
"The generator instance requested by newGenCRand never instantiates.")
go t
i = do let p :: Proxy t
p = Proxy t
forall {k} (t :: k). Proxy t
Proxy
getTypedGen :: (Functor m, CryptoRandomGen g, MonadCRandom GenError m)
=> Proxy g -> m (Either GenError g)
getTypedGen :: forall (m :: * -> *) g.
(Functor m, CryptoRandomGen g, MonadCRandom GenError m) =>
Proxy g -> m (Either GenError g)
getTypedGen Proxy g
pr = (ByteString -> Either GenError g)
-> m ByteString -> m (Either GenError g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> Either GenError g
newGen (Int -> m ByteString
forall e (m :: * -> *). MonadCRandom e m => Int -> m ByteString
getBytes (Int -> m ByteString) -> Int -> m ByteString
forall a b. (a -> b) -> a -> b
$ Tagged g Int -> Proxy g -> Int
forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged g Int
forall g. CryptoRandomGen g => Tagged g Int
genSeedLength Proxy g
pr)
Either GenError a
res <- Proxy a -> m (Either GenError a)
forall (m :: * -> *) g.
(Functor m, CryptoRandomGen g, MonadCRandom GenError m) =>
Proxy g -> m (Either GenError g)
getTypedGen Proxy a
forall {t}. Proxy t
p
case Either GenError a
res of
Left GenError
_ -> t -> m a
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)
Right a
g -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
g a -> Proxy a -> a
forall a (proxy :: * -> *). a -> proxy a -> a
`asProxyTypeOf` Proxy a
forall {t}. Proxy t
p)
class (ContainsGenError e, MonadError e m) => MonadCRandomR e m where
getCRandomR :: CRandomR a => (a,a) -> m a
class ContainsGenError e where
toGenError :: e -> Maybe GenError
fromGenError :: GenError -> e
instance ContainsGenError GenError where
toGenError :: GenError -> Maybe GenError
toGenError = GenError -> Maybe GenError
forall a. a -> Maybe a
Just
fromGenError :: GenError -> GenError
fromGenError = GenError -> GenError
forall a. a -> a
id
class CRandom a where
crandom :: (CryptoRandomGen g) => g -> Either GenError (a, g)
crandoms :: (CryptoRandomGen g) => g -> [a]
crandoms g
g =
case g -> Either GenError (a, g)
forall a g.
(CRandom a, CryptoRandomGen g) =>
g -> Either GenError (a, g)
crandom g
g of
Left GenError
_ -> []
Right (a
a,g
g') -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: g -> [a]
forall a g. (CRandom a, CryptoRandomGen g) => g -> [a]
crandoms g
g'
class CRandomR a where
crandomR :: (CryptoRandomGen g) => (a, a) -> g -> Either GenError (a, g)
crandomRs :: (CryptoRandomGen g) => (a, a) -> g -> [a]
crandomRs (a, a)
r g
g =
case (a, a) -> g -> Either GenError (a, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (a, a)
r g
g of
Left GenError
_ -> []
Right (a
a,g
g') -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a, a) -> g -> [a]
forall a g. (CRandomR a, CryptoRandomGen g) => (a, a) -> g -> [a]
crandomRs (a, a)
r g
g'
instance CRandomR Integer where
crandomR :: forall g.
CryptoRandomGen g =>
(Integer, Integer) -> g -> Either GenError (Integer, g)
crandomR = (Integer, Integer) -> g -> Either GenError (Integer, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Int where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Int, g)
crandom = (Int, Int) -> g -> Either GenError (Int, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Int
forall a. Bounded a => a
minBound, Int
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Int where
crandomR :: forall g.
CryptoRandomGen g =>
(Int, Int) -> g -> Either GenError (Int, g)
crandomR = (Int, Int) -> g -> Either GenError (Int, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Word8 where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Word8, g)
crandom = (Word8, Word8) -> g -> Either GenError (Word8, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Word8
forall a. Bounded a => a
minBound, Word8
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Word8 where
crandomR :: forall g.
CryptoRandomGen g =>
(Word8, Word8) -> g -> Either GenError (Word8, g)
crandomR = (Word8, Word8) -> g -> Either GenError (Word8, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Word16 where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Word16, g)
crandom = (Word16, Word16) -> g -> Either GenError (Word16, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Word16
forall a. Bounded a => a
minBound, Word16
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Word16 where
crandomR :: forall g.
CryptoRandomGen g =>
(Word16, Word16) -> g -> Either GenError (Word16, g)
crandomR = (Word16, Word16) -> g -> Either GenError (Word16, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Word32 where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Word32, g)
crandom = (Word32, Word32) -> g -> Either GenError (Word32, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Word32
forall a. Bounded a => a
minBound, Word32
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Word32 where
crandomR :: forall g.
CryptoRandomGen g =>
(Word32, Word32) -> g -> Either GenError (Word32, g)
crandomR = (Word32, Word32) -> g -> Either GenError (Word32, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Word64 where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Word64, g)
crandom = (Word64, Word64) -> g -> Either GenError (Word64, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Word64
forall a. Bounded a => a
minBound, Word64
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Word64 where
crandomR :: forall g.
CryptoRandomGen g =>
(Word64, Word64) -> g -> Either GenError (Word64, g)
crandomR = (Word64, Word64) -> g -> Either GenError (Word64, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Int8 where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Int8, g)
crandom = (Int8, Int8) -> g -> Either GenError (Int8, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Int8
forall a. Bounded a => a
minBound, Int8
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Int8 where
crandomR :: forall g.
CryptoRandomGen g =>
(Int8, Int8) -> g -> Either GenError (Int8, g)
crandomR = (Int8, Int8) -> g -> Either GenError (Int8, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Int16 where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Int16, g)
crandom = (Int16, Int16) -> g -> Either GenError (Int16, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Int16
forall a. Bounded a => a
minBound, Int16
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Int16 where
crandomR :: forall g.
CryptoRandomGen g =>
(Int16, Int16) -> g -> Either GenError (Int16, g)
crandomR = (Int16, Int16) -> g -> Either GenError (Int16, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Int32 where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Int32, g)
crandom = (Int32, Int32) -> g -> Either GenError (Int32, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Int32
forall a. Bounded a => a
minBound, Int32
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Int32 where
crandomR :: forall g.
CryptoRandomGen g =>
(Int32, Int32) -> g -> Either GenError (Int32, g)
crandomR = (Int32, Int32) -> g -> Either GenError (Int32, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Int64 where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Int64, g)
crandom = (Int64, Int64) -> g -> Either GenError (Int64, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Int64
forall a. Bounded a => a
minBound, Int64
forall a. Bounded a => a
maxBound)
{-# INLINE crandom #-}
instance CRandomR Int64 where
crandomR :: forall g.
CryptoRandomGen g =>
(Int64, Int64) -> g -> Either GenError (Int64, g)
crandomR = (Int64, Int64) -> g -> Either GenError (Int64, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num
{-# INLINE crandomR #-}
instance CRandom Bool where
crandom :: forall g. CryptoRandomGen g => g -> Either GenError (Bool, g)
crandom g
g = (Word8 -> Bool) -> (Word8, g) -> (Bool, g)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Int -> Bool
forall a. Enum a => Int -> a
toEnum (Int -> Bool) -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ((Word8, g) -> (Bool, g))
-> Either GenError (Word8, g) -> Either GenError (Bool, g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Word8, Word8) -> g -> Either GenError (Word8, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR (Word8
0::Word8,Word8
1) g
g
crandomR_Num :: (Integral a, CryptoRandomGen g) => (a,a) -> g -> Either GenError (a,g)
crandomR_Num :: forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num (a
low, a
high) g
g
| a
high a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
low = (a, a) -> g -> Either GenError (a, g)
forall a g.
(Integral a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR_Num (a
high,a
low) g
g
| a
high a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
low = (a, g) -> Either GenError (a, g)
forall a b. b -> Either a b
Right (a
high, g
g)
| Bool
otherwise = g -> Either GenError (a, g)
forall {a} {b}.
(Num a, CryptoRandomGen b) =>
b -> Either GenError (a, b)
go g
g
where
mask :: Integer
mask = (Integer -> Int -> Integer) -> Integer -> [Int] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
setBit Integer
0 [Int
0 .. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nrBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
nrBits :: Integer
nrBits = Integer -> Integer
base2Log Integer
range
range :: Integer
range :: Integer
range = (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
high) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
low) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
nrBytes :: Integer
nrBytes = (Integer
nrBits Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
8
go :: b -> Either GenError (a, b)
go b
gen =
let offset :: Either GenError (ByteString, b)
offset = Int -> b -> Either GenError (ByteString, b)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nrBytes) b
gen
in case Either GenError (ByteString, b)
offset of
Left GenError
err -> GenError -> Either GenError (a, b)
forall a b. a -> Either a b
Left GenError
err
Right (ByteString
bs, b
g') ->
let res :: Integer
res = a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
low Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (ByteString -> Integer
bs2i ByteString
bs Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask)
in if Integer
res Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
high then b -> Either GenError (a, b)
go b
g' else (a, b) -> Either GenError (a, b)
forall a b. b -> Either a b
Right (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
res, b
g')
{-# INLINE crandomR_Num #-}
wrap :: (Monad m, ContainsGenError e) => (g -> Either GenError (a,g)) -> CRandT g e m a
wrap :: forall (m :: * -> *) e g a.
(Monad m, ContainsGenError e) =>
(g -> Either GenError (a, g)) -> CRandT g e m a
wrap g -> Either GenError (a, g)
f = StateT g (ExceptT e m) a -> CRandT g e m a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) a -> CRandT g e m a)
-> StateT g (ExceptT e m) a -> CRandT g e m a
forall a b. (a -> b) -> a -> b
$ do
g
g <- StateT g (ExceptT e m) g
forall s (m :: * -> *). MonadState s m => m s
get
case g -> Either GenError (a, g)
f g
g of
Right (a
a,g
g') -> g -> StateT g (ExceptT e m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put g
g' StateT g (ExceptT e m) ()
-> StateT g (ExceptT e m) a -> StateT g (ExceptT e m) a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> StateT g (ExceptT e m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Left GenError
x -> e -> StateT g (ExceptT e m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenError -> e
forall e. ContainsGenError e => GenError -> e
fromGenError GenError
x)
{-# INLINE wrap #-}
liftCRand :: (g -> Either e (a, g)) -> CRand g e a
liftCRand :: forall g e a. (g -> Either e (a, g)) -> CRand g e a
liftCRand g -> Either e (a, g)
f = StateT g (ExceptT e Identity) a -> CRandT g e Identity a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e Identity) a -> CRandT g e Identity a)
-> StateT g (ExceptT e Identity) a -> CRandT g e Identity a
forall a b. (a -> b) -> a -> b
$ (g -> ExceptT e Identity (a, g)) -> StateT g (ExceptT e Identity) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((g -> ExceptT e Identity (a, g))
-> StateT g (ExceptT e Identity) a)
-> (g -> ExceptT e Identity (a, g))
-> StateT g (ExceptT e Identity) a
forall a b. (a -> b) -> a -> b
$ (\g
g -> Identity (Either e (a, g)) -> ExceptT e Identity (a, g)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Identity (Either e (a, g)) -> ExceptT e Identity (a, g))
-> Identity (Either e (a, g)) -> ExceptT e Identity (a, g)
forall a b. (a -> b) -> a -> b
$ Either e (a, g) -> Identity (Either e (a, g))
forall a. a -> Identity a
Identity (Either e (a, g) -> Identity (Either e (a, g)))
-> Either e (a, g) -> Identity (Either e (a, g))
forall a b. (a -> b) -> a -> b
$ g -> Either e (a, g)
f g
g)
{-# INLINE liftCRand #-}
liftCRandT :: (Monad m) => (g -> Either e (a, g)) -> CRandT g e m a
liftCRandT :: forall (m :: * -> *) g e a.
Monad m =>
(g -> Either e (a, g)) -> CRandT g e m a
liftCRandT g -> Either e (a, g)
f = StateT g (ExceptT e m) a -> CRandT g e m a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) a -> CRandT g e m a)
-> StateT g (ExceptT e m) a -> CRandT g e m a
forall a b. (a -> b) -> a -> b
$ (g -> ExceptT e m (a, g)) -> StateT g (ExceptT e m) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((g -> ExceptT e m (a, g)) -> StateT g (ExceptT e m) a)
-> (g -> ExceptT e m (a, g)) -> StateT g (ExceptT e m) a
forall a b. (a -> b) -> a -> b
$ (\g
g -> m (Either e (a, g)) -> ExceptT e m (a, g)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e (a, g)) -> ExceptT e m (a, g))
-> m (Either e (a, g)) -> ExceptT e m (a, g)
forall a b. (a -> b) -> a -> b
$ Either e (a, g) -> m (Either e (a, g))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e (a, g) -> m (Either e (a, g)))
-> Either e (a, g) -> m (Either e (a, g))
forall a b. (a -> b) -> a -> b
$ g -> Either e (a, g)
f g
g)
{-# INLINE liftCRandT #-}
newtype CRandT g e m a = CRandT { forall g e (m :: * -> *) a.
CRandT g e m a -> StateT g (ExceptT e m) a
unCRandT :: Lazy.StateT g (ExceptT e m) a }
deriving ((forall a b. (a -> b) -> CRandT g e m a -> CRandT g e m b)
-> (forall a b. a -> CRandT g e m b -> CRandT g e m a)
-> Functor (CRandT g e m)
forall a b. a -> CRandT g e m b -> CRandT g e m a
forall a b. (a -> b) -> CRandT g e m a -> CRandT g e m b
forall g e (m :: * -> *) a b.
Functor m =>
a -> CRandT g e m b -> CRandT g e m a
forall g e (m :: * -> *) a b.
Functor m =>
(a -> b) -> CRandT g e m a -> CRandT g e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CRandT g e m b -> CRandT g e m a
$c<$ :: forall g e (m :: * -> *) a b.
Functor m =>
a -> CRandT g e m b -> CRandT g e m a
fmap :: forall a b. (a -> b) -> CRandT g e m a -> CRandT g e m b
$cfmap :: forall g e (m :: * -> *) a b.
Functor m =>
(a -> b) -> CRandT g e m a -> CRandT g e m b
Functor, Functor (CRandT g e m)
Functor (CRandT g e m)
-> (forall a. a -> CRandT g e m a)
-> (forall a b.
CRandT g e m (a -> b) -> CRandT g e m a -> CRandT g e m b)
-> (forall a b c.
(a -> b -> c)
-> CRandT g e m a -> CRandT g e m b -> CRandT g e m c)
-> (forall a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m b)
-> (forall a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m a)
-> Applicative (CRandT g e m)
forall a. a -> CRandT g e m a
forall a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m a
forall a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m b
forall a b.
CRandT g e m (a -> b) -> CRandT g e m a -> CRandT g e m b
forall a b c.
(a -> b -> c) -> CRandT g e m a -> CRandT g e m b -> CRandT g e m c
forall {g} {e} {m :: * -> *}. Monad m => Functor (CRandT g e m)
forall g e (m :: * -> *) a. Monad m => a -> CRandT g e m a
forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m a -> CRandT g e m b -> CRandT g e m a
forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m a -> CRandT g e m b -> CRandT g e m b
forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m (a -> b) -> CRandT g e m a -> CRandT g e m b
forall g e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CRandT g e m a -> CRandT g e m b -> CRandT g e 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 a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m a
$c<* :: forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m a -> CRandT g e m b -> CRandT g e m a
*> :: forall a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m b
$c*> :: forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m a -> CRandT g e m b -> CRandT g e m b
liftA2 :: forall a b c.
(a -> b -> c) -> CRandT g e m a -> CRandT g e m b -> CRandT g e m c
$cliftA2 :: forall g e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CRandT g e m a -> CRandT g e m b -> CRandT g e m c
<*> :: forall a b.
CRandT g e m (a -> b) -> CRandT g e m a -> CRandT g e m b
$c<*> :: forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m (a -> b) -> CRandT g e m a -> CRandT g e m b
pure :: forall a. a -> CRandT g e m a
$cpure :: forall g e (m :: * -> *) a. Monad m => a -> CRandT g e m a
Applicative, Applicative (CRandT g e m)
Applicative (CRandT g e m)
-> (forall a b.
CRandT g e m a -> (a -> CRandT g e m b) -> CRandT g e m b)
-> (forall a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m b)
-> (forall a. a -> CRandT g e m a)
-> Monad (CRandT g e m)
forall a. a -> CRandT g e m a
forall a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m b
forall a b.
CRandT g e m a -> (a -> CRandT g e m b) -> CRandT g e m b
forall g e (m :: * -> *). Monad m => Applicative (CRandT g e m)
forall g e (m :: * -> *) a. Monad m => a -> CRandT g e m a
forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m a -> CRandT g e m b -> CRandT g e m b
forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m a -> (a -> CRandT g e m b) -> CRandT g e 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 :: forall a. a -> CRandT g e m a
$creturn :: forall g e (m :: * -> *) a. Monad m => a -> CRandT g e m a
>> :: forall a b. CRandT g e m a -> CRandT g e m b -> CRandT g e m b
$c>> :: forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m a -> CRandT g e m b -> CRandT g e m b
>>= :: forall a b.
CRandT g e m a -> (a -> CRandT g e m b) -> CRandT g e m b
$c>>= :: forall g e (m :: * -> *) a b.
Monad m =>
CRandT g e m a -> (a -> CRandT g e m b) -> CRandT g e m b
Monad, Monad (CRandT g e m)
Monad (CRandT g e m)
-> (forall a. IO a -> CRandT g e m a) -> MonadIO (CRandT g e m)
forall a. IO a -> CRandT g e m a
forall {g} {e} {m :: * -> *}. MonadIO m => Monad (CRandT g e m)
forall g e (m :: * -> *) a. MonadIO m => IO a -> CRandT g e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> CRandT g e m a
$cliftIO :: forall g e (m :: * -> *) a. MonadIO m => IO a -> CRandT g e m a
MonadIO, MonadError e, Monad (CRandT g e m)
Monad (CRandT g e m)
-> (forall a. (a -> CRandT g e m a) -> CRandT g e m a)
-> MonadFix (CRandT g e m)
forall a. (a -> CRandT g e m a) -> CRandT g e m a
forall {g} {e} {m :: * -> *}. MonadFix m => Monad (CRandT g e m)
forall g e (m :: * -> *) a.
MonadFix m =>
(a -> CRandT g e m a) -> CRandT g e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> CRandT g e m a) -> CRandT g e m a
$cmfix :: forall g e (m :: * -> *) a.
MonadFix m =>
(a -> CRandT g e m a) -> CRandT g e m a
MonadFix)
instance MonadTrans (CRandT g e) where
lift :: forall (m :: * -> *) a. Monad m => m a -> CRandT g e m a
lift = StateT g (ExceptT e m) a -> CRandT g e m a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) a -> CRandT g e m a)
-> (m a -> StateT g (ExceptT e m) a) -> m a -> CRandT g e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e m a -> StateT g (ExceptT e m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT e m a -> StateT g (ExceptT e m) a)
-> (m a -> ExceptT e m a) -> m a -> StateT g (ExceptT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
{-# INLINE lift #-}
instance (MonadState s m) => MonadState s (CRandT g e m) where
get :: CRandT g e m s
get = m s -> CRandT g e m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
{-# INLINE get #-}
put :: s -> CRandT g e m ()
put = m () -> CRandT g e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CRandT g e m ()) -> (s -> m ()) -> s -> CRandT g e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
{-# INLINE put #-}
instance (MonadReader r m) => MonadReader r (CRandT g e m) where
ask :: CRandT g e m r
ask = m r -> CRandT g e m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINE ask #-}
local :: forall a. (r -> r) -> CRandT g e m a -> CRandT g e m a
local r -> r
f = StateT g (ExceptT e m) a -> CRandT g e m a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) a -> CRandT g e m a)
-> (CRandT g e m a -> StateT g (ExceptT e m) a)
-> CRandT g e m a
-> CRandT g e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> StateT g (ExceptT e m) a -> StateT g (ExceptT e m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (StateT g (ExceptT e m) a -> StateT g (ExceptT e m) a)
-> (CRandT g e m a -> StateT g (ExceptT e m) a)
-> CRandT g e m a
-> StateT g (ExceptT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRandT g e m a -> StateT g (ExceptT e m) a
forall g e (m :: * -> *) a.
CRandT g e m a -> StateT g (ExceptT e m) a
unCRandT
{-# INLINE local #-}
instance (MonadWriter w m) => MonadWriter w (CRandT g e m) where
tell :: w -> CRandT g e m ()
tell = m () -> CRandT g e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CRandT g e m ()) -> (w -> m ()) -> w -> CRandT g e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
{-# INLINE tell #-}
listen :: forall a. CRandT g e m a -> CRandT g e m (a, w)
listen = StateT g (ExceptT e m) (a, w) -> CRandT g e m (a, w)
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) (a, w) -> CRandT g e m (a, w))
-> (CRandT g e m a -> StateT g (ExceptT e m) (a, w))
-> CRandT g e m a
-> CRandT g e m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT g (ExceptT e m) a -> StateT g (ExceptT e m) (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (StateT g (ExceptT e m) a -> StateT g (ExceptT e m) (a, w))
-> (CRandT g e m a -> StateT g (ExceptT e m) a)
-> CRandT g e m a
-> StateT g (ExceptT e m) (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRandT g e m a -> StateT g (ExceptT e m) a
forall g e (m :: * -> *) a.
CRandT g e m a -> StateT g (ExceptT e m) a
unCRandT
{-# INLINE listen #-}
pass :: forall a. CRandT g e m (a, w -> w) -> CRandT g e m a
pass = StateT g (ExceptT e m) a -> CRandT g e m a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) a -> CRandT g e m a)
-> (CRandT g e m (a, w -> w) -> StateT g (ExceptT e m) a)
-> CRandT g e m (a, w -> w)
-> CRandT g e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT g (ExceptT e m) (a, w -> w) -> StateT g (ExceptT e m) a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (StateT g (ExceptT e m) (a, w -> w) -> StateT g (ExceptT e m) a)
-> (CRandT g e m (a, w -> w) -> StateT g (ExceptT e m) (a, w -> w))
-> CRandT g e m (a, w -> w)
-> StateT g (ExceptT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRandT g e m (a, w -> w) -> StateT g (ExceptT e m) (a, w -> w)
forall g e (m :: * -> *) a.
CRandT g e m a -> StateT g (ExceptT e m) a
unCRandT
{-# INLINE pass #-}
instance (MonadCont m) => MonadCont (CRandT g e m) where
callCC :: forall a b.
((a -> CRandT g e m b) -> CRandT g e m a) -> CRandT g e m a
callCC (a -> CRandT g e m b) -> CRandT g e m a
f = StateT g (ExceptT e m) a -> CRandT g e m a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) a -> CRandT g e m a)
-> StateT g (ExceptT e m) a -> CRandT g e m a
forall a b. (a -> b) -> a -> b
$ ((a -> StateT g (ExceptT e m) b) -> StateT g (ExceptT e m) a)
-> StateT g (ExceptT e m) a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((a -> StateT g (ExceptT e m) b) -> StateT g (ExceptT e m) a)
-> StateT g (ExceptT e m) a)
-> ((a -> StateT g (ExceptT e m) b) -> StateT g (ExceptT e m) a)
-> StateT g (ExceptT e m) a
forall a b. (a -> b) -> a -> b
$ \a -> StateT g (ExceptT e m) b
amb -> CRandT g e m a -> StateT g (ExceptT e m) a
forall g e (m :: * -> *) a.
CRandT g e m a -> StateT g (ExceptT e m) a
unCRandT (CRandT g e m a -> StateT g (ExceptT e m) a)
-> CRandT g e m a -> StateT g (ExceptT e m) a
forall a b. (a -> b) -> a -> b
$ (a -> CRandT g e m b) -> CRandT g e m a
f (StateT g (ExceptT e m) b -> CRandT g e m b
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) b -> CRandT g e m b)
-> (a -> StateT g (ExceptT e m) b) -> a -> CRandT g e m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT g (ExceptT e m) b
amb)
{-# INLINE callCC #-}
instance C.MonadThrow m => C.MonadThrow (CRandT g e m) where
throwM :: forall e a. Exception e => e -> CRandT g e m a
throwM = StateT g (ExceptT e m) a -> CRandT g e m a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) a -> CRandT g e m a)
-> (e -> StateT g (ExceptT e m) a) -> e -> CRandT g e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> StateT g (ExceptT e m) a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM
instance C.MonadCatch m => C.MonadCatch (CRandT g e m) where
catch :: forall e a.
Exception e =>
CRandT g e m a -> (e -> CRandT g e m a) -> CRandT g e m a
catch (CRandT StateT g (ExceptT e m) a
m) e -> CRandT g e m a
f = StateT g (ExceptT e m) a -> CRandT g e m a
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) a -> CRandT g e m a)
-> StateT g (ExceptT e m) a -> CRandT g e m a
forall a b. (a -> b) -> a -> b
$ StateT g (ExceptT e m) a
-> (e -> StateT g (ExceptT e m) a) -> StateT g (ExceptT e m) a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
C.catch StateT g (ExceptT e m) a
m (CRandT g e m a -> StateT g (ExceptT e m) a
forall g e (m :: * -> *) a.
CRandT g e m a -> StateT g (ExceptT e m) a
unCRandT (CRandT g e m a -> StateT g (ExceptT e m) a)
-> (e -> CRandT g e m a) -> e -> StateT g (ExceptT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> CRandT g e m a
f)
type CRand g e = CRandT g e Identity
runCRandT :: ContainsGenError e => CRandT g e m a -> g -> m (Either e (a,g))
runCRandT :: forall e g (m :: * -> *) a.
ContainsGenError e =>
CRandT g e m a -> g -> m (Either e (a, g))
runCRandT CRandT g e m a
m g
g = ExceptT e m (a, g) -> m (Either e (a, g))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m (a, g) -> m (Either e (a, g)))
-> (CRandT g e m a -> ExceptT e m (a, g))
-> CRandT g e m a
-> m (Either e (a, g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT g (ExceptT e m) a -> g -> ExceptT e m (a, g))
-> g -> StateT g (ExceptT e m) a -> ExceptT e m (a, g)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT g (ExceptT e m) a -> g -> ExceptT e m (a, g)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT g
g (StateT g (ExceptT e m) a -> ExceptT e m (a, g))
-> (CRandT g e m a -> StateT g (ExceptT e m) a)
-> CRandT g e m a
-> ExceptT e m (a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRandT g e m a -> StateT g (ExceptT e m) a
forall g e (m :: * -> *) a.
CRandT g e m a -> StateT g (ExceptT e m) a
unCRandT (CRandT g e m a -> m (Either e (a, g)))
-> CRandT g e m a -> m (Either e (a, g))
forall a b. (a -> b) -> a -> b
$ CRandT g e m a
m
{-# INLINE runCRandT #-}
evalCRandT :: (ContainsGenError e, Monad m) => CRandT g e m a -> g -> m (Either e a)
evalCRandT :: forall e (m :: * -> *) g a.
(ContainsGenError e, Monad m) =>
CRandT g e m a -> g -> m (Either e a)
evalCRandT CRandT g e m a
m g
g = (Either e (a, g) -> Either e a)
-> m (Either e (a, g)) -> m (Either e a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((a, g) -> a) -> Either e (a, g) -> Either e a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right (a, g) -> a
forall a b. (a, b) -> a
fst) (CRandT g e m a -> g -> m (Either e (a, g))
forall e g (m :: * -> *) a.
ContainsGenError e =>
CRandT g e m a -> g -> m (Either e (a, g))
runCRandT CRandT g e m a
m g
g)
{-# INLINE evalCRandT #-}
runCRand :: (ContainsGenError e) => CRand g e a -> g -> Either e (a, g)
runCRand :: forall e g a.
ContainsGenError e =>
CRand g e a -> g -> Either e (a, g)
runCRand CRand g e a
m = Identity (Either e (a, g)) -> Either e (a, g)
forall a. Identity a -> a
runIdentity (Identity (Either e (a, g)) -> Either e (a, g))
-> (g -> Identity (Either e (a, g))) -> g -> Either e (a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRand g e a -> g -> Identity (Either e (a, g))
forall e g (m :: * -> *) a.
ContainsGenError e =>
CRandT g e m a -> g -> m (Either e (a, g))
runCRandT CRand g e a
m
{-# INLINE runCRand #-}
evalCRand :: CRand g GenError a -> g -> Either GenError a
evalCRand :: forall g a. CRand g GenError a -> g -> Either GenError a
evalCRand CRand g GenError a
m = Identity (Either GenError a) -> Either GenError a
forall a. Identity a -> a
runIdentity (Identity (Either GenError a) -> Either GenError a)
-> (g -> Identity (Either GenError a)) -> g -> Either GenError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRand g GenError a -> g -> Identity (Either GenError a)
forall e (m :: * -> *) g a.
(ContainsGenError e, Monad m) =>
CRandT g e m a -> g -> m (Either e a)
evalCRandT CRand g GenError a
m
{-# INLINE evalCRand #-}
instance (ContainsGenError e, Monad m, CryptoRandomGen g) => MonadCRandom e (CRandT g e m) where
getCRandom :: forall a. CRandom a => CRandT g e m a
getCRandom = (g -> Either GenError (a, g)) -> CRandT g e m a
forall (m :: * -> *) e g a.
(Monad m, ContainsGenError e) =>
(g -> Either GenError (a, g)) -> CRandT g e m a
wrap g -> Either GenError (a, g)
forall a g.
(CRandom a, CryptoRandomGen g) =>
g -> Either GenError (a, g)
crandom
{-# INLINE getCRandom #-}
getBytes :: Int -> CRandT g e m ByteString
getBytes Int
i = (g -> Either GenError (ByteString, g)) -> CRandT g e m ByteString
forall (m :: * -> *) e g a.
(Monad m, ContainsGenError e) =>
(g -> Either GenError (a, g)) -> CRandT g e m a
wrap (Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
i)
{-# INLINE getBytes #-}
getBytesWithEntropy :: Int -> ByteString -> CRandT g e m ByteString
getBytesWithEntropy Int
i ByteString
e = (g -> Either GenError (ByteString, g)) -> CRandT g e m ByteString
forall (m :: * -> *) e g a.
(Monad m, ContainsGenError e) =>
(g -> Either GenError (a, g)) -> CRandT g e m a
wrap (Int -> ByteString -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> ByteString -> g -> Either GenError (ByteString, g)
genBytesWithEntropy Int
i ByteString
e)
{-# INLINE getBytesWithEntropy #-}
doReseed :: ByteString -> CRandT g e m ()
doReseed ByteString
bs = StateT g (ExceptT e m) () -> CRandT g e m ()
forall g e (m :: * -> *) a.
StateT g (ExceptT e m) a -> CRandT g e m a
CRandT (StateT g (ExceptT e m) () -> CRandT g e m ())
-> StateT g (ExceptT e m) () -> CRandT g e m ()
forall a b. (a -> b) -> a -> b
$ do
StateT g (ExceptT e m) g
forall s (m :: * -> *). MonadState s m => m s
get StateT g (ExceptT e m) g
-> (g -> StateT g (ExceptT e m) ()) -> StateT g (ExceptT e m) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \g
g ->
case ByteString -> g -> Either GenError g
forall g. CryptoRandomGen g => ByteString -> g -> Either GenError g
reseed ByteString
bs g
g of
Right g
g' -> g -> StateT g (ExceptT e m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put g
g'
Left GenError
x -> e -> StateT g (ExceptT e m) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenError -> e
forall e. ContainsGenError e => GenError -> e
fromGenError GenError
x)
{-# INLINE doReseed #-}
instance (ContainsGenError e, Monad m, CryptoRandomGen g) => MonadCRandomR e (CRandT g e m) where
getCRandomR :: forall a. CRandomR a => (a, a) -> CRandT g e m a
getCRandomR = (g -> Either GenError (a, g)) -> CRandT g e m a
forall (m :: * -> *) e g a.
(Monad m, ContainsGenError e) =>
(g -> Either GenError (a, g)) -> CRandT g e m a
wrap ((g -> Either GenError (a, g)) -> CRandT g e m a)
-> ((a, a) -> g -> Either GenError (a, g))
-> (a, a)
-> CRandT g e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> g -> Either GenError (a, g)
forall a g.
(CRandomR a, CryptoRandomGen g) =>
(a, a) -> g -> Either GenError (a, g)
crandomR
{-# INLINE getCRandomR #-}
instance MonadCRandomR e m => MonadCRandomR e (Lazy.StateT s m) where
getCRandomR :: forall a. CRandomR a => (a, a) -> StateT s m a
getCRandomR = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> ((a, a) -> m a) -> (a, a) -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> m a
forall e (m :: * -> *) a.
(MonadCRandomR e m, CRandomR a) =>
(a, a) -> m a
getCRandomR
{-# INLINE getCRandomR #-}
instance MonadCRandomR e m => MonadCRandomR e (Strict.StateT s m) where
getCRandomR :: forall a. CRandomR a => (a, a) -> StateT s m a
getCRandomR = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> ((a, a) -> m a) -> (a, a) -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> m a
forall e (m :: * -> *) a.
(MonadCRandomR e m, CRandomR a) =>
(a, a) -> m a
getCRandomR
{-# INLINE getCRandomR #-}
instance (MonadCRandomR e m, Monoid w) => MonadCRandomR e (Lazy.WriterT w m) where
getCRandomR :: forall a. CRandomR a => (a, a) -> WriterT w m a
getCRandomR = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> ((a, a) -> m a) -> (a, a) -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> m a
forall e (m :: * -> *) a.
(MonadCRandomR e m, CRandomR a) =>
(a, a) -> m a
getCRandomR
{-# INLINE getCRandomR #-}
instance (MonadCRandomR e m, Monoid w) => MonadCRandomR e (Strict.WriterT w m) where
getCRandomR :: forall a. CRandomR a => (a, a) -> WriterT w m a
getCRandomR = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> ((a, a) -> m a) -> (a, a) -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> m a
forall e (m :: * -> *) a.
(MonadCRandomR e m, CRandomR a) =>
(a, a) -> m a
getCRandomR
{-# INLINE getCRandomR #-}
instance MonadCRandomR e m => MonadCRandomR e (ReaderT r m) where
getCRandomR :: forall a. CRandomR a => (a, a) -> ReaderT r m a
getCRandomR = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> ((a, a) -> m a) -> (a, a) -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> m a
forall e (m :: * -> *) a.
(MonadCRandomR e m, CRandomR a) =>
(a, a) -> m a
getCRandomR
{-# INLINE getCRandomR #-}
instance (MonadCRandomR e m, Monoid w) => MonadCRandomR e (Lazy.RWST r w s m) where
getCRandomR :: forall a. CRandomR a => (a, a) -> RWST r w s m a
getCRandomR = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> ((a, a) -> m a) -> (a, a) -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> m a
forall e (m :: * -> *) a.
(MonadCRandomR e m, CRandomR a) =>
(a, a) -> m a
getCRandomR
{-# INLINE getCRandomR #-}
instance (MonadCRandomR e m, Monoid w) => MonadCRandomR e (Strict.RWST r w s m) where
getCRandomR :: forall a. CRandomR a => (a, a) -> RWST r w s m a
getCRandomR = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> ((a, a) -> m a) -> (a, a) -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> m a
forall e (m :: * -> *) a.
(MonadCRandomR e m, CRandomR a) =>
(a, a) -> m a
getCRandomR
{-# INLINE getCRandomR #-}
base2Log :: Integer -> Integer
base2Log :: Integer -> Integer
base2Log Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
setBit Integer
0 Int
64 = Integer
64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
base2Log (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
64)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
setBit Integer
0 Int
32 = Integer
32 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
base2Log (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
setBit Integer
0 Int
16 = Integer
16 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
base2Log (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
setBit Integer
0 Int
8 = Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
base2Log (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
setBit Integer
0 Int
0 = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
base2Log (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
| Bool
otherwise = Integer
0
bs2i :: B.ByteString -> Integer
bs2i :: ByteString -> Integer
bs2i ByteString
bs = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Integer
i Word8
b -> (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Integer
0 ByteString
bs
{-# INLINE bs2i #-}