    -- |
    -- 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           Crypto.Internal.Imports
    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 = generate

    systemChunkSize :: Int
    systemChunkSize = 256

    -- | Grab one instance of the System DRG
    getSystemDRG :: IO SystemDRG
    getSystemDRG = do
        backends <- catMaybes `fmap` sequence supportedBackends
        let getNext = unsafeInterleaveIO $ do
                bs   <- B.alloc systemChunkSize (replenish systemChunkSize backends)
                more <- getNext
                return (bs:more)
        SystemDRG 0 <$> getNext

    generate :: ByteArray output => Int -> SystemDRG -> (output, SystemDRG)
    generate nbBytes (SystemDRG ofs sysChunks) = swap $ unsafeDoIO $ B.allocRet nbBytes $ loop ofs sysChunks nbBytes
      where loop currentOfs chunks 0 _ = return $! SystemDRG currentOfs chunks
            loop _          []     _ _ = error "SystemDRG: the impossible happened: empty chunk"
            loop currentOfs oChunks@(c:cs) n d = do
                let currentLeft = B.length c - currentOfs
                    toCopy      = min n currentLeft
                    nextOfs     = currentOfs + toCopy
                    n'          = n - toCopy
                B.withByteArray c $ \src -> B.memCopy d (src `plusPtr` currentOfs) toCopy
                if nextOfs == B.length c
                    then loop 0 cs n' (d `plusPtr` toCopy)
                    else loop nextOfs oChunks n' (d `plusPtr` toCopy)