65 lines
2.4 KiB
Haskell
65 lines
2.4 KiB
Haskell
-- |
|
|
-- 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)
|