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

import Crypto.Internal.ByteArray (ByteArray)
import qualified Crypto.Internal.ByteArray as B
import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)

import Crypto.Random.Entropy.Unsafe

-- | The backends this system has, worked out once and no further than
-- needed.
--
-- Opening one is not free: for a device file it means opening and closing
-- @\/dev\/random@ or @\/dev\/urandom@ just to learn that it is there.  This
-- used to be done on every call, and for the whole list before any backend
-- was asked for a byte, so a program paid for both devices even when the
-- first backend answered everything.
--
-- Once, now, and lazily: 'replenish' stops as soon as the buffer is full,
-- which leaves the tail of this list unforced, so a system where the first
-- backend answers never opens a device at all.
{-# NOINLINE openedBackends #-}
openedBackends :: [EntropyBackend]
openedBackends :: [EntropyBackend]
openedBackends = IO [EntropyBackend] -> [EntropyBackend]
forall a. IO a -> a
unsafePerformIO ([IO (Maybe EntropyBackend)] -> IO [EntropyBackend]
forall {a}. [IO (Maybe a)] -> IO [a]
openAsNeeded [IO (Maybe EntropyBackend)]
supportedBackends)
  where
    openAsNeeded :: [IO (Maybe a)] -> IO [a]
openAsNeeded [] = [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    openAsNeeded (IO (Maybe a)
o : [IO (Maybe a)]
os) = do
        Maybe a
m <- IO (Maybe a)
o
        [a]
rest <- IO [a] -> IO [a]
forall a. IO a -> IO a
unsafeInterleaveIO ([IO (Maybe a)] -> IO [a]
openAsNeeded [IO (Maybe a)]
os)
        [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ [a] -> (a -> [a]) -> Maybe a -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
rest (a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest) Maybe a
m

-- | Get some entropy from the system source of entropy
getEntropy :: ByteArray byteArray => Int -> IO byteArray
getEntropy :: forall byteArray. ByteArray byteArray => Int -> IO byteArray
getEntropy Int
n = Int -> (Ptr Word8 -> IO ()) -> IO byteArray
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
n (Int -> [EntropyBackend] -> Ptr Word8 -> IO ()
replenish Int
n [EntropyBackend]
openedBackends)