Add test for AES-GCM CPU support to Sodium monad

.gitmodules

@@ -7,3 +7,6 @@
 [submodule "lib/libsodium"]
 	path = lib/libsodium
 	url = https://github.com/ambiata/libsodium
+[submodule "lib/x"]
+	path = lib/x
+	url = https://github.com/ambiata/x

ambiata-tinfoil.cabal

@@ -16,6 +16,7 @@ library
   build-depends:
                        base                            >= 3          && < 5
                      , ambiata-p
+                     , ambiata-x-eithert
                      , base16-bytestring               == 0.1.1.*
                      , base64-bytestring               == 1.0.0.*
                      , binary                          >= 0.5 &&     < 0.9

src/Tinfoil/Internal/Sodium.hs

@@ -8,21 +8,34 @@ module Tinfoil.Internal.Sodium (
   , runSodium
   ) where
 
+import           Control.Monad.IO.Class (liftIO)
+
 import           P
 
 import           System.IO (IO)
 
 import           Tinfoil.Internal.Sodium.Data
 import           Tinfoil.Internal.Sodium.Foreign
 
+import           X.Control.Monad.Trans.Either (EitherT, left)
+
+data SodiumError =
+    SodiumInitFailed
+  | NoAESGCMCPUSupport
+  deriving (Eq, Show)
+
 newtype Sodium a =
     Sodium (IO a)
   deriving (Monad, Functor, Applicative)
 
-runSodium :: Sodium a -> IO (Maybe' a)
+runSodium :: Sodium a -> EitherT SodiumError IO a
 runSodium (Sodium s) =
-  sodiumInit >>= \x -> case x of
+  (liftIO sodiumInit) >>= \x -> case x of
     SodiumInitialised ->
-      Just' <$> s
+      (liftIO aesgcmSupported) >>= \y -> case y of
+        AESGCMSupported ->
+          liftIO s
+        AESGCMNotSupported ->
+          left NoAESGCMCPUSupport
     SodiumNotInitialised ->
-      pure Nothing'
+      left SodiumInitFailed

src/Tinfoil/Internal/Sodium/Data.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Tinfoil.Internal.Sodium.Data (
     SodiumInitStatus(..)
+  , AESGCMSupport(..)
   ) where
 
 import           P
@@ -11,3 +12,9 @@ data SodiumInitStatus =
     SodiumInitialised
   | SodiumNotInitialised
   deriving (Eq, Show, Enum, Bounded)
+
+data AESGCMSupport =
+    AESGCMSupported
+  | AESGCMNotSupported
+  deriving (Eq, Show, Enum, Bounded)
+

src/Tinfoil/Internal/Sodium/Foreign.hs

@@ -4,6 +4,7 @@
 
 module Tinfoil.Internal.Sodium.Foreign (
     sodiumInit
+  , aesgcmSupported
   ) where
 
 import           Foreign.C (CInt(..))
@@ -19,7 +20,9 @@ import           Tinfoil.Internal.Sodium.Data
 -- can be used without this function being called, but will generally result
 -- in loss of thread-safety - in other words, don't do it.
 --
--- This function is thread-safe and idempotent.
+-- This function is thread-safe and idempotent. It doesn't allocate anything on
+-- the heap, but does keep one file descriptor open (for /dev/urandom); it
+-- will only do this once.
 foreign import ccall safe "sodium_init" sodium_init
   :: IO CInt
 
@@ -30,3 +33,16 @@ sodiumInit =
     1 -> pure SodiumInitialised -- already initialised
     _ -> pure SodiumNotInitialised
 
+-- |
+-- Whether or not the CPU supports the x86 extensions required for
+-- hardware-accelerated AES-GCM (the only kind libsodium supports).
+--
+-- sodium_init must be called before this function.
+aesgcmSupported :: IO AESGCMSupport
+aesgcmSupported =
+  sodium_aesgcm_is_available >>= \x -> case x of
+    1 -> pure AESGCMSupported
+    _ -> pure AESGCMNotSupported
+
+foreign import ccall safe "crypto_aead_aes256gcm_is_available" sodium_aesgcm_is_available
+  :: IO CInt

test/Test/IO/Tinfoil/Internal/Sodium/Foreign.hs

@@ -19,6 +19,12 @@ prop_sodiumInit = once . testIO $ do
   r2 <- sodiumInit
   pure $ (r1, r2) === (SodiumInitialised, SodiumInitialised)
 
+prop_aesgcmSupported :: Property
+prop_aesgcmSupported = once . testIO $ do
+  void sodiumInit
+  r1 <- aesgcmSupported
+  pure $ r1 === AESGCMSupported
+
 return []
 tests :: IO Bool
 tests = $forAllProperties $ quickCheckWithResult (stdArgs { maxSuccess = 1000 } )