-- |
-- Module      : Foundation.System.Entropy
-- License     : BSD-style
-- Maintainer  : Foundation
-- Stability   : stable
-- Portability : good
--
{-# LANGUAGE CPP #-}
module Foundation.System.Entropy
    ( getEntropy
    ) where


import           Basement.Compat.Base
import           Basement.Types.OffsetSize
import qualified Basement.UArray.Mutable as A
import qualified Basement.UArray as A
import           Control.Exception
import           Foreign.Ptr
import           Foundation.Numerical

import           Foundation.System.Entropy.Common
#ifdef mingw32_HOST_OS
import           Foundation.System.Entropy.Windows
#else
import           Foundation.System.Entropy.Unix
#endif

-- | Get some of the system entropy
getEntropy :: CountOf Word8 -> IO (A.UArray Word8)
getEntropy :: CountOf Word8 -> IO (UArray Word8)
getEntropy n :: CountOf Word8
n@(CountOf Int
x) = do
    MUArray Word8 RealWorld
m <- CountOf Word8 -> IO (MUArray Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
A.newPinned CountOf Word8
n
    IO EntropyCtx
-> (EntropyCtx -> IO ()) -> (EntropyCtx -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO EntropyCtx
entropyOpen EntropyCtx -> IO ()
entropyClose ((EntropyCtx -> IO ()) -> IO ()) -> (EntropyCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \EntropyCtx
ctx -> MUArray Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
forall (prim :: * -> *) ty a.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
A.withMutablePtr MUArray Word8 RealWorld
MUArray Word8 (PrimState IO)
m ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ EntropyCtx -> Int -> Ptr Word8 -> IO ()
loop EntropyCtx
ctx Int
x
    MUArray Word8 (PrimState IO) -> IO (UArray Word8)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
A.unsafeFreeze MUArray Word8 RealWorld
MUArray Word8 (PrimState IO)
m
  where
    loop :: EntropyCtx -> Int -> Ptr Word8 -> IO ()
    loop :: EntropyCtx -> Int -> Ptr Word8 -> IO ()
loop EntropyCtx
_   Int
0 Ptr Word8
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop EntropyCtx
ctx Int
i Ptr Word8
p = do
        let chSz :: Int
chSz = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
entropyMaximumSize Int
i
        Bool
r <- EntropyCtx -> Ptr Word8 -> Int -> IO Bool
entropyGather EntropyCtx
ctx Ptr Word8
p Int
chSz
        if Bool
r
            then EntropyCtx -> Int -> Ptr Word8 -> IO ()
loop EntropyCtx
ctx (Int
iInt -> Int -> Difference Int
forall a. Subtractive a => a -> a -> Difference a
-Int
chSz) (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
chSz)
            else EntropySystemMissing -> IO ()
forall e a. Exception e => e -> IO a
throwIO EntropySystemMissing
EntropySystemMissing