module Data.Random.Source.DevRandom
( DevRandom(..)
) where
import Data.Random.Source
import System.IO (openBinaryFile, hGetBuf, Handle, IOMode(..))
import Foreign
data DevRandom = DevRandom | DevURandom
deriving (Eq, Show)
devRandom :: Handle
devRandom = unsafePerformIO (openBinaryFile "/dev/random" ReadMode)
devURandom :: Handle
devURandom = unsafePerformIO (openBinaryFile "/dev/urandom" ReadMode)
dev :: DevRandom -> Handle
dev DevRandom = devRandom
dev DevURandom = devURandom
instance RandomSource IO DevRandom where
supportedPrimsFrom _ PrimWord8 = True
supportedPrimsFrom _ PrimWord32 = True
supportedPrimsFrom _ PrimWord64 = True
supportedPrimsFrom _ _ = False
getSupportedRandomPrimFrom src PrimWord8 = allocaBytes 1 $ \buf -> do
1 <- hGetBuf (dev src) buf 1
peek buf
getSupportedRandomPrimFrom src PrimWord32 = allocaBytes 1 $ \buf -> do
4 <- hGetBuf (dev src) buf 4
peek (castPtr buf)
getSupportedRandomPrimFrom src PrimWord64 = allocaBytes 8 $ \buf -> do
8 <- hGetBuf (dev src) buf 8
peek (castPtr buf)
getSupportedRandomPrimFrom src prim = error ("getSupportedRandomPrimFrom/" ++ show src ++ ": unsupported prim requested: " ++ show prim)