{-# LINE 1 "implementation/entropy/getrandom/Entropy.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface         #-}
-- | Entropy based on the getrandom system call on Linux.
module Entropy( getEntropy, entropySource ) where

import Foreign.C             ( CLong(..) )

import Raaz.Core.Prelude
import Raaz.Core.Types
import Raaz.Core.Types.Internal





-- | The name of the source from which entropy is gathered. For
-- information purposes only.
entropySource :: String
entropySource :: String
entropySource = String
"getrandom(linux)"

-- | The getrandom system call.
foreign import ccall unsafe
  "syscall"
  c_syscall :: CLong
            -> Ptr Word8    -- Message
            -> BYTES Int    -- number of bytes to be read.
            -> Int          -- flags
            -> IO (BYTES Int)

sysGETRANDOM :: CLong
sysGETRANDOM :: CLong
sysGETRANDOM = CLong
318
{-# LINE 31 "implementation/entropy/getrandom/Entropy.hsc" #-}

-- | Get random bytes from using the @getrandom@ system call on
-- linux. This is only used to seed the PRG and not intended for call
-- by others.
getEntropy :: BYTES Int -> Ptr Word8 -> IO (BYTES Int)
getEntropy :: BYTES Int -> Ptr Word8 -> IO (BYTES Int)
getEntropy BYTES Int
l Ptr Word8
ptr = CLong -> Ptr Word8 -> BYTES Int -> Int -> IO (BYTES Int)
c_syscall CLong
sysGETRANDOM Ptr Word8
ptr BYTES Int
l Int
0