diff --git a/.gitmodules b/.gitmodules index c9ada0a..39f61f9 100644 --- a/.gitmodules +++ b/.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 diff --git a/ambiata-tinfoil.cabal b/ambiata-tinfoil.cabal index 432f4ac..7e13276 100644 --- a/ambiata-tinfoil.cabal +++ b/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 diff --git a/lib/x b/lib/x new file mode 160000 index 0000000..29d9c8c --- /dev/null +++ b/lib/x @@ -0,0 +1 @@ +Subproject commit 29d9c8c188f6f02a59228bd7649f13abceb1311a diff --git a/src/Tinfoil/Internal/Sodium.hs b/src/Tinfoil/Internal/Sodium.hs index 3bbf51c..ad4121d 100644 --- a/src/Tinfoil/Internal/Sodium.hs +++ b/src/Tinfoil/Internal/Sodium.hs @@ -8,6 +8,8 @@ module Tinfoil.Internal.Sodium ( , runSodium ) where +import Control.Monad.IO.Class (liftIO) + import P import System.IO (IO) @@ -15,14 +17,25 @@ 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 diff --git a/src/Tinfoil/Internal/Sodium/Data.hs b/src/Tinfoil/Internal/Sodium/Data.hs index 603743e..3dcf874 100644 --- a/src/Tinfoil/Internal/Sodium/Data.hs +++ b/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) + diff --git a/src/Tinfoil/Internal/Sodium/Foreign.hs b/src/Tinfoil/Internal/Sodium/Foreign.hs index 3f59249..495fbae 100644 --- a/src/Tinfoil/Internal/Sodium/Foreign.hs +++ b/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 diff --git a/test/Test/IO/Tinfoil/Internal/Sodium/Foreign.hs b/test/Test/IO/Tinfoil/Internal/Sodium/Foreign.hs index b631043..9e935d9 100644 --- a/test/Test/IO/Tinfoil/Internal/Sodium/Foreign.hs +++ b/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 } )