From b37ee0163665961b1e06433c2504c770aa469a7b Mon Sep 17 00:00:00 2001
From: Vincent Hanquez <vincent@snarc.org>
Date: Sat, 20 Jun 2015 15:51:42 +0100
Subject: [PATCH] [random] add a System "DRG"

---
 Crypto/Random.hs           |  4 ++-
 Crypto/Random/SystemDRG.hs | 64 ++++++++++++++++++++++++++++++++++++++
 cryptonite.cabal           |  1 +
 3 files changed, 68 insertions(+), 1 deletion(-)
 create mode 100644 Crypto/Random/SystemDRG.hs

diff --git a/Crypto/Random.hs b/Crypto/Random.hs
index 274c891..e71fa51 100644
--- a/Crypto/Random.hs
+++ b/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
 
diff --git a/Crypto/Random/SystemDRG.hs b/Crypto/Random/SystemDRG.hs
new file mode 100644
index 0000000..50872f2
--- /dev/null
+++ b/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)
diff --git a/cryptonite.cabal b/cryptonite.cabal
index 8107f0f..db1c513 100644
--- a/cryptonite.cabal
+++ b/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