{-# LANGUAGE ForeignFunctionInterface #-}

-- |
-- Module      : Crypto.Random.Entropy.RDRand
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
module Crypto.Random.Entropy.RDRand (
    RDRand,
) where

import Crypto.Random.Entropy.Source
import Data.Word (Word8)
import Foreign.C.Types
import Foreign.Ptr

foreign import ccall unsafe "crypton_cpu_has_rdrand"
    c_cpu_has_rdrand :: IO CInt

foreign import ccall unsafe "crypton_get_rand_bytes"
    c_get_rand_bytes :: Ptr Word8 -> CInt -> IO CInt

-- | Fake handle to Intel RDRand entropy CPU instruction
data RDRand = RDRand

instance EntropySource RDRand where
    entropyOpen :: IO (Maybe RDRand)
entropyOpen = IO (Maybe RDRand)
rdrandGrab
    entropyGather :: RDRand -> Ptr Word8 -> Int -> IO Int
entropyGather RDRand
_ = Ptr Word8 -> Int -> IO Int
rdrandGetBytes
    entropyClose :: RDRand -> IO ()
entropyClose RDRand
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

rdrandGrab :: IO (Maybe RDRand)
rdrandGrab :: IO (Maybe RDRand)
rdrandGrab = CInt -> Maybe RDRand
forall {a}. (Eq a, Num a) => a -> Maybe RDRand
supported (CInt -> Maybe RDRand) -> IO CInt -> IO (Maybe RDRand)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO CInt
c_cpu_has_rdrand
  where
    supported :: a -> Maybe RDRand
supported a
0 = Maybe RDRand
forall a. Maybe a
Nothing
    supported a
_ = RDRand -> Maybe RDRand
forall a. a -> Maybe a
Just RDRand
RDRand

rdrandGetBytes :: Ptr Word8 -> Int -> IO Int
rdrandGetBytes :: Ptr Word8 -> Int -> IO Int
rdrandGetBytes Ptr Word8
ptr Int
sz = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> CInt -> IO CInt
c_get_rand_bytes Ptr Word8
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)