1-- |
2-- Module      : Crypto.System.CPU
3-- License     : BSD-style
4-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Gives information about cryptonite runtime environment.
9--
10{-# LANGUAGE CPP #-}
11{-# LANGUAGE DeriveDataTypeable #-}
12{-# LANGUAGE ForeignFunctionInterface #-}
13module Crypto.System.CPU
14    ( ProcessorOption (..)
15    , processorOptions
16    ) where
17
18import Data.Data
19import Data.List (findIndices)
20#ifdef SUPPORT_RDRAND
21import Data.Maybe (isJust)
22#endif
23import Data.Word (Word8)
24import Foreign.Ptr
25import Foreign.Storable
26
27import Crypto.Internal.Compat
28
29#ifdef SUPPORT_RDRAND
30import Crypto.Random.Entropy.RDRand
31import Crypto.Random.Entropy.Source
32#endif
33
34-- | CPU options impacting cryptography implementation and library performance.
35data ProcessorOption
36    = AESNI   -- ^ Support for AES instructions, with flag @support_aesni@
37    | PCLMUL  -- ^ Support for CLMUL instructions, with flag @support_pclmuldq@
38    | RDRAND  -- ^ Support for RDRAND instruction, with flag @support_rdrand@
39    deriving (Show,Eq,Enum,Data)
40
41-- | Options which have been enabled at compile time and are supported by the
42-- current CPU.
43processorOptions :: [ProcessorOption]
44processorOptions = unsafeDoIO $ do
45    p <- cryptonite_aes_cpu_init
46    options <- traverse (getOption p) aesOptions
47    rdrand  <- hasRDRand
48    return (decodeOptions options ++ [ RDRAND | rdrand ])
49  where
50    aesOptions    = [ AESNI .. PCLMUL ]
51    getOption p   = peekElemOff p . fromEnum
52    decodeOptions = map toEnum . findIndices (> 0)
53{-# NOINLINE processorOptions #-}
54
55hasRDRand :: IO Bool
56#ifdef SUPPORT_RDRAND
57hasRDRand = fmap isJust getRDRand
58  where getRDRand = entropyOpen :: IO (Maybe RDRand)
59#else
60hasRDRand = return False
61#endif
62
63foreign import ccall unsafe "cryptonite_aes_cpu_init"
64    cryptonite_aes_cpu_init :: IO (Ptr Word8)
65