Add 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
@@ -50,6 +51,7 @@ library
                        Tinfoil.Data.Verify
                        Tinfoil.Encode
                        Tinfoil.Hash
+                       Tinfoil.Internal.Sodium
                        Tinfoil.Internal.Sodium.Data
                        Tinfoil.Internal.Sodium.Foreign
                        Tinfoil.KDF

src/Tinfoil/Internal/Sodium.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Tinfoil.Internal.Sodium (
+    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 -> EitherT SodiumError IO a
+runSodium (Sodium s) =
+  (liftIO sodiumInit) >>= \x -> case x of
+    SodiumInitialised ->
+      (liftIO aesgcmSupported) >>= \y -> case y of
+        AESGCMSupported ->
+          liftIO s
+        AESGCMNotSupported ->
+          left NoAESGCMCPUSupport
+    SodiumNotInitialised ->
+      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 } )