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 4df766f..18f94d7 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 @@ -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 @@ -148,6 +150,7 @@ test-suite test-io , ambiata-disorder-core , ambiata-disorder-corpus , ambiata-p + , ambiata-x-eithert , bytestring >= 0.10.4 && < 0.11 , QuickCheck >= 2.7 && < 2.9 , quickcheck-instances == 0.3.* 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 new file mode 100644 index 0000000..cd70b09 --- /dev/null +++ b/src/Tinfoil/Internal/Sodium.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Tinfoil.Internal.Sodium ( + SodiumError(..) + , SodiumInitMarker + , initialiseSodium + ) where + +import Control.Monad.IO.Class (liftIO) + +import P + +import System.IO (IO) + +import Tinfoil.Internal.Sodium.Data +import qualified Tinfoil.Internal.Sodium.Foreign as F + +import X.Control.Monad.Trans.Either (EitherT, left) + +data SodiumError = + SodiumInitFailed + | NoAESGCMCPUSupport + deriving (Eq, Show) + +-- | Marker type indicating that the sodium C library has been +-- successfully initialised. Every function which calls out to +-- libsodium should require this as an argument. +data SodiumInitMarker = + -- | `sodium_init()` has been called successfully, and we're running on a + -- CPU which meets our requirements (aesni). + SodiumIsInitialised + deriving (Eq, Show) + +-- | Perform required initialisation required for the sodium C library. This +-- includes ensuring we have hardware support for aes-gcm (can't run safely +-- without it). +-- +-- This function must be called before calling out to anything else in +-- libsodium. +initialiseSodium :: EitherT SodiumError IO SodiumInitMarker +initialiseSodium = + (liftIO F.sodiumInit) >>= \x -> case x of + SodiumInitialised -> + (liftIO F.aesgcmSupported) >>= \y -> case y of + AESGCMSupported -> + pure SodiumIsInitialised + AESGCMNotSupported -> + left NoAESGCMCPUSupport + SodiumNotInitialised -> + 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.hs b/test/Test/IO/Tinfoil/Internal/Sodium.hs new file mode 100644 index 0000000..93d1ed4 --- /dev/null +++ b/test/Test/IO/Tinfoil/Internal/Sodium.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +module Test.IO.Tinfoil.Internal.Sodium where + +import Disorder.Core.IO (testIO) + +import P + +import System.IO + +import Test.QuickCheck + +import Tinfoil.Internal.Sodium + +import X.Control.Monad.Trans.Either (runEitherT) + +prop_initialiseSodium :: Property +prop_initialiseSodium = once . testIO $ do + r1 <- runEitherT initialiseSodium + r2 <- runEitherT initialiseSodium + pure $ (r1, isRight r1, isRight r2) === (r2, True, True) + +return [] +tests :: IO Bool +tests = $forAllProperties $ quickCheckWithResult (stdArgs { maxSuccess = 1000 } ) 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 } ) diff --git a/test/test-io.hs b/test/test-io.hs index a9d289a..da7ec39 100644 --- a/test/test-io.hs +++ b/test/test-io.hs @@ -3,6 +3,7 @@ import Disorder.Core.Main import qualified Test.IO.Tinfoil.Comparison import qualified Test.IO.Tinfoil.Data.MAC import qualified Test.IO.Tinfoil.Hash +import qualified Test.IO.Tinfoil.Internal.Sodium import qualified Test.IO.Tinfoil.Internal.Sodium.Foreign import qualified Test.IO.Tinfoil.KDF import qualified Test.IO.Tinfoil.KDF.Scrypt @@ -18,6 +19,7 @@ main = Test.IO.Tinfoil.Comparison.tests , Test.IO.Tinfoil.Data.MAC.tests , Test.IO.Tinfoil.Hash.tests + , Test.IO.Tinfoil.Internal.Sodium.tests , Test.IO.Tinfoil.Internal.Sodium.Foreign.tests , Test.IO.Tinfoil.KDF.tests , Test.IO.Tinfoil.KDF.Scrypt.tests