diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,22 @@ # CHANGELOG +## sel-0.1.0.0 + +* Consistently rename ciphertext-related types and functions [#182](https://github.com/haskell-cryptography/libsodium-bindings/pull/182) +* Add support for additional data (AD) in `Sel.SecretKey.Stream` [#183](https://github.com/haskell-cryptography/libsodium-bindings/pull/183) +* Define some cryptographic functions in sel as pure [#189](https://github.com/haskell-cryptography/libsodium-bindings/pull/189) + +## sel-0.0.3.0 + +* Add constant time hex encoding [#176](https://github.com/haskell-cryptography/libsodium-bindings/pull/176) +* Support `text-display` 1.0.0.0 +* Replace usages of `memcpy` with `Foreign.copyBytes` [#172](https://github.com/haskell-cryptography/libsodium-bindings/pull/172) +* Add constant-time pointer comparison [#171](https://github.com/haskell-cryptography/libsodium-bindings/pull/171) +* (Internal) Add constant-time Eq, use Scoped for internals [#169](https://github.com/haskell-cryptography/libsodium-bindings/pull/169) +* Cleanup, allow more versions of `tasty` [#168](https://github.com/haskell-cryptography/libsodium-bindings/pull/168) +* (Internal) Add `Scoped` for better readability of nested continuations [#167](https://github.com/haskell-cryptography/libsodium-bindings/pull/167) +* Update hedgehog [#180](https://github.com/haskell-cryptography/libsodium-bindings/pull/180) + ## sel-0.0.2.0 * Add usages of `secureMain` in examples diff --git a/sel.cabal b/sel.cabal --- a/sel.cabal +++ b/sel.cabal @@ -1,59 +1,71 @@ -cabal-version: 3.0 -name: sel -version: 0.0.2.0 -category: Cryptography -synopsis: Cryptography for the casual user +cabal-version: 3.0 +name: sel +version: 0.1.0.0 +category: Cryptography +synopsis: Cryptography for the casual user description: The high-level library aimed at casual users of cryptography, by the Haskell Cryptography Group -homepage: https://github.com/haskell-cryptography/libsodium-bindings +homepage: https://github.com/haskell-cryptography/libsodium-bindings bug-reports: https://github.com/haskell-cryptography/libsodium-bindings/issues -author: Hécate Moonlight, Koz Ross -maintainer: The Haskell Cryptography contributors -license: BSD-3-Clause -build-type: Simple +author: Hécate Moonlight, Koz Ross +maintainer: The Haskell Cryptography contributors +license: BSD-3-Clause +build-type: Simple tested-with: - GHC ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.2 || ==9.10.1 + GHC ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.2 || ==9.10.1 || ==9.12.1 extra-source-files: LICENSE README.md -extra-doc-files: CHANGELOG.md +extra-doc-files: CHANGELOG.md source-repository head - type: git + type: git location: https://github.com/haskell-cryptography/libsodium-bindings + subdir: sel common common ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints - -fhide-source-paths -Wno-unused-do-bind -fshow-hole-constraints - -fprint-potential-instances -Wno-unticked-promoted-constructors + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wpartial-fields + -Wredundant-constraints + -fhide-source-paths + -Wno-unused-do-bind + -fshow-hole-constraints + -fprint-potential-instances + -Wno-unticked-promoted-constructors -Werror=unused-imports default-language: Haskell2010 common test-options - ghc-options: -rtsopts -threaded -with-rtsopts=-N + ghc-options: + -rtsopts + -threaded + -with-rtsopts=-N library - import: common - hs-source-dirs: src + import: common + hs-source-dirs: src exposed-modules: Sel + Sel.HMAC + Sel.HMAC.SHA256 + Sel.HMAC.SHA512 + Sel.HMAC.SHA512_256 Sel.Hashing Sel.Hashing.Password Sel.Hashing.SHA256 Sel.Hashing.SHA512 Sel.Hashing.Short - Sel.HMAC - Sel.HMAC.SHA256 - Sel.HMAC.SHA512 - Sel.HMAC.SHA512_256 Sel.PublicKey.Cipher Sel.PublicKey.Seal Sel.PublicKey.Signature @@ -62,26 +74,33 @@ Sel.SecretKey.Cipher Sel.SecretKey.Stream - other-modules: Sel.Internal + other-modules: + Sel.Internal + Sel.Internal.Scoped + Sel.Internal.Scoped.Foreign + Sel.Internal.Sodium + build-depends: - , base >=4.14 && <5 - , base16 ^>=1.0 - , bytestring >=0.10 && <0.13 - , libsodium-bindings ^>=0.0.2 - , text >=1.2 && <2.2 - , text-display ^>=0.0 + base >=4.14 && <5, + base16 ^>=1.0, + bytestring >=0.10 && <0.13, + libsodium-bindings ^>=0.0.3, + text >=1.2 && <2.2, + text-builder-linear ^>=0.1, + text-display ^>=1.0, + transformers ^>=0.6.0, test-suite sel-tests - import: common - import: test-options - type: exitcode-stdio-1.0 - main-is: Main.hs + import: common + import: test-options + type: exitcode-stdio-1.0 + main-is: Main.hs other-modules: + Test.HMAC Test.Hashing Test.Hashing.Password Test.Hashing.SHA2 Test.Hashing.Short - Test.HMAC Test.PublicKey.Cipher Test.PublicKey.Seal Test.PublicKey.Signature @@ -93,13 +112,13 @@ hs-source-dirs: test build-depends: - , base - , base16 - , bytestring - , hedgehog ^>=1.4 - , libsodium-bindings - , sel - , tasty ^>=1.5 - , tasty-hunit ^>=0.10 - , text - , text-display + base, + base16, + bytestring, + hedgehog >=1.4, + libsodium-bindings, + sel, + tasty >=1.4 && <1.6, + tasty-hunit ^>=0.10, + text, + text-display, diff --git a/src/Sel/HMAC/SHA256.hs b/src/Sel/HMAC/SHA256.hs --- a/src/Sel/HMAC/SHA256.hs +++ b/src/Sel/HMAC/SHA256.hs @@ -52,7 +52,6 @@ import Control.Monad (void, when) import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 @@ -66,8 +65,6 @@ import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong) import Foreign.C.Error (throwErrno) -import System.IO.Unsafe (unsafeDupablePerformIO) - import LibSodium.Bindings.SHA2 ( CryptoAuthHMACSHA256State , cryptoAuthHMACSHA256 @@ -81,8 +78,11 @@ , cryptoAuthHMACSHA256Verify ) import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc) -import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd) +import System.IO.Unsafe (unsafeDupablePerformIO) +import Sel.Internal (allocateWith, foreignPtrEqConstantTime, foreignPtrOrdConstantTime) +import Sel.Internal.Sodium (binaryToHex) + -- $introduction -- The 'authenticate' function computes an authentication tag for a message and a secret key, -- and provides a way to verify that a given tag is valid for a given message and a key. @@ -117,9 +117,9 @@ -- ^ Message to authenticate -> AuthenticationKey -- ^ Secret key for authentication - -> IO AuthenticationTag + -> AuthenticationTag -- ^ Cryptographic tag for authentication -authenticate message (AuthenticationKey authenticationKeyForeignPtr) = +authenticate message (AuthenticationKey authenticationKeyForeignPtr) = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do authenticationTagForeignPtr <- Foreign.mallocForeignPtrBytes @@ -244,16 +244,14 @@ -- @since 0.0.1.0 instance Eq AuthenticationKey where (AuthenticationKey hk1) == (AuthenticationKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoAuthHMACSHA256KeyBytes + foreignPtrEqConstantTime hk1 hk2 cryptoAuthHMACSHA256KeyBytes -- | -- -- @since 0.0.1.0 instance Ord AuthenticationKey where compare (AuthenticationKey hk1) (AuthenticationKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA256KeyBytes + foreignPtrOrdConstantTime hk1 hk2 cryptoAuthHMACSHA256KeyBytes -- | > show authenticationKey == "[REDACTED]" -- @@ -318,14 +316,14 @@ (Foreign.castForeignPtr @CUChar @Word8 authenticationKeyForeignPtr) (fromIntegral @CSize @Int cryptoAuthHMACSHA256KeyBytes) --- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString -unsafeAuthenticationKeyToHexByteString = - Base16.extractBase16 . Base16.encodeBase16' . unsafeAuthenticationKeyToBinary +unsafeAuthenticationKeyToHexByteString (AuthenticationKey authenticationKeyForeignPtr) = + binaryToHex authenticationKeyForeignPtr cryptoAuthHMACSHA256KeyBytes -- | A secret authentication key of size 'cryptoAuthHMACSHA256Bytes'. -- @@ -342,16 +340,14 @@ -- @since 0.0.1.0 instance Eq AuthenticationTag where (AuthenticationTag hk1) == (AuthenticationTag hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoAuthHMACSHA256Bytes + foreignPtrEqConstantTime hk1 hk2 cryptoAuthHMACSHA256Bytes -- | -- -- @since 0.0.1.0 instance Ord AuthenticationTag where compare (AuthenticationTag hk1) (AuthenticationTag hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA256Bytes + foreignPtrOrdConstantTime hk1 hk2 cryptoAuthHMACSHA256Bytes -- | -- @@ -359,14 +355,12 @@ instance Show AuthenticationTag where show = BS.unpackChars . authenticationTagToHexByteString --- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString -authenticationTagToHexByteString authenticationTag = - Base16.extractBase16 $ - Base16.encodeBase16' $ - authenticationTagToBinary authenticationTag +authenticationTagToHexByteString (AuthenticationTag authenticationTagForeignPtr) = + binaryToHex authenticationTagForeignPtr cryptoAuthHMACSHA256Bytes -- | Convert an 'AuthenticationTag' to a binary 'StrictByteString'. -- diff --git a/src/Sel/HMAC/SHA512.hs b/src/Sel/HMAC/SHA512.hs --- a/src/Sel/HMAC/SHA512.hs +++ b/src/Sel/HMAC/SHA512.hs @@ -52,7 +52,6 @@ import Control.Monad (void, when) import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 @@ -66,8 +65,6 @@ import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong) import Foreign.C.Error (throwErrno) -import System.IO.Unsafe (unsafeDupablePerformIO) - import LibSodium.Bindings.SHA2 ( CryptoAuthHMACSHA512State , cryptoAuthHMACSHA512 @@ -81,8 +78,11 @@ , cryptoAuthHMACSHA512Verify ) import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc) -import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd) +import System.IO.Unsafe (unsafeDupablePerformIO) +import Sel.Internal (allocateWith, foreignPtrEqConstantTime, foreignPtrOrdConstantTime) +import Sel.Internal.Sodium (binaryToHex) + -- $introduction -- The 'authenticate' function computes an authentication tag for a message and a secret key, -- and provides a way to verify that a given tag is valid for a given message and a key. @@ -117,9 +117,9 @@ -- ^ Message to authenticate -> AuthenticationKey -- ^ Secret key for authentication - -> IO AuthenticationTag + -> AuthenticationTag -- ^ Cryptographic tag for authentication -authenticate message (AuthenticationKey authenticationKeyForeignPtr) = +authenticate message (AuthenticationKey authenticationKeyForeignPtr) = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do authenticationTagForeignPtr <- Foreign.mallocForeignPtrBytes @@ -244,16 +244,14 @@ -- @since 0.0.1.0 instance Eq AuthenticationKey where (AuthenticationKey hk1) == (AuthenticationKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoAuthHMACSHA512KeyBytes + foreignPtrEqConstantTime hk1 hk2 cryptoAuthHMACSHA512KeyBytes -- | -- -- @since 0.0.1.0 instance Ord AuthenticationKey where compare (AuthenticationKey hk1) (AuthenticationKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA512KeyBytes + foreignPtrOrdConstantTime hk1 hk2 cryptoAuthHMACSHA512KeyBytes -- | > show authenticationKey == "[REDACTED]" -- @@ -318,14 +316,14 @@ (Foreign.castForeignPtr @CUChar @Word8 authenticationKeyForeignPtr) (fromIntegral @CSize @Int cryptoAuthHMACSHA512KeyBytes) --- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString -unsafeAuthenticationKeyToHexByteString = - Base16.extractBase16 . Base16.encodeBase16' . unsafeAuthenticationKeyToBinary +unsafeAuthenticationKeyToHexByteString (AuthenticationKey authenticationKeyForeignPtr) = + binaryToHex authenticationKeyForeignPtr cryptoAuthHMACSHA512KeyBytes -- | A secret authentication key of size 'cryptoAuthHMACSHA512Bytes'. -- @@ -342,16 +340,14 @@ -- @since 0.0.1.0 instance Eq AuthenticationTag where (AuthenticationTag hk1) == (AuthenticationTag hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoAuthHMACSHA512Bytes + foreignPtrEqConstantTime hk1 hk2 cryptoAuthHMACSHA512Bytes -- | -- -- @since 0.0.1.0 instance Ord AuthenticationTag where compare (AuthenticationTag hk1) (AuthenticationTag hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA512Bytes + foreignPtrOrdConstantTime hk1 hk2 cryptoAuthHMACSHA512Bytes -- | -- @@ -359,14 +355,12 @@ instance Show AuthenticationTag where show = BS.unpackChars . authenticationTagToHexByteString --- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString -authenticationTagToHexByteString authenticationTag = - Base16.extractBase16 $ - Base16.encodeBase16' $ - authenticationTagToBinary authenticationTag +authenticationTagToHexByteString (AuthenticationTag authenticationTagForeignPtr) = + binaryToHex authenticationTagForeignPtr cryptoAuthHMACSHA512Bytes -- | Convert an 'AuthenticationTag' to a binary 'StrictByteString'. -- diff --git a/src/Sel/HMAC/SHA512_256.hs b/src/Sel/HMAC/SHA512_256.hs --- a/src/Sel/HMAC/SHA512_256.hs +++ b/src/Sel/HMAC/SHA512_256.hs @@ -64,8 +64,6 @@ import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong) import Foreign.C.Error (throwErrno) -import System.IO.Unsafe (unsafeDupablePerformIO) - import LibSodium.Bindings.SHA2 ( CryptoAuthHMACSHA512256State , cryptoAuthHMACSHA512256 @@ -79,8 +77,11 @@ , cryptoAuthHMACSHA512256Verify ) import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc) -import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd) +import System.IO.Unsafe (unsafeDupablePerformIO) +import Sel.Internal (allocateWith, foreignPtrEqConstantTime, foreignPtrOrdConstantTime) +import Sel.Internal.Sodium (binaryToHex) + -- $introduction -- The 'authenticate' function computes an authentication tag for a message and a secret key, -- and provides a way to verify that a given tag is valid for a given message and a key. @@ -115,9 +116,9 @@ -- ^ Message to authenticate -> AuthenticationKey -- ^ Secret key for authentication - -> IO AuthenticationTag + -> AuthenticationTag -- ^ Cryptographic tag for authentication -authenticate message (AuthenticationKey authenticationKeyForeignPtr) = +authenticate message (AuthenticationKey authenticationKeyForeignPtr) = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do authenticationTagForeignPtr <- Foreign.mallocForeignPtrBytes @@ -242,16 +243,14 @@ -- @since 0.0.1.0 instance Eq AuthenticationKey where (AuthenticationKey hk1) == (AuthenticationKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoAuthHMACSHA512256KeyBytes + foreignPtrEqConstantTime hk1 hk2 cryptoAuthHMACSHA512256KeyBytes -- | -- -- @since 0.0.1.0 instance Ord AuthenticationKey where compare (AuthenticationKey hk1) (AuthenticationKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA512256KeyBytes + foreignPtrOrdConstantTime hk1 hk2 cryptoAuthHMACSHA512256KeyBytes -- | > show authenticationKey == "[REDACTED]" -- @@ -317,14 +316,14 @@ (Foreign.castForeignPtr @CUChar @Word8 authenticationKeyForeignPtr) (fromIntegral @CSize @Int cryptoAuthHMACSHA512256KeyBytes) --- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString -unsafeAuthenticationKeyToHexByteString = - Base16.extractBase16 . Base16.encodeBase16' . unsafeAuthenticationKeyToBinary +unsafeAuthenticationKeyToHexByteString (AuthenticationKey authenticationKeyForeignPtr) = + binaryToHex authenticationKeyForeignPtr cryptoAuthHMACSHA512256KeyBytes -- | A secret authentication key of size 'cryptoAuthHMACSHA512256Bytes'. -- @@ -341,16 +340,14 @@ -- @since 0.0.1.0 instance Eq AuthenticationTag where (AuthenticationTag hk1) == (AuthenticationTag hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoAuthHMACSHA512256Bytes + foreignPtrEqConstantTime hk1 hk2 cryptoAuthHMACSHA512256Bytes -- | -- -- @since 0.0.1.0 instance Ord AuthenticationTag where compare (AuthenticationTag hk1) (AuthenticationTag hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA512256Bytes + foreignPtrOrdConstantTime hk1 hk2 cryptoAuthHMACSHA512256Bytes -- | -- @@ -358,14 +355,12 @@ instance Show AuthenticationTag where show = BS.unpackChars . authenticationTagToHexByteString --- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString -authenticationTagToHexByteString authenticationTag = - Base16.extractBase16 $ - Base16.encodeBase16' $ - authenticationTagToBinary authenticationTag +authenticationTagToHexByteString (AuthenticationTag authenticationTagForeignPtr) = + binaryToHex authenticationTagForeignPtr cryptoAuthHMACSHA512256Bytes -- | Convert an 'AuthenticationTag' to a binary 'StrictByteString'. -- diff --git a/src/Sel/Hashing.hs b/src/Sel/Hashing.hs --- a/src/Sel/Hashing.hs +++ b/src/Sel/Hashing.hs @@ -36,24 +36,22 @@ where import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO, liftIO) +import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Internal as BS import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import qualified Data.ByteString.Unsafe as BS +import Data.Kind (Type) import Data.Text (Text) +import qualified Data.Text.Builder.Linear as Builder import Data.Text.Display -import qualified Data.Text.Lazy.Builder as Builder import Foreign (Ptr) import qualified Foreign import Foreign.C (CChar, CInt, CSize, CUChar, CULLong) import Foreign.ForeignPtr import Foreign.Storable -import System.IO.Unsafe (unsafeDupablePerformIO) - -import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.Base16.Types as Base16 -import Data.Kind (Type) import LibSodium.Bindings.GenericHashing ( CryptoGenericHashState , cryptoGenericHash @@ -65,7 +63,10 @@ , cryptoGenericHashStateBytes , cryptoGenericHashUpdate ) +import System.IO.Unsafe (unsafeDupablePerformIO) + import Sel.Internal +import Sel.Internal.Sodium (binaryToHex) -- $introduction -- @@ -94,13 +95,11 @@ instance Eq HashKey where (HashKey hk1) == (HashKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoGenericHashKeyBytes + foreignPtrEq hk1 hk2 cryptoGenericHashKeyBytes instance Ord HashKey where compare (HashKey hk1) (HashKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoGenericHashKeyBytes + foreignPtrOrd hk1 hk2 cryptoGenericHashKeyBytes -- | Create a new 'HashKey' of size 'cryptoGenericHashKeyBytes'. -- @@ -127,16 +126,14 @@ -- @since 0.0.1.0 instance Eq Hash where (Hash h1) == (Hash h2) = - unsafeDupablePerformIO $ - foreignPtrEq h1 h2 cryptoGenericHashBytes + foreignPtrEq h1 h2 cryptoGenericHashBytes -- | -- -- @since 0.0.1.0 instance Ord Hash where compare (Hash h1) (Hash h2) = - unsafeDupablePerformIO $ - foreignPtrOrd h1 h2 cryptoGenericHashBytes + foreignPtrOrd h1 h2 cryptoGenericHashBytes -- | -- @@ -178,8 +175,8 @@ -- Without a 'HashKey', hashing the same data twice will give the same result. -- -- @since 0.0.1.0 -hashByteString :: Maybe HashKey -> StrictByteString -> IO Hash -hashByteString mHashKey bytestring = +hashByteString :: Maybe HashKey -> StrictByteString -> Hash +hashByteString mHashKey bytestring = unsafeDupablePerformIO $ case mHashKey of Just (HashKey fPtr) -> Foreign.withForeignPtr fPtr $ \keyPtr -> @@ -208,11 +205,11 @@ hashToHexText :: Hash -> Text hashToHexText = Base16.extractBase16 . Base16.encodeBase16 . hashToBinary --- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 hashToHexByteString :: Hash -> StrictByteString -hashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . hashToBinary +hashToHexByteString (Hash hashPtr) = binaryToHex hashPtr cryptoGenericHashBytes -- | Convert a 'Hash' to a strict binary 'StrictByteString'. -- diff --git a/src/Sel/Hashing/Password.hs b/src/Sel/Hashing/Password.hs --- a/src/Sel/Hashing/Password.hs +++ b/src/Sel/Hashing/Password.hs @@ -53,6 +53,7 @@ where import Control.Monad (void) +import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 @@ -60,20 +61,19 @@ import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Unsafe as BS import Data.Text (Text) +import qualified Data.Text.Builder.Linear as Builder import Data.Text.Display import qualified Data.Text.Encoding as Text -import qualified Data.Text.Lazy.Builder as Builder import Foreign hiding (void) import Foreign.C -import System.IO.Unsafe (unsafeDupablePerformIO) - -import Sel.Internal - -import qualified Data.Base16.Types as Base16 import GHC.Generics import LibSodium.Bindings.PasswordHashing import LibSodium.Bindings.Random +import System.IO.Unsafe (unsafeDupablePerformIO) +import Sel.Internal +import Sel.Internal.Sodium (binaryToHex) + -- $introduction -- -- This API provides functions for password hashing, backed by the [Argon2id](https://en.wikipedia.org/wiki/Argon2) algorithm. @@ -94,14 +94,18 @@ -- | @since 0.0.1.0 instance Eq PasswordHash where (PasswordHash ph1) == (PasswordHash ph2) = - unsafeDupablePerformIO $ - foreignPtrEq ph1 ph2 cryptoPWHashStrBytes + foreignPtrEq + (Foreign.castForeignPtr @CChar @CUChar ph1) + (Foreign.castForeignPtr @CChar @CUChar ph2) + cryptoPWHashStrBytes -- | @since 0.0.1.0 instance Ord PasswordHash where (PasswordHash ph1) `compare` (PasswordHash ph2) = - unsafeDupablePerformIO $ - foreignPtrOrd ph1 ph2 cryptoPWHashStrBytes + foreignPtrOrd + (Foreign.castForeignPtr @CChar @CUChar ph1) + (Foreign.castForeignPtr @CChar @CUChar ph2) + cryptoPWHashStrBytes -- | @since 0.0.1.0 instance Show PasswordHash where @@ -148,8 +152,8 @@ -- The hash is __not__ encoded in human-readable format. -- -- @since 0.0.1.0 -hashByteStringWithParams :: Argon2Params -> Salt -> StrictByteString -> IO PasswordHash -hashByteStringWithParams Argon2Params{opsLimit, memLimit} (Salt argonSalt) bytestring = +hashByteStringWithParams :: Argon2Params -> Salt -> StrictByteString -> PasswordHash +hashByteStringWithParams Argon2Params{opsLimit, memLimit} (Salt argonSalt) bytestring = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do BS.unsafeUseAsCStringLen argonSalt $ \(saltString, _) -> do hashForeignPtr <- mallocForeignPtrBytes (fromIntegral cryptoPWHashStrBytes) @@ -212,13 +216,14 @@ let !errPos = BS.length bs - BS.length suffix in error $ "decodeASCII: detected non-ASCII codepoint " ++ show word ++ " at position " ++ show errPos <> ". " <> show bs --- | Convert a 'PasswordHash' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'PasswordHash' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- It is recommended to use this one on a 'PasswordHash' produced by 'hashByteStringWithParams'. -- -- @since 0.0.1.0 passwordHashToHexByteString :: PasswordHash -> StrictByteString -passwordHashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . passwordHashToByteString +passwordHashToHexByteString (PasswordHash passwordHashForeignPtr) = + binaryToHex (Foreign.castForeignPtr @CChar @CUChar passwordHashForeignPtr) cryptoPWHashStrBytes -- | Convert a 'PasswordHash' to a strict hexadecimal-encoded 'Text'. -- diff --git a/src/Sel/Hashing/SHA256.hs b/src/Sel/Hashing/SHA256.hs --- a/src/Sel/Hashing/SHA256.hs +++ b/src/Sel/Hashing/SHA256.hs @@ -33,14 +33,17 @@ ) where import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Unsafe as BS +import Data.Kind (Type) import Data.Text (Text) +import qualified Data.Text.Builder.Linear as Builder import Data.Text.Display (Display (..)) import qualified Data.Text.Encoding as Text -import qualified Data.Text.Internal.Builder as Builder import Foreign (ForeignPtr, Ptr, Storable) import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong) @@ -55,10 +58,8 @@ ) import System.IO.Unsafe (unsafeDupablePerformIO) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import qualified Data.Base16.Types as Base16 -import Data.Kind (Type) import Sel.Internal +import Sel.Internal.Sodium (binaryToHex) -- $usage -- @@ -83,16 +84,14 @@ -- @since 0.0.1.0 instance Eq Hash where (Hash h1) == (Hash h2) = - unsafeDupablePerformIO $ - foreignPtrEq h1 h2 cryptoHashSHA256Bytes + foreignPtrEq h1 h2 cryptoHashSHA256Bytes -- | -- -- @since 0.0.1.0 instance Ord Hash where compare (Hash h1) (Hash h2) = - unsafeDupablePerformIO $ - foreignPtrOrd h1 h2 cryptoHashSHA256Bytes + foreignPtrOrd h1 h2 cryptoHashSHA256Bytes -- | -- @@ -132,8 +131,8 @@ -- | Hash a 'StrictByteString' with the SHA-256 algorithm. -- -- @since 0.0.1.0 -hashByteString :: StrictByteString -> IO Hash -hashByteString bytestring = +hashByteString :: StrictByteString -> Hash +hashByteString bytestring = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoHashSHA256Bytes) Foreign.withForeignPtr hashForeignPtr $ \hashPtr -> @@ -147,7 +146,7 @@ -- | Hash a UTF8-encoded strict 'Text' with the SHA-256 algorithm. -- -- @since 0.0.1.0 -hashText :: Text -> IO Hash +hashText :: Text -> Hash hashText text = hashByteString (Text.encodeUtf8 text) -- == Displaying @@ -158,11 +157,12 @@ hashToHexText :: Hash -> Text hashToHexText = Base16.extractBase16 . Base16.encodeBase16 . hashToBinary --- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 hashToHexByteString :: Hash -> StrictByteString -hashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . hashToBinary +hashToHexByteString (Hash hashForeignPtr) = + binaryToHex hashForeignPtr cryptoHashSHA256Bytes -- | Convert a 'Hash' to a binary 'StrictByteString'. -- diff --git a/src/Sel/Hashing/SHA512.hs b/src/Sel/Hashing/SHA512.hs --- a/src/Sel/Hashing/SHA512.hs +++ b/src/Sel/Hashing/SHA512.hs @@ -33,14 +33,17 @@ ) where import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO, liftIO) +import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Unsafe as BS +import Data.Kind (Type) import Data.Text (Text) +import qualified Data.Text.Builder.Linear as Builder import Data.Text.Display (Display (..)) import qualified Data.Text.Encoding as Text -import qualified Data.Text.Internal.Builder as Builder import Foreign (ForeignPtr, Ptr, Storable) import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong) @@ -55,10 +58,8 @@ ) import System.IO.Unsafe (unsafeDupablePerformIO) -import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.Base16.Types as Base16 -import Data.Kind (Type) import Sel.Internal +import Sel.Internal.Sodium (binaryToHex) -- $usage -- @@ -83,16 +84,14 @@ -- @since 0.0.1.0 instance Eq Hash where (Hash h1) == (Hash h2) = - unsafeDupablePerformIO $ - foreignPtrEq h1 h2 cryptoHashSHA512Bytes + foreignPtrEq h1 h2 cryptoHashSHA512Bytes -- | -- -- @since 0.0.1.0 instance Ord Hash where compare (Hash h1) (Hash h2) = - unsafeDupablePerformIO $ - foreignPtrOrd h1 h2 cryptoHashSHA512Bytes + foreignPtrOrd h1 h2 cryptoHashSHA512Bytes -- | -- @@ -137,11 +136,12 @@ hashToHexText :: Hash -> Text hashToHexText = Base16.extractBase16 . Base16.encodeBase16 . hashToBinary --- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 hashToHexByteString :: Hash -> StrictByteString -hashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . hashToBinary +hashToHexByteString (Hash hashForeignPtr) = + binaryToHex hashForeignPtr cryptoHashSHA512Bytes -- | Convert a 'Hash' to a binary 'StrictByteString'. -- @@ -156,8 +156,8 @@ -- | Hash a 'StrictByteString' with the SHA-512 algorithm. -- -- @since 0.0.1.0 -hashByteString :: StrictByteString -> IO Hash -hashByteString bytestring = +hashByteString :: StrictByteString -> Hash +hashByteString bytestring = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoHashSHA512Bytes) Foreign.withForeignPtr hashForeignPtr $ \hashPtr -> @@ -171,7 +171,7 @@ -- | Hash a UTF8-encoded strict 'Text' with the SHA-512 algorithm. -- -- @since 0.0.1.0 -hashText :: Text -> IO Hash +hashText :: Text -> Hash hashText text = hashByteString (Text.encodeUtf8 text) -- ** Hashing a multi-parts message diff --git a/src/Sel/Hashing/Short.hs b/src/Sel/Hashing/Short.hs --- a/src/Sel/Hashing/Short.hs +++ b/src/Sel/Hashing/Short.hs @@ -43,6 +43,7 @@ import Control.Exception (throw) import Control.Monad (void, when) +import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 @@ -50,23 +51,22 @@ import qualified Data.ByteString.Unsafe as BS import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.Builder.Linear as Builder +import Data.Text.Display import qualified Data.Text.Encoding as Text -import qualified Data.Text.Lazy.Builder as Builder import Foreign hiding (void) -import Foreign.C (CSize, CUChar, CULLong) +import Foreign.C (CChar, CSize, CUChar, CULLong) import GHC.Exception (Exception) -import GHC.IO.Handle.Text (memcpy) -import System.IO.Unsafe (unsafeDupablePerformIO) - -import qualified Data.Base16.Types as Base16 -import Data.Text.Display import LibSodium.Bindings.ShortHashing ( cryptoShortHashSipHashX24Bytes , cryptoShortHashSipHashX24KeyBytes , cryptoShortHashX24 , cryptoShortHashX24KeyGen ) +import System.IO.Unsafe (unsafeDupablePerformIO) + import Sel.Internal +import Sel.Internal.Sodium (binaryToHex) -- $introduction -- @@ -89,16 +89,14 @@ -- @since 0.0.1.0 instance Eq ShortHash where (ShortHash sh1) == (ShortHash sh2) = - unsafeDupablePerformIO $ - foreignPtrEq sh1 sh2 cryptoShortHashSipHashX24Bytes + foreignPtrEq sh1 sh2 cryptoShortHashSipHashX24Bytes -- | -- -- @since 0.0.1.0 instance Ord ShortHash where compare (ShortHash sh1) (ShortHash sh2) = - unsafeDupablePerformIO $ - foreignPtrOrd sh1 sh2 cryptoShortHashSipHashX24Bytes + foreignPtrOrd sh1 sh2 cryptoShortHashSipHashX24Bytes -- | -- @@ -124,8 +122,8 @@ -- ^ Random key produced by 'newKey' -> StrictByteString -- ^ Data to hash - -> IO ShortHash -hashByteString (ShortHashKey keyFPtr) message = + -> ShortHash +hashByteString (ShortHashKey keyFPtr) message = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do shortHashFPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoShortHashSipHashX24Bytes) Foreign.withForeignPtr keyFPtr $ \keyPtr -> @@ -151,7 +149,7 @@ -- ^ Random key produced by 'newKey' -> Text -- ^ UTF-8 encoded data to hash - -> IO ShortHash + -> ShortHash hashText key message = hashByteString key (Text.encodeUtf8 message) -- | Convert a 'ShortHash' to a strict binary 'StrictByteString'. @@ -164,11 +162,12 @@ 0 (fromIntegral @CSize @Int cryptoShortHashSipHashX24Bytes) --- | Convert a 'ShortHash' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'ShortHash' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 shortHashToHexByteString :: ShortHash -> StrictByteString -shortHashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . shortHashToBinary +shortHashToHexByteString (ShortHash hashForeignPtr) = + binaryToHex hashForeignPtr cryptoShortHashSipHashX24Bytes -- | Convert a 'ShortHash' to a strict hexadecimal-encoded 'Text'. -- @@ -188,16 +187,14 @@ -- @since 0.0.1.0 instance Eq ShortHashKey where (ShortHashKey sh1) == (ShortHashKey sh2) = - unsafeDupablePerformIO $ - foreignPtrEq sh1 sh2 cryptoShortHashSipHashX24Bytes + foreignPtrEq sh1 sh2 cryptoShortHashSipHashX24Bytes -- | -- -- @since 0.0.1.0 instance Ord ShortHashKey where compare (ShortHashKey sh1) (ShortHashKey sh2) = - unsafeDupablePerformIO $ - foreignPtrOrd sh1 sh2 cryptoShortHashSipHashX24Bytes + foreignPtrOrd sh1 sh2 cryptoShortHashSipHashX24Bytes -- | -- @@ -229,11 +226,12 @@ 0 (fromIntegral @CSize @Int cryptoShortHashSipHashX24KeyBytes) --- | Convert a 'ShortHash' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'ShortHashKey' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 shortHashKeyToHexByteString :: ShortHashKey -> StrictByteString -shortHashKeyToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . shortHashKeyToBinary +shortHashKeyToHexByteString (ShortHashKey hashKeyForeignPtr) = + binaryToHex hashKeyForeignPtr cryptoShortHashSipHashX24KeyBytes -- | Convert a 'ShortHash' to a strict hexadecimal-encoded 'Text'. -- @@ -254,7 +252,10 @@ BS.unsafeUseAsCString binaryKey $ \cString -> do shortHashKeyFPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoShortHashSipHashX24KeyBytes) Foreign.withForeignPtr shortHashKeyFPtr $ \shortHashKeyPtr -> - memcpy shortHashKeyPtr (Foreign.castPtr cString) cryptoShortHashSipHashX24KeyBytes + Foreign.copyBytes + shortHashKeyPtr + (Foreign.castPtr @CChar @CUChar cString) + (fromIntegral cryptoShortHashSipHashX24KeyBytes) pure $ Just $ ShortHashKey shortHashKeyFPtr -- | Convert a strict hexadecimal-encoded 'Text' to a 'ShortHashKey'. @@ -282,11 +283,11 @@ -- @since 0.0.1.0 data ShortHashingException = ShortHashingException deriving stock - ( Show - -- ^ @since 0.0.1.0 - , Eq + ( Eq -- ^ @since 0.0.1.0 , Ord + -- ^ @since 0.0.1.0 + , Show -- ^ @since 0.0.1.0 ) deriving anyclass diff --git a/src/Sel/Internal.hs b/src/Sel/Internal.hs --- a/src/Sel/Internal.hs +++ b/src/Sel/Internal.hs @@ -1,53 +1,115 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} module Sel.Internal where +import Control.Monad (when) import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.Base16.Types as Base16 -import qualified Data.ByteString.Base16 as Base16 -import qualified Data.ByteString.Internal as BS +import Control.Monad.Trans.Class (lift) +import Data.Base16.Types qualified as Base16 +import Data.ByteString (StrictByteString) +import Data.ByteString.Base16 qualified as Base16 +import Data.ByteString.Internal (memcmp) +import Data.ByteString.Internal qualified as ByteString +import Data.Coerce (coerce) import Data.Kind (Type) -import Foreign (Ptr, castForeignPtr) -import Foreign.C.Types (CInt (CInt), CSize (CSize)) -import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) -import LibSodium.Bindings.SecureMemory (sodiumFree, sodiumMalloc) +import Foreign (ForeignPtr, Ptr) +import Foreign qualified +import Foreign.C (CSize, CUChar, throwErrno) +import Foreign.C.Types (CChar) +import LibSodium.Bindings.Comparison (sodiumCompare, sodiumMemcmp) +import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumFree, sodiumMalloc) +import System.IO.Unsafe (unsafeDupablePerformIO) --- | This calls to C's @memcmp@ function, used in lieu of --- libsodium's @memcmp@ in cases when the return code is necessary. -foreign import capi unsafe "string.h memcmp" - memcmp :: Ptr a -> Ptr b -> CSize -> IO CInt +import Sel.Internal.Scoped +import Sel.Internal.Scoped.Foreign --- | Compare if the contents of two @ForeignPtr@s are equal. -foreignPtrEq :: ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool -foreignPtrEq fptr1 fptr2 size = - withForeignPtr fptr1 $ \p -> - withForeignPtr fptr2 $ \q -> - do - result <- memcmp p q size - return $ 0 == result +-- | Compare the contents of two byte arrays for equality in constant time. +-- +-- /See:/ [Constant-time test for equality](https://doc.libsodium.org/helpers#constant-time-test-for-equality) +-- +-- @since 0.0.3.0 +foreignPtrEqConstantTime :: ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Bool +foreignPtrEqConstantTime p q size = + unsafeDupablePerformIO . fmap (== 0) . use $ + sodiumMemcmp <$> foreignPtr p <*> foreignPtr q <*> pure size --- | Compare the contents of two @ForeignPtr@s using lexicographical ordering. -foreignPtrOrd :: ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering -foreignPtrOrd fptr1 fptr2 size = - withForeignPtr fptr1 $ \p -> - withForeignPtr fptr2 $ \q -> - do - result <- memcmp p q size - return $ - if - | result == 0 -> EQ - | result < 0 -> LT - | otherwise -> GT +-- | Lexicographically compare the contents of two byte arrays. +-- +-- ⚠️ Such comparisons are vulnerable to timing attacks, and should be +-- avoided for secret data. +-- +-- @since 0.0.1.0 +foreignPtrOrd :: ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Ordering +foreignPtrOrd p q size = + unsafeDupablePerformIO . fmap (`compare` 0) . useM $ + memcmp + <$> foreignPtr (coerce p) + <*> foreignPtr (coerce q) + <*> pure (fromIntegral size) +-- | Lexicographically compare the contents of two byte arrays in constant time. +-- +-- /See:/ [Comparing large numbers](https://libsodium.gitbook.io/doc/helpers#comparing-large-numbers) +-- +-- @since 0.0.3.0 +foreignPtrOrdConstantTime :: ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Ordering +foreignPtrOrdConstantTime p q size = + unsafeDupablePerformIO . fmap (`compare` 0) . useM $ + sodiumCompare <$> foreignPtr p <*> foreignPtr q <*> pure size + +-- | Compare two byte arrays for lexicographic equality. +-- +-- ⚠️ Such comparisons are vulnerable to timing attacks, and should be +-- avoided for secret data. +-- +-- @since 0.0.1.0 +foreignPtrEq :: ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Bool +foreignPtrEq p q size = foreignPtrOrd p q size == EQ + +-- | Convert a @'ForeignPtr' a@ to a 'ByteString' of the given length +-- and render the hexadecimal-encoded bytes as a 'String'. +-- +-- @since 0.0.1.0 foreignPtrShow :: ForeignPtr a -> CSize -> String -foreignPtrShow fptr size = - BS.unpackChars . Base16.extractBase16 . Base16.encodeBase16' $ - BS.fromForeignPtr (Foreign.castForeignPtr fptr) 0 (fromIntegral @CSize @Int size) +foreignPtrShow (Foreign.castForeignPtr -> cstring) size = + ByteString.unpackChars . Base16.extractBase16 . Base16.encodeBase16' $ + ByteString.fromForeignPtr cstring 0 (fromIntegral @CSize @Int size) + +-- | Copy a byte array to a @libsodium@ pointer. +-- +-- The size of the array is not checked. The input may be truncated if +-- it is too long, or an unchecked exception may be thrown if it is +-- too short. +-- +-- @since 0.0.3.0 +unsafeCopyToSodiumPointer :: CSize -> StrictByteString -> IO (ForeignPtr CUChar) +unsafeCopyToSodiumPointer size s = use $ do + str <- unsafeCString s + lift $ sodiumPointer size $ \k -> + Foreign.copyArray + (Foreign.castPtr @CUChar @CChar k) + str + (fromIntegral @CSize @Int size) + +-- | Allocate secure memory and populate it with the provided action. +-- +-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc' (see notes). +-- +-- A finalizer frees the memory when the key goes out of scope. +-- +-- @since 0.0.3.0 +sodiumPointer :: CSize -> (Ptr CUChar -> IO ()) -> IO (ForeignPtr CUChar) +sodiumPointer size action = do + ptr <- sodiumMalloc size + when (ptr == Foreign.nullPtr) $ do + throwErrno "sodium_malloc" + action ptr + Foreign.newForeignPtr finalizerSodiumFree ptr -- | Securely allocate an amount of memory with 'sodiumMalloc' and pass -- a pointer to the region to the provided action. diff --git a/src/Sel/Internal/Scoped.hs b/src/Sel/Internal/Scoped.hs new file mode 100644 --- /dev/null +++ b/src/Sel/Internal/Scoped.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +-- | +-- Module : Sel.Internal.Scoped +-- Description : Continuation-passing utilities +-- Copyright : (c) Jack Henahan, 2024 +-- License : BSD-3-Clause +-- Maintainer : The Haskell Cryptography Group +-- Portability : GHC only +-- +-- This module implements a version of @Codensity@, modeling delimited +-- continuations. Useful for avoiding extreme rightward drift in +-- chains of @withForeignPtr@ and friends. +module Sel.Internal.Scoped where + +import Control.Monad (ap, void) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Data.Kind (Type) +import Data.Type.Equality (type (~~)) +import GHC.Exts (RuntimeRep, TYPE) + +-- | @since 0.0.3.0 +type Scoped :: forall {k} {rep :: RuntimeRep}. (k -> TYPE rep) -> Type -> Type +newtype Scoped m a = Scoped {runScoped :: forall b. (a -> m b) -> m b} + +-- | @since 0.0.3.0 +instance Functor (Scoped f) where + fmap f (Scoped m) = Scoped $ \k -> m (k . f) + {-# INLINE fmap #-} + +-- | @since 0.0.3.0 +instance Applicative (Scoped f) where + pure a = Scoped $ \k -> k a + {-# INLINE pure #-} + + (<*>) = ap + {-# INLINE (<*>) #-} + +-- | @since 0.0.3.0 +instance Monad (Scoped f) where + Scoped m >>= f = Scoped $ \k -> + m $ \a -> runScoped (f a) k + {-# INLINE (>>=) #-} + +-- | @since 0.0.3.0 +instance (MonadIO m', m' ~~ m) => MonadIO (Scoped m) where + liftIO = lift . liftIO + {-# INLINE liftIO #-} + +-- | @since 0.0.3.0 +instance MonadTrans Scoped where + lift m = Scoped (m >>=) + {-# INLINE lift #-} + +-- | @since 0.0.3.0 +reset :: Monad m => Scoped m a -> Scoped m a +reset = lift . use + +-- | @since 0.0.3.0 +shift :: Applicative m => (forall b. (a -> m b) -> Scoped m b) -> Scoped m a +shift f = Scoped $ use . f + +-- | @since 0.0.3.0 +use :: Applicative m => Scoped m a -> m a +use (Scoped m) = m pure + +-- | @since 0.0.3.0 +useM :: Monad m => Scoped m (m a) -> m a +useM f = use $ f >>= lift + +-- | @since 0.0.3.0 +use_ :: Applicative m => Scoped m a -> m () +use_ = void . use + +-- | @since 0.0.3.0 +useM_ :: Monad m => Scoped m (m a) -> m () +useM_ = void . useM diff --git a/src/Sel/Internal/Scoped/Foreign.hs b/src/Sel/Internal/Scoped/Foreign.hs new file mode 100644 --- /dev/null +++ b/src/Sel/Internal/Scoped/Foreign.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +-- | +-- Module : Sel.Internal.Scoped.Foreign +-- Description : Scoped wrappers around pointer manipulation +-- Copyright : (c) Jack Henahan, 2024 +-- License : BSD-3-Clause +-- Maintainer : The Haskell Cryptography Group +-- Portability : GHC only +-- +-- This module wraps some common points of contact with 'Ptr', +-- 'ForeignPtr', and friends up in 'Scoped' for the sake of not saying +-- 'lift' absolutely everywhere. +module Sel.Internal.Scoped.Foreign where + +import Control.Monad.Trans.Class (lift) +import Data.ByteString (StrictByteString) +import Data.ByteString.Unsafe qualified as ByteString +import Foreign (ForeignPtr, Ptr, Storable) +import Foreign qualified +import Foreign.C (CString, CStringLen) + +import Sel.Internal.Scoped + +-- | @since 0.0.3.0 +foreignPtr :: ForeignPtr a -> Scoped IO (Ptr a) +foreignPtr fptr = Scoped $ Foreign.withForeignPtr fptr + +-- | @since 0.0.3.0 +unsafeCStringLen :: StrictByteString -> Scoped IO CStringLen +unsafeCStringLen bs = Scoped $ ByteString.unsafeUseAsCStringLen bs + +-- | @since 0.0.3.0 +unsafeCString :: StrictByteString -> Scoped IO CString +unsafeCString bs = Scoped $ ByteString.unsafeUseAsCString bs + +-- | @since 0.0.3.0 +mallocBytes :: Int -> Scoped IO (Ptr a) +mallocBytes = lift . Foreign.mallocBytes + +-- | @since 0.0.3.0 +mallocForeignPtrBytes :: Int -> Scoped IO (ForeignPtr a) +mallocForeignPtrBytes len = lift $ Foreign.mallocForeignPtrBytes len + +-- | @since 0.0.3.0 +copyArray :: Storable a => Ptr a -> Ptr a -> Int -> Scoped IO () +copyArray target source len = lift $ Foreign.copyArray target source len diff --git a/src/Sel/Internal/Sodium.hs b/src/Sel/Internal/Sodium.hs new file mode 100644 --- /dev/null +++ b/src/Sel/Internal/Sodium.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +module Sel.Internal.Sodium where + +import Control.Monad.Trans.Class (lift) +import Data.ByteString (StrictByteString) +import Data.ByteString qualified as ByteString +import Foreign (ForeignPtr) +import Foreign.C (CSize, CUChar) +import LibSodium.Bindings.Utils +import System.IO.Unsafe (unsafeDupablePerformIO) + +import Sel.Internal.Scoped +import Sel.Internal.Scoped.Foreign + +-- | Convert a byte array to a hexadecimal-encoded 'StrictByteString' in constant time. +-- +-- /See:/ [@sodium_bin2hex@](https://libsodium.gitbook.io/doc/helpers#hexadecimal-encoding-decoding) +-- +-- @since 0.0.3.0 +binaryToHex :: ForeignPtr CUChar -> CSize -> StrictByteString +binaryToHex fPtr size = unsafeDupablePerformIO . use $ do + let hexLength = size * 2 + 1 + hexPtr <- foreignPtr =<< mallocForeignPtrBytes (fromIntegral hexLength) + ptr <- foreignPtr fPtr + lift $ ByteString.packCString =<< sodiumBin2Hex hexPtr hexLength ptr size diff --git a/src/Sel/PublicKey/Cipher.hs b/src/Sel/PublicKey/Cipher.hs --- a/src/Sel/PublicKey/Cipher.hs +++ b/src/Sel/PublicKey/Cipher.hs @@ -33,12 +33,12 @@ , nonceFromHexByteString , nonceToHexByteString - -- ** Cipher text - , CipherText (..) - , cipherTextFromHexByteString - , cipherTextToHexText - , cipherTextToHexByteString - , cipherTextToBinary + -- ** Ciphertext + , Ciphertext (..) + , ciphertextFromHexByteString + , ciphertextToHexText + , ciphertextToHexByteString + , ciphertextToBinary -- ** Encryption and Decryption , encrypt @@ -49,7 +49,9 @@ , EncryptionError (..) ) where +import Control.Exception import Control.Monad (when) +import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 @@ -57,18 +59,13 @@ import qualified Data.ByteString.Unsafe as BS import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.Builder.Linear as Builder import Data.Text.Display (Display (displayBuilder), OpaqueInstance (..), ShowInstance (..)) -import qualified Data.Text.Lazy.Builder as Builder import Data.Word (Word8) import Foreign (ForeignPtr, Ptr) import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong) import qualified Foreign.C as Foreign -import GHC.IO.Handle.Text (memcpy) -import System.IO.Unsafe (unsafeDupablePerformIO) - -import Control.Exception -import qualified Data.Base16.Types as Base16 import LibSodium.Bindings.CryptoBox ( cryptoBoxEasy , cryptoBoxKeyPair @@ -80,7 +77,10 @@ ) import LibSodium.Bindings.Random (randombytesBuf) import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumFree, sodiumMalloc) +import System.IO.Unsafe (unsafeDupablePerformIO) + import Sel.Internal +import Sel.Internal.Sodium (binaryToHex) -- $introduction -- Public-key authenticated encryption allows a sender to encrypt a confidential message @@ -116,16 +116,14 @@ -- @since 0.0.1.0 instance Eq SecretKey where (SecretKey hk1) == (SecretKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoBoxSecretKeyBytes + foreignPtrEqConstantTime hk1 hk2 cryptoBoxSecretKeyBytes -- | -- -- @since 0.0.1.0 instance Ord SecretKey where compare (SecretKey hk1) (SecretKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoBoxSecretKeyBytes + foreignPtrOrdConstantTime hk1 hk2 cryptoBoxSecretKeyBytes -- | > show secretKey == "[REDACTED]" -- @@ -148,16 +146,14 @@ -- @since 0.0.1.0 instance Eq PublicKey where (PublicKey hk1) == (PublicKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoBoxPublicKeyBytes + foreignPtrEq hk1 hk2 cryptoBoxPublicKeyBytes -- | -- -- @since 0.0.1.0 instance Ord PublicKey where compare (PublicKey hk1) (PublicKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoBoxPublicKeyBytes + foreignPtrOrd hk1 hk2 cryptoBoxPublicKeyBytes -- | -- @@ -251,25 +247,14 @@ action publicKeyPtr secretKeyPtr pure (PublicKey publicKeyForeignPtr, SecretKey secretKeyForeignPtr) --- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 unsafeSecretKeyToHexByteString :: SecretKey -> StrictByteString unsafeSecretKeyToHexByteString (SecretKey secretKeyForeignPtr) = - Base16.extractBase16 . Base16.encodeBase16' $ - BS.fromForeignPtr0 - (Foreign.castForeignPtr @CUChar @Word8 secretKeyForeignPtr) - (fromIntegral @CSize @Int cryptoBoxSecretKeyBytes) - --- - --- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString'. --- --- ⚠️ Be prudent as to where you store it! --- --- @since 0.0.1.0 + binaryToHex secretKeyForeignPtr cryptoBoxSecretKeyBytes -- | A random number that must only be used once per exchanged message. -- It does not have to be confidential. @@ -288,16 +273,14 @@ -- @since 0.0.1.0 instance Eq Nonce where (Nonce hk1) == (Nonce hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoBoxNonceBytes + foreignPtrEq hk1 hk2 cryptoBoxNonceBytes -- | -- -- @since 0.0.1.0 instance Ord Nonce where compare (Nonce hk1) (Nonce hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoBoxNonceBytes + foreignPtrOrd hk1 hk2 cryptoBoxNonceBytes -- | -- @@ -337,113 +320,109 @@ pure $ Right $ Nonce (Foreign.castForeignPtr @CChar @CUChar nonceForeignPtr) Left msg -> pure $ Left msg --- | Convert a 'Nonce' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'Nonce' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 nonceToHexByteString :: Nonce -> StrictByteString nonceToHexByteString (Nonce nonceForeignPtr) = - Base16.extractBase16 . Base16.encodeBase16' $ - BS.fromForeignPtr0 - (Foreign.castForeignPtr @CUChar @Word8 nonceForeignPtr) - (fromIntegral @CSize @Int cryptoBoxNonceBytes) + binaryToHex nonceForeignPtr cryptoBoxNonceBytes -- | A ciphertext consisting of an encrypted message and an authentication tag. -- -- @since 0.0.1.0 -data CipherText = CipherText +data Ciphertext = Ciphertext { messageLength :: CULLong - , cipherTextForeignPtr :: ForeignPtr CUChar + , ciphertextForeignPtr :: ForeignPtr CUChar } -- | -- -- @since 0.0.1.0 -instance Eq CipherText where - (CipherText messageLength1 hk1) == (CipherText messageLength2 hk2) = - unsafeDupablePerformIO $ do - let result1 = messageLength1 == messageLength2 - result2 <- - foreignPtrEq - hk1 - hk2 - (fromIntegral messageLength1) - pure $ result1 && result2 +instance Eq Ciphertext where + (Ciphertext messageLength1 hk1) == (Ciphertext messageLength2 hk2) = + let + messageLength = messageLength1 == messageLength2 + content = foreignPtrEqConstantTime hk1 hk2 (fromIntegral messageLength1) + in + messageLength && content -- | -- -- @since 0.0.1.0 -instance Ord CipherText where - compare (CipherText messageLength1 hk1) (CipherText messageLength2 hk2) = - unsafeDupablePerformIO $ do - let result1 = compare messageLength1 messageLength2 - result2 <- foreignPtrOrd hk1 hk2 (fromIntegral messageLength1 + cryptoBoxMACBytes) - pure $ result1 <> result2 +instance Ord Ciphertext where + compare (Ciphertext messageLength1 hk1) (Ciphertext messageLength2 hk2) = + let + messageLength = compare messageLength1 messageLength2 + content = foreignPtrOrdConstantTime hk1 hk2 (fromIntegral messageLength1 + cryptoBoxMACBytes) + in + messageLength <> content -- | ⚠️ Be prudent as to what you do with it! -- -- @since 0.0.1.0 -instance Display CipherText where - displayBuilder = Builder.fromText . cipherTextToHexText +instance Display Ciphertext where + displayBuilder = Builder.fromText . ciphertextToHexText -- | ⚠️ Be prudent as to what you do with it! -- -- @since 0.0.1.0 -instance Show CipherText where - show = BS.unpackChars . cipherTextToHexByteString +instance Show Ciphertext where + show = BS.unpackChars . ciphertextToHexByteString --- | Create a 'CipherText' from a binary 'StrictByteString' that you have obtained on your own, --- usually from the network or disk. It must be a valid cipherText built from the concatenation +-- | Create a 'Ciphertext' from a binary 'StrictByteString' that you have obtained on your own, +-- usually from the network or disk. It must be a valid ciphertext built from the concatenation -- of the encrypted message and the authentication tag. -- -- The input cipher text, once decoded from base16, must be at least of length -- 'cryptoBoxMACBytes'. -- -- @since 0.0.1.0 -cipherTextFromHexByteString :: StrictByteString -> Either Text CipherText -cipherTextFromHexByteString hexByteString = unsafeDupablePerformIO $ +ciphertextFromHexByteString :: StrictByteString -> Either Text Ciphertext +ciphertextFromHexByteString hexByteString = unsafeDupablePerformIO $ case Base16.decodeBase16Untyped hexByteString of Right bytestring -> if BS.length bytestring >= fromIntegral cryptoBoxMACBytes - then BS.unsafeUseAsCStringLen bytestring $ \(outsideCipherTextPtr, outsideCipherTextLength) -> do - cipherTextForeignPtr <- BS.mallocByteString @CChar outsideCipherTextLength - Foreign.withForeignPtr cipherTextForeignPtr $ \cipherTextPtr -> - Foreign.copyArray cipherTextPtr outsideCipherTextPtr outsideCipherTextLength + then BS.unsafeUseAsCStringLen bytestring $ \(outsideCiphertextPtr, outsideCiphertextLength) -> do + ciphertextForeignPtr <- BS.mallocByteString @CChar outsideCiphertextLength + Foreign.withForeignPtr ciphertextForeignPtr $ \ciphertextPtr -> + Foreign.copyArray ciphertextPtr outsideCiphertextPtr outsideCiphertextLength pure $ Right $ - CipherText - (fromIntegral @Int @CULLong outsideCipherTextLength - fromIntegral @CSize @CULLong cryptoBoxMACBytes) - (Foreign.castForeignPtr @CChar @CUChar cipherTextForeignPtr) + Ciphertext + (fromIntegral @Int @CULLong outsideCiphertextLength - fromIntegral @CSize @CULLong cryptoBoxMACBytes) + (Foreign.castForeignPtr @CChar @CUChar ciphertextForeignPtr) else pure $ Left $ Text.pack "Cipher text is too short" Left msg -> error (Text.unpack msg) --- | Convert a 'CipherText' to a hexadecimal-encoded 'Text'. +-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'Text'. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -cipherTextToHexText :: CipherText -> Text -cipherTextToHexText = Base16.extractBase16 . Base16.encodeBase16 . cipherTextToBinary +ciphertextToHexText :: Ciphertext -> Text +ciphertextToHexText = Base16.extractBase16 . Base16.encodeBase16 . ciphertextToBinary --- | Convert a 'CipherText' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -cipherTextToHexByteString :: CipherText -> StrictByteString -cipherTextToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . cipherTextToBinary +ciphertextToHexByteString :: Ciphertext -> StrictByteString +ciphertextToHexByteString (Ciphertext messageLength fPtr) = + binaryToHex fPtr (cryptoBoxMACBytes + fromIntegral messageLength) --- | Convert a 'CipherText' to a binary 'StrictByteString'. +-- | Convert a 'Ciphertext' to a binary 'StrictByteString'. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -cipherTextToBinary :: CipherText -> StrictByteString -cipherTextToBinary (CipherText messageLength fPtr) = +ciphertextToBinary :: Ciphertext -> StrictByteString +ciphertextToBinary (Ciphertext messageLength fPtr) = BS.fromForeignPtr0 (Foreign.castForeignPtr fPtr) (fromIntegral messageLength + fromIntegral cryptoBoxMACBytes) --- | Create an authenticated 'CipherText' from a message, a 'SecretKey', +-- | Create an authenticated 'Ciphertext' from a message, a 'SecretKey', -- and a one-time cryptographic 'Nonce' that must never be re-used with the same -- secret key to encrypt another message. -- @@ -455,33 +434,33 @@ -- ^ Public key of the recipient -> SecretKey -- ^ Secret key of the sender - -> IO (Nonce, CipherText) + -> IO (Nonce, Ciphertext) encrypt message (PublicKey publicKeyForeignPtr) (SecretKey secretKeyForeignPtr) = BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do (Nonce nonceForeignPtr) <- newNonce - cipherTextForeignPtr <- Foreign.mallocForeignPtrBytes (cStringLen + fromIntegral cryptoBoxMACBytes) - Foreign.withForeignPtr cipherTextForeignPtr $ \cipherTextPtr -> + ciphertextForeignPtr <- Foreign.mallocForeignPtrBytes (cStringLen + fromIntegral cryptoBoxMACBytes) + Foreign.withForeignPtr ciphertextForeignPtr $ \ciphertextPtr -> Foreign.withForeignPtr publicKeyForeignPtr $ \publicKeyPtr -> Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr -> Foreign.withForeignPtr nonceForeignPtr $ \noncePtr -> do result <- cryptoBoxEasy - cipherTextPtr + ciphertextPtr (Foreign.castPtr @CChar @CUChar cString) (fromIntegral @Int @CULLong cStringLen) noncePtr publicKeyPtr secretKeyPtr when (result /= 0) $ throw EncryptionError - let cipherText = CipherText (fromIntegral @Int @CULLong cStringLen) cipherTextForeignPtr - pure (Nonce nonceForeignPtr, cipherText) + let ciphertext = Ciphertext (fromIntegral @Int @CULLong cStringLen) ciphertextForeignPtr + pure (Nonce nonceForeignPtr, ciphertext) --- | Decrypt a 'CipherText' and authenticated message with the shared +-- | Decrypt a 'Ciphertext' and authenticated message with the shared -- secret key and the one-time cryptographic nonce. -- -- @since 0.0.1.0 decrypt - :: CipherText + :: Ciphertext -- ^ Encrypted message you want to decrypt. -> PublicKey -- ^ Public key of the sender. @@ -491,19 +470,19 @@ -- ^ Nonce used for encrypting the original message. -> Maybe StrictByteString decrypt - CipherText{messageLength, cipherTextForeignPtr} + Ciphertext{messageLength, ciphertextForeignPtr} (PublicKey publicKeyForeignPtr) (SecretKey secretKeyForeignPtr) (Nonce nonceForeignPtr) = unsafeDupablePerformIO $ do messagePtr <- Foreign.mallocBytes (fromIntegral @CULLong @Int messageLength) - Foreign.withForeignPtr cipherTextForeignPtr $ \cipherTextPtr -> + Foreign.withForeignPtr ciphertextForeignPtr $ \ciphertextPtr -> Foreign.withForeignPtr publicKeyForeignPtr $ \publicKeyPtr -> Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr -> Foreign.withForeignPtr nonceForeignPtr $ \noncePtr -> do result <- cryptoBoxOpenEasy messagePtr - cipherTextPtr + ciphertextPtr (messageLength + fromIntegral @CSize @CULLong cryptoBoxMACBytes) noncePtr publicKeyPtr @@ -512,10 +491,10 @@ (-1) -> pure Nothing _ -> do bsPtr <- Foreign.mallocBytes (fromIntegral messageLength) - memcpy bsPtr (Foreign.castPtr messagePtr) (fromIntegral messageLength) + Foreign.copyBytes bsPtr messagePtr (fromIntegral messageLength) Just <$> BS.unsafePackMallocCStringLen - (Foreign.castPtr @CChar bsPtr, fromIntegral messageLength) + (Foreign.castPtr @CUChar @CChar bsPtr, fromIntegral messageLength) -- | Exception thrown upon error during the generation of -- the key pair by 'newKeyPair'. diff --git a/src/Sel/PublicKey/Seal.hs b/src/Sel/PublicKey/Seal.hs --- a/src/Sel/PublicKey/Seal.hs +++ b/src/Sel/PublicKey/Seal.hs @@ -38,11 +38,21 @@ import qualified Data.ByteString.Unsafe as BS import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong) -import GHC.IO.Handle.Text (memcpy) +import LibSodium.Bindings.SealedBoxes + ( cryptoBoxSeal + , cryptoBoxSealOpen + , cryptoBoxSealbytes + ) import System.IO.Unsafe (unsafeDupablePerformIO) -import LibSodium.Bindings.SealedBoxes (cryptoBoxSeal, cryptoBoxSealOpen, cryptoBoxSealbytes) -import Sel.PublicKey.Cipher (CipherText (CipherText), EncryptionError (..), KeyPairGenerationException, PublicKey (PublicKey), SecretKey (..), newKeyPair) +import Sel.PublicKey.Cipher + ( Ciphertext (Ciphertext) + , EncryptionError (..) + , KeyPairGenerationException + , PublicKey (PublicKey) + , SecretKey (..) + , newKeyPair + ) -- $introduction -- Ephemeral authenticated encryption allows to anonymously send message to @@ -82,32 +92,32 @@ -- ^ Message to encrypt -> PublicKey -- ^ Public key of the recipient - -> IO CipherText + -> IO Ciphertext seal messageByteString (PublicKey publicKeyFptr) = do BS.unsafeUseAsCStringLen messageByteString $ \(messagePtr, messageLen) -> do - cipherTextForeignPtr <- + ciphertextForeignPtr <- Foreign.mallocForeignPtrBytes (messageLen + fromIntegral cryptoBoxSealbytes) Foreign.withForeignPtr publicKeyFptr $ \publicKeyPtr -> - Foreign.withForeignPtr cipherTextForeignPtr $ \cipherTextPtr -> do + Foreign.withForeignPtr ciphertextForeignPtr $ \ciphertextPtr -> do result <- cryptoBoxSeal - cipherTextPtr + ciphertextPtr (Foreign.castPtr @CChar @CUChar messagePtr) (fromIntegral @Int @CULLong messageLen) publicKeyPtr when (result /= 0) $ throw EncryptionError pure $ - CipherText + Ciphertext (fromIntegral @Int @CULLong messageLen) - cipherTextForeignPtr + ciphertextForeignPtr -- | Open a sealed message from an unknown sender. -- You need your public and secret keys. -- -- @since 0.0.1.0 open - :: CipherText + :: Ciphertext -- ^ Cipher to decrypt -> PublicKey -- ^ Public key of the recipient @@ -115,17 +125,17 @@ -- ^ Secret key of the recipient -> Maybe StrictByteString open - (CipherText messageLen cipherForeignPtr) + (Ciphertext messageLen cipherForeignPtr) (PublicKey publicKeyFPtr) (SecretKey secretKeyFPtr) = unsafeDupablePerformIO $ do messagePtr <- Foreign.mallocBytes (fromIntegral @CULLong @Int messageLen) - Foreign.withForeignPtr cipherForeignPtr $ \cipherTextPtr -> + Foreign.withForeignPtr cipherForeignPtr $ \ciphertextPtr -> Foreign.withForeignPtr publicKeyFPtr $ \publicKeyPtr -> Foreign.withForeignPtr secretKeyFPtr $ \secretKeyPtr -> do result <- cryptoBoxSealOpen messagePtr - cipherTextPtr + ciphertextPtr (messageLen + fromIntegral @CSize @CULLong cryptoBoxSealbytes) publicKeyPtr secretKeyPtr @@ -133,7 +143,7 @@ (-1) -> pure Nothing _ -> do bsPtr <- Foreign.mallocBytes (fromIntegral messageLen) - memcpy bsPtr (Foreign.castPtr messagePtr) (fromIntegral messageLen) + Foreign.copyBytes bsPtr messagePtr (fromIntegral messageLen) Just <$> BS.unsafePackMallocCStringLen - (Foreign.castPtr @CChar bsPtr, fromIntegral messageLen) + (Foreign.castPtr @CUChar @CChar bsPtr, fromIntegral messageLen) diff --git a/src/Sel/PublicKey/Signature.hs b/src/Sel/PublicKey/Signature.hs --- a/src/Sel/PublicKey/Signature.hs +++ b/src/Sel/PublicKey/Signature.hs @@ -48,8 +48,6 @@ import qualified Foreign.Marshal.Array as Foreign import qualified Foreign.Ptr as Foreign import GHC.IO.Handle.Text (memcpy) -import System.IO.Unsafe (unsafeDupablePerformIO) - import LibSodium.Bindings.CryptoSign ( cryptoSignBytes , cryptoSignDetached @@ -58,6 +56,8 @@ , cryptoSignSecretKeyBytes , cryptoSignVerifyDetached ) +import System.IO.Unsafe (unsafeDupablePerformIO) + import Sel.Internal -- $introduction @@ -81,16 +81,14 @@ -- @since 0.0.1.0 instance Eq PublicKey where (PublicKey pk1) == (PublicKey pk2) = - unsafeDupablePerformIO $ - foreignPtrEq pk1 pk2 cryptoSignPublicKeyBytes + foreignPtrEq pk1 pk2 cryptoSignPublicKeyBytes -- | -- -- @since 0.0.1.0 instance Ord PublicKey where compare (PublicKey pk1) (PublicKey pk2) = - unsafeDupablePerformIO $ - foreignPtrOrd pk1 pk2 cryptoSignPublicKeyBytes + foreignPtrOrd pk1 pk2 cryptoSignPublicKeyBytes -- | -- @@ -102,16 +100,14 @@ -- @since 0.0.1.0 instance Eq SecretKey where (SecretKey sk1) == (SecretKey sk2) = - unsafeDupablePerformIO $ - foreignPtrEq sk1 sk2 cryptoSignSecretKeyBytes + foreignPtrEqConstantTime sk1 sk2 cryptoSignSecretKeyBytes -- | -- -- @since 0.0.1.0 instance Ord SecretKey where compare (SecretKey sk1) (SecretKey sk2) = - unsafeDupablePerformIO $ - foreignPtrOrd sk1 sk2 cryptoSignSecretKeyBytes + foreignPtrOrd sk1 sk2 cryptoSignSecretKeyBytes -- | -- @@ -127,20 +123,24 @@ -- @since 0.0.1.0 instance Eq SignedMessage where (SignedMessage len1 msg1 sig1) == (SignedMessage len2 msg2 sig2) = - unsafeDupablePerformIO $ do - result1 <- foreignPtrEq msg1 msg2 len1 - result2 <- foreignPtrEq sig1 sig2 cryptoSignBytes - return $ (len1 == len2) && result1 && result2 + let + messageLength = len1 == len2 + msg1Eq = foreignPtrEq msg1 msg2 len1 + msg2Eq = foreignPtrEq sig1 sig2 cryptoSignBytes + in + messageLength && msg1Eq && msg2Eq -- | -- -- @since 0.0.1.0 instance Ord SignedMessage where compare (SignedMessage len1 msg1 sig1) (SignedMessage len2 msg2 sig2) = - unsafeDupablePerformIO $ do - result1 <- foreignPtrOrd msg1 msg2 len1 - result2 <- foreignPtrOrd sig1 sig2 cryptoSignBytes - return $ compare len1 len2 <> result1 <> result2 + let + messageLength = compare len1 len2 + msg1Ord = foreignPtrOrd msg1 msg2 len1 + msg2Ord = foreignPtrOrd sig1 sig2 cryptoSignBytes + in + messageLength <> msg1Ord <> msg2Ord -- | Generate a pair of public and secret key. -- @@ -161,6 +161,15 @@ pure (PublicKey publicKeyForeignPtr, SecretKey secretKeyForeignPtr) -- | Sign a message. +-- +-- Note that, if @libsodium@ is compiled with the @ED25519_NONDETERMINISTIC@ +-- macro defined, this function will produce non-deterministic (but also +-- non-standard) Ed25519 signatures. If @libsodium@ hasn't been compiled with +-- the @ED25519_NONDETERMINISTIC@ macro defined, it's safe to call this +-- function in a pure context with 'unsafeDupablePerformIO'. +-- +-- For more information, see the +-- [@libsodium@ docs](https://doc.libsodium.org/public-key_cryptography/public-key_signatures#notes). -- -- @since 0.0.1.0 signMessage :: StrictByteString -> SecretKey -> IO SignedMessage diff --git a/src/Sel/Scrypt.hs b/src/Sel/Scrypt.hs --- a/src/Sel/Scrypt.hs +++ b/src/Sel/Scrypt.hs @@ -31,14 +31,15 @@ import qualified Data.ByteString.Internal as BS import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Data.Text as Text +import qualified Data.Text.Builder.Linear as Builder import Data.Text.Display import qualified Data.Text.Encoding as Text -import qualified Data.Text.Lazy.Builder as Builder import Foreign hiding (void) import Foreign.C import LibSodium.Bindings.Scrypt + import Sel.Internal -import System.IO.Unsafe (unsafeDupablePerformIO) +import Sel.Internal.Sodium (binaryToHex) -- $introduction -- @@ -54,14 +55,18 @@ -- | @since 0.0.1.0 instance Eq ScryptHash where (ScryptHash sh1) == (ScryptHash sh2) = - unsafeDupablePerformIO $ - foreignPtrEq sh1 sh2 cryptoPWHashScryptSalsa208SHA256StrBytes + foreignPtrEq + (Foreign.castForeignPtr @CChar @CUChar sh1) + (Foreign.castForeignPtr @CChar @CUChar sh2) + cryptoPWHashScryptSalsa208SHA256StrBytes -- | @since 0.0.1.0 instance Ord ScryptHash where compare (ScryptHash sh1) (ScryptHash sh2) = - unsafeDupablePerformIO $ - foreignPtrOrd sh1 sh2 cryptoPWHashScryptSalsa208SHA256StrBytes + foreignPtrOrd + (Foreign.castForeignPtr @CChar @CUChar sh1) + (Foreign.castForeignPtr @CChar @CUChar sh2) + cryptoPWHashScryptSalsa208SHA256StrBytes -- | @since 0.0.1.0 instance Show ScryptHash where @@ -112,12 +117,12 @@ (fromIntegral cStringLen) return (result == 0) --- | Convert a 'ScryptHash' to a binary 'StrictByteString'. +-- | Convert a 'ScryptHash' to a binary 'StrictByteString' in constant time. -- -- @since 0.0.1.0 scryptHashToByteString :: ScryptHash -> StrictByteString scryptHashToByteString (ScryptHash fPtr) = - BS.fromForeignPtr0 (Foreign.castForeignPtr fPtr) (fromIntegral @CSize @Int cryptoPWHashScryptSalsa208SHA256StrBytes) + binaryToHex (Foreign.castForeignPtr @CChar @CUChar fPtr) cryptoPWHashScryptSalsa208SHA256StrBytes -- | Convert a 'ScryptHash' to a hexadecimal-encoded 'Text'. -- diff --git a/src/Sel/SecretKey/Authentication.hs b/src/Sel/SecretKey/Authentication.hs --- a/src/Sel/SecretKey/Authentication.hs +++ b/src/Sel/SecretKey/Authentication.hs @@ -33,7 +33,6 @@ ) where import Control.Monad (void, when) -import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 @@ -42,12 +41,9 @@ import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Display (Display, OpaqueInstance (..), ShowInstance (..)) -import Data.Word (Word8) import Foreign (ForeignPtr) import qualified Foreign -import Foreign.C (CChar, CSize, CUChar, CULLong, throwErrno) -import System.IO.Unsafe (unsafeDupablePerformIO) - +import Foreign.C (CChar, CUChar, CULLong, throwErrno) import LibSodium.Bindings.CryptoAuth ( cryptoAuth , cryptoAuthBytes @@ -56,7 +52,10 @@ , cryptoAuthVerify ) import LibSodium.Bindings.SecureMemory +import System.IO.Unsafe (unsafeDupablePerformIO) + import Sel.Internal +import Sel.Internal.Sodium (binaryToHex) -- $introduction -- The 'authenticate' function computes an authentication tag for a message and a secret key, @@ -77,7 +76,7 @@ -- > authKey <- Auth.newAuthenticationKey -- > -- An authentication tag is computed for the message by the server -- > let message = "Hello, world!" --- > tag <- Auth.authenticate message +-- > tag = Auth.authenticate message -- > -- The server sends the message and its authentication tag -- > -- […] -- > -- The recipient of the message uses the shared secret to validate the message's tag @@ -92,9 +91,9 @@ -- ^ Message to authenticate -> AuthenticationKey -- ^ Secret key for authentication - -> IO AuthenticationTag + -> AuthenticationTag -- ^ Cryptographic tag for authentication -authenticate message (AuthenticationKey authenticationKeyForeignPtr) = +authenticate message (AuthenticationKey authenticationKeyForeignPtr) = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do authenticationTagForeignPtr <- Foreign.mallocForeignPtrBytes @@ -145,16 +144,14 @@ -- @since 0.0.1.0 instance Eq AuthenticationKey where (AuthenticationKey hk1) == (AuthenticationKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoAuthKeyBytes + foreignPtrEqConstantTime hk1 hk2 cryptoAuthKeyBytes -- | -- -- @since 0.0.1.0 instance Ord AuthenticationKey where compare (AuthenticationKey hk1) (AuthenticationKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoAuthKeyBytes + foreignPtrOrdConstantTime hk1 hk2 cryptoAuthKeyBytes -- | > show authenticationKey == "[REDACTED]" -- @@ -206,17 +203,14 @@ else pure $ Left $ Text.pack "Authentication Key is too short" Left msg -> pure $ Left msg --- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString unsafeAuthenticationKeyToHexByteString (AuthenticationKey authenticationKeyForeignPtr) = - Base16.extractBase16 . Base16.encodeBase16' $ - BS.fromForeignPtr0 - (Foreign.castForeignPtr @CUChar @Word8 authenticationKeyForeignPtr) - (fromIntegral @CSize @Int cryptoAuthKeyBytes) + binaryToHex authenticationKeyForeignPtr cryptoAuthKeyBytes -- | A secret authentication key of size 'cryptoAuthBytes'. -- @@ -233,16 +227,14 @@ -- @since 0.0.1.0 instance Eq AuthenticationTag where (AuthenticationTag hk1) == (AuthenticationTag hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoAuthBytes + foreignPtrEqConstantTime hk1 hk2 cryptoAuthBytes -- | -- -- @since 0.0.1.0 instance Ord AuthenticationTag where compare (AuthenticationTag hk1) (AuthenticationTag hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoAuthBytes + foreignPtrOrdConstantTime hk1 hk2 cryptoAuthBytes -- | -- @@ -250,16 +242,12 @@ instance Show AuthenticationTag where show = BS.unpackChars . authenticationTagToHexByteString --- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString authenticationTagToHexByteString (AuthenticationTag fPtr) = - Base16.extractBase16 $ - Base16.encodeBase16' $ - BS.fromForeignPtr0 - (Foreign.castForeignPtr fPtr) - (fromIntegral cryptoAuthBytes) + binaryToHex fPtr cryptoAuthBytes -- | Create an 'AuthenticationTag' from a binary 'StrictByteString' that you have obtained on your own, -- usually from the network or disk. diff --git a/src/Sel/SecretKey/Cipher.hs b/src/Sel/SecretKey/Cipher.hs --- a/src/Sel/SecretKey/Cipher.hs +++ b/src/Sel/SecretKey/Cipher.hs @@ -34,12 +34,12 @@ , nonceFromHexByteString , nonceToHexByteString - -- ** Hash - , Hash - , hashFromHexByteString - , hashToBinary - , hashToHexByteString - , hashToHexText + -- ** Ciphertext + , Ciphertext + , ciphertextFromHexByteString + , ciphertextToBinary + , ciphertextToHexByteString + , ciphertextToHexText ) where import Control.Monad (void, when) @@ -51,15 +51,12 @@ import qualified Data.ByteString.Unsafe as BS import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.Builder.Linear as Builder import Data.Text.Display (Display (displayBuilder), OpaqueInstance (..), ShowInstance (..)) -import qualified Data.Text.Lazy.Builder as Builder import Data.Word (Word8) import Foreign (ForeignPtr) import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong, throwErrno) -import GHC.IO.Handle.Text (memcpy) -import System.IO.Unsafe (unsafeDupablePerformIO) - import LibSodium.Bindings.Random (randombytesBuf) import LibSodium.Bindings.Secretbox ( cryptoSecretboxEasy @@ -70,12 +67,15 @@ , cryptoSecretboxOpenEasy ) import LibSodium.Bindings.SecureMemory +import System.IO.Unsafe (unsafeDupablePerformIO) + import Sel.Internal +import Sel.Internal.Sodium (binaryToHex) -- $introduction -- "Authenticated Encryption" uses a secret key along with a single-use number -- called a "nonce" to encrypt a message. --- The resulting hash is accompanied by an authentication tag. +-- The resulting ciphertext is accompanied by an authentication tag. -- -- Encryption is done with the XSalsa20 stream cipher and authentication is done with the -- Poly1305 MAC hash. @@ -110,16 +110,14 @@ -- @since 0.0.1.0 instance Eq SecretKey where (SecretKey hk1) == (SecretKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoSecretboxKeyBytes + foreignPtrEqConstantTime hk1 hk2 cryptoSecretboxKeyBytes -- | -- -- @since 0.0.1.0 instance Ord SecretKey where compare (SecretKey hk1) (SecretKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoSecretboxKeyBytes + foreignPtrOrdConstantTime hk1 hk2 cryptoSecretboxKeyBytes -- | > show secretKey == "[REDACTED]" -- @@ -171,17 +169,14 @@ action ptr pure $ SecretKey fPtr --- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 unsafeSecretKeyToHexByteString :: SecretKey -> StrictByteString unsafeSecretKeyToHexByteString (SecretKey secretKeyForeignPtr) = - Base16.extractBase16 . Base16.encodeBase16' $ - BS.fromForeignPtr0 - (Foreign.castForeignPtr @CUChar @Word8 secretKeyForeignPtr) - (fromIntegral @CSize @Int cryptoSecretboxKeyBytes) + binaryToHex secretKeyForeignPtr cryptoSecretboxKeyBytes -- | A random number that must only be used once per exchanged message. -- It does not have to be confidential. @@ -200,16 +195,14 @@ -- @since 0.0.1.0 instance Eq Nonce where (Nonce hk1) == (Nonce hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoSecretboxNonceBytes + foreignPtrEq hk1 hk2 cryptoSecretboxNonceBytes -- | -- -- @since 0.0.1.0 instance Ord Nonce where compare (Nonce hk1) (Nonce hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoSecretboxNonceBytes + foreignPtrOrd hk1 hk2 cryptoSecretboxNonceBytes -- | -- @@ -220,7 +213,7 @@ -- | Generate a new random nonce. -- Only use it once per exchanged message. -- --- Do not use this outside of hash creation! +-- Do not use this outside of ciphertext creation! newNonce :: IO Nonce newNonce = do (fPtr :: ForeignPtr CUChar) <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoSecretboxNonceBytes) @@ -252,111 +245,118 @@ else pure $ Left $ Text.pack "Nonce is too short" Left msg -> pure $ Left msg --- | Convert a 'Nonce' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'Nonce' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 nonceToHexByteString :: Nonce -> StrictByteString nonceToHexByteString (Nonce nonceForeignPtr) = - Base16.extractBase16 . Base16.encodeBase16' $ - BS.fromForeignPtr0 - (Foreign.castForeignPtr @CUChar @Word8 nonceForeignPtr) - (fromIntegral @CSize @Int cryptoSecretboxNonceBytes) + binaryToHex nonceForeignPtr cryptoSecretboxNonceBytes -- | A ciphertext consisting of an encrypted message and an authentication tag. -- -- @since 0.0.1.0 -data Hash = Hash +data Ciphertext = Ciphertext { messageLength :: CULLong - , hashForeignPtr :: ForeignPtr CUChar + , ciphertextForeignPtr :: ForeignPtr CUChar } -- | -- -- @since 0.0.1.0 -instance Eq Hash where - (Hash messageLength1 hk1) == (Hash messageLength2 hk2) = - unsafeDupablePerformIO $ do - result1 <- - foreignPtrEq +instance Eq Ciphertext where + (Ciphertext messageLength1 hk1) == (Ciphertext messageLength2 hk2) = + let + messageLength = messageLength1 == messageLength2 + content = + foreignPtrEqConstantTime hk1 hk2 (fromIntegral messageLength1 + cryptoSecretboxMACBytes) - pure $ (messageLength1 == messageLength2) && result1 + in + messageLength && content -- | -- -- @since 0.0.1.0 -instance Ord Hash where - compare (Hash messageLength1 hk1) (Hash messageLength2 hk2) = - unsafeDupablePerformIO $ do - result1 <- foreignPtrOrd hk1 hk2 (fromIntegral messageLength1 + cryptoSecretboxMACBytes) - pure $ compare messageLength1 messageLength2 <> result1 +instance Ord Ciphertext where + compare (Ciphertext messageLength1 hk1) (Ciphertext messageLength2 hk2) = + let + messageLength = compare messageLength1 messageLength2 + content = + foreignPtrOrdConstantTime + hk1 + hk2 + (fromIntegral messageLength1 + cryptoSecretboxMACBytes) + in + messageLength <> content -- | ⚠️ Be prudent as to what you do with it! -- -- @since 0.0.1.0 -instance Display Hash where - displayBuilder = Builder.fromText . hashToHexText +instance Display Ciphertext where + displayBuilder = Builder.fromText . ciphertextToHexText -- | ⚠️ Be prudent as to what you do with it! -- -- @since 0.0.1.0 -instance Show Hash where - show = BS.unpackChars . hashToHexByteString +instance Show Ciphertext where + show = BS.unpackChars . ciphertextToHexByteString --- | Create a 'Hash' from a binary 'StrictByteString' that you have obtained on your own, --- usually from the network or disk. It must be a valid hash built from the concatenation --- of the encrypted message and the authentication tag. +-- | Create a 'Ciphertext' from a hexadecimal-encoded 'StrictByteString' that +-- you have obtained on your own, usually from the network or disk. It must be +-- a valid ciphertext built from the concatenation of the encrypted message and +-- the authentication tag. -- --- The input hash must at least of length 'cryptoSecretboxMACBytes' +-- The input ciphertext must at least of length 'cryptoSecretboxMACBytes'. -- -- @since 0.0.1.0 -hashFromHexByteString :: StrictByteString -> Either Text Hash -hashFromHexByteString hexHash = unsafeDupablePerformIO $ - case Base16.decodeBase16Untyped hexHash of +ciphertextFromHexByteString :: StrictByteString -> Either Text Ciphertext +ciphertextFromHexByteString hexCiphertext = unsafeDupablePerformIO $ + case Base16.decodeBase16Untyped hexCiphertext of Right bytestring -> if BS.length bytestring >= fromIntegral cryptoSecretboxMACBytes - then BS.unsafeUseAsCStringLen bytestring $ \(outsideHashPtr, outsideHashLength) -> do - hashForeignPtr <- BS.mallocByteString @CChar outsideHashLength -- The foreign pointer that will receive the hash data. - Foreign.withForeignPtr hashForeignPtr $ \hashPtr -> - -- We copy bytes from 'outsideHashPtr' to 'hashPtr'. - Foreign.copyArray hashPtr outsideHashPtr outsideHashLength + then BS.unsafeUseAsCStringLen bytestring $ \(outsideCiphertextPtr, outsideCiphertextLength) -> do + ciphertextForeignPtr <- BS.mallocByteString @CChar outsideCiphertextLength -- The foreign pointer that will receive the ciphertext data. + Foreign.withForeignPtr ciphertextForeignPtr $ \ciphertextPtr -> + -- We copy bytes from 'outsideCiphertextPtr' to 'ciphertextPtr'. + Foreign.copyArray ciphertextPtr outsideCiphertextPtr outsideCiphertextLength pure $ Right $ - Hash - (fromIntegral @Int @CULLong outsideHashLength - fromIntegral @CSize @CULLong cryptoSecretboxMACBytes) - (Foreign.castForeignPtr @CChar @CUChar hashForeignPtr) - else pure $ Left $ Text.pack "Hash is too short" + Ciphertext + (fromIntegral @Int @CULLong outsideCiphertextLength - fromIntegral @CSize @CULLong cryptoSecretboxMACBytes) + (Foreign.castForeignPtr @CChar @CUChar ciphertextForeignPtr) + else pure $ Left $ Text.pack "Ciphertext is too short" Left msg -> pure $ Left msg --- | Convert a 'Hash' to a hexadecimal-encoded 'Text'. +-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'Text'. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -hashToHexText :: Hash -> Text -hashToHexText = Base16.extractBase16 . Base16.encodeBase16 . hashToBinary +ciphertextToHexText :: Ciphertext -> Text +ciphertextToHexText = Base16.extractBase16 . Base16.encodeBase16 . ciphertextToBinary --- | Convert a 'Hash' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -hashToHexByteString :: Hash -> StrictByteString -hashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . hashToBinary +ciphertextToHexByteString :: Ciphertext -> StrictByteString +ciphertextToHexByteString (Ciphertext messageLength fPtr) = + binaryToHex fPtr (cryptoSecretboxMACBytes + fromIntegral messageLength) --- | Convert a 'Hash' to a binary 'StrictByteString'. +-- | Convert a 'Ciphertext' to a binary 'StrictByteString'. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -hashToBinary :: Hash -> StrictByteString -hashToBinary (Hash messageLength fPtr) = +ciphertextToBinary :: Ciphertext -> StrictByteString +ciphertextToBinary (Ciphertext messageLength fPtr) = BS.fromForeignPtr0 (Foreign.castForeignPtr fPtr) (fromIntegral messageLength + fromIntegral cryptoSecretboxMACBytes) --- | Create an authenticated hash from a message, a secret key, +-- | Create an authenticated ciphertext from a message, a secret key, -- and a one-time cryptographic nonce that must never be re-used with the same -- secret key to encrypt another message. -- @@ -366,46 +366,46 @@ -- ^ Message to encrypt. -> SecretKey -- ^ Secret key generated with 'newSecretKey'. - -> IO (Nonce, Hash) + -> IO (Nonce, Ciphertext) encrypt message (SecretKey secretKeyForeignPtr) = BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do (Nonce nonceForeignPtr) <- newNonce - hashForeignPtr <- + ciphertextForeignPtr <- Foreign.mallocForeignPtrBytes (cStringLen + fromIntegral cryptoSecretboxMACBytes) - Foreign.withForeignPtr hashForeignPtr $ \hashPtr -> + Foreign.withForeignPtr ciphertextForeignPtr $ \ciphertextPtr -> Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr -> Foreign.withForeignPtr nonceForeignPtr $ \noncePtr -> do void $ cryptoSecretboxEasy - hashPtr + ciphertextPtr (Foreign.castPtr @CChar @CUChar cString) (fromIntegral @Int @CULLong cStringLen) noncePtr secretKeyPtr - let hash = Hash (fromIntegral @Int @CULLong cStringLen) hashForeignPtr - pure (Nonce nonceForeignPtr, hash) + let ciphertext = Ciphertext (fromIntegral @Int @CULLong cStringLen) ciphertextForeignPtr + pure (Nonce nonceForeignPtr, ciphertext) --- | Decrypt a hashed and authenticated message with the shared secret key and the one-time cryptographic nonce. +-- | Decrypt an encrypted and authenticated message with the shared secret key and the one-time cryptographic nonce. -- -- @since 0.0.1.0 decrypt - :: Hash + :: Ciphertext -- ^ Encrypted message you want to decrypt. -> SecretKey -- ^ Secret key used for encrypting the original message. -> Nonce -- ^ Nonce used for encrypting the original message. -> Maybe StrictByteString -decrypt Hash{messageLength, hashForeignPtr} (SecretKey secretKeyForeignPtr) (Nonce nonceForeignPtr) = unsafeDupablePerformIO $ do +decrypt Ciphertext{messageLength, ciphertextForeignPtr} (SecretKey secretKeyForeignPtr) (Nonce nonceForeignPtr) = unsafeDupablePerformIO $ do messagePtr <- Foreign.mallocBytes (fromIntegral @CULLong @Int messageLength) - Foreign.withForeignPtr hashForeignPtr $ \hashPtr -> + Foreign.withForeignPtr ciphertextForeignPtr $ \ciphertextPtr -> Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr -> Foreign.withForeignPtr nonceForeignPtr $ \noncePtr -> do result <- cryptoSecretboxOpenEasy messagePtr - hashPtr + ciphertextPtr (messageLength + fromIntegral cryptoSecretboxMACBytes) noncePtr secretKeyPtr @@ -413,7 +413,7 @@ (-1) -> pure Nothing _ -> do bsPtr <- Foreign.mallocBytes (fromIntegral messageLength) - memcpy bsPtr (Foreign.castPtr messagePtr) (fromIntegral messageLength) + Foreign.copyBytes bsPtr messagePtr (fromIntegral messageLength) Just <$> BS.unsafePackMallocCStringLen - (Foreign.castPtr @CChar bsPtr, fromIntegral messageLength) + (Foreign.castPtr @CUChar @CChar bsPtr, fromIntegral messageLength) diff --git a/src/Sel/SecretKey/Stream.hs b/src/Sel/SecretKey/Stream.hs --- a/src/Sel/SecretKey/Stream.hs +++ b/src/Sel/SecretKey/Stream.hs @@ -12,7 +12,7 @@ -- | -- -- Module: Sel.SecretKey.Stream --- Description: Encrypted Streams with ChaCha20Poly1305 +-- Description: Encrypted Streams with XChaCha20-Poly1305 -- Copyright: (C) Hécate Moonlight 2024 -- License: BSD-3-Clause -- Maintainer: The Haskell Cryptography Group @@ -51,8 +51,16 @@ -- ** Message Tags , MessageTag (..) - -- ** CipherText - , CipherText + -- ** Additional data (AD) + , AdditionalData (..) + , AdditionalDataHexDecodingError (..) + , additionalDataFromHexByteString + , additionalDataToBinary + , additionalDataToHexByteString + , additionalDataToHexText + + -- ** Ciphertext + , Ciphertext , ciphertextFromHexByteString , ciphertextToBinary , ciphertextToHexByteString @@ -78,15 +86,12 @@ import qualified Data.List as List import Data.Text (Text) import qualified Data.Text as Text -import Data.Text.Display (Display (..), OpaqueInstance (..)) -import qualified Data.Text.Lazy.Builder as Builder -import Data.Word (Word8) +import qualified Data.Text.Builder.Linear as Builder +import Data.Text.Display (Display (..), OpaqueInstance (..), ShowInstance (..)) import Foreign (ForeignPtr, Ptr) import qualified Foreign import Foreign.C (CChar, CSize, CUChar, CULLong) import Foreign.C.Error (throwErrno) -import System.IO.Unsafe (unsafeDupablePerformIO) - import LibSodium.Bindings.SecretStream ( CryptoSecretStreamXChaCha20Poly1305State , cryptoSecretStreamXChaCha20Poly1305ABytes @@ -104,7 +109,10 @@ , cryptoSecretStreamXChaCha20Poly1305TagRekey ) import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc) +import System.IO.Unsafe (unsafeDupablePerformIO) + import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd) +import Sel.Internal.Sodium (binaryToHex) -- $introduction -- This high-level API encrypts a sequence of messages, or a single message split into an arbitrary number of chunks, using a secret key, with the following properties: @@ -121,15 +129,15 @@ -- $usage -- -- >>> secretKey <- Stream.newSecretKey --- >>> (header, cipherTexts) <- Stream.encryptStream secretKey $ \multipartState -> do -- we are in MonadIO +-- >>> (header, ciphertexts) <- Stream.encryptStream secretKey $ \multipartState -> do -- we are in MonadIO -- ... message1 <- getMessage -- This is your way to fetch a message from outside -- ... encryptedChunk1 <- Stream.encryptChunk multipartState Stream.messag message1 -- ... message2 <- getMessage -- ... encryptedChunk2 <- Stream.encryptChunk multipartState Stream.Final message2 -- ... pure [encryptedChunk1, encryptedChunk2] -- >>> result <- Stream.decryptStream secretKey header $ \multipartState-> do --- ... forM encryptedMessages $ \cipherText -> do --- ... decryptChunk multipartState cipherText +-- ... forM encryptedMessages $ \ciphertext -> do +-- ... decryptChunk multipartState ciphertext -- | 'Multipart' is the cryptographic context for stream encryption. -- @@ -138,7 +146,7 @@ type role Multipart nominal --- | Perform streaming hashing with a 'Multipart' cryptographic context. +-- | Perform streaming encryption with a 'Multipart' cryptographic context. -- -- Use 'Stream.encryptChunk' within the continuation. -- @@ -184,41 +192,47 @@ -- ^ Cryptographic context -> MessageTag -- ^ Tag that will be associated with the message. See the documentation of 'MessageTag' to know which to choose when. + -> Maybe AdditionalData + -- ^ Additional data (AD) to be authenticated. -> StrictByteString -- ^ Message to encrypt. - -> m CipherText -encryptChunk (Multipart statePtr) messageTag message = liftIO $ BSU.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do - let messagePtr = Foreign.castPtr @CChar @CUChar cString - let messageLen = fromIntegral @Int @CULLong cStringLen - cipherTextFPtr <- Foreign.mallocForeignPtrBytes (cStringLen + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes) - Foreign.withForeignPtr cipherTextFPtr $ \cipherTextBuffer -> do - result <- - cryptoSecretStreamXChaCha20Poly1305Push - statePtr - cipherTextBuffer - Foreign.nullPtr -- default size of messageLen + 'cryptoSecretStreamXChaCha20Poly1305ABytes' - messagePtr - messageLen - Foreign.nullPtr -- No additional data - 0 -- No additional data size - (messageTagToConstant messageTag) - when (result /= 0) $ throw StreamEncryptionException - pure $ CipherText (fromIntegral cStringLen) cipherTextFPtr + -> m Ciphertext +encryptChunk (Multipart statePtr) messageTag mbAd message = liftIO $ + BSU.unsafeUseAsCStringLen message $ \(messageCString, messageCStringLen) -> + BSU.unsafeUseAsCStringLen (maybe BS.empty additionalDataToBinary mbAd) $ \(adCString, adCStringLen) -> do + let messagePtr = Foreign.castPtr @CChar @CUChar messageCString + messageLen = fromIntegral @Int @CULLong messageCStringLen + adPtr = Foreign.castPtr @CChar @CUChar adCString + adLen = fromIntegral @Int @CULLong adCStringLen + ciphertextFPtr <- Foreign.mallocForeignPtrBytes (messageCStringLen + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes) + Foreign.withForeignPtr ciphertextFPtr $ \ciphertextBuffer -> do + result <- + cryptoSecretStreamXChaCha20Poly1305Push + statePtr + ciphertextBuffer + Foreign.nullPtr -- default size of messageLen + 'cryptoSecretStreamXChaCha20Poly1305ABytes' + messagePtr + messageLen + adPtr + adLen + (messageTagToConstant messageTag) + when (result /= 0) $ throw StreamEncryptionException + pure $ Ciphertext (fromIntegral messageCStringLen) ciphertextFPtr -- | Perform streaming encryption of a finite list. -- -- This function can throw 'StreamEncryptionException' upon an error in the underlying implementation. -- -- @since 0.0.1.0 -encryptList :: forall m. MonadIO m => SecretKey -> [StrictByteString] -> m (Header, [CipherText]) +encryptList :: forall m. MonadIO m => SecretKey -> [(Maybe AdditionalData, StrictByteString)] -> m (Header, [Ciphertext]) encryptList secretKey messages = encryptStream secretKey $ \multipart -> go multipart messages [] where - go :: Multipart s -> [StrictByteString] -> [CipherText] -> m [CipherText] - go multipart [lastMsg] acc = do - encryptedChunk <- encryptChunk multipart Final lastMsg + go :: Multipart s -> [(Maybe AdditionalData, StrictByteString)] -> [Ciphertext] -> m [Ciphertext] + go multipart [(mbLastAd, lastMsg)] acc = do + encryptedChunk <- encryptChunk multipart Final mbLastAd lastMsg pure $ List.reverse $ encryptedChunk : acc - go multipart (msg : rest) acc = do - encryptedChunk <- encryptChunk multipart Message msg + go multipart ((mbAd, msg) : rest) acc = do + encryptedChunk <- encryptChunk multipart Message mbAd msg go multipart rest (encryptedChunk : acc) go _ [] acc = pure acc @@ -264,41 +278,46 @@ . MonadIO m => Multipart s -- ^ Cryptographic context - -> CipherText + -> Maybe AdditionalData + -- ^ Additional data (AD) to be authenticated. + -> Ciphertext -- ^ Encrypted message portion to decrypt -> m StrictByteString -- ^ Decrypted message portion -decryptChunk (Multipart statePtr) CipherText{messageLength, cipherTextForeignPtr} = do +decryptChunk (Multipart statePtr) mbAd Ciphertext{messageLength, ciphertextForeignPtr} = do clearTextForeignPtr <- liftIO $ Foreign.mallocForeignPtrBytes (fromIntegral messageLength) - let cipherTextLen = messageLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes - liftIO $ Foreign.withForeignPtr cipherTextForeignPtr $ \cipherTextBuffer -> do - liftIO $ Foreign.withForeignPtr clearTextForeignPtr $ \clearTextBuffer -> do - tagBuffer <- sodiumMalloc 1 - result <- - cryptoSecretStreamXChaCha20Poly1305Pull - statePtr - clearTextBuffer - Foreign.nullPtr - tagBuffer - cipherTextBuffer - cipherTextLen - Foreign.nullPtr - 0 - when (result /= 0) $ throw StreamDecryptionException - bsPtr <- Foreign.mallocBytes (fromIntegral messageLength) - Foreign.copyBytes bsPtr (Foreign.castPtr clearTextBuffer) (fromIntegral messageLength) - BSU.unsafePackMallocCStringLen (bsPtr, fromIntegral messageLength) + let ciphertextLen = messageLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes + liftIO $ Foreign.withForeignPtr ciphertextForeignPtr $ \ciphertextBuffer -> do + BSU.unsafeUseAsCStringLen (maybe BS.empty additionalDataToBinary mbAd) $ \(adCString, adCStringLen) -> do + let adPtr = Foreign.castPtr @CChar @CUChar adCString + adLen = fromIntegral @Int @CULLong adCStringLen + liftIO $ Foreign.withForeignPtr clearTextForeignPtr $ \clearTextBuffer -> do + tagBuffer <- sodiumMalloc 1 + result <- + cryptoSecretStreamXChaCha20Poly1305Pull + statePtr + clearTextBuffer + Foreign.nullPtr + tagBuffer + ciphertextBuffer + ciphertextLen + adPtr + adLen + when (result /= 0) $ throw StreamDecryptionException + bsPtr <- Foreign.mallocBytes (fromIntegral messageLength) + Foreign.copyBytes bsPtr (Foreign.castPtr clearTextBuffer) (fromIntegral messageLength) + BSU.unsafePackMallocCStringLen (bsPtr, fromIntegral messageLength) -- | Perform streaming decryption of a finite Linked List. -- -- This function can throw 'StreamDecryptionException' if the chunk is invalid, incomplete, or corrupted. -- -- @since 0.0.1.0 -decryptList :: forall m. MonadIO m => SecretKey -> Header -> [CipherText] -> m (Maybe [StrictByteString]) +decryptList :: forall m. MonadIO m => SecretKey -> Header -> [(Maybe AdditionalData, Ciphertext)] -> m (Maybe [StrictByteString]) decryptList secretKey header encryptedMessages = decryptStream secretKey header $ \multipart -> do - forM encryptedMessages $ \cipherText -> do - decryptChunk multipart cipherText + forM encryptedMessages $ \(mbAd, ciphertext) -> do + decryptChunk multipart mbAd ciphertext -- | A secret key of size 'cryptoSecretStreamXChaCha20Poly1305KeyBytes'. -- @@ -314,14 +333,12 @@ -- | @since 0.0.1.0 instance Eq SecretKey where (SecretKey hk1) == (SecretKey hk2) = - unsafeDupablePerformIO $ - foreignPtrEq hk1 hk2 cryptoSecretStreamXChaCha20Poly1305KeyBytes + foreignPtrEq hk1 hk2 cryptoSecretStreamXChaCha20Poly1305KeyBytes -- | @since 0.0.1.0 instance Ord SecretKey where compare (SecretKey hk1) (SecretKey hk2) = - unsafeDupablePerformIO $ - foreignPtrOrd hk1 hk2 cryptoSecretStreamXChaCha20Poly1305KeyBytes + foreignPtrOrd hk1 hk2 cryptoSecretStreamXChaCha20Poly1305KeyBytes -- | > show secretKey == "[REDACTED]" -- @@ -357,17 +374,14 @@ else pure $ Left $ Text.pack ("Secret Key is not of size " <> show cryptoSecretStreamXChaCha20Poly1305KeyBytes) Left msg -> pure $ Left msg --- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 unsafeSecretKeyToHexByteString :: SecretKey -> Base16 StrictByteString unsafeSecretKeyToHexByteString (SecretKey secretKeyForeignPtr) = - Base16.encodeBase16' $ - BSI.fromForeignPtr0 - (Foreign.castForeignPtr @CUChar @Word8 secretKeyForeignPtr) - (fromIntegral @CSize @Int cryptoSecretStreamXChaCha20Poly1305KeyBytes) + Base16.assertBase16 $ binaryToHex secretKeyForeignPtr cryptoSecretStreamXChaCha20Poly1305KeyBytes -- Prepare memory for a 'SecretKey' and use the provided action to fill it. -- @@ -403,24 +417,19 @@ -- | @since 0.0.1.0 instance Eq Header where (Header header1) == (Header header2) = - unsafeDupablePerformIO $ - foreignPtrEq header1 header2 cryptoSecretStreamXChaCha20Poly1305HeaderBytes + foreignPtrEq header1 header2 cryptoSecretStreamXChaCha20Poly1305HeaderBytes -- | @since 0.0.1.0 instance Ord Header where compare (Header header1) (Header header2) = - unsafeDupablePerformIO $ - foreignPtrOrd header1 header2 cryptoSecretStreamXChaCha20Poly1305HeaderBytes + foreignPtrOrd header1 header2 cryptoSecretStreamXChaCha20Poly1305HeaderBytes --- | Convert a 'Header' to a hexadecimal-encoded 'StrictByteString' +-- | Convert a 'Header' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- @since 0.0.1.0 headerToHexByteString :: Header -> Base16 StrictByteString headerToHexByteString (Header headerForeignPtr) = - Base16.encodeBase16' $ - BSI.fromForeignPtr0 - (Foreign.castForeignPtr @CUChar @Word8 headerForeignPtr) - (fromIntegral @CSize @Int cryptoSecretStreamXChaCha20Poly1305HeaderBytes) + Base16.assertBase16 $ binaryToHex headerForeignPtr cryptoSecretStreamXChaCha20Poly1305HeaderBytes -- | Build a 'Header' from a base16-encoded 'StrictByteString' -- @@ -471,94 +480,144 @@ Push -> fromIntegral cryptoSecretStreamXChaCha20Poly1305TagPush Rekey -> fromIntegral cryptoSecretStreamXChaCha20Poly1305TagRekey +-- | Additional data (AD). Also known as \"additional authenticated data\" +-- (AAD). +-- +-- This refers to non-confidential data which is authenticated along with the +-- message, but not encrypted (i.e. its integrity is protected, but it is not +-- made confidential). +-- +-- A typical use case for additional data is to authenticate protocol-specific +-- metadata about a message, such as its length and encoding. +newtype AdditionalData = AdditionalData StrictByteString + deriving stock (Eq, Show) + deriving (Display) via (ShowInstance AdditionalData) + +-- | Convert an 'AdditionalData' value to hexadecimal-encoded 'Text'. +additionalDataToHexText :: AdditionalData -> Base16 Text +additionalDataToHexText = Base16.encodeBase16 . additionalDataToBinary + +-- | Convert an 'AdditionalData' value to a hexadecimal-encoded +-- 'StrictByteString'. +additionalDataToHexByteString :: AdditionalData -> Base16 StrictByteString +additionalDataToHexByteString = Base16.encodeBase16' . additionalDataToBinary + +-- | Convert an 'AdditionalData' value to a raw binary 'StrictByteString'. +additionalDataToBinary :: AdditionalData -> StrictByteString +additionalDataToBinary (AdditionalData bs) = bs + +-- | Error decoding 'AdditionalData' from hexadecimal-encoded bytes. +newtype AdditionalDataHexDecodingError = AdditionalDataHexDecodingError Text + deriving stock (Eq, Show) + +-- | Construct an 'AdditionalData' value from a hexadecimal-encoded +-- 'StrictByteString' that you have obtained on your own, usually from the +-- network or disk. +additionalDataFromHexByteString + :: Base16 StrictByteString + -> Either AdditionalDataHexDecodingError AdditionalData +additionalDataFromHexByteString hexBs = + case Base16.decodeBase16Untyped (Base16.extractBase16 hexBs) of + Left err -> Left (AdditionalDataHexDecodingError err) + Right bs -> Right (AdditionalData bs) + -- | An encrypted message. It is guaranteed to be of size: -- @original_message_length + 'cryptoSecretStreamXChaCha20Poly1305ABytes'@ -- -- @since 0.0.1.0 -data CipherText = CipherText +data Ciphertext = Ciphertext { messageLength :: CULLong - , cipherTextForeignPtr :: ForeignPtr CUChar + , ciphertextForeignPtr :: ForeignPtr CUChar } -- | -- -- @since 0.0.1.0 -instance Eq CipherText where - (CipherText cipherTextLength1 h1) == (CipherText cipherTextLength2 h2) = - unsafeDupablePerformIO $ do - result1 <- +instance Eq Ciphertext where + (Ciphertext ciphertextLength1 h1) == (Ciphertext ciphertextLength2 h2) = + let + textLength = ciphertextLength1 == ciphertextLength2 + content = foreignPtrEq h1 h2 - (fromIntegral cipherTextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes) - pure $ cipherTextLength1 == cipherTextLength2 && result1 + (fromIntegral ciphertextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes) + in + textLength && content -- | @since 0.0.1.0 -instance Ord CipherText where - compare (CipherText cipherTextLength1 c1) (CipherText cipherTextLength2 c2) = - unsafeDupablePerformIO $ do - result1 <- foreignPtrOrd c1 c2 (fromIntegral cipherTextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes) - pure $ compare cipherTextLength1 cipherTextLength2 <> result1 +instance Ord Ciphertext where + compare (Ciphertext ciphertextLength1 c1) (Ciphertext ciphertextLength2 c2) = + let + textLength = compare ciphertextLength1 ciphertextLength2 + content = + foreignPtrOrd + c1 + c2 + (fromIntegral ciphertextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes) + in + textLength <> content -- | @since 0.0.1.0 -instance Display CipherText where +instance Display Ciphertext where displayBuilder = Builder.fromText . Base16.extractBase16 . ciphertextToHexText -- | @since 0.0.1.0 -instance Show CipherText where +instance Show Ciphertext where show = BSI.unpackChars . Base16.extractBase16 . ciphertextToHexByteString --- | Create a 'CipherText' from a binary 'StrictByteString' that you have obtained on your own, --- usually from the network or disk. It must be a valid hash built from the concatenation +-- | Create a 'Ciphertext' from a binary 'StrictByteString' that you have obtained on your own, +-- usually from the network or disk. It must be a valid ciphertext built from the concatenation -- of the encrypted message and the authentication tag. -- --- The input hash must at least of length 'cryptoSecretStreamXChaCha20Poly1305ABytes' +-- The input ciphertext must at least of length 'cryptoSecretStreamXChaCha20Poly1305ABytes' -- -- @since 0.0.1.0 -ciphertextFromHexByteString :: Base16 StrictByteString -> Either Text CipherText -ciphertextFromHexByteString hexCipherText = unsafeDupablePerformIO $ - case Base16.decodeBase16Untyped (Base16.extractBase16 hexCipherText) of +ciphertextFromHexByteString :: Base16 StrictByteString -> Either Text Ciphertext +ciphertextFromHexByteString hexCiphertext = unsafeDupablePerformIO $ + case Base16.decodeBase16Untyped (Base16.extractBase16 hexCiphertext) of Right bytestring -> if BS.length bytestring >= fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes - then BSU.unsafeUseAsCStringLen bytestring $ \(outsideCipherTextPtr, outsideCipherTextLength) -> do - cipherTextFPtr <- BSI.mallocByteString @CChar outsideCipherTextLength -- The foreign pointer that will receive the hash data. - Foreign.withForeignPtr cipherTextFPtr $ \cipherTextPtr -> - -- We copy bytes from 'outsideCipherTextPtr' to 'cipherTextPtr. - Foreign.copyArray cipherTextPtr outsideCipherTextPtr outsideCipherTextLength + then BSU.unsafeUseAsCStringLen bytestring $ \(outsideCiphertextPtr, outsideCiphertextLength) -> do + ciphertextFPtr <- BSI.mallocByteString @CChar outsideCiphertextLength -- The foreign pointer that will receive the ciphertext data. + Foreign.withForeignPtr ciphertextFPtr $ \ciphertextPtr -> + -- We copy bytes from 'outsideCiphertextPtr' to 'ciphertextPtr. + Foreign.copyArray ciphertextPtr outsideCiphertextPtr outsideCiphertextLength pure $ Right $ - CipherText - (fromIntegral @Int @CULLong outsideCipherTextLength - fromIntegral @CSize @CULLong cryptoSecretStreamXChaCha20Poly1305ABytes) - (Foreign.castForeignPtr @CChar @CUChar cipherTextFPtr) - else pure $ Left $ Text.pack "CipherText is too short" + Ciphertext + (fromIntegral @Int @CULLong outsideCiphertextLength - fromIntegral @CSize @CULLong cryptoSecretStreamXChaCha20Poly1305ABytes) + (Foreign.castForeignPtr @CChar @CUChar ciphertextFPtr) + else pure $ Left $ Text.pack "Ciphertext is too short" Left msg -> pure $ Left msg --- | Convert a 'CipherText' to a hexadecimal-encoded 'Text'. +-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'Text'. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -ciphertextToHexText :: CipherText -> Base16 Text +ciphertextToHexText :: Ciphertext -> Base16 Text ciphertextToHexText = Base16.encodeBase16 . ciphertextToBinary --- | Convert a 'CipherText' to a hexadecimal-encoded 'StrictByteString'. +-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -ciphertextToHexByteString :: CipherText -> Base16 StrictByteString -ciphertextToHexByteString = Base16.encodeBase16' . ciphertextToBinary +ciphertextToHexByteString :: Ciphertext -> Base16 StrictByteString +ciphertextToHexByteString (Ciphertext ciphertextLength fPtr) = + Base16.assertBase16 $ binaryToHex fPtr (cryptoSecretStreamXChaCha20Poly1305ABytes + fromIntegral ciphertextLength) --- | Convert a 'CipherText' to a binary 'StrictByteString'. +-- | Convert a 'Ciphertext' to a binary 'StrictByteString' in constant time. -- -- ⚠️ Be prudent as to where you store it! -- -- @since 0.0.1.0 -ciphertextToBinary :: CipherText -> StrictByteString -ciphertextToBinary (CipherText cipherTextLength fPtr) = +ciphertextToBinary :: Ciphertext -> StrictByteString +ciphertextToBinary (Ciphertext ciphertextLength fPtr) = BSI.fromForeignPtr0 (Foreign.castForeignPtr fPtr) - (fromIntegral cipherTextLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes) + (fromIntegral ciphertextLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes) -- | @since 0.0.1.0 data StreamEncryptionException = StreamEncryptionException diff --git a/test/Test/HMAC.hs b/test/Test/HMAC.hs --- a/test/Test/HMAC.hs +++ b/test/Test/HMAC.hs @@ -2,11 +2,12 @@ module Test.HMAC where -import qualified Sel.HMAC.SHA256 as SHA256 -import qualified Sel.HMAC.SHA256 as SHA512 -import qualified Sel.HMAC.SHA256 as SHA512_256 import Test.Tasty import Test.Tasty.HUnit + +import qualified Sel.HMAC.SHA256 as SHA256 +import qualified Sel.HMAC.SHA512 as SHA512 +import qualified Sel.HMAC.SHA512_256 as SHA512_256 import TestUtils (assertRight) spec :: TestTree @@ -41,7 +42,7 @@ testSingleHMACSHA256Hashing :: Assertion testSingleHMACSHA256Hashing = do key <- SHA256.newAuthenticationKey - tag <- SHA256.authenticate "Hello, world!" key + let tag = SHA256.authenticate "Hello, world!" key assertBool "message is verified" $ SHA256.verify tag key "Hello, world!" @@ -66,7 +67,7 @@ testHMAC256AuthenticationTagSerialisation :: Assertion testHMAC256AuthenticationTagSerialisation = do key <- SHA256.newAuthenticationKey - tag1 <- SHA256.authenticate "Hello, world!" key + let tag1 = SHA256.authenticate "Hello, world!" key let hexTag = SHA256.authenticationTagToHexByteString tag1 tag2 <- assertRight $ SHA256.authenticationTagFromHexByteString hexTag assertEqual "Roundtripping authentication key" tag1 tag2 @@ -76,7 +77,7 @@ testSingleHMACSHA512Hashing :: Assertion testSingleHMACSHA512Hashing = do key <- SHA512.newAuthenticationKey - tag <- SHA512.authenticate "Hello, world!" key + let tag = SHA512.authenticate "Hello, world!" key assertBool "message is verified" $ SHA512.verify tag key "Hello, world!" @@ -88,7 +89,7 @@ SHA512.updateMultipart multipart "2" assertEqual "HMAC-SHA512 tag is consistent" - "be884a372976dd92e819d55ea7090d0b87377b3ac0773a97a5fdc12523104c35" + "7aad3ea0ca427425ba2fc3cf8078d31e94a62483b7ead624825f9a3fe36bbf5aaf8276e8876faef1a84226e439466774ebc7062495b19a6811cc376bfcccede0" (SHA512.authenticationTagToHexByteString actual) testHMAC512AuthenticationKeySerialisation :: Assertion @@ -101,7 +102,7 @@ testHMAC512AuthenticationTagSerialisation :: Assertion testHMAC512AuthenticationTagSerialisation = do key <- SHA512.newAuthenticationKey - tag1 <- SHA512.authenticate "Hello, world!" key + let tag1 = SHA512.authenticate "Hello, world!" key let hexTag = SHA512.authenticationTagToHexByteString tag1 tag2 <- assertRight $ SHA512.authenticationTagFromHexByteString hexTag assertEqual "Roundtripping authentication key" tag1 tag2 @@ -111,7 +112,7 @@ testSingleHMACSHA512_256Hashing :: Assertion testSingleHMACSHA512_256Hashing = do key <- SHA512_256.newAuthenticationKey - tag <- SHA512_256.authenticate "Hello, world!" key + let tag = SHA512_256.authenticate "Hello, world!" key assertBool "message is verified" $ SHA512_256.verify tag key "Hello, world!" @@ -123,7 +124,7 @@ SHA512_256.updateMultipart multipart "2" assertEqual "HMAC-SHA512_256 tag is consistent" - "be884a372976dd92e819d55ea7090d0b87377b3ac0773a97a5fdc12523104c35" + "7aad3ea0ca427425ba2fc3cf8078d31e94a62483b7ead624825f9a3fe36bbf5a" (SHA512_256.authenticationTagToHexByteString actual) testHMAC512_256AuthenticationKeySerialisation :: Assertion @@ -136,7 +137,7 @@ testHMAC512_256AuthenticationTagSerialisation :: Assertion testHMAC512_256AuthenticationTagSerialisation = do key <- SHA512_256.newAuthenticationKey - tag1 <- SHA512_256.authenticate "Hello, world!" key + let tag1 = SHA512_256.authenticate "Hello, world!" key let hexTag = SHA512_256.authenticationTagToHexByteString tag1 tag2 <- assertRight $ SHA512_256.authenticationTagFromHexByteString hexTag assertEqual "Roundtripping authentication key" tag1 tag2 diff --git a/test/Test/Hashing.hs b/test/Test/Hashing.hs --- a/test/Test/Hashing.hs +++ b/test/Test/Hashing.hs @@ -4,15 +4,15 @@ module Test.Hashing where import Control.Monad (void) - import qualified Data.ByteString.Unsafe as BS import Foreign hiding (void) import Foreign.C import LibSodium.Bindings.GenericHashing (cryptoGenericHash, cryptoGenericHashBytes) -import qualified Sel.Hashing as Hashing import Test.Tasty import Test.Tasty.HUnit +import qualified Sel.Hashing as Hashing + spec :: TestTree spec = testGroup @@ -24,7 +24,7 @@ testCryptoGenericHashWithoutKey :: Assertion testCryptoGenericHashWithoutKey = do - expected <- Hashing.hashToHexByteString <$> Hashing.hashByteString Nothing "test test" + let expected = Hashing.hashToHexByteString $ Hashing.hashByteString Nothing "test test" assertEqual "Hashed test string is consistent without key" expected @@ -54,7 +54,7 @@ testMultipartHahsing :: Assertion testMultipartHahsing = do hashKey <- Hashing.newHashKey - expectedHash <- Hashing.hashByteString (Just hashKey) "test test" + let expectedHash = Hashing.hashByteString (Just hashKey) "test test" actualHash <- Hashing.withMultipart (Just hashKey) $ \multipartState -> do let message1 = "test " Hashing.updateMultipart multipartState message1 diff --git a/test/Test/Hashing/Password.hs b/test/Test/Hashing/Password.hs --- a/test/Test/Hashing/Password.hs +++ b/test/Test/Hashing/Password.hs @@ -6,10 +6,11 @@ import Data.Maybe (isNothing) import Data.Text (Text) import qualified Data.Text as Text -import qualified Sel.Hashing.Password as Sel import Test.Tasty import Test.Tasty.HUnit +import qualified Sel.Hashing.Password as Sel + spec :: TestTree spec = testGroup @@ -45,8 +46,8 @@ cmpPWHashes = on (==) Sel.passwordHashToByteString salt1 <- Sel.genSalt - hashOrig <- hashWSalt salt1 password - hashOrig' <- hashWSalt salt1 password + let hashOrig = hashWSalt salt1 password + hashOrig' = hashWSalt salt1 password assertBool "Password hashing with salt is consistent" (cmpPWHashes hashOrig hashOrig') @@ -57,7 +58,7 @@ (not $ cmpPWHashes hashOrig hashWoSalt) salt2 <- Sel.genSalt - hashWNewSalt <- hashWSalt salt2 password + let hashWNewSalt = hashWSalt salt2 password assertBool "Password hashing differs with a new salt" (not $ cmpPWHashes hashOrig hashWNewSalt) diff --git a/test/Test/Hashing/SHA2.hs b/test/Test/Hashing/SHA2.hs --- a/test/Test/Hashing/SHA2.hs +++ b/test/Test/Hashing/SHA2.hs @@ -3,11 +3,12 @@ module Test.Hashing.SHA2 where import Data.Text (Text) -import qualified Sel.Hashing.SHA256 as SHA256 -import qualified Sel.Hashing.SHA512 as SHA512 import Test.Tasty import Test.Tasty.HUnit +import qualified Sel.Hashing.SHA256 as SHA256 +import qualified Sel.Hashing.SHA512 as SHA512 + spec :: TestTree spec = testGroup @@ -27,7 +28,7 @@ testSingleHashSHA512 :: Assertion testSingleHashSHA512 = do let password = "hunter2" :: Text - actual <- SHA512.hashText password + actual = SHA512.hashText password assertEqual "SHA-512 hashing is consistent" (SHA512.hashToHexByteString actual) @@ -46,7 +47,7 @@ testSingleHashSHA256 :: Assertion testSingleHashSHA256 = do let password = "hunter2" :: Text - actual <- SHA256.hashText password + actual = SHA256.hashText password assertEqual "SHA-256 hashing is consistent" (SHA256.hashToHexByteString actual) diff --git a/test/Test/Hashing/Short.hs b/test/Test/Hashing/Short.hs --- a/test/Test/Hashing/Short.hs +++ b/test/Test/Hashing/Short.hs @@ -4,10 +4,11 @@ import Data.Maybe (fromJust) import Data.Text (Text) -import qualified Sel.Hashing.Short as Short import Test.Tasty import Test.Tasty.HUnit +import qualified Sel.Hashing.Short as Short + spec :: TestTree spec = testGroup @@ -19,7 +20,7 @@ testHashPassword = do let key = fromJust $ Short.hexTextToShortHashKey "9301a3c5eedf2d783b72dc41fb907964" let input = "kwak kwak" :: Text - hash <- Short.hashText key input + let hash = Short.hashText key input assertEqual "input hashing is consistent" (Short.shortHashToHexText hash) diff --git a/test/Test/PublicKey/Cipher.hs b/test/Test/PublicKey/Cipher.hs --- a/test/Test/PublicKey/Cipher.hs +++ b/test/Test/PublicKey/Cipher.hs @@ -2,9 +2,10 @@ module Test.PublicKey.Cipher where -import Sel.PublicKey.Cipher import Test.Tasty import Test.Tasty.HUnit + +import Sel.PublicKey.Cipher import TestUtils spec :: TestTree @@ -14,7 +15,7 @@ [ testCase "Encrypt a message with public-key encryption" testEncryptMessage , testCase "Round-trip nonce serialisation" testNonceSerdeRoundtrip , testCase "Round-trip keys serialisation" testKeysSerdeRoundtrip - , testCase "Round-trip cipher text serialisation" testCipherTextSerdeRoundtrip + , testCase "Round-trip cipher text serialisation" testCiphertextSerdeRoundtrip ] testEncryptMessage :: Assertion @@ -45,10 +46,10 @@ (pk2, sk2) <- assertRight $ keyPairFromHexByteStrings hexPk hexSk assertEqual "Roundtripping keys serialisation" (pk1, sk1) (pk2, sk2) -testCipherTextSerdeRoundtrip :: Assertion -testCipherTextSerdeRoundtrip = do +testCiphertextSerdeRoundtrip :: Assertion +testCiphertextSerdeRoundtrip = do (publicKey, secretKey) <- newKeyPair - (_, cipherText) <- encrypt "hello hello" publicKey secretKey - let hexCipherText = cipherTextToHexByteString cipherText - cipherText2 <- assertRight $ cipherTextFromHexByteString hexCipherText - assertEqual "Roundtripping cipher text serialisation" cipherText cipherText2 + (_, ciphertext) <- encrypt "hello hello" publicKey secretKey + let hexCiphertext = ciphertextToHexByteString ciphertext + ciphertext2 <- assertRight $ ciphertextFromHexByteString hexCiphertext + assertEqual "Roundtripping cipher text serialisation" ciphertext ciphertext2 diff --git a/test/Test/PublicKey/Seal.hs b/test/Test/PublicKey/Seal.hs --- a/test/Test/PublicKey/Seal.hs +++ b/test/Test/PublicKey/Seal.hs @@ -2,10 +2,11 @@ module Test.PublicKey.Seal where -import Sel.PublicKey.Cipher -import Sel.PublicKey.Seal import Test.Tasty import Test.Tasty.HUnit + +import Sel.PublicKey.Cipher +import Sel.PublicKey.Seal spec :: TestTree spec = diff --git a/test/Test/PublicKey/Signature.hs b/test/Test/PublicKey/Signature.hs --- a/test/Test/PublicKey/Signature.hs +++ b/test/Test/PublicKey/Signature.hs @@ -2,9 +2,10 @@ module Test.PublicKey.Signature where -import Sel.PublicKey.Signature import Test.Tasty import Test.Tasty.HUnit + +import Sel.PublicKey.Signature spec :: TestTree spec = diff --git a/test/Test/Scrypt.hs b/test/Test/Scrypt.hs --- a/test/Test/Scrypt.hs +++ b/test/Test/Scrypt.hs @@ -4,9 +4,10 @@ module Test.Scrypt where import Data.ByteString -import Sel.Scrypt import Test.Tasty import Test.Tasty.HUnit + +import Sel.Scrypt spec :: TestTree spec = diff --git a/test/Test/SecretKey/Authentication.hs b/test/Test/SecretKey/Authentication.hs --- a/test/Test/SecretKey/Authentication.hs +++ b/test/Test/SecretKey/Authentication.hs @@ -2,9 +2,10 @@ module Test.SecretKey.Authentication where -import Sel.SecretKey.Authentication import Test.Tasty import Test.Tasty.HUnit + +import Sel.SecretKey.Authentication import TestUtils (assertRight) spec :: TestTree @@ -19,7 +20,7 @@ testAuthenticateMessage :: Assertion testAuthenticateMessage = do key <- newAuthenticationKey - tag <- authenticate "hello, world" key + let tag = authenticate "hello, world" key assertBool "Tag verified" (verify tag key "hello, world") @@ -37,8 +38,8 @@ testAuthTagSerdeRoundtrip :: Assertion testAuthTagSerdeRoundtrip = do key <- newAuthenticationKey - expectedTag <- authenticate "hello, world" key - let hexTag = authenticationTagToHexByteString expectedTag + let expectedTag = authenticate "hello, world" key + hexTag = authenticationTagToHexByteString expectedTag actualTag <- assertRight $ authenticationTagFromHexByteString hexTag assertEqual "Tag is expected" diff --git a/test/Test/SecretKey/Cipher.hs b/test/Test/SecretKey/Cipher.hs --- a/test/Test/SecretKey/Cipher.hs +++ b/test/Test/SecretKey/Cipher.hs @@ -2,9 +2,10 @@ module Test.SecretKey.Cipher where -import Sel.SecretKey.Cipher import Test.Tasty import Test.Tasty.HUnit + +import Sel.SecretKey.Cipher import TestUtils (assertRight) spec :: TestTree @@ -14,7 +15,7 @@ [ testCase "Encrypt a message with a secret key and a nonce" testEncryptMessage , testCase "Round-trip nonce serialisation" testNonceSerdeRoundtrip , testCase "Round-trip secret key serialisation" testSecretKeySerdeRoundtrip - , testCase "Round-trip hash serialisation" testHashSerdeRoundtrip + , testCase "Round-trip ciphertext serialisation" testCiphertextSerdeRoundtrip ] testEncryptMessage :: Assertion @@ -40,9 +41,9 @@ secretKey2 <- assertRight $ secretKeyFromHexByteString . unsafeSecretKeyToHexByteString $ secretKey assertEqual "Roundtripping secret key" secretKey secretKey2 -testHashSerdeRoundtrip :: Assertion -testHashSerdeRoundtrip = do +testCiphertextSerdeRoundtrip :: Assertion +testCiphertextSerdeRoundtrip = do secretKey <- newSecretKey - (_, hash) <- encrypt "" secretKey - hash2 <- assertRight $ hashFromHexByteString . hashToHexByteString $ hash - assertEqual "Roundtripping hash" hash hash2 + (_, ciphertext) <- encrypt "" secretKey + ciphertext2 <- assertRight $ ciphertextFromHexByteString . ciphertextToHexByteString $ ciphertext + assertEqual "Roundtripping ciphertext" ciphertext ciphertext2 diff --git a/test/Test/SecretKey/Stream.hs b/test/Test/SecretKey/Stream.hs --- a/test/Test/SecretKey/Stream.hs +++ b/test/Test/SecretKey/Stream.hs @@ -3,9 +3,10 @@ module Test.SecretKey.Stream where import Data.ByteString (StrictByteString) -import qualified Sel.SecretKey.Stream as Stream import Test.Tasty import Test.Tasty.HUnit + +import qualified Sel.SecretKey.Stream as Stream import TestUtils spec :: TestTree @@ -14,7 +15,7 @@ "Secret Key Encrypted Stream tests" [ testCase "Encrypt a stream with a secret key" testEncryptStream , testCase "Round-trip secret key serialisation" testSecretKeySerdeRoundtrip - , testCase "Round-trip ciphertext serialisation" testCipherTextSerdeRoundtrip + , testCase "Round-trip ciphertext serialisation" testCiphertextSerdeRoundtrip -- , testCase "Round-trip header serialisation" testHeaderSerdeRoundtrip ] @@ -22,8 +23,11 @@ testEncryptStream = do secretKey <- Stream.newSecretKey let messages = ["Hello", "abcdf", "world"] - (header, cipherTexts) <- Stream.encryptList secretKey messages - mResult <- Stream.decryptList secretKey header cipherTexts + ad = map Just [Stream.AdditionalData "Goodbye", Stream.AdditionalData "31337", Stream.AdditionalData "planet"] + messagesAndAd = zip ad messages + (header, ciphertexts) <- Stream.encryptList secretKey messagesAndAd + let ciphertextsAndAd = zip ad ciphertexts + mResult <- Stream.decryptList secretKey header ciphertextsAndAd result <- assertJust mResult assertEqual @@ -42,15 +46,16 @@ secretKey1 secretKey2 -testCipherTextSerdeRoundtrip :: Assertion -testCipherTextSerdeRoundtrip = do +testCiphertextSerdeRoundtrip :: Assertion +testCiphertextSerdeRoundtrip = do secretKey <- Stream.newSecretKey let message = "hello" :: StrictByteString + additionalData = Stream.AdditionalData "this is additional data" (_, encryptedPayload1) <- Stream.encryptStream secretKey $ \multipart -> do - Stream.encryptChunk multipart Stream.Final message + Stream.encryptChunk multipart Stream.Final (Just additionalData) message - let hexCipherText = Stream.ciphertextToHexByteString encryptedPayload1 - encryptedPayload2 <- assertRight $ Stream.ciphertextFromHexByteString hexCipherText + let hexCiphertext = Stream.ciphertextToHexByteString encryptedPayload1 + encryptedPayload2 <- assertRight $ Stream.ciphertextFromHexByteString hexCiphertext assertEqual "The ciphertexts remain equal"