-- |
-- Module      : Crypto.Random.EntropyPool
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
--
module Crypto.Random.EntropyPool
    ( EntropyPool
    , createEntropyPool
    , createEntropyPoolWith
    , getEntropyFrom
    ) where

import           Control.Concurrent.MVar
import           Crypto.Random.Entropy.Unsafe
import           Crypto.Internal.ByteArray (ByteArray, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
import           Data.Word (Word8)
import           Data.Maybe (catMaybes)
import           Foreign.Marshal.Utils (copyBytes)
import           Foreign.Ptr (plusPtr, Ptr)

-- | Pool of Entropy. Contains a self-mutating pool of entropy,
-- that is always guaranteed to contain data.
data EntropyPool = EntropyPool [EntropyBackend] (MVar Int) ScrubbedBytes

-- size of entropy pool by default
defaultPoolSize :: Int
defaultPoolSize :: Int
defaultPoolSize = Int
4096

-- | Create a new entropy pool of a specific size
--
-- While you can create as many entropy pools as you want,
-- the pool can be shared between multiples RNGs.
createEntropyPoolWith :: Int -> [EntropyBackend] -> IO EntropyPool
createEntropyPoolWith :: Int -> [EntropyBackend] -> IO EntropyPool
createEntropyPoolWith Int
poolSize [EntropyBackend]
backends = do
    MVar Int
m  <- forall a. a -> IO (MVar a)
newMVar Int
0
    ScrubbedBytes
sm <- forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
poolSize (Int -> [EntropyBackend] -> Ptr Word8 -> IO ()
replenish Int
poolSize [EntropyBackend]
backends)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [EntropyBackend] -> MVar Int -> ScrubbedBytes -> EntropyPool
EntropyPool [EntropyBackend]
backends MVar Int
m ScrubbedBytes
sm

-- | Create a new entropy pool with a default size.
--
-- While you can create as many entropy pools as you want,
-- the pool can be shared between multiples RNGs.
createEntropyPool :: IO EntropyPool
createEntropyPool :: IO EntropyPool
createEntropyPool = do
    [EntropyBackend]
backends <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO (Maybe EntropyBackend)]
supportedBackends
    Int -> [EntropyBackend] -> IO EntropyPool
createEntropyPoolWith Int
defaultPoolSize [EntropyBackend]
backends

-- | Put a chunk of the entropy pool into a buffer
getEntropyPtr :: EntropyPool -> Int -> Ptr Word8 -> IO ()
getEntropyPtr :: EntropyPool -> Int -> Ptr Word8 -> IO ()
getEntropyPtr (EntropyPool [EntropyBackend]
backends MVar Int
posM ScrubbedBytes
sm) Int
n Ptr Word8
outPtr =
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ScrubbedBytes
sm forall a b. (a -> b) -> a -> b
$ \Ptr Word8
entropyPoolPtr ->
        forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Int
posM forall a b. (a -> b) -> a -> b
$ \Int
pos ->
            forall {b}. Ptr b -> Ptr Word8 -> Int -> Int -> IO Int
copyLoop Ptr Word8
outPtr Ptr Word8
entropyPoolPtr Int
pos Int
n
  where poolSize :: Int
poolSize = forall ba. ByteArrayAccess ba => ba -> Int
B.length ScrubbedBytes
sm
        copyLoop :: Ptr b -> Ptr Word8 -> Int -> Int -> IO Int
copyLoop Ptr b
d Ptr Word8
s Int
pos Int
left
            | Int
left forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return Int
pos
            | Bool
otherwise = do
                Int
wrappedPos <-
                    if Int
pos forall a. Eq a => a -> a -> Bool
== Int
poolSize
                        then Int -> [EntropyBackend] -> Ptr Word8 -> IO ()
replenish Int
poolSize [EntropyBackend]
backends Ptr Word8
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
                        else forall (m :: * -> *) a. Monad m => a -> m a
return Int
pos
                let m :: Int
m = forall a. Ord a => a -> a -> a
min (Int
poolSize forall a. Num a => a -> a -> a
- Int
wrappedPos) Int
left
                forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr b
d (Ptr Word8
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
wrappedPos) Int
m
                Ptr b -> Ptr Word8 -> Int -> Int -> IO Int
copyLoop (Ptr b
d forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
m) Ptr Word8
s (Int
wrappedPos forall a. Num a => a -> a -> a
+ Int
m) (Int
left forall a. Num a => a -> a -> a
- Int
m)

-- | Grab a chunk of entropy from the entropy pool.
getEntropyFrom :: ByteArray byteArray => EntropyPool -> Int -> IO byteArray
getEntropyFrom :: forall byteArray.
ByteArray byteArray =>
EntropyPool -> Int -> IO byteArray
getEntropyFrom EntropyPool
pool Int
n = forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
n (EntropyPool -> Int -> Ptr Word8 -> IO ()
getEntropyPtr EntropyPool
pool Int
n)