[random] add a System "DRG"

Crypto/Random.hs

@@ -9,7 +9,9 @@ module Crypto.Random
     (
     -- * Deterministic instances
       ChaChaDRG
+    , SystemDRG
     -- * Deterministic Random class
+    , getSystemDRG
     , drgNew
     , drgNewTest
     , withDRG
@@ -22,7 +24,7 @@ module Crypto.Random
 
 import Crypto.Random.Types
 import Crypto.Random.ChaChaDRG
-import Crypto.Random.Entropy
+import Crypto.Random.SystemDRG
 import Data.ByteArray (ByteArray, ScrubbedBytes)
 import Crypto.Internal.Imports
 

Crypto/Random/SystemDRG.hs

@@ -0,0 +1,64 @@
+-- |
+-- 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)

cryptonite.cabal

@@ -147,6 +147,7 @@ Library
                      Crypto.Random.Entropy.Source
                      Crypto.Random.Entropy.Backend
                      Crypto.Random.ChaChaDRG
+                     Crypto.Random.SystemDRG
                      Crypto.Random.Probabilistic
                      Crypto.PubKey.Internal
                      Crypto.PubKey.ElGamal