module Raaz.Random.ChaCha20PRG
( reseedMT, fillRandomBytesMT, RandomState(..)
) where
import Control.Applicative
import Control.Monad
import Foreign.Ptr (Ptr, castPtr)
import Prelude
import Raaz.Core
import Raaz.Cipher.ChaCha20.Internal
import Raaz.Cipher.ChaCha20.Recommendation
import Raaz.Entropy
maxCounterVal :: Counter
maxCounterVal = 1024 * 1024 * 1024
data RandomState = RandomState { chacha20State :: ChaCha20Mem
, auxBuffer :: RandomBuf
, remainingBytes :: MemoryCell (BYTES Int)
}
withAuxBuffer :: (Ptr something -> MT RandomState a) -> MT RandomState a
withAuxBuffer action = onSubMemory auxBuffer getBufferPointer >>= action . castPtr
getRemainingBytes :: MT RandomState (BYTES Int)
getRemainingBytes = onSubMemory remainingBytes extract
setRemainingBytes :: BYTES Int -> MT RandomState ()
setRemainingBytes = onSubMemory remainingBytes . initialise
instance Memory RandomState where
memoryAlloc = RandomState <$> memoryAlloc <*> memoryAlloc <*> memoryAlloc
unsafeToPointer = unsafeToPointer . chacha20State
newSample :: MT RandomState ()
newSample = do setRemainingBytes $ inBytes randomBufferSize
onSubMemory chacha20State seedIfReq
withAuxBuffer $ onSubMemory chacha20State . flip chacha20Random randomBufferSize
seed :: MT ChaCha20Mem ()
seed = do onSubMemory counterCell $ initialise (0 :: Counter)
onSubMemory keyCell getCellPointer >>= void . getEntropy keySize . castPtr
onSubMemory ivCell getCellPointer >>= void . getEntropy ivSize . castPtr
where keySize = sizeOf (undefined :: KEY)
ivSize = sizeOf (undefined :: IV)
seedIfReq :: MT ChaCha20Mem ()
seedIfReq = do c <- onSubMemory counterCell extract
when (c > maxCounterVal) $ seed
reseedMT :: MT RandomState ()
reseedMT = onSubMemory chacha20State seed >> newSample
fillRandomBytesMT :: LengthUnit l => l -> Pointer -> MT RandomState ()
fillRandomBytesMT l = go (inBytes l)
where go m ptr
| m <= 0 = return ()
| otherwise = do
mGot <- fillExistingBytes m ptr
go
(m mGot)
$ movePtr ptr mGot
fillExistingBytes :: BYTES Int -> Pointer -> MT RandomState (BYTES Int)
fillExistingBytes m ptr = do
r <- getRemainingBytes
withAuxBuffer $ \ sptr -> do
if r <= m then do memcpy (destination ptr) (source sptr) r
newSample
return r
else let leftOver = r m
tailPtr = movePtr sptr leftOver
in do memcpy (destination ptr) (source tailPtr) m
setRemainingBytes leftOver
return m