    -- |
    -- Module      : Crypto.Random.SystemDRG
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : Good
    --
    {-# LANGUAGE BangPatterns #-}
    module Crypto.Random.SystemDRG
        ( SystemDRG
        , getSystemDRG
        ) where

    import           Crypto.Random.Types
    import           Crypto.Random.Entropy.Unsafe
    import           Crypto.Internal.Compat
    import           Data.ByteArray (ScrubbedBytes, ByteArray)
    import           Data.Memory.PtrMethods as B (memCopy)
    import           Data.Maybe (catMaybes)
    import           Data.Tuple (swap)
    import           Foreign.Ptr
    import qualified Data.ByteArray as B
    import           System.IO.Unsafe (unsafeInterleaveIO)

    -- | A referentially transparent System representation of
    -- the random evaluated out of the system.
    --
    -- Holding onto a specific DRG means that all the already
    -- evaluated bytes will be consistently replayed.
    --
    -- There's no need to reseed this DRG, as only pure
    -- entropy is represented here.
    data SystemDRG = SystemDRG !Int [ScrubbedBytes]

    instance DRG SystemDRG where
        randomBytesGenerate :: forall byteArray.
    ByteArray byteArray =>
    Int -> SystemDRG -> (byteArray, SystemDRG)
    randomBytesGenerate = Int -> SystemDRG -> (byteArray, SystemDRG)
    forall byteArray.
    ByteArray byteArray =>
    Int -> SystemDRG -> (byteArray, SystemDRG)
    generate

    systemChunkSize :: Int
    systemChunkSize :: Int
    systemChunkSize = Int
    256

    -- | Grab one instance of the System DRG
    getSystemDRG :: IO SystemDRG
    getSystemDRG :: IO SystemDRG
    getSystemDRG = do
        backends <- [Maybe EntropyBackend] -> [EntropyBackend]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe EntropyBackend] -> [EntropyBackend])
    -> IO [Maybe EntropyBackend] -> IO [EntropyBackend]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` [IO (Maybe EntropyBackend)] -> IO [Maybe EntropyBackend]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [IO (Maybe EntropyBackend)]
    supportedBackends
        let getNext = IO [ScrubbedBytes] -> IO [ScrubbedBytes]
    forall a. IO a -> IO a
    unsafeInterleaveIO (IO [ScrubbedBytes] -> IO [ScrubbedBytes])
    -> IO [ScrubbedBytes] -> IO [ScrubbedBytes]
    forall a b. (a -> b) -> a -> b
    $ do
                bs   <- Int -> (Ptr Word8 -> IO ()) -> IO ScrubbedBytes
    forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
    B.alloc Int
    systemChunkSize (Int -> [EntropyBackend] -> Ptr Word8 -> IO ()
    replenish Int
    systemChunkSize [EntropyBackend]
    backends)
                more <- getNext
                return (bs:more)
        SystemDRG 0 <$> getNext

    generate :: ByteArray output => Int -> SystemDRG -> (output, SystemDRG)
    generate :: forall byteArray.
    ByteArray byteArray =>
    Int -> SystemDRG -> (byteArray, SystemDRG)
    generate Int
    nbBytes (SystemDRG Int
    ofs [ScrubbedBytes]
    sysChunks) = (SystemDRG, output) -> (output, SystemDRG)
    forall a b. (a, b) -> (b, a)
    swap ((SystemDRG, output) -> (output, SystemDRG))
    -> (SystemDRG, output) -> (output, SystemDRG)
    forall a b. (a -> b) -> a -> b
    $ IO (SystemDRG, output) -> (SystemDRG, output)
    forall a. IO a -> a
    unsafeDoIO (IO (SystemDRG, output) -> (SystemDRG, output))
    -> IO (SystemDRG, output) -> (SystemDRG, output)
    forall a b. (a -> b) -> a -> b
    $ Int -> (Ptr Word8 -> IO SystemDRG) -> IO (SystemDRG, output)
    forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
    forall p a. Int -> (Ptr p -> IO a) -> IO (a, output)
    B.allocRet Int
    nbBytes ((Ptr Word8 -> IO SystemDRG) -> IO (SystemDRG, output))
    -> (Ptr Word8 -> IO SystemDRG) -> IO (SystemDRG, output)
    forall a b. (a -> b) -> a -> b
    $ Int -> [ScrubbedBytes] -> Int -> Ptr Word8 -> IO SystemDRG
    loop Int
    ofs [ScrubbedBytes]
    sysChunks Int
    nbBytes
      where loop :: Int -> [ScrubbedBytes] -> Int -> Ptr Word8 -> IO SystemDRG
    loop Int
    currentOfs [ScrubbedBytes]
    chunks Int
    0 Ptr Word8
    _ = SystemDRG -> IO SystemDRG
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SystemDRG -> IO SystemDRG) -> SystemDRG -> IO SystemDRG
    forall a b. (a -> b) -> a -> b
    $! Int -> [ScrubbedBytes] -> SystemDRG
    SystemDRG Int
    currentOfs [ScrubbedBytes]
    chunks
            loop Int
    _          []     Int
    _ Ptr Word8
    _ = [Char] -> IO SystemDRG
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "SystemDRG: the impossible happened: empty chunk"
            loop Int
    currentOfs oChunks :: [ScrubbedBytes]
    oChunks@(ScrubbedBytes
    c:[ScrubbedBytes]
    cs) Int
    n Ptr Word8
    d = do
                let currentLeft :: Int
    currentLeft = ScrubbedBytes -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ScrubbedBytes
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    currentOfs
                    toCopy :: Int
    toCopy      = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    n Int
    currentLeft
                    nextOfs :: Int
    nextOfs     = Int
    currentOfs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    toCopy
                    n' :: Int
    n'          = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    toCopy
                ScrubbedBytes -> (Ptr (ZonkAny 0) -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
    B.withByteArray ScrubbedBytes
    c ((Ptr (ZonkAny 0) -> IO ()) -> IO ())
    -> (Ptr (ZonkAny 0) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr (ZonkAny 0)
    src -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    B.memCopy Ptr Word8
    d (Ptr (ZonkAny 0)
    src Ptr (ZonkAny 0) -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    currentOfs) Int
    toCopy
                if Int
    nextOfs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == ScrubbedBytes -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ScrubbedBytes
    c
                    then Int -> [ScrubbedBytes] -> Int -> Ptr Word8 -> IO SystemDRG
    loop Int
    0 [ScrubbedBytes]
    cs Int
    n' (Ptr Word8
    d Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    toCopy)
                    else Int -> [ScrubbedBytes] -> Int -> Ptr Word8 -> IO SystemDRG
    loop Int
    nextOfs [ScrubbedBytes]
    oChunks Int
    n' (Ptr Word8
    d Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    toCopy)