1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
-- |
-- 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 = 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)
|
