{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.Random.MWC.SeedSource (
acquireSeedSystem
, acquireSeedTime
, randomSourceName
) where
import Control.Monad (liftM)
import Data.Word (Word32,Word64)
import Data.Bits (shiftR)
import Data.Ratio ((%), numerator)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Foreign.Storable
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Array (peekArray)
#if defined(mingw32_HOST_OS)
import Foreign.Ptr
import Foreign.C.Types
#endif
import System.CPUTime (cpuTimePrecision, getCPUTime)
import System.IO (IOMode(..), hGetBuf, withBinaryFile)
acquireSeedTime :: IO [Word32]
acquireSeedTime = do
c <- (numerator . (%cpuTimePrecision)) `liftM` getCPUTime
t <- toRational `liftM` getPOSIXTime
let n = fromIntegral (numerator t) :: Word64
return [fromIntegral c, fromIntegral n, fromIntegral (n `shiftR` 32)]
acquireSeedSystem :: forall a. Storable a => Int -> IO [a]
acquireSeedSystem nElts = do
let eltSize = sizeOf (undefined :: a)
nbytes = nElts * eltSize
#if !defined(mingw32_HOST_OS)
allocaBytes nbytes $ \buf -> do
nread <- withBinaryFile "/dev/urandom" ReadMode $ \h -> hGetBuf h buf nbytes
peekArray (nread `div` eltSize) buf
#else
allocaBytes nbytes $ \buf -> do
ok <- c_RtlGenRandom buf (fromIntegral nbytes)
if ok then return () else fail "Couldn't use RtlGenRandom"
peekArray nElts buf
#if defined(i386_HOST_ARCH)
# define WINDOWS_CCONV stdcall
#elif defined(x86_64_HOST_ARCH)
# define WINDOWS_CCONV ccall
#else
# error Unknown mingw32 architecture!
#endif
foreign import WINDOWS_CCONV unsafe "SystemFunction036"
c_RtlGenRandom :: Ptr a -> CULong -> IO Bool
#endif
randomSourceName :: String
#if !defined(mingw32_HOST_OS)
randomSourceName = "/dev/urandom"
#else
randomSourceName = "RtlGenRandom"
#endif