{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables      #-}
-- |
-- Low level source of random values for seeds. It should work on both
-- unices and windows
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)

-- Acquire seed from current time. This is horrible fallback for
-- Windows system.
acquireSeedTime :: IO [Word32]
acquireSeedTime :: IO [Word32]
acquireSeedTime = do
  Integer
c <- (forall a. Ratio a -> a
numerator forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> Ratio a
%Integer
cpuTimePrecision)) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO Integer
getCPUTime
  Ratio Integer
t <- forall a. Real a => a -> Ratio Integer
toRational forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO POSIXTime
getPOSIXTime
  let n :: Word64
n    = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Ratio a -> a
numerator Ratio Integer
t) :: Word64
  forall (m :: * -> *) a. Monad m => a -> m a
return [forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n, forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
n forall a. Bits a => a -> Int -> a
`shiftR` Int
32)]

-- | Acquire seed from the system entropy source. On Unix machines,
-- this will attempt to use @/dev/urandom@. On Windows, it will internally
-- use @RtlGenRandom@.
acquireSeedSystem :: forall a. Storable a => Int -> IO [a]
acquireSeedSystem :: forall a. Storable a => Int -> IO [a]
acquireSeedSystem Int
nElts = do
  let eltSize :: Int
eltSize = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
      nbytes :: Int
nbytes  = Int
nElts forall a. Num a => a -> a -> a
* Int
eltSize
#if !defined(mingw32_HOST_OS)
  forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
nbytes forall a b. (a -> b) -> a -> b
$ \Ptr a
buf -> do
    Int
nread <- forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
"/dev/urandom" IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr a
buf Int
nbytes
    forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int
nread forall a. Integral a => a -> a -> a
`div` Int
eltSize) Ptr a
buf
#else
  -- Generate 256 random Word32s from RtlGenRandom
  allocaBytes nbytes $ \buf -> do
    ok <- c_RtlGenRandom buf (fromIntegral nbytes)
    if ok then return () else fail "Couldn't use RtlGenRandom"
    peekArray nElts buf

-- Note: on 64-bit Windows, the 'stdcall' calling convention
-- isn't supported, so we use 'ccall' instead.
#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

-- Note: On Windows, the typical convention would be to use
-- the CryptoGenRandom API in order to generate random data.
-- However, here we use 'SystemFunction036', AKA RtlGenRandom.
--
-- This is a commonly used API for this purpose; one bonus is
-- that it avoids having to bring in the CryptoAPI library,
-- and completely sidesteps the initialization cost of CryptoAPI.
--
-- While this function is technically "subject to change" that is
-- extremely unlikely in practice: rand_s in the Microsoft CRT uses
-- this, and they can't change it easily without also breaking
-- backwards compatibility with e.g. statically linked applications.
--
-- The name 'SystemFunction036' is the actual link-time name; the
-- display name is just for giggles, I guess.
--
-- See also:
--   - http://blogs.msdn.com/b/michael_howard/archive/2005/01/14/353379.aspx
--   - https://bugzilla.mozilla.org/show_bug.cgi?id=504270
--
foreign import WINDOWS_CCONV unsafe "SystemFunction036"
  c_RtlGenRandom :: Ptr a -> CULong -> IO Bool
#endif


-- | Name of source of randomness. It should be used in error messages
randomSourceName :: String
#if !defined(mingw32_HOST_OS)
randomSourceName :: FilePath
randomSourceName = FilePath
"/dev/urandom"
#else
randomSourceName = "RtlGenRandom"
#endif