    -- |
    -- Module      : Foundation.System.Entropy.Unix
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : Good
    --
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ForeignFunctionInterface #-}
    module Foundation.System.Entropy.Unix
        ( EntropyCtx
        , entropyOpen
        , entropyGather
        , entropyClose
        , entropyMaximumSize
        ) where

    import Foreign.Ptr
    import Control.Exception as E
    import Control.Monad
    import System.IO
    import System.IO.Unsafe (unsafePerformIO)
    import Basement.Compat.Base
    import Basement.Compat.C.Types
    import Prelude (fromIntegral)
    import Foundation.System.Entropy.Common
    import Foundation.Numerical

    data EntropyCtx =
          EntropyCtx Handle
        | EntropySyscall

    entropyOpen :: IO EntropyCtx
    entropyOpen :: IO EntropyCtx
    entropyOpen = do
        if Bool
    supportSyscall
            then EntropyCtx -> IO EntropyCtx
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EntropyCtx
    EntropySyscall
            else do
                mh <- [Char] -> IO (Maybe Handle)
    openDev [Char]
    "/dev/urandom"
                case mh of
                    Maybe Handle
    Nothing -> EntropySystemMissing -> IO EntropyCtx
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO EntropySystemMissing
    EntropySystemMissing
                    Just Handle
    h  -> EntropyCtx -> IO EntropyCtx
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EntropyCtx -> IO EntropyCtx) -> EntropyCtx -> IO EntropyCtx
    forall a b. (a -> b) -> a -> b
    $ Handle -> EntropyCtx
    EntropyCtx Handle
    h

    -- | try to fill the ptr with the amount of data required.
    -- Return the number of bytes, or a negative number otherwise
    entropyGather :: EntropyCtx -> Ptr Word8 -> Int -> IO Bool
    entropyGather :: EntropyCtx -> Ptr Word8 -> Int -> IO Bool
    entropyGather (EntropyCtx Handle
    h) Ptr Word8
    ptr Int
    n = Handle -> Ptr Word8 -> Int -> IO Bool
    gatherDevEntropy Handle
    h Ptr Word8
    ptr Int
    n
    entropyGather EntropyCtx
    EntropySyscall Ptr Word8
    ptr Int
    n = Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Int
    0 (Int -> Bool) -> IO Int -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr Word8 -> CSize -> IO Int
    c_sysrandom_linux Ptr Word8
    ptr (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n)

    entropyClose :: EntropyCtx -> IO ()
    entropyClose :: EntropyCtx -> IO ()
    entropyClose (EntropyCtx Handle
    h)  = Handle -> IO ()
    hClose Handle
    h
    entropyClose EntropyCtx
    EntropySyscall  = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    entropyMaximumSize :: Int
    entropyMaximumSize :: Int
    entropyMaximumSize = Int
    4096

    openDev :: [Char] -> IO (Maybe Handle)
    openDev :: [Char] -> IO (Maybe Handle)
    openDev [Char]
    filepath = (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` IO Handle
    openAndNoBuffering) IO (Maybe Handle)
    -> (IOException -> IO (Maybe Handle)) -> IO (Maybe Handle)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(IOException
    _ :: IOException) -> Maybe Handle -> IO (Maybe Handle)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Handle
    forall a. Maybe a
    Nothing
      where openAndNoBuffering :: IO Handle
    openAndNoBuffering = do
                h <- [Char] -> IOMode -> IO Handle
    openBinaryFile [Char]
    filepath IOMode
    ReadMode
                hSetBuffering h NoBuffering
                return h

    gatherDevEntropy :: Handle -> Ptr Word8 -> Int -> IO Bool
    gatherDevEntropy :: Handle -> Ptr Word8 -> Int -> IO Bool
    gatherDevEntropy Handle
    h Ptr Word8
    ptr Int
    sz = Ptr Word8 -> Int -> IO Bool
    loop Ptr Word8
    ptr Int
    sz IO Bool -> (IOException -> IO Bool) -> IO Bool
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` IOException -> IO Bool
    failOnException
      where
        loop :: Ptr Word8 -> Int -> IO Bool
    loop Ptr Word8
    _ Int
    0 = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
        loop Ptr Word8
    p Int
    n = do
            r <- Handle -> Ptr Word8 -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBufSome Handle
    h Ptr Word8
    p Int
    n
            if r >= 0
                then loop (p `plusPtr` r) (n - r)
                else return False
        failOnException :: E.IOException -> IO Bool
        failOnException :: IOException -> IO Bool
    failOnException IOException
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    supportSyscall :: Bool
    supportSyscall :: Bool
    supportSyscall = IO Bool -> Bool
    forall a. IO a -> a
    unsafePerformIO (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Int
    0 (Int -> Bool) -> IO Int -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr Word8 -> CSize -> IO Int
    c_sysrandom_linux Ptr Word8
    forall a. Ptr a
    nullPtr CSize
    0)
    {-# NOINLINE supportSyscall #-}

    -- return 0 on success, !0 for failure
    foreign import ccall unsafe "foundation_sysrandom_linux"
       c_sysrandom_linux :: Ptr Word8 -> CSize -> IO Int