    {-# 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 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
    #else
    import System.IO        (IOMode(..), hGetBuf, withBinaryFile)
    #endif
    import System.CPUTime   (cpuTimePrecision, getCPUTime)

    -- Acquire seed from current time. This is horrible fallback for
    -- Windows system.
    acquireSeedTime :: IO [Word32]
    acquireSeedTime :: IO [Word32]
    acquireSeedTime = do
      c <- Ratio Integer -> Integer
    forall a. Ratio a -> a
    numerator (Ratio Integer -> Integer)
    -> (Integer -> Ratio Integer) -> Integer -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Integer -> Ratio Integer
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    cpuTimePrecision) (Integer -> Integer) -> IO Integer -> IO Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Integer
    getCPUTime
      t <- toRational <$> getPOSIXTime
      let n    = Integer -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Ratio Integer -> Integer
    forall a. Ratio a -> a
    numerator Ratio Integer
    t) :: Word64
      return [fromIntegral c, fromIntegral n, fromIntegral (n `shiftR` 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 = a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)
          nbytes :: Int
    nbytes  = Int
    nElts Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    eltSize
    #if !defined(mingw32_HOST_OS)
      Int -> (Ptr a -> IO [a]) -> IO [a]
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes Int
    nbytes ((Ptr a -> IO [a]) -> IO [a]) -> (Ptr a -> IO [a]) -> IO [a]
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    buf -> do
        nread <- FilePath -> IOMode -> (Handle -> IO Int) -> IO Int
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile FilePath
    "/dev/urandom" IOMode
    ReadMode ((Handle -> IO Int) -> IO Int) -> (Handle -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> Handle -> Ptr a -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBuf Handle
    h Ptr a
    buf Int
    nbytes
        peekArray (nread `div` eltSize) 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