1-- |
2-- Module      : Crypto.Random.Entropy.RDRand
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : Good
7--
8{-# LANGUAGE ForeignFunctionInterface #-}
9module Crypto.Random.Entropy.RDRand
10    ( RDRand
11    ) where
12
13import Foreign.Ptr
14import Foreign.C.Types
15import Data.Word (Word8)
16import Crypto.Random.Entropy.Source
17
18foreign import ccall unsafe "cryptonite_cpu_has_rdrand"
19   c_cpu_has_rdrand :: IO CInt
20
21foreign import ccall unsafe "cryptonite_get_rand_bytes"
22  c_get_rand_bytes :: Ptr Word8 -> CInt -> IO CInt
23
24-- | Fake handle to Intel RDRand entropy CPU instruction
25data RDRand = RDRand
26
27instance EntropySource RDRand where
28    entropyOpen     = rdrandGrab
29    entropyGather _ = rdrandGetBytes
30    entropyClose  _ = return ()
31
32rdrandGrab :: IO (Maybe RDRand)
33rdrandGrab = supported `fmap` c_cpu_has_rdrand
34  where supported 0 = Nothing
35        supported _ = Just RDRand
36
37rdrandGetBytes :: Ptr Word8 -> Int -> IO Int
38rdrandGetBytes ptr sz = fromIntegral `fmap` c_get_rand_bytes ptr (fromIntegral sz)
39