-- |
-- 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 = 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
    [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
    let getNext :: IO [ScrubbedBytes]
getNext = forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ do
            ScrubbedBytes
bs   <- 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)
            [ScrubbedBytes]
more <- IO [ScrubbedBytes]
getNext
            forall (m :: * -> *) a. Monad m => a -> m a
return (ScrubbedBytes
bsforall a. a -> [a] -> [a]
:[ScrubbedBytes]
more)
    Int -> [ScrubbedBytes] -> SystemDRG
SystemDRG Int
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ScrubbedBytes]
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) = forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
nbBytes 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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> [ScrubbedBytes] -> SystemDRG
SystemDRG Int
currentOfs [ScrubbedBytes]
chunks
        loop Int
_          []     Int
_ Ptr Word8
_ = 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 = forall ba. ByteArrayAccess ba => ba -> Int
B.length ScrubbedBytes
c forall a. Num a => a -> a -> a
- Int
currentOfs
                toCopy :: Int
toCopy      = forall a. Ord a => a -> a -> a
min Int
n Int
currentLeft
                nextOfs :: Int
nextOfs     = Int
currentOfs forall a. Num a => a -> a -> a
+ Int
toCopy
                n' :: Int
n'          = Int
n forall a. Num a => a -> a -> a
- Int
toCopy
            forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ScrubbedBytes
c forall a b. (a -> b) -> a -> b
$ \Ptr Any
src -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memCopy Ptr Word8
d (Ptr Any
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
currentOfs) Int
toCopy
            if Int
nextOfs forall a. Eq a => a -> a -> Bool
== 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 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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
toCopy)