module Data.Random.Source.DevRandom
( DevRandom(..)
) where
import Data.Random.Source
import Data.Random.Internal.Primitives
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
getRandomPrimFrom src = getPrimWhere supported getPrim
where
supported :: Prim a -> Bool
supported PrimWord8 = True
supported PrimWord16 = True
supported PrimWord32 = True
supported PrimWord64 = True
supported _ = False
getPrim :: Prim a -> IO a
getPrim PrimWord8 = allocaBytes 1 $ \buf -> do
1 <- hGetBuf (dev src) buf 1
peek buf
getPrim PrimWord16 = allocaBytes 2 $ \buf -> do
2 <- hGetBuf (dev src) buf 2
peek (castPtr buf)
getPrim PrimWord32 = allocaBytes 4 $ \buf -> do
4 <- hGetBuf (dev src) buf 4
peek (castPtr buf)
getPrim PrimWord64 = allocaBytes 8 $ \buf -> do
8 <- hGetBuf (dev src) buf 8
peek (castPtr buf)
getPrim prim = error ("getRandomPrimFrom/" ++ show src ++ ": unsupported prim requested: " ++ show prim)