module Raaz.Core.Random
( PRG(..), Random(..)
#ifdef HAVE_SYSTEM_PRG
, SystemPRG
#endif
) where
import Control.Applicative
import Control.Monad (void)
import Data.Word
import Foreign.Ptr (castPtr)
import Foreign.Storable(Storable, peek)
import System.IO ( openBinaryFile, Handle, IOMode(ReadMode)
, BufferMode(NoBuffering), hSetBuffering
)
import Raaz.Core.ByteSource(InfiniteSource, slurpBytes)
import Raaz.Core.Types
class InfiniteSource prg => PRG prg where
type Seed prg :: *
newPRG :: Seed prg -> IO prg
reseed :: Seed prg -> prg -> IO ()
class Random r where
random :: PRG prg => prg -> IO r
default random :: (PRG prg, Storable r) => prg -> IO r
random = go undefined
where go :: (PRG prg, Storable a) => a -> prg -> IO a
go w prg = let sz = byteSize w in
allocaBuffer sz $ \ ptr -> do
void $ slurpBytes sz prg ptr
peek $ castPtr ptr
instance Random Word
instance Random Word16
instance Random Word32
instance Random Word64
instance Random w => Random (LE w) where
random = fmap littleEndian . random
instance Random w => Random (BE w) where
random = fmap bigEndian . random
instance (Random a, Random b) => Random (a,b) where
random prg = (,) <$> random prg <*> random prg
instance (Random a, Random b, Random c) => Random (a,b,c) where
random prg = (,,) <$> random prg <*> random prg <*> random prg
#ifdef HAVE_SYSTEM_PRG
#endif
#ifdef HAVE_DEV_URANDOM
newtype SystemPRG = SystemPRG Handle
instance InfiniteSource SystemPRG where
slurpBytes sz sprg@(SystemPRG hand) cptr = hFillBuf hand cptr sz >> return sprg
instance PRG SystemPRG where
type Seed SystemPRG = ()
newPRG _ = do h <- openBinaryFile "/dev/urandom" ReadMode
hSetBuffering h NoBuffering
return $ SystemPRG h
reseed _ _ = return ()
#endif