{-# 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 forall (m :: * -> *) a. Monad m => a -> m a
return EntropyCtx
EntropySyscall
else do
Maybe Handle
mh <- [Char] -> IO (Maybe Handle)
openDev [Char]
"/dev/urandom"
case Maybe Handle
mh of
Maybe Handle
Nothing -> forall e a. Exception e => e -> IO a
E.throwIO EntropySystemMissing
EntropySystemMissing
Just Handle
h -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Handle -> EntropyCtx
EntropyCtx Handle
h
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 = forall a. Eq a => a -> a -> Bool
(==) Int
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> CSize -> IO Int
c_sysrandom_linux Ptr Word8
ptr (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 = 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 = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO Handle
openAndNoBuffering) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(IOException
_ :: IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where openAndNoBuffering :: IO Handle
openAndNoBuffering = do
Handle
h <- [Char] -> IOMode -> IO Handle
openBinaryFile [Char]
filepath IOMode
ReadMode
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
NoBuffering
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
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 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 = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
loop Ptr Word8
p Int
n = do
Int
r <- forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufSome Handle
h Ptr Word8
p Int
n
if Int
r forall a. Ord a => a -> a -> Bool
>= Int
0
then Ptr Word8 -> Int -> IO Bool
loop (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
r) (Int
n forall a. Subtractive a => a -> a -> Difference a
- Int
r)
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
failOnException :: E.IOException -> IO Bool
failOnException :: IOException -> IO Bool
failOnException IOException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
supportSyscall :: Bool
supportSyscall :: Bool
supportSyscall = forall a. IO a -> a
unsafePerformIO (forall a. Eq a => a -> a -> Bool
(==) Int
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> CSize -> IO Int
c_sysrandom_linux forall a. Ptr a
nullPtr CSize
0)
{-# NOINLINE supportSyscall #-}
foreign import ccall unsafe "foundation_sysrandom_linux"
c_sysrandom_linux :: Ptr Word8 -> CSize -> IO Int