packages feed

sel (empty) → 0.0.1.0

raw patch · 36 files changed

+6058/−0 lines, 36 filesdep +basedep +base16dep +bytestring

Dependencies added: base, base16, bytestring, hedgehog, libsodium-bindings, sel, tasty, tasty-hunit, text, text-display

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# CHANGELOG++## [Unreleased]
+ LICENSE view
@@ -0,0 +1,11 @@+Copyright 2022 Hécate Moonlight and contributors++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,45 @@+# sel [![CI](https://github.com/haskell-cryptography/libsodium-bindings/actions/workflows/sel.yml/badge.svg)](https://github.com/haskell-cryptography/libsodium-bindings/actions/workflows/sel.yml) [![made with Haskell](https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell&style=flat-square)](https://haskell.org)+++Sel is the library for casual users by the [Haskell Cryptography Group](https://haskell-cryptography.org).+It builds on [Libsodium](https://doc.libsodium.org), a reliable and audited library for common operations.++## Hashing++|                              Purpose                                 | Module                         |+|----------------------------------------------------------------------|--------------------------------|+| Hash passwords                                                       | [Sel.Hashing.Password](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-Hashing-Password.html)         |+| Verify the integrity of files and hash large data                    | [Sel.Hashing](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-Hashing.html)                  |+| Hash tables, bloom filters, fast integrity checking of short input   | [Sel.Hashing.Short](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-Hashing-Short.html)            |++## Secret key / Symmetric cryptography++|                              Purpose                                 | Module                         |+|----------------------------------------------------------------------|--------------------------------|+| Authenticate a message with a secret key                             | [Sel.SecretKey.Authentication](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-SecretKey-Authentication.html) |+| Encrypt and sign data with a secret key                              | [Sel.SecretKey.Cipher](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-SecretKey-Cipher.html)         |+| Encrypt a stream of messages                                         | [Sel.SecretKey.Stream](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-SecretKey-Stream.html)         |++## Public and Secret key / Asymmetric cryptography++|                              Purpose                                 | Module                         |+|----------------------------------------------------------------------|--------------------------------|+| Sign and encrypt with my secret key and my recipient's public key    | [Sel.PublicKey.Cipher](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-PublicKey-Cipher.html)         |+| Sign and encrypt an anonymous message with my recipient's public key | [Sel.PublicKey.Seal](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-PublicKey-Seal.html)           |+| Sign with a secret key and distribute my public key                  | [Sel.PublicKey.Signature](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-PublicKey-Signature.html)      |++## HMAC message authentication++|                              Purpose                                 | Module                         |+|----------------------------------------------------------------------|--------------------------------|+| HMAC-256                                                             | [Sel.HMAC.SHA256](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-HMAC-SHA256.html)              |+| HMAC-512                                                             | [Sel.HMAC.SHA512](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-HMAC-SHA512.html)              |+| HMAC-512-256                                                         | [Sel.HMAC.SHA512_256](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-HMAC-SHA512_256.html)          |++## Legacy SHA2 constructs++|                              Purpose                                 | Module                         |+|----------------------------------------------------------------------|--------------------------------|+| SHA-256                                                              | [Sel.Hashing.SHA256](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-Hashing-SHA256.html)           |+| SHA-512                                                              | [Sel.Hashing.SHA512](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-Hashing-SHA512.html)           |+| Scrypt                                                               | [Sel.Scrypt](https://hackage.haskell.org/package/sel-0.0.1.0/candidate/docs/Sel-Scrypt.html)                   |
+ sel.cabal view
@@ -0,0 +1,105 @@+cabal-version:      3.0+name:               sel+version:            0.0.1.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+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+tested-with:+  GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.2++extra-source-files:+  LICENSE+  README.md++extra-doc-files:    CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/haskell-cryptography/libsodium-bindings++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+    -Werror=unused-imports++  default-language: Haskell2010++common test-options+  ghc-options: -rtsopts -threaded -with-rtsopts=-N++library+  import:          common+  hs-source-dirs:  src+  exposed-modules:+    Sel+    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+    Sel.Scrypt+    Sel.SecretKey.Authentication+    Sel.SecretKey.Cipher+    Sel.SecretKey.Stream++  other-modules:   Sel.Internal+  build-depends:+    , base                >=4.14     && <5+    , base16              ^>=1.0+    , bytestring          >=0.10     && <0.13+    , libsodium-bindings  ^>=0.0.1.1+    , text                >=1.2      && <2.2+    , text-display        ^>=0.0++test-suite sel-tests+  import:         common+  import:         test-options+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  other-modules:+    Test.Hashing+    Test.Hashing.Password+    Test.Hashing.SHA2+    Test.Hashing.Short+    Test.HMAC+    Test.PublicKey.Cipher+    Test.PublicKey.Seal+    Test.PublicKey.Signature+    Test.Scrypt+    Test.SecretKey.Authentication+    Test.SecretKey.Cipher+    Test.SecretKey.Stream+    TestUtils++  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
+ src/Sel.hs view
@@ -0,0 +1,81 @@+-- |+--+-- Module: Sel+-- Description: Cryptography for the casual user+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+--+-- Sel is the library for casual users by the [Haskell Cryptography Group](https://haskell-cryptography.org).+--+-- It builds on [Libsodium](https://doc.libsodium.org), a reliable and audited library for common operations.+--+-- ⚠️ Important note: if you want to use any of this code in an executable, ensure that you use 'secureMain' or 'secureMainWithError'+-- in your @main@ function __before__ you call any functions from this library. Failing to do so will cause problems. For libraries, this is not necessary.+module Sel+  ( -- ** Available APIs+    -- $tableofcontent++    -- ** Program entrypoint+    secureMain+  , secureMainWithError+  ) where++import LibSodium.Bindings.Main (secureMain, secureMainWithError)++-- $tableofcontent+-- === Hashing+-- +----------------------------------------------------------------------+--------------------------------++-- |                              Purpose                                 | Module                         |+-- +======================================================================+================================++-- | Hash passwords                                                       | "Sel.Hashing.Password"         |+-- +----------------------------------------------------------------------+--------------------------------++-- | Verify the integrity of files and hash large data                    | "Sel.Hashing"                  |+-- +----------------------------------------------------------------------+--------------------------------++-- | Hash tables, bloom filters, fast integrity checking of short input   | "Sel.Hashing.Short"            |+-- +----------------------------------------------------------------------+--------------------------------++--+-- === Secret key / symmetric cryptography+-- +----------------------------------------------------------------------+--------------------------------++-- |                              Purpose                                 | Module                         |+-- +======================================================================+================================++-- | Authenticate a message with a secret key                             | "Sel.SecretKey.Authentication" |+-- +----------------------------------------------------------------------+--------------------------------++-- | Encrypt and sign data with a secret key                              | "Sel.SecretKey.Cipher"         |+-- +----------------------------------------------------------------------+--------------------------------++-- | Encrypt a stream of messages                                         | "Sel.SecretKey.Stream"         |+-- +----------------------------------------------------------------------+--------------------------------++--+--+-- === Public and Secret key / asymmetric cryptography+-- +----------------------------------------------------------------------+--------------------------------++-- |                              Purpose                                 | Module                         |+-- +======================================================================+================================++-- | Sign and encrypt with my secret key and my recipient's public key    | "Sel.PublicKey.Cipher"         |+-- +----------------------------------------------------------------------+--------------------------------++-- | Sign and encrypt an anonymous message with my recipient's public key | "Sel.PublicKey.Seal"           |+-- +----------------------------------------------------------------------+--------------------------------++-- | Sign with a secret key and distribute my public key                  | "Sel.PublicKey.Signature"      |+-- +----------------------------------------------------------------------+--------------------------------++--+-- === HMAC message authentication+-- +----------------------------------------------------------------------+--------------------------------++-- |                              Purpose                                 | Module                         |+-- +======================================================================+================================++-- | HMAC-256                                                             | "Sel.HMAC.SHA256"              |+-- +----------------------------------------------------------------------+--------------------------------++-- | HMAC-512                                                             | "Sel.HMAC.SHA512"              |+-- +----------------------------------------------------------------------+--------------------------------++-- | HMAC-512-256                                                         | "Sel.HMAC.SHA512_256"          |+-- +----------------------------------------------------------------------+--------------------------------++--+-- === Legacy constructs+-- +----------------------------------------------------------------------+--------------------------------++-- |                              Purpose                                 | Module                         |+-- +======================================================================+================================++-- | SHA-256                                                              | "Sel.Hashing.SHA256"           |+-- +----------------------------------------------------------------------+--------------------------------++-- | SHA-512                                                              | "Sel.Hashing.SHA512"           |+-- +----------------------------------------------------------------------+--------------------------------++-- | Scrypt                                                               | "Sel.Scrypt"                   |+-- +----------------------------------------------------------------------+--------------------------------+
+ src/Sel/HMAC.hs view
@@ -0,0 +1,21 @@+-- |+--+-- Module: Sel.HMAC.SHA512+-- Description: Keyed Message Authentication Codes+--+-- [HMAC](https://en.wikipedia.org/wiki/HMAC) provides a way to both encrypt a communication+-- and authenticate its origin.+--+-- This relies on a shared pair of secret keys between all the parties+--+-- The function computing the tag deterministic: the same @(message, key)@ tuple will always+-- produce the same output. However, even if the message is public, knowing the key is required+-- in order to be able to compute a valid tag.+-- Therefore, the key should remain confidential. The tag, however, can be public.+--+-- The following keyed message authentication codes are availabled:+--+-- * "Sel.HMAC.SHA256"+-- * "Sel.HMAC.SHA512"+-- * "Sel.HMAC.SHA512_256" (truncated HMAC-SHA-512)+module Sel.HMAC where
+ src/Sel/HMAC/SHA256.hs view
@@ -0,0 +1,401 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.HMAC.SHA256+-- Description: HMAC-SHA-256+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.HMAC.SHA256+  ( -- ** Introduction+    -- $introduction++    -- ** Usage+    -- $usage++    -- ** Operations++    -- *** Authenticating a single messsage+    authenticate++    -- *** Authenicating a multi-part message+  , Multipart+  , withMultipart+  , updateMultipart++    -- *** Verifying a message+  , verify++    -- ** Authentication key+  , AuthenticationKey+  , newAuthenticationKey+  , authenticationKeyFromHexByteString+  , unsafeAuthenticationKeyToBinary+  , unsafeAuthenticationKeyToHexByteString++    -- ** Authentication tag+  , AuthenticationTag+  , authenticationTagToHexByteString+  , authenticationTagToBinary+  , authenticationTagFromHexByteString+  ) where++--++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+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 as Text+import Data.Text.Display+import Foreign (ForeignPtr, Ptr, Word8)+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+  , cryptoAuthHMACSHA256Bytes+  , cryptoAuthHMACSHA256Final+  , cryptoAuthHMACSHA256Init+  , cryptoAuthHMACSHA256KeyBytes+  , cryptoAuthHMACSHA256Keygen+  , cryptoAuthHMACSHA256StateBytes+  , cryptoAuthHMACSHA256Update+  , cryptoAuthHMACSHA256Verify+  )+import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc)+import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd)++-- $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.+--+-- The function computing the tag deterministic: the same @(message, key)@ tuple will always+-- produce the same output. However, even if the message is public, knowing the key is required+-- in order to be able to compute a valid tag.+-- Therefore, the key should remain confidential. The tag, however, can be public.++-- $usage+--+-- > import Sel.HMAC.SHA256 qualified as HMAC+-- >+-- > main = do+-- >   -- The parties agree on a shared secret key+-- >   authKey <- HMAC.newAuthenticationKey+-- >   -- An authentication tag is computed for the message by the server+-- >   let message = ("Hello, world!" :: StrictByteString)+-- >   tag <- HMAC.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+-- >   HMAC.verify tag authKey message+-- >   -- => True++-- | Compute an authentication tag for a message with a secret key shared by all parties.+--+-- @since 0.0.1.0+authenticate+  :: StrictByteString+  -- ^ Message to authenticate+  -> AuthenticationKey+  -- ^ Secret key for authentication+  -> IO AuthenticationTag+  -- ^ Cryptographic tag for authentication+authenticate message (AuthenticationKey authenticationKeyForeignPtr) =+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    authenticationTagForeignPtr <-+      Foreign.mallocForeignPtrBytes+        (fromIntegral cryptoAuthHMACSHA256Bytes)+    Foreign.withForeignPtr authenticationTagForeignPtr $ \authTagPtr ->+      Foreign.withForeignPtr authenticationKeyForeignPtr $ \authKeyPtr ->+        void $+          cryptoAuthHMACSHA256+            authTagPtr+            (Foreign.castPtr @CChar @CUChar cString)+            (fromIntegral @Int @CULLong cStringLen)+            authKeyPtr+    pure $ AuthenticationTag authenticationTagForeignPtr++-- ** Authenicating a multi-part message++-- | 'Multipart' is a cryptographic context for streaming hashing.+-- This API can be used when a message is too big to fit+-- in memory or when the message is received in portions.+--+-- Use it like this:+--+-- >>> secretKey <- HMAC.newSecreKey+-- >>> hash <- HMAC.withMultipart secretKey $ \multipartState -> do -- we are in MonadIO+-- ...   message1 <- getMessage+-- ...   HMAC.updateMultipart multipartState message1+-- ...   message2 <- getMessage+-- ...   HMAC.updateMultipart multipartState message2+--+-- @since 0.0.1.0+newtype Multipart s = Multipart (Ptr CryptoAuthHMACSHA256State)++type role Multipart nominal++-- | Perform streaming hashing with a 'Multipart' cryptographic context.+--+-- Use 'HMAC.updateMultipart' within the continuation.+--+-- The context is safely allocated first, then the continuation is run+-- and then it is deallocated after that.+--+-- @since 0.0.1.0+withMultipart+  :: forall (a :: Type) (m :: Type -> Type)+   . MonadIO m+  => AuthenticationKey+  -> (forall s. Multipart s -> m a)+  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context+  -> m AuthenticationTag+withMultipart (AuthenticationKey secretKeyForeignPtr) actions = do+  allocateWith cryptoAuthHMACSHA256StateBytes $ \statePtr -> do+    liftIO $ Foreign.withForeignPtr secretKeyForeignPtr $ \keyPtr ->+      cryptoAuthHMACSHA256Init statePtr keyPtr cryptoAuthHMACSHA256KeyBytes+    let part = Multipart statePtr+    actions part+    finaliseMultipart part++-- | Compute the 'AuthenticationTag' of all the portions that were fed to the cryptographic context.+--+--  this function is only used within 'withMultipart'+--+--  @since 0.0.1.0+finaliseMultipart :: MonadIO m => Multipart s -> m AuthenticationTag+finaliseMultipart (Multipart statePtr) = do+  authenticatorForeignPtr <- liftIO $ Foreign.mallocForeignPtrBytes (fromIntegral cryptoAuthHMACSHA256Bytes)+  liftIO $ Foreign.withForeignPtr authenticatorForeignPtr $ \(authenticatorPtr :: Ptr CUChar) ->+    void $+      cryptoAuthHMACSHA256Final+        statePtr+        authenticatorPtr+  pure $ AuthenticationTag authenticatorForeignPtr++-- | Add a message portion to be hashed.+--+-- This function should be used within 'withMultipart'.+--+-- @since 0.0.1.0+updateMultipart :: Multipart s -> StrictByteString -> IO ()+updateMultipart (Multipart statePtr) message = do+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    let messagePtr = Foreign.castPtr @CChar @CUChar cString+    let messageLen = fromIntegral @Int @CULLong cStringLen+    void $+      cryptoAuthHMACSHA256Update+        statePtr+        messagePtr+        messageLen++-- | Verify that the tag is valid for the provided message and secret key.+--+-- @since 0.0.1.0+verify+  :: AuthenticationTag+  -> AuthenticationKey+  -> StrictByteString+  -> Bool+verify (AuthenticationTag tagForeignPtr) (AuthenticationKey keyForeignPtr) message = unsafeDupablePerformIO $+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) ->+    Foreign.withForeignPtr tagForeignPtr $ \authTagPtr ->+      Foreign.withForeignPtr keyForeignPtr $ \authKeyPtr -> do+        result <-+          cryptoAuthHMACSHA256Verify+            authTagPtr+            (Foreign.castPtr @CChar @CUChar cString)+            (fromIntegral @Int @CULLong cStringLen)+            authKeyPtr+        pure $ result == 0++-- | A secret authentication key of size 'cryptoAuthHMACSHA256Bytes'.+--+-- @since 0.0.1.0+newtype AuthenticationKey = AuthenticationKey (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+      -- > display authenticatonKey == "[REDACTED]"+    )+    via (OpaqueInstance "[REDACTED]" AuthenticationKey)++-- |+--+-- @since 0.0.1.0+instance Eq AuthenticationKey where+  (AuthenticationKey hk1) == (AuthenticationKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoAuthHMACSHA256KeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord AuthenticationKey where+  compare (AuthenticationKey hk1) (AuthenticationKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA256KeyBytes++-- | > show authenticationKey == "[REDACTED]"+--+-- @since 0.0.1.0+instance Show AuthenticationKey where+  show _ = "[REDACTED]"++-- | Generate a new random secret key of size 'cryptoAuthHMACSHA256KeyBytes'.+--+-- @since 0.0.1.0+newAuthenticationKey :: IO AuthenticationKey+newAuthenticationKey = newAuthenticationKeyWith cryptoAuthHMACSHA256Keygen++-- | Prepare memory for a 'AuthenticationKey' and use the provided action to fill it.+--+-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc'+-- (see the note attached there).+-- A finalizer is run when the key is goes out of scope.+newAuthenticationKeyWith :: (Foreign.Ptr CUChar -> IO ()) -> IO AuthenticationKey+newAuthenticationKeyWith action = do+  ptr <- sodiumMalloc cryptoAuthHMACSHA256KeyBytes+  when (ptr == Foreign.nullPtr) $ do+    throwErrno "sodium_malloc"++  fPtr <- Foreign.newForeignPtr_ ptr+  Foreign.addForeignPtrFinalizer finalizerSodiumFree fPtr+  action ptr+  pure $ AuthenticationKey fPtr++-- | Create an 'AuthenticationKey' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoAuthHMACSHA256Bytes'.+--+-- @since 0.0.1.0+authenticationKeyFromHexByteString :: StrictByteString -> Either Text AuthenticationKey+authenticationKeyFromHexByteString hexKey = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexKey of+    Right bytestring ->+      if BS.length bytestring == fromIntegral cryptoAuthHMACSHA256KeyBytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideAuthenticationKeyPtr, _) ->+          fmap Right $+            newAuthenticationKeyWith $ \authenticationKeyPtr ->+              Foreign.copyArray+                (Foreign.castPtr @CUChar @CChar authenticationKeyPtr)+                outsideAuthenticationKeyPtr+                (fromIntegral cryptoAuthHMACSHA256KeyBytes)+        else pure $ Left $ Text.pack "Authentication Key is too short"+    Left msg -> pure $ Left msg++-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.+--+-- This format is useful if you need conversion to base32 or base64.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+unsafeAuthenticationKeyToBinary :: AuthenticationKey -> StrictByteString+unsafeAuthenticationKeyToBinary (AuthenticationKey authenticationKeyForeignPtr) =+  BS.fromForeignPtr0+    (Foreign.castForeignPtr @CUChar @Word8 authenticationKeyForeignPtr)+    (fromIntegral @CSize @Int cryptoAuthHMACSHA256KeyBytes)++-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString+unsafeAuthenticationKeyToHexByteString =+  Base16.extractBase16 . Base16.encodeBase16' . unsafeAuthenticationKeyToBinary++-- | A secret authentication key of size 'cryptoAuthHMACSHA256Bytes'.+--+-- @since 0.0.1.0+newtype AuthenticationTag = AuthenticationTag (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+    )+    via (ShowInstance AuthenticationTag)++-- |+--+-- @since 0.0.1.0+instance Eq AuthenticationTag where+  (AuthenticationTag hk1) == (AuthenticationTag hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoAuthHMACSHA256Bytes++-- |+--+-- @since 0.0.1.0+instance Ord AuthenticationTag where+  compare (AuthenticationTag hk1) (AuthenticationTag hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA256Bytes++-- |+--+-- @since 0.0.1.0+instance Show AuthenticationTag where+  show = BS.unpackChars . authenticationTagToHexByteString++-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString+authenticationTagToHexByteString authenticationTag =+  Base16.extractBase16 $+    Base16.encodeBase16' $+      authenticationTagToBinary authenticationTag++-- | Convert an 'AuthenticationTag' to a binary 'StrictByteString'.+--+-- @since 0.0.1.0+authenticationTagToBinary :: AuthenticationTag -> StrictByteString+authenticationTagToBinary (AuthenticationTag fPtr) =+  BS.fromForeignPtr0+    (Foreign.castForeignPtr fPtr)+    (fromIntegral cryptoAuthHMACSHA256Bytes)++-- | Create an 'AuthenticationTag' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoAuthHMACSHA256Bytes'.+--+-- @since 0.0.1.0+authenticationTagFromHexByteString :: StrictByteString -> Either Text AuthenticationTag+authenticationTagFromHexByteString hexTag = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexTag of+    Right bytestring ->+      if BS.length bytestring >= fromIntegral cryptoAuthHMACSHA256Bytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideTagPtr, outsideTagLength) -> do+          hashForeignPtr <- BS.mallocByteString @CChar outsideTagLength -- The foreign pointer that will receive the hash data.+          Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+            -- We copy bytes from 'outsideTagPtr' to 'hashPtr'.+            Foreign.copyArray hashPtr outsideTagPtr outsideTagLength+          pure $+            Right $+              AuthenticationTag+                (Foreign.castForeignPtr @CChar @CUChar hashForeignPtr)+        else pure $ Left $ Text.pack "Authenticationg tag is too short"+    Left msg -> pure $ Left msg
+ src/Sel/HMAC/SHA512.hs view
@@ -0,0 +1,401 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.HMAC.SHA512+-- Description: HMAC-SHA-512+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.HMAC.SHA512+  ( -- ** Introduction+    -- $introduction++    -- ** Usage+    -- $usage++    -- ** Operations++    -- *** Authenticating a single messsage+    authenticate++    -- *** Authenticating a multi-part message+  , Multipart+  , withMultipart+  , updateMultipart++    -- *** Verifying a message+  , verify++    -- ** Authentication key+  , AuthenticationKey+  , newAuthenticationKey+  , authenticationKeyFromHexByteString+  , unsafeAuthenticationKeyToHexByteString+  , unsafeAuthenticationKeyToBinary++    -- ** Authentication tag+  , AuthenticationTag+  , authenticationTagToHexByteString+  , authenticationTagToBinary+  , authenticationTagFromHexByteString+  ) where++--++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+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 as Text+import Data.Text.Display+import Foreign (ForeignPtr, Ptr, Word8)+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+  , cryptoAuthHMACSHA512Bytes+  , cryptoAuthHMACSHA512Final+  , cryptoAuthHMACSHA512Init+  , cryptoAuthHMACSHA512KeyBytes+  , cryptoAuthHMACSHA512Keygen+  , cryptoAuthHMACSHA512StateBytes+  , cryptoAuthHMACSHA512Update+  , cryptoAuthHMACSHA512Verify+  )+import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc)+import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd)++-- $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.+--+-- The function computing the tag deterministic: the same @(message, key)@ tuple will always+-- produce the same output. However, even if the message is public, knowing the key is required+-- in order to be able to compute a valid tag.+-- Therefore, the key should remain confidential. The tag, however, can be public.++-- $usage+--+-- > import Sel.HMAC.SHA512 qualified as HMAC+-- >+-- > main = do+-- >   -- The parties agree on a shared secret key+-- >   authKey <- HMAC.newAuthenticationKey+-- >   -- An authentication tag is computed for the message by the server+-- >   let message = ("Hello, world!" :: StrictByteString)+-- >   tag <- HMAC.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+-- >   HMAC.verify tag authKey message+-- >   -- => True++-- | Compute an authentication tag for a message with a secret key shared by all parties.+--+-- @since 0.0.1.0+authenticate+  :: StrictByteString+  -- ^ Message to authenticate+  -> AuthenticationKey+  -- ^ Secret key for authentication+  -> IO AuthenticationTag+  -- ^ Cryptographic tag for authentication+authenticate message (AuthenticationKey authenticationKeyForeignPtr) =+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    authenticationTagForeignPtr <-+      Foreign.mallocForeignPtrBytes+        (fromIntegral cryptoAuthHMACSHA512Bytes)+    Foreign.withForeignPtr authenticationTagForeignPtr $ \authTagPtr ->+      Foreign.withForeignPtr authenticationKeyForeignPtr $ \authKeyPtr ->+        void $+          cryptoAuthHMACSHA512+            authTagPtr+            (Foreign.castPtr @CChar @CUChar cString)+            (fromIntegral @Int @CULLong cStringLen)+            authKeyPtr+    pure $ AuthenticationTag authenticationTagForeignPtr++-- ** Authenticating a multi-part message++-- | 'Multipart' is a cryptographic context for streaming hashing.+-- This API can be used when a message is too big to fit+-- in memory or when the message is received in portions.+--+-- Use it like this:+--+-- >>> secretKey <- HMAC.newSecreKey+-- >>> hash <- HMAC.withMultipart secretKey $ \multipartState -> do -- we are in MonadIO+-- ...   message1 <- getMessage+-- ...   HMAC.updateMultipart multipartState message1+-- ...   message2 <- getMessage+-- ...   HMAC.updateMultipart multipartState message2+--+-- @since 0.0.1.0+newtype Multipart s = Multipart (Ptr CryptoAuthHMACSHA512State)++type role Multipart nominal++-- | Perform streaming hashing with a 'Multipart' cryptographic context.+--+-- Use 'HMAC.updateMultipart' within the continuation.+--+-- The context is safely allocated first, then the continuation is run+-- and then it is deallocated after that.+--+-- @since 0.0.1.0+withMultipart+  :: forall (a :: Type) (m :: Type -> Type)+   . MonadIO m+  => AuthenticationKey+  -> (forall s. Multipart s -> m a)+  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context+  -> m AuthenticationTag+withMultipart (AuthenticationKey secretKeyForeignPtr) actions = do+  allocateWith cryptoAuthHMACSHA512StateBytes $ \statePtr -> do+    liftIO $ Foreign.withForeignPtr secretKeyForeignPtr $ \keyPtr ->+      cryptoAuthHMACSHA512Init statePtr keyPtr cryptoAuthHMACSHA512KeyBytes+    let part = Multipart statePtr+    actions part+    finaliseMultipart part++-- | Compute the 'AuthenticationTag' of all the portions that were fed to the cryptographic context.+--+--  this function is only used within 'withMultipart'+--+--  @since 0.0.1.0+finaliseMultipart :: MonadIO m => Multipart s -> m AuthenticationTag+finaliseMultipart (Multipart statePtr) = do+  authenticatorForeignPtr <- liftIO $ Foreign.mallocForeignPtrBytes (fromIntegral cryptoAuthHMACSHA512Bytes)+  liftIO $ Foreign.withForeignPtr authenticatorForeignPtr $ \(authenticatorPtr :: Ptr CUChar) ->+    void $+      cryptoAuthHMACSHA512Final+        statePtr+        authenticatorPtr+  pure $ AuthenticationTag authenticatorForeignPtr++-- | Add a message portion to be hashed.+--+-- This function should be used within 'withMultipart'.+--+-- @since 0.0.1.0+updateMultipart :: Multipart s -> StrictByteString -> IO ()+updateMultipart (Multipart statePtr) message = do+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    let messagePtr = Foreign.castPtr @CChar @CUChar cString+    let messageLen = fromIntegral @Int @CULLong cStringLen+    void $+      cryptoAuthHMACSHA512Update+        statePtr+        messagePtr+        messageLen++-- | Verify that the tag is valid for the provided message and secret key.+--+-- @since 0.0.1.0+verify+  :: AuthenticationTag+  -> AuthenticationKey+  -> StrictByteString+  -> Bool+verify (AuthenticationTag tagForeignPtr) (AuthenticationKey keyForeignPtr) message = unsafeDupablePerformIO $+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) ->+    Foreign.withForeignPtr tagForeignPtr $ \authTagPtr ->+      Foreign.withForeignPtr keyForeignPtr $ \authKeyPtr -> do+        result <-+          cryptoAuthHMACSHA512Verify+            authTagPtr+            (Foreign.castPtr @CChar @CUChar cString)+            (fromIntegral @Int @CULLong cStringLen)+            authKeyPtr+        pure $ result == 0++-- | A secret authentication key of size 'cryptoAuthHMACSHA512Bytes'.+--+-- @since 0.0.1.0+newtype AuthenticationKey = AuthenticationKey (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+      -- > display authenticatonKey == "[REDACTED]"+    )+    via (OpaqueInstance "[REDACTED]" AuthenticationKey)++-- |+--+-- @since 0.0.1.0+instance Eq AuthenticationKey where+  (AuthenticationKey hk1) == (AuthenticationKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoAuthHMACSHA512KeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord AuthenticationKey where+  compare (AuthenticationKey hk1) (AuthenticationKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA512KeyBytes++-- | > show authenticationKey == "[REDACTED]"+--+-- @since 0.0.1.0+instance Show AuthenticationKey where+  show _ = "[REDACTED]"++-- | Generate a new random secret key of size 'cryptoAuthHMACSHA512KeyBytes'.+--+-- @since 0.0.1.0+newAuthenticationKey :: IO AuthenticationKey+newAuthenticationKey = newAuthenticationKeyWith cryptoAuthHMACSHA512Keygen++-- | Prepare memory for a 'AuthenticationKey' and use the provided action to fill it.+--+-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc'+-- (see the note attached there).+-- A finalizer is run when the key is goes out of scope.+newAuthenticationKeyWith :: (Foreign.Ptr CUChar -> IO ()) -> IO AuthenticationKey+newAuthenticationKeyWith action = do+  ptr <- sodiumMalloc cryptoAuthHMACSHA512KeyBytes+  when (ptr == Foreign.nullPtr) $ do+    throwErrno "sodium_malloc"++  fPtr <- Foreign.newForeignPtr_ ptr+  Foreign.addForeignPtrFinalizer finalizerSodiumFree fPtr+  action ptr+  pure $ AuthenticationKey fPtr++-- | Create an 'AuthenticationKey' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoAuthHMACSHA512Bytes'.+--+-- @since 0.0.1.0+authenticationKeyFromHexByteString :: StrictByteString -> Either Text AuthenticationKey+authenticationKeyFromHexByteString hexKey = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexKey of+    Right bytestring ->+      if BS.length bytestring == fromIntegral cryptoAuthHMACSHA512KeyBytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideAuthenticationKeyPtr, _) ->+          fmap Right $+            newAuthenticationKeyWith $ \authenticationKeyPtr ->+              Foreign.copyArray+                (Foreign.castPtr @CUChar @CChar authenticationKeyPtr)+                outsideAuthenticationKeyPtr+                (fromIntegral cryptoAuthHMACSHA512KeyBytes)+        else pure $ Left $ Text.pack "Authentication Key is too short"+    Left msg -> pure $ Left msg++-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.+--+-- This format is useful if you need conversion to base32 or base64.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+unsafeAuthenticationKeyToBinary :: AuthenticationKey -> StrictByteString+unsafeAuthenticationKeyToBinary (AuthenticationKey authenticationKeyForeignPtr) =+  BS.fromForeignPtr0+    (Foreign.castForeignPtr @CUChar @Word8 authenticationKeyForeignPtr)+    (fromIntegral @CSize @Int cryptoAuthHMACSHA512KeyBytes)++-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString+unsafeAuthenticationKeyToHexByteString =+  Base16.extractBase16 . Base16.encodeBase16' . unsafeAuthenticationKeyToBinary++-- | A secret authentication key of size 'cryptoAuthHMACSHA512Bytes'.+--+-- @since 0.0.1.0+newtype AuthenticationTag = AuthenticationTag (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+    )+    via (ShowInstance AuthenticationTag)++-- |+--+-- @since 0.0.1.0+instance Eq AuthenticationTag where+  (AuthenticationTag hk1) == (AuthenticationTag hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoAuthHMACSHA512Bytes++-- |+--+-- @since 0.0.1.0+instance Ord AuthenticationTag where+  compare (AuthenticationTag hk1) (AuthenticationTag hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA512Bytes++-- |+--+-- @since 0.0.1.0+instance Show AuthenticationTag where+  show = BS.unpackChars . authenticationTagToHexByteString++-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString+authenticationTagToHexByteString authenticationTag =+  Base16.extractBase16 $+    Base16.encodeBase16' $+      authenticationTagToBinary authenticationTag++-- | Convert an 'AuthenticationTag' to a binary 'StrictByteString'.+--+-- @since 0.0.1.0+authenticationTagToBinary :: AuthenticationTag -> StrictByteString+authenticationTagToBinary (AuthenticationTag fPtr) =+  BS.fromForeignPtr0+    (Foreign.castForeignPtr fPtr)+    (fromIntegral cryptoAuthHMACSHA512Bytes)++-- | Create an 'AuthenticationTag' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoAuthHMACSHA512Bytes'.+--+-- @since 0.0.1.0+authenticationTagFromHexByteString :: StrictByteString -> Either Text AuthenticationTag+authenticationTagFromHexByteString hexTag = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexTag of+    Right bytestring ->+      if BS.length bytestring >= fromIntegral cryptoAuthHMACSHA512Bytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideTagPtr, outsideTagLength) -> do+          hashForeignPtr <- BS.mallocByteString @CChar outsideTagLength -- The foreign pointer that will receive the hash data.+          Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+            -- We copy bytes from 'outsideTagPtr' to 'hashPtr'.+            Foreign.copyArray hashPtr outsideTagPtr outsideTagLength+          pure $+            Right $+              AuthenticationTag+                (Foreign.castForeignPtr @CChar @CUChar hashForeignPtr)+        else pure $ Left $ Text.pack "Authentication tag is too short"+    Left msg -> pure $ Left msg
+ src/Sel/HMAC/SHA512_256.hs view
@@ -0,0 +1,400 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.HMAC.SHA512_256+-- Description: HMAC-SHA-512-256+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.HMAC.SHA512_256+  ( -- ** Introduction+    -- $introduction++    -- ** Usage+    -- $usage++    -- ** Operations++    -- *** Authenticating a single messsage+    authenticate++    -- *** Authenticating a multi-part message+  , Multipart+  , withMultipart+  , updateMultipart++    -- *** Verifying a message+  , verify++    -- ** Authentication key+  , AuthenticationKey+  , newAuthenticationKey+  , authenticationKeyFromHexByteString+  , unsafeAuthenticationKeyToHexByteString+  , unsafeAuthenticationKeyToBinary++    -- ** Authentication tag+  , AuthenticationTag+  , authenticationTagToHexByteString+  , authenticationTagToBinary+  , authenticationTagFromHexByteString+  ) where++--++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+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 as Text+import Data.Text.Display+import Foreign (ForeignPtr, Ptr, Word8)+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+  , cryptoAuthHMACSHA512256Bytes+  , cryptoAuthHMACSHA512256Final+  , cryptoAuthHMACSHA512256Init+  , cryptoAuthHMACSHA512256KeyBytes+  , cryptoAuthHMACSHA512256Keygen+  , cryptoAuthHMACSHA512256StateBytes+  , cryptoAuthHMACSHA512256Update+  , cryptoAuthHMACSHA512256Verify+  )+import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc)+import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd)++-- $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.+--+-- The function computing the tag deterministic: the same @(message, key)@ tuple will always+-- produce the same output. However, even if the message is public, knowing the key is required+-- in order to be able to compute a valid tag.+-- Therefore, the key should remain confidential. The tag, however, can be public.++-- $usage+--+-- > import Sel.HMAC.SHA512_256 qualified as HMAC+-- >+-- > main = do+-- >   -- The parties agree on a shared secret key+-- >   authKey <- HMAC.newAuthenticationKey+-- >   -- An authentication tag is computed for the message by the server+-- >   let message = ("Hello, world!" :: StrictByteString)+-- >   tag <- HMAC.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+-- >   HMAC.verify tag authKey message+-- >   -- => True++-- | Compute an authentication tag for a message with a secret key shared by all parties.+--+-- @since 0.0.1.0+authenticate+  :: StrictByteString+  -- ^ Message to authenticate+  -> AuthenticationKey+  -- ^ Secret key for authentication+  -> IO AuthenticationTag+  -- ^ Cryptographic tag for authentication+authenticate message (AuthenticationKey authenticationKeyForeignPtr) =+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    authenticationTagForeignPtr <-+      Foreign.mallocForeignPtrBytes+        (fromIntegral cryptoAuthHMACSHA512256Bytes)+    Foreign.withForeignPtr authenticationTagForeignPtr $ \authTagPtr ->+      Foreign.withForeignPtr authenticationKeyForeignPtr $ \authKeyPtr ->+        void $+          cryptoAuthHMACSHA512256+            authTagPtr+            (Foreign.castPtr @CChar @CUChar cString)+            (fromIntegral @Int @CULLong cStringLen)+            authKeyPtr+    pure $ AuthenticationTag authenticationTagForeignPtr++-- ** Authenticating a multi-part message++-- | 'Multipart' is a cryptographic context for streaming hashing.+-- This API can be used when a message is too big to fit+-- in memory or when the message is received in portions.+--+-- Use it like this:+--+-- >>> secretKey <- HMAC.newSecreKey+-- >>> hash <- HMAC.withMultipart secretKey $ \multipartState -> do -- we are in MonadIO+-- ...   message1 <- getMessage+-- ...   HMAC.updateMultipart multipartState message1+-- ...   message2 <- getMessage+-- ...   HMAC.updateMultipart multipartState message2+--+-- @since 0.0.1.0+newtype Multipart s = Multipart (Ptr CryptoAuthHMACSHA512256State)++type role Multipart nominal++-- | Perform streaming hashing with a 'Multipart' cryptographic context.+--+-- Use 'HMAC.updateMultipart' within the continuation.+--+-- The context is safely allocated first, then the continuation is run+-- and then it is deallocated after that.+--+-- @since 0.0.1.0+withMultipart+  :: forall (a :: Type) (m :: Type -> Type)+   . MonadIO m+  => AuthenticationKey+  -> (forall s. Multipart s -> m a)+  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context+  -> m AuthenticationTag+withMultipart (AuthenticationKey secretKeyForeignPtr) actions = do+  allocateWith cryptoAuthHMACSHA512256StateBytes $ \statePtr -> do+    liftIO $ Foreign.withForeignPtr secretKeyForeignPtr $ \keyPtr ->+      cryptoAuthHMACSHA512256Init statePtr keyPtr cryptoAuthHMACSHA512256KeyBytes+    let part = Multipart statePtr+    actions part+    finaliseMultipart part++-- | Compute the 'AuthenticationTag' of all the portions that were fed to the cryptographic context.+--+--  this function is only used within 'withMultipart'+--+--  @since 0.0.1.0+finaliseMultipart :: MonadIO m => Multipart s -> m AuthenticationTag+finaliseMultipart (Multipart statePtr) = do+  authenticatorForeignPtr <- liftIO $ Foreign.mallocForeignPtrBytes (fromIntegral cryptoAuthHMACSHA512256Bytes)+  liftIO $ Foreign.withForeignPtr authenticatorForeignPtr $ \(authenticatorPtr :: Ptr CUChar) ->+    void $+      cryptoAuthHMACSHA512256Final+        statePtr+        authenticatorPtr+  pure $ AuthenticationTag authenticatorForeignPtr++-- | Add a message portion to be hashed.+--+-- This function should be used within 'withMultipart'.+--+-- @since 0.0.1.0+updateMultipart :: Multipart s -> StrictByteString -> IO ()+updateMultipart (Multipart statePtr) message = do+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    let messagePtr = Foreign.castPtr @CChar @CUChar cString+    let messageLen = fromIntegral @Int @CULLong cStringLen+    void $+      cryptoAuthHMACSHA512256Update+        statePtr+        messagePtr+        messageLen++-- | Verify that the tag is valid for the provided message and secret key.+--+-- @since 0.0.1.0+verify+  :: AuthenticationTag+  -> AuthenticationKey+  -> StrictByteString+  -> Bool+verify (AuthenticationTag tagForeignPtr) (AuthenticationKey keyForeignPtr) message = unsafeDupablePerformIO $+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) ->+    Foreign.withForeignPtr tagForeignPtr $ \authTagPtr ->+      Foreign.withForeignPtr keyForeignPtr $ \authKeyPtr -> do+        result <-+          cryptoAuthHMACSHA512256Verify+            authTagPtr+            (Foreign.castPtr @CChar @CUChar cString)+            (fromIntegral @Int @CULLong cStringLen)+            authKeyPtr+        pure $ result == 0++-- | A secret authentication key of size 'cryptoAuthHMACSHA512256Bytes'.+--+-- @since 0.0.1.0+newtype AuthenticationKey = AuthenticationKey (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+      -- > display authenticatonKey == "[REDACTED]"+    )+    via (OpaqueInstance "[REDACTED]" AuthenticationKey)++-- |+--+-- @since 0.0.1.0+instance Eq AuthenticationKey where+  (AuthenticationKey hk1) == (AuthenticationKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoAuthHMACSHA512256KeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord AuthenticationKey where+  compare (AuthenticationKey hk1) (AuthenticationKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA512256KeyBytes++-- | > show authenticationKey == "[REDACTED]"+--+-- @since 0.0.1.0+instance Show AuthenticationKey where+  show _ = "[REDACTED]"++-- | Generate a new random secret key of size 'cryptoAuthHMACSHA512256KeyBytes'.+--+-- @since 0.0.1.0+newAuthenticationKey :: IO AuthenticationKey+newAuthenticationKey = newAuthenticationKeyWith cryptoAuthHMACSHA512256Keygen++-- | Prepare memory for a 'AuthenticationKey' and use the provided action to fill it.+--+-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc'+-- (see the note attached there).+-- A finalizer is run when the key is goes out of scope.+newAuthenticationKeyWith :: (Foreign.Ptr CUChar -> IO ()) -> IO AuthenticationKey+newAuthenticationKeyWith action = do+  ptr <- sodiumMalloc cryptoAuthHMACSHA512256KeyBytes+  when (ptr == Foreign.nullPtr) $ do+    throwErrno "sodium_malloc"++  fPtr <- Foreign.newForeignPtr_ ptr+  Foreign.addForeignPtrFinalizer finalizerSodiumFree fPtr+  action ptr+  pure $ AuthenticationKey fPtr++-- | Create an 'AuthenticationKey' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoAuthHMACSHA512256Bytes'.+--+-- @since 0.0.1.0+authenticationKeyFromHexByteString :: StrictByteString -> Either Text AuthenticationKey+authenticationKeyFromHexByteString hexKey = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexKey of+    Right bytestring ->+      if BS.length bytestring == fromIntegral cryptoAuthHMACSHA512256KeyBytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideAuthenticationKeyPtr, _) ->+          fmap Right $+            newAuthenticationKeyWith $ \authenticationKeyPtr ->+              Foreign.copyArray+                (Foreign.castPtr @CUChar @CChar authenticationKeyPtr)+                outsideAuthenticationKeyPtr+                (fromIntegral cryptoAuthHMACSHA512256KeyBytes)+        else pure $ Left $ Text.pack "Authentication Key is too short"+    Left msg -> pure $ Left msg++-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.+--+-- This format is useful if you need conversion to base32 or base64.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+unsafeAuthenticationKeyToBinary :: AuthenticationKey -> StrictByteString+unsafeAuthenticationKeyToBinary (AuthenticationKey authenticationKeyForeignPtr) =+  Base16.extractBase16 . Base16.encodeBase16' $+    BS.fromForeignPtr0+      (Foreign.castForeignPtr @CUChar @Word8 authenticationKeyForeignPtr)+      (fromIntegral @CSize @Int cryptoAuthHMACSHA512256KeyBytes)++-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString+unsafeAuthenticationKeyToHexByteString =+  Base16.extractBase16 . Base16.encodeBase16' . unsafeAuthenticationKeyToBinary++-- | A secret authentication key of size 'cryptoAuthHMACSHA512256Bytes'.+--+-- @since 0.0.1.0+newtype AuthenticationTag = AuthenticationTag (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+    )+    via (ShowInstance AuthenticationTag)++-- |+--+-- @since 0.0.1.0+instance Eq AuthenticationTag where+  (AuthenticationTag hk1) == (AuthenticationTag hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoAuthHMACSHA512256Bytes++-- |+--+-- @since 0.0.1.0+instance Ord AuthenticationTag where+  compare (AuthenticationTag hk1) (AuthenticationTag hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoAuthHMACSHA512256Bytes++-- |+--+-- @since 0.0.1.0+instance Show AuthenticationTag where+  show = BS.unpackChars . authenticationTagToHexByteString++-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString+authenticationTagToHexByteString authenticationTag =+  Base16.extractBase16 $+    Base16.encodeBase16' $+      authenticationTagToBinary authenticationTag++-- | Convert an 'AuthenticationTag' to a binary 'StrictByteString'.+--+-- @since 0.0.1.0+authenticationTagToBinary :: AuthenticationTag -> StrictByteString+authenticationTagToBinary (AuthenticationTag fPtr) =+  BS.fromForeignPtr0+    (Foreign.castForeignPtr fPtr)+    (fromIntegral cryptoAuthHMACSHA512256Bytes)++-- | Create an 'AuthenticationTag' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoAuthHMACSHA512256Bytes'.+--+-- @since 0.0.1.0+authenticationTagFromHexByteString :: StrictByteString -> Either Text AuthenticationTag+authenticationTagFromHexByteString hexTag = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexTag of+    Right bytestring ->+      if BS.length bytestring >= fromIntegral cryptoAuthHMACSHA512256Bytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideTagPtr, outsideTagLength) -> do+          hashForeignPtr <- BS.mallocByteString @CChar outsideTagLength -- The foreign pointer that will receive the hash data.+          Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+            -- We copy bytes from 'outsideTagPtr' to 'hashPtr'.+            Foreign.copyArray hashPtr outsideTagPtr outsideTagLength+          pure $+            Right $+              AuthenticationTag+                (Foreign.castForeignPtr @CChar @CUChar hashForeignPtr)+        else pure $ Left $ Text.pack "Authentication tag is too short"+    Left msg -> pure $ Left msg
+ src/Sel/Hashing.hs view
@@ -0,0 +1,326 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.Hashing+-- Description: Hashing with the BLAKE2b algorithm+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.Hashing+  ( -- ** Introduction+    -- $introduction++    -- ** Hashing a message+    HashKey+  , newHashKey+  , Hash+  , hashByteString++    -- ** Hashing a multi-part message+  , Multipart+  , withMultipart+  , updateMultipart++    -- ** Conversion+  , hashToHexText+  , hashToHexByteString+  , hashToBinary+  )+where++import Control.Monad (void)+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.Text (Text)+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+  , cryptoGenericHashBytes+  , cryptoGenericHashFinal+  , cryptoGenericHashInit+  , cryptoGenericHashKeyBytes+  , cryptoGenericHashKeyGen+  , cryptoGenericHashStateBytes+  , cryptoGenericHashUpdate+  )+import Sel.Internal++-- $introduction+--+-- This API computes a fixed-length fingerprint for an arbitrarily long message.+-- It is backed by the [BLAKE2b](https://en.wikipedia.org/wiki/BLAKE_\(hash_function\)) algorithm.+--+-- Sample use cases:+--+--   * File integrity checking+--   * Creating unique identifiers to index arbitrarily long data+--+-- __⚠️ Do not use this module to hash passwords! ⚠️__ Please use the "Sel.Hashing.Password" module instead.+--+-- If you need to deviate from the defaults enforced by this module,+-- please use the underlying bindings at "LibSodium.Bindings.GenericHashing".++-- | The 'HashKey' is used to produce distinct fingerprints for the same message.+-- It is optional to use, and 'hashByteString' will always produce the same fingerprint+-- for the same message if a 'HashKey' is not given. This behaviour is similar to+-- MD5 and SHA-1 functions, for which 'hashByteString' is a faster and more secure alternative.+--+-- Create a new 'HashKey' with 'newHashKey'.+--+-- @since 0.0.1.0+newtype HashKey = HashKey (ForeignPtr CUChar)++instance Eq HashKey where+  (HashKey hk1) == (HashKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoGenericHashKeyBytes++instance Ord HashKey where+  compare (HashKey hk1) (HashKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoGenericHashKeyBytes++-- | Create a new 'HashKey' of size 'cryptoGenericHashKeyBytes'.+--+-- @since 0.0.1.0+newHashKey :: IO HashKey+newHashKey = do+  fPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoGenericHashKeyBytes)+  Foreign.withForeignPtr fPtr $ \ptr ->+    cryptoGenericHashKeyGen ptr+  pure $ HashKey fPtr++-- | The fingerprint computed by @hashByteString@.+-- It is produced by the BLAKE2b algorithm, and is+-- of size 'cryptoGenericHashBytes', as recommended.+--+-- You can produce a human-readable string representation+-- of a 'Hash' by using the @display@ function.+--+-- @since 0.0.1.0+newtype Hash = Hash (ForeignPtr CUChar)++-- |+--+-- @since 0.0.1.0+instance Eq Hash where+  (Hash h1) == (Hash h2) =+    unsafeDupablePerformIO $+      foreignPtrEq h1 h2 cryptoGenericHashBytes++-- |+--+-- @since 0.0.1.0+instance Ord Hash where+  compare (Hash h1) (Hash h2) =+    unsafeDupablePerformIO $+      foreignPtrOrd h1 h2 cryptoGenericHashBytes++-- |+--+-- @since 0.0.1.0+instance Storable Hash where+  sizeOf :: Hash -> Int+  sizeOf _ = fromIntegral cryptoGenericHashBytes++  --  Aligned on the size of 'cryptoGenericHashBytes'+  alignment :: Hash -> Int+  alignment _ = 32++  poke :: Ptr Hash -> Hash -> IO ()+  poke ptr (Hash hashForeignPtr) =+    Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+      Foreign.copyArray (Foreign.castPtr ptr) hashPtr (fromIntegral cryptoGenericHashKeyBytes)++  peek :: Ptr Hash -> IO Hash+  peek ptr = do+    hashfPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoGenericHashKeyBytes)+    Foreign.withForeignPtr hashfPtr $ \hashPtr ->+      Foreign.copyArray hashPtr (Foreign.castPtr ptr) (fromIntegral cryptoGenericHashKeyBytes)+    pure $ Hash hashfPtr++-- |+--+-- @since 0.0.1.0+instance Display Hash where+  displayBuilder = Builder.fromText . hashToHexText++-- |+--+-- @since 0.0.1.0+instance Show Hash where+  show = BS.unpackChars . hashToHexByteString++-- | Hash a 'StrictByteString' with the BLAKE2b algorithm, and an optional key.+--+-- 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 =+  case mHashKey of+    Just (HashKey fPtr) ->+      Foreign.withForeignPtr fPtr $ \keyPtr ->+        doHashByteString keyPtr cryptoGenericHashKeyBytes+    Nothing ->+      doHashByteString Foreign.nullPtr 0+  where+    doHashByteString :: Ptr a -> CSize -> IO Hash+    doHashByteString keyPtr keyLength =+      unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do+        hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoGenericHashBytes)+        Foreign.withForeignPtr hashForeignPtr $ \hashPtr -> do+          void $+            cryptoGenericHash+              hashPtr+              cryptoGenericHashBytes+              (Foreign.castPtr cString :: Ptr CUChar)+              (fromIntegral cStringLen)+              (Foreign.castPtr keyPtr :: Ptr CUChar)+              keyLength+        pure $ Hash hashForeignPtr++-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'Text'.+--+-- @since 0.0.1.0+hashToHexText :: Hash -> Text+hashToHexText = Base16.extractBase16 . Base16.encodeBase16 . hashToBinary++-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+hashToHexByteString :: Hash -> StrictByteString+hashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . hashToBinary++-- | Convert a 'Hash' to a strict binary 'StrictByteString'.+--+-- @since 0.0.1.0+hashToBinary :: Hash -> StrictByteString+hashToBinary (Hash fPtr) =+  BS.fromForeignPtr (Foreign.castForeignPtr fPtr) 0 hashBytesSize+  where+    hashBytesSize = fromIntegral cryptoGenericHashBytes++-- ** Hashing a multi-part message++-- | 'Multipart' is a cryptographic context for streaming hashing.+-- This API can be used when a message is too big to fit+-- in memory or when the message is received in portions.+--+-- Use it like this:+--+-- >>> hashKey <- Hashing.newHashKey+-- >>> hash <- Hashing.withMultipart (Just hashKey) $ \multipartState -> do -- we are in MonadIO+-- ...   message1 <- getMessage+-- ...   Hashing.updateMultipart multipartState message1+-- ...   message2 <- getMessage+-- ...   Hashing.updateMultipart multipartState message2+--+-- @since 0.0.1.0+newtype Multipart s = Multipart (Ptr CryptoGenericHashState)++type role Multipart nominal++-- | Perform streaming hashing with a 'Multipart' cryptographic context.+-- If there is no 'HashKey', you will get the same output for the same input all the time.+--+-- Use 'Hashing.updateMultipart' within the continuation to add more message parts to be hashed.+--+-- The context is safely allocated first, then the continuation is run+-- and then it is deallocated after that.+--+-- @since 0.0.1.0+withMultipart+  :: forall (a :: Type) (m :: Type -> Type)+   . MonadIO m+  => Maybe HashKey+  -- ^ Optional cryptographic key+  -> (forall s. Multipart s -> m a)+  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context+  -> m Hash+withMultipart mKey actions = do+  allocateWith cryptoGenericHashStateBytes $ \statePtr -> do+    case mKey of+      Just (HashKey hashKeyFPtr) ->+        liftIO $ Foreign.withForeignPtr hashKeyFPtr $ \(hashKeyPtr :: Ptr CUChar) ->+          liftIO $+            initMultipart+              statePtr+              hashKeyPtr+              cryptoGenericHashKeyBytes+      Nothing ->+        liftIO $+          initMultipart+            statePtr+            Foreign.nullPtr+            0+    let part = Multipart statePtr+    actions part+    finaliseMultipart part++-- Internal+initMultipart+  :: Ptr CryptoGenericHashState+  -> Ptr CUChar+  -> CSize+  -> IO CInt+initMultipart statePtr hashKeyPtr hashKeyLength =+  cryptoGenericHashInit+    statePtr+    hashKeyPtr+    hashKeyLength+    cryptoGenericHashBytes++-- | Compute the 'Hash' of all the portions that were fed to the cryptographic context.+--+--  this function is only used within 'withMultipart'+--+--  @since 0.0.1.0+finaliseMultipart :: MonadIO m => Multipart s -> m Hash+finaliseMultipart (Multipart statePtr) = liftIO $ do+  hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoGenericHashBytes)+  Foreign.withForeignPtr hashForeignPtr $ \(hashPtr :: Ptr CUChar) ->+    void $+      cryptoGenericHashFinal+        statePtr+        hashPtr+        cryptoGenericHashBytes+  pure $ Hash hashForeignPtr++-- | Add a message portion to be hashed.+--+-- This function is to be used within 'withMultipart'.+--+-- @since 0.0.1.0+updateMultipart :: forall (m :: Type -> Type) (s :: Type). MonadIO m => Multipart s -> StrictByteString -> m ()+updateMultipart (Multipart statePtr) message = liftIO $ do+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    let messagePtr = Foreign.castPtr @CChar @CUChar cString+    let messageLen = fromIntegral @Int @CULLong cStringLen+    void $+      cryptoGenericHashUpdate+        statePtr+        messagePtr+        messageLen
+ src/Sel/Hashing/Password.hs view
@@ -0,0 +1,357 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.Hashing.Password+-- Description: Password hashing with the Argon2id algorithm+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.Hashing.Password+  ( -- * Introduction+    -- $introduction+    PasswordHash++    -- ** Password Hashing and Verifying+  , hashByteString+  , hashText+  , verifyByteString+  , verifyText+  , hashByteStringWithParams++    -- *** Conversion+  , passwordHashToByteString+  , passwordHashToText+  , passwordHashToHexText+  , passwordHashToHexByteString+  , asciiTextToPasswordHash+  , asciiByteStringToPasswordHash++    -- ** Salt+  , Salt+  , genSalt++    -- ** Conversion+  , saltToBinary+  , saltToHexText+  , saltToHexByteString+  , binaryToSalt+  , hexTextToSalt+  , hexByteStringToSalt++    -- * Argon2 Parameters+  , Argon2Params (Argon2Params)+  , defaultArgon2Params+  )+where++import Control.Monad (void)+import Data.ByteString (StrictByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Char8 as Char8+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import Data.Text (Text)+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++-- $introduction+--+-- This API provides functions for password hashing, backed by the [Argon2id](https://en.wikipedia.org/wiki/Argon2) algorithm.+--+-- If you need to deviate from the defaults enforced by this module,+-- please use the underlying bindings at "LibSodium.Bindings.PasswordHashing".++-- | A hashed password from the Argon2id algorithm.+--+-- @since 0.0.1.0+newtype PasswordHash = PasswordHash (ForeignPtr CChar)+  deriving stock (Generic)++-- | @since 0.0.1.0+instance Display PasswordHash where+  displayBuilder = Builder.fromText . passwordHashToHexText++-- | @since 0.0.1.0+instance Eq PasswordHash where+  (PasswordHash ph1) == (PasswordHash ph2) =+    unsafeDupablePerformIO $+      foreignPtrEq ph1 ph2 cryptoPWHashStrBytes++-- | @since 0.0.1.0+instance Ord PasswordHash where+  (PasswordHash ph1) `compare` (PasswordHash ph2) =+    unsafeDupablePerformIO $+      foreignPtrOrd ph1 ph2 cryptoPWHashStrBytes++-- | @since 0.0.1.0+instance Show PasswordHash where+  show s = showHash s+    where+      showHash :: PasswordHash -> String+      showHash = show . passwordHashToText++-- | Hash the password with the Argon2id algorithm and a set of pre-defined parameters.+--+-- The hash is encoded in a human-readable format that includes:+--+--   * The result of a memory-hard, CPU-intensive hash function applied to the password;+--   * The automatically generated salt used for the previous computation;+--   * The other parameters required to verify the password, including the algorithm+--     identifier, its version, opslimit, and memlimit.+--+-- Example output: @$argon2id$v=19$m=262144,t=3,p=1$fpPdXj9mK7J4m…@+--+-- @since 0.0.1.0+hashByteString :: StrictByteString -> IO PasswordHash+hashByteString bytestring =+  BS.unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do+    hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoPWHashStrBytes)+    Foreign.withForeignPtr hashForeignPtr $ \passwordHashPtr ->+      void $+        cryptoPWHashStr+          passwordHashPtr+          cString+          (fromIntegral @Int @CULLong cStringLen)+          cryptoPWHashOpsLimitModerate+          cryptoPWHashMemLimitModerate+    pure $ PasswordHash hashForeignPtr++-- | Hash a UTF8-encoded password with the Argon2id algorithm and+-- a set of pre-defined parameters.+--+-- @since 0.0.1.0+hashText :: Text -> IO PasswordHash+hashText text = hashByteString (Text.encodeUtf8 text)++-- | Hash the password with the Argon2id algorithm.+--+-- 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 =+  BS.unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do+    BS.unsafeUseAsCStringLen argonSalt $ \(saltString, _) -> do+      hashForeignPtr <- mallocForeignPtrBytes (fromIntegral cryptoPWHashStrBytes)+      withForeignPtr hashForeignPtr $ \passwordHashPtr ->+        void $+          cryptoPWHash+            passwordHashPtr+            (fromIntegral @CSize @CLLong cryptoPWHashStrBytes)+            cString+            (fromIntegral @Int @CULLong cStringLen)+            (castPtr saltString)+            opsLimit+            memLimit+            cryptoPWHashAlgDefault+      pure $ PasswordHash (castForeignPtr @CUChar @CChar hashForeignPtr)++-- | Verify the password hash against a clear 'Text' password+--+-- This function purposefully takes some time to complete, in order to alleviate bruteforce attacks.+--+-- @since 0.0.1.0+verifyText :: PasswordHash -> Text -> Bool+verifyText passwordHash clearTextPassword = verifyByteString passwordHash (Text.encodeUtf8 clearTextPassword)++-- | Verify the password hash against a clear 'StrictByteString' password+--+-- This function purposefully takes some time to complete, in order to alleviate bruteforce attacks.+--+-- @since 0.0.1.0+verifyByteString :: PasswordHash -> StrictByteString -> Bool+verifyByteString (PasswordHash fPtr) clearTextPassword = unsafeDupablePerformIO $ do+  BS.unsafeUseAsCStringLen clearTextPassword $ \(cString, cStringLen) -> do+    Foreign.withForeignPtr fPtr $ \hashPtr -> do+      result <-+        cryptoPWHashStrVerify+          hashPtr+          cString+          (fromIntegral @Int @CULLong cStringLen)+      pure $ result == 0++-- | Convert a 'PasswordHash' to a 'StrictByteString'.+--+-- @since 0.0.1.0+passwordHashToByteString :: PasswordHash -> StrictByteString+passwordHashToByteString (PasswordHash fPtr) = unsafeDupablePerformIO $+  Foreign.withForeignPtr fPtr $ \hashPtr -> do+    resultByteString <- BS.unsafePackCStringLen (hashPtr, fromIntegral @CSize @Int cryptoPWHashStrBytes)+    pure $ Char8.dropWhileEnd (== '\NUL') resultByteString++-- | Convert a 'PasswordHash' to a strict 'Text'.+--+-- @since 0.0.1.0+passwordHashToText :: PasswordHash -> Text+passwordHashToText passwordHash =+  let bs = passwordHashToByteString passwordHash+      (prefix, suffix) = Text.decodeASCIIPrefix bs+   in case BS.uncons suffix of+        Nothing -> prefix+        Just (word, _) ->+          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'.+--+-- 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++-- | Convert a 'PasswordHash' to a strict hexadecimal-encoded 'Text'.+--+-- It is recommended to use this one on a 'PasswordHash' produced by 'hashByteStringWithParams'.+--+-- @since 0.0.1.0+passwordHashToHexText :: PasswordHash -> Text+passwordHashToHexText = Base16.extractBase16 . Base16.encodeBase16 . passwordHashToByteString++-- | Convert an ascii-encoded password hash to a 'PasswordHash'+--+-- This function does not perform ASCII validation.+--+-- @since 0.0.1.0+asciiTextToPasswordHash :: Text -> PasswordHash+asciiTextToPasswordHash = asciiByteStringToPasswordHash . Text.encodeUtf8++-- | Convert an ascii-encoded password hash to a 'PasswordHash'+--+-- This function does not perform ASCII validation.+--+-- @since 0.0.1.0+asciiByteStringToPasswordHash :: StrictByteString -> PasswordHash+asciiByteStringToPasswordHash textualHash = unsafeDupablePerformIO $ do+  destinationFPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoPWHashStrBytes)+  Foreign.withForeignPtr destinationFPtr $ \destinationPtr -> do+    BS.useAsCStringLen textualHash $ \(sourcePtr, len) -> do+      Foreign.fillBytes destinationPtr 0 (fromIntegral cryptoPWHashStrBytes)+      Foreign.copyBytes destinationPtr sourcePtr len+      pure $ PasswordHash destinationFPtr++-- | The 'Salt' is used in conjunction with 'hashByteStringWithParams'+-- when you want to manually provide the piece of data that will+-- differentiate two fingerprints of the same password.+--+-- It is automatically taken care of for you when you use+-- 'hashByteString' or 'hashText'.+--+-- Use 'genSalt' to create a 'Salt' of size+-- equal to the constant 'cryptoPWHashSaltBytes'.+--+-- @since 0.0.1.0+newtype Salt = Salt StrictByteString+  deriving newtype+    ( Eq+      -- ^ @since 0.0.1.0+    , Ord+      -- ^ @since 0.0.1.0+    , Show+      -- ^ @since 0.0.1.0+    )++-- |+--+-- @since 0.0.1.0+instance Display Salt where+  displayBuilder salt = Builder.fromText . saltToHexText $ salt++-- | Generate a random 'Salt' for password hashing+--+-- @since 0.0.1.0+genSalt :: IO Salt+genSalt =+  Salt+    <$> BS.create+      (fromIntegral cryptoPWHashSaltBytes)+      (`randombytesBuf` cryptoPWHashSaltBytes)++-- | Convert 'Salt' to underlying 'StrictByteString' binary.+--+-- @since 0.0.2.0+saltToBinary :: Salt -> StrictByteString+saltToBinary (Salt bs) = bs++-- | Convert 'Salt' to a strict hexadecimal-encoded 'Text'.+--+-- @since 0.0.2.0+saltToHexText :: Salt -> Text+saltToHexText = Base16.extractBase16 . Base16.encodeBase16 . saltToBinary++-- | Convert 'Salt' to a hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.2.0+saltToHexByteString :: Salt -> StrictByteString+saltToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . saltToBinary++-- | Convert 'StrictByteString' to 'Salt'.+--+-- The input salt must be of length 'cryptoPWHashSaltBytes'.+--+-- @since 0.0.2.0+binaryToSalt :: StrictByteString -> Maybe Salt+binaryToSalt bs =+  if BS.length bs /= fromIntegral cryptoPWHashSaltBytes+    then Nothing+    else Just (Salt bs)++-- | Convert a strict hexadecimal-encoded 'Text' to a 'Salt'.+--+-- The input salt, once decoded from base16, must be of length 'cryptoPWHashSaltBytes'.+--+-- @since 0.0.1.0+hexTextToSalt :: Text -> Maybe Salt+hexTextToSalt = hexByteStringToSalt . Text.encodeUtf8++-- | Convert a hexadecimal-encoded 'StrictByteString' to a 'Salt'.+--+-- The input salt, once decoded from base16, must be of length 'cryptoPWHashSaltBytes'.+--+-- @since 0.0.1.0+hexByteStringToSalt :: StrictByteString -> Maybe Salt+hexByteStringToSalt hexByteString =+  case Base16.decodeBase16Untyped hexByteString of+    Right binary -> binaryToSalt binary+    Left _ -> Nothing++-- |+--+-- @since 0.0.1.0+data Argon2Params = Argon2Params+  { opsLimit :: CULLong+  , memLimit :: CSize+  }++-- | These are the default parameters with which 'hashByteStringWithParams' can be invoked:+--+-- * /opsLimit/ = 'cryptoPWHashOpsLimitModerate'+-- * /memLimit/ = 'cryptoPWHashMemLimitModerate'+--+-- @since 0.0.1.0+defaultArgon2Params :: Argon2Params+defaultArgon2Params =+  Argon2Params+    { opsLimit = cryptoPWHashOpsLimitModerate+    , memLimit = cryptoPWHashMemLimitModerate+    }
+ src/Sel/Hashing/SHA256.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Sel.Hashing.SHA256+-- Description: Legacy SHA-256 hashing+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.Hashing.SHA256+  ( -- ** Usage+    -- $usage+    Hash++    -- ** Hashing a single message+  , hashByteString+  , hashText++    -- ** Hashing a multi-part message+  , Multipart+  , withMultipart+  , updateMultipart++    -- ** Displaying+  , hashToBinary+  , hashToHexText+  , hashToHexByteString+  ) where++import Control.Monad (void)+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.Text (Text)+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)+import LibSodium.Bindings.SHA2+  ( CryptoHashSHA256State+  , cryptoHashSHA256+  , cryptoHashSHA256Bytes+  , cryptoHashSHA256Final+  , cryptoHashSHA256Init+  , cryptoHashSHA256StateBytes+  , cryptoHashSHA256Update+  )+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++-- $usage+--+-- The SHA-2 family of hashing functions is only provided for interoperability with other applications.+--+-- If you are looking for a generic hash function, do use 'Sel.Hashing'.+--+-- If you are looking to hash passwords or deriving keys from passwords, do use 'Sel.Hashing.Password',+-- as the functions of the SHA-2 family are not suitable for this task.+--+-- Only import this module qualified like this:+--+-- >>> import qualified Sel.Hashing.SHA256 as SHA256++-- | A hashed value from the SHA-256 algorithm.+--+-- @since 0.0.1.0+newtype Hash = Hash (ForeignPtr CUChar)++-- |+--+-- @since 0.0.1.0+instance Eq Hash where+  (Hash h1) == (Hash h2) =+    unsafeDupablePerformIO $+      foreignPtrEq h1 h2 cryptoHashSHA256Bytes++-- |+--+-- @since 0.0.1.0+instance Ord Hash where+  compare (Hash h1) (Hash h2) =+    unsafeDupablePerformIO $+      foreignPtrOrd h1 h2 cryptoHashSHA256Bytes++-- |+--+-- @since 0.0.1.0+instance Storable Hash where+  sizeOf :: Hash -> Int+  sizeOf _ = fromIntegral cryptoHashSHA256Bytes++  --  Aligned on the size of 'cryptoHashSHA256Bytes'+  alignment :: Hash -> Int+  alignment _ = 32++  poke :: Ptr Hash -> Hash -> IO ()+  poke ptr (Hash hashForeignPtr) =+    Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+      Foreign.copyArray (Foreign.castPtr ptr) hashPtr (fromIntegral cryptoHashSHA256Bytes)++  peek :: Ptr Hash -> IO Hash+  peek ptr = do+    hashfPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoHashSHA256Bytes)+    Foreign.withForeignPtr hashfPtr $ \hashPtr ->+      Foreign.copyArray hashPtr (Foreign.castPtr ptr) (fromIntegral cryptoHashSHA256Bytes)+    pure $ Hash hashfPtr++-- |+--+-- @since 0.0.1.0+instance Display Hash where+  displayBuilder = Builder.fromText . hashToHexText++-- |+--+-- @since 0.0.1.0+instance Show Hash where+  show = BS.unpackChars . hashToHexByteString++-- | Hash a 'StrictByteString' with the SHA-256 algorithm.+--+-- @since 0.0.1.0+hashByteString :: StrictByteString -> IO Hash+hashByteString bytestring =+  BS.unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do+    hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoHashSHA256Bytes)+    Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+      void $+        cryptoHashSHA256+          hashPtr+          (Foreign.castPtr cString :: Ptr CUChar)+          (fromIntegral @Int @CULLong cStringLen)+    pure $ Hash hashForeignPtr++-- | Hash a UTF8-encoded strict 'Text' with the SHA-256 algorithm.+--+-- @since 0.0.1.0+hashText :: Text -> IO Hash+hashText text = hashByteString (Text.encodeUtf8 text)++-- == Displaying++-- | Convert a 'Hash' to a strict hexadecimal 'Text'.+--+-- @since 0.0.1.0+hashToHexText :: Hash -> Text+hashToHexText = Base16.extractBase16 . Base16.encodeBase16 . hashToBinary++-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+hashToHexByteString :: Hash -> StrictByteString+hashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . hashToBinary++-- | Convert a 'Hash' to a binary 'StrictByteString'.+--+-- @since 0.0.1.0+hashToBinary :: Hash -> StrictByteString+hashToBinary (Hash fPtr) =+  BS.fromForeignPtr+    (Foreign.castForeignPtr fPtr)+    0+    (fromIntegral @CSize @Int cryptoHashSHA256Bytes)++-- ** Hashing a multi-part message++-- | 'Multipart' is a cryptographic context for streaming hashing.+-- This API can be used when a message is too big to fit in memory or when the message is received in portions.+--+-- Use it like this:+--+-- >>> hash <- SHA256.withMultipart $ \multipartState -> do -- we are in MonadIO+-- ...   message1 <- getMessage+-- ...   SHA256.updateMultipart multipartState message1+-- ...   message2 <- getMessage+-- ...   SHA256.updateMultipart multipartState message2+--+-- @since 0.0.1.0+newtype Multipart s = Multipart (Ptr CryptoHashSHA256State)++type role Multipart nominal++-- | Perform streaming hashing with a 'Multipart' cryptographic context.+--+-- Use 'SHA256.updateMultipart' within the continuation.+--+-- The context is safely allocated first, then the continuation is run+-- and then it is deallocated after that.+--+-- @since 0.0.1.0+withMultipart+  :: forall (a :: Type) (m :: Type -> Type)+   . MonadIO m+  => (forall s. Multipart s -> m a)+  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context+  -> m Hash+withMultipart actions = do+  allocateWith cryptoHashSHA256StateBytes $ \statePtr -> do+    void $ liftIO $ cryptoHashSHA256Init statePtr+    let part = Multipart statePtr+    actions part+    liftIO (finaliseMultipart part)++-- | Compute the 'Hash' of all the portions that were fed to the cryptographic context.+--+--  this function is only used within 'withMultipart'+--+--  @since 0.0.1.0+finaliseMultipart :: Multipart s -> IO Hash+finaliseMultipart (Multipart statePtr) = do+  hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoHashSHA256Bytes)+  Foreign.withForeignPtr hashForeignPtr $ \(hashPtr :: Ptr CUChar) ->+    void $+      cryptoHashSHA256Final+        statePtr+        hashPtr+  pure $ Hash hashForeignPtr++-- | Add a message portion to be hashed.+--+-- This function should be used within 'withMultipart'.+--+-- @since 0.0.1.0+updateMultipart :: Multipart s -> StrictByteString -> IO ()+updateMultipart (Multipart statePtr) message = do+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    let messagePtr = Foreign.castPtr @CChar @CUChar cString+    let messageLen = fromIntegral @Int @CULLong cStringLen+    void $+      cryptoHashSHA256Update+        statePtr+        messagePtr+        messageLen
+ src/Sel/Hashing/SHA512.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Sel.Hashing.SHA512+-- Description: Legacy SHA-512 hashing+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.Hashing.SHA512+  ( -- ** Usage+    -- $usage++    -- ** Hash+    Hash+  , hashToBinary+  , hashToHexText+  , hashToHexByteString++    -- ** Hashing a single message+  , hashByteString+  , hashText++    -- ** Hashing a multi-parts message+  , Multipart+  , withMultipart+  , updateMultipart+  ) where++import Control.Monad (void)+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.Text (Text)+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)+import LibSodium.Bindings.SHA2+  ( CryptoHashSHA512State+  , cryptoHashSHA512+  , cryptoHashSHA512Bytes+  , cryptoHashSHA512Final+  , cryptoHashSHA512Init+  , cryptoHashSHA512StateBytes+  , cryptoHashSHA512Update+  )+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++-- $usage+--+-- The SHA-2 family of hashing functions is only provided for interoperability with other applications.+--+-- If you are looking for a generic hash function, do use 'Sel.Hashing'.+--+-- If you are looking to hash passwords or deriving keys from passwords, do use 'Sel.Hashing.Password',+-- as the functions of the SHA-2 family are not suitable for this task.+--+-- Only import this module qualified like this:+--+-- >>> import qualified Sel.Hashing.SHA512 as SHA512++-- | A hashed value from the SHA-512 algorithm.+--+-- @since 0.0.1.0+newtype Hash = Hash (ForeignPtr CUChar)++-- |+--+-- @since 0.0.1.0+instance Eq Hash where+  (Hash h1) == (Hash h2) =+    unsafeDupablePerformIO $+      foreignPtrEq h1 h2 cryptoHashSHA512Bytes++-- |+--+-- @since 0.0.1.0+instance Ord Hash where+  compare (Hash h1) (Hash h2) =+    unsafeDupablePerformIO $+      foreignPtrOrd h1 h2 cryptoHashSHA512Bytes++-- |+--+-- @since 0.0.1.0+instance Storable Hash where+  sizeOf :: Hash -> Int+  sizeOf _ = fromIntegral cryptoHashSHA512Bytes++  --  Aligned on the size of 'cryptoHashSHA512Bytes'+  alignment :: Hash -> Int+  alignment _ = 32++  poke :: Ptr Hash -> Hash -> IO ()+  poke ptr (Hash hashForeignPtr) =+    Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+      Foreign.copyArray (Foreign.castPtr ptr) hashPtr (fromIntegral cryptoHashSHA512Bytes)++  peek :: Ptr Hash -> IO Hash+  peek ptr = do+    hashfPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoHashSHA512Bytes)+    Foreign.withForeignPtr hashfPtr $ \hashPtr ->+      Foreign.copyArray hashPtr (Foreign.castPtr ptr) (fromIntegral cryptoHashSHA512Bytes)+    pure $ Hash hashfPtr++-- |+--+-- @since 0.0.1.0+instance Display Hash where+  displayBuilder = Builder.fromText . hashToHexText++-- |+--+-- @since 0.0.1.0+instance Show Hash where+  show = BS.unpackChars . hashToHexByteString++-- ** Hashing a single message++-- | Convert a 'Hash' to a strict hexadecimal 'Text'.+--+-- @since 0.0.1.0+hashToHexText :: Hash -> Text+hashToHexText = Base16.extractBase16 . Base16.encodeBase16 . hashToBinary++-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+hashToHexByteString :: Hash -> StrictByteString+hashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . hashToBinary++-- | Convert a 'Hash' to a binary 'StrictByteString'.+--+-- @since 0.0.1.0+hashToBinary :: Hash -> StrictByteString+hashToBinary (Hash fPtr) =+  BS.fromForeignPtr+    (Foreign.castForeignPtr fPtr)+    0+    (fromIntegral @CSize @Int cryptoHashSHA512Bytes)++-- | Hash a 'StrictByteString' with the SHA-512 algorithm.+--+-- @since 0.0.1.0+hashByteString :: StrictByteString -> IO Hash+hashByteString bytestring =+  BS.unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do+    hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoHashSHA512Bytes)+    Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+      void $+        cryptoHashSHA512+          hashPtr+          (Foreign.castPtr cString :: Ptr CUChar)+          (fromIntegral @Int @CULLong cStringLen)+    pure $ Hash hashForeignPtr++-- | Hash a UTF8-encoded strict 'Text' with the SHA-512 algorithm.+--+-- @since 0.0.1.0+hashText :: Text -> IO Hash+hashText text = hashByteString (Text.encodeUtf8 text)++-- ** Hashing a multi-parts message++-- | 'Multipart' is a cryptographic context for streaming hashing.+-- This API can be used when a message is too big to fit in memory or when the message is received in portions.+--+-- Use it like this:+--+-- >>> hash <- SHA512.withMultipart $ \multipartState -> do -- we are in MonadIO+-- ...   message1 <- getMessage+-- ...   SHA512.updateMultipart multipartState message1+-- ...   message2 <- getMessage+-- ...   SHA512.updateMultipart multipartState message2+--+-- @since 0.0.1.0+newtype Multipart s = Multipart (Ptr CryptoHashSHA512State)++type role Multipart nominal++-- | Perform streaming hashing with a 'Multipart' cryptographic context.+--+-- Use 'SHA512.updateMultipart' and 'SHA512.finaliseMultipart' inside of the continuation.+--+-- The context is safely allocated and deallocated inside of the continuation.+--+-- @since 0.0.1.0+withMultipart+  :: forall (a :: Type) (m :: Type -> Type)+   . MonadIO m+  => (forall s. Multipart s -> m a)+  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context+  -> m Hash+withMultipart action = do+  allocateWith cryptoHashSHA512StateBytes $ \statePtr -> do+    void $ liftIO $ cryptoHashSHA512Init statePtr+    let part = Multipart statePtr+    action part+    liftIO $ finaliseMultipart part++-- | Compute the 'Hash' of all the portions that were fed to the cryptographic context.+--+-- This function is only used within 'withMultipart'.+--+-- @since 0.0.1.0+finaliseMultipart :: Multipart s -> IO Hash+finaliseMultipart (Multipart statePtr) = do+  hashForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoHashSHA512Bytes)+  Foreign.withForeignPtr hashForeignPtr $ \(hashPtr :: Ptr CUChar) ->+    void $+      cryptoHashSHA512Final+        statePtr+        hashPtr+  pure $ Hash hashForeignPtr++-- | Add a message portion to be hashed.+--+-- This function should be used within 'withMultipart'.+--+-- @since 0.0.1.0+updateMultipart :: Multipart s -> StrictByteString -> IO ()+updateMultipart (Multipart statePtr) message = do+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    let messagePtr = Foreign.castPtr @CChar @CUChar cString+    let messageLen = fromIntegral @Int @CULLong cStringLen+    void $+      cryptoHashSHA512Update+        statePtr+        messagePtr+        messageLen
+ src/Sel/Hashing/Short.hs view
@@ -0,0 +1,300 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.Hashing.Short+-- Description: Short input hashing with the SipHash-2-4 algorithm+-- Copyright: (C) Hécate Moonlight 2023+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.Hashing.Short+  ( -- ** Introduction+    -- $introduction+    ShortHash++    -- ** Short-input Hashing+  , hashByteString+  , hashText++    -- *** Conversion+  , shortHashToBinary+  , shortHashToHexText+  , shortHashToHexByteString++    -- ** Short Hash Key+  , ShortHashKey+  , newKey++    -- *** Conversion+  , shortHashKeyToBinary+  , shortHashKeyToHexText+  , shortHashKeyToHexByteString+  , binaryToShortHashKey+  , hexTextToShortHashKey+  , hexByteStringToShortHashKey++    -- ** Errors+  , ShortHashingException (..)+  )+where++import Control.Exception (throw)+import Control.Monad (void, when)+import Data.ByteString (StrictByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import Data.Text (Text)+import qualified Data.Text as Text+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 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 Sel.Internal++-- $introduction+--+-- This module provides an API for performant short-input hashing,+-- backed by the [SipHash-2-4](https://en.wikipedia.org/wiki/SipHash) algorithm.+--+-- Short-input hashing functions have a variety of use-cases, such as:+--+-- * Hash Tables+-- * Probabilistic data structures, such as Bloom filters+-- * Integrity checking in interactive protocols++-- | A 128-bit hash of a short input, of size 'cryptoShortHashSipHashX24Bytes'+--+-- @since 0.0.1.0+newtype ShortHash = ShortHash (ForeignPtr CUChar)++-- |+--+-- @since 0.0.1.0+instance Eq ShortHash where+  (ShortHash sh1) == (ShortHash sh2) =+    unsafeDupablePerformIO $+      foreignPtrEq sh1 sh2 cryptoShortHashSipHashX24Bytes++-- |+--+-- @since 0.0.1.0+instance Ord ShortHash where+  compare (ShortHash sh1) (ShortHash sh2) =+    unsafeDupablePerformIO $+      foreignPtrOrd sh1 sh2 cryptoShortHashSipHashX24Bytes++-- |+--+-- @since 0.0.1.0+instance Show ShortHash where+  show = Text.unpack . shortHashToHexText++-- |+--+-- @since 0.0.1.0+instance Display ShortHash where+  displayBuilder = Builder.fromText . shortHashToHexText++-- | Hash a 'StrictByteString'.+--+-- The same message hashed with the same key will always produce the same output.+--+-- The 'ShortHash' is of length 'cryptoShortHashSipHashX24Bytes'+--+-- @since 0.0.1.0+hashByteString+  :: ShortHashKey+  -- ^ Random key produced by 'newKey'+  -> StrictByteString+  -- ^ Data to hash+  -> IO ShortHash+hashByteString (ShortHashKey keyFPtr) message =+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    shortHashFPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoShortHashSipHashX24Bytes)+    Foreign.withForeignPtr keyFPtr $ \keyPtr ->+      Foreign.withForeignPtr shortHashFPtr $ \shortHashPtr -> do+        result <-+          cryptoShortHashX24+            shortHashPtr+            (Foreign.castPtr cString)+            (fromIntegral @Int @CULLong cStringLen)+            keyPtr+        when (result /= 0) $ throw ShortHashingException+        pure $ ShortHash shortHashFPtr++-- | Hash a strict 'Text'.+--+-- The same message hashed with the same key will always produce the same output.+--+-- The 'ShortHash' is of length 'cryptoShortHashSipHashX24Bytes'+--+-- @since 0.0.1.0+hashText+  :: ShortHashKey+  -- ^ Random key produced by 'newKey'+  -> Text+  -- ^ UTF-8 encoded data to hash+  -> IO ShortHash+hashText key message = hashByteString key (Text.encodeUtf8 message)++-- | Convert a 'ShortHash' to a strict binary 'StrictByteString'.+--+-- @since 0.0.1.0+shortHashToBinary :: ShortHash -> StrictByteString+shortHashToBinary (ShortHash hashFPtr) =+  BS.fromForeignPtr+    (Foreign.castForeignPtr hashFPtr)+    0+    (fromIntegral @CSize @Int cryptoShortHashSipHashX24Bytes)++-- | Convert a 'ShortHash' to a hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+shortHashToHexByteString :: ShortHash -> StrictByteString+shortHashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . shortHashToBinary++-- | Convert a 'ShortHash' to a strict hexadecimal-encoded 'Text'.+--+-- @since 0.0.1.0+shortHashToHexText :: ShortHash -> Text+shortHashToHexText = Base16.extractBase16 . Base16.encodeBase16 . shortHashToBinary++-- | A random key used for hashing, of size 'cryptoShortHashSipHashX24KeyBytes'.+--+-- The same message hashed with the same key will always produce the same output.+--+-- @since 0.0.1.0+newtype ShortHashKey = ShortHashKey (ForeignPtr CUChar)++-- |+--+-- @since 0.0.1.0+instance Eq ShortHashKey where+  (ShortHashKey sh1) == (ShortHashKey sh2) =+    unsafeDupablePerformIO $+      foreignPtrEq sh1 sh2 cryptoShortHashSipHashX24Bytes++-- |+--+-- @since 0.0.1.0+instance Ord ShortHashKey where+  compare (ShortHashKey sh1) (ShortHashKey sh2) =+    unsafeDupablePerformIO $+      foreignPtrOrd sh1 sh2 cryptoShortHashSipHashX24Bytes++-- |+--+-- @since 0.0.1.0+instance Show ShortHashKey where+  show = Text.unpack . shortHashKeyToHexText++instance Display ShortHashKey where+  displayBuilder = Builder.fromText . shortHashKeyToHexText++-- | Generate a random 'ShortHashKey' of size 'cryptoShortHashSipHashX24KeyBytes'+--+-- @since 0.0.1.0+newKey :: IO ShortHashKey+newKey = do+  shortHashKeyForeignPtr <-+    Foreign.mallocForeignPtrBytes (fromIntegral cryptoShortHashSipHashX24KeyBytes)+  Foreign.withForeignPtr shortHashKeyForeignPtr $ \shortHashKeyPtr ->+    void $ cryptoShortHashX24KeyGen shortHashKeyPtr+  pure $ ShortHashKey shortHashKeyForeignPtr++-- | Convert a 'ShortHash' to a strict binary 'StrictByteString'.+--+-- @since 0.0.1.0+shortHashKeyToBinary :: ShortHashKey -> StrictByteString+shortHashKeyToBinary (ShortHashKey hashKeyFPtr) =+  BS.fromForeignPtr+    (Foreign.castForeignPtr hashKeyFPtr)+    0+    (fromIntegral @CSize @Int cryptoShortHashSipHashX24KeyBytes)++-- | Convert a 'ShortHash' to a hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+shortHashKeyToHexByteString :: ShortHashKey -> StrictByteString+shortHashKeyToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . shortHashKeyToBinary++-- | Convert a 'ShortHash' to a strict hexadecimal-encoded 'Text'.+--+-- @since 0.0.1.0+shortHashKeyToHexText :: ShortHashKey -> Text+shortHashKeyToHexText = Base16.extractBase16 . Base16.encodeBase16 . shortHashKeyToBinary++-- | Convert a binary 'StrictByteString' to a 'ShortHashKey'.+--+-- The input key must be of length 'cryptoShortHashSipHashX24KeyBytes'+--+-- @since 0.0.1.0+binaryToShortHashKey :: StrictByteString -> Maybe ShortHashKey+binaryToShortHashKey binaryKey =+  if BS.length binaryKey /= fromIntegral cryptoShortHashSipHashX24KeyBytes+    then Nothing+    else unsafeDupablePerformIO $ do+      BS.unsafeUseAsCString binaryKey $ \cString -> do+        shortHashKeyFPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoShortHashSipHashX24KeyBytes)+        Foreign.withForeignPtr shortHashKeyFPtr $ \shortHashKeyPtr ->+          memcpy shortHashKeyPtr (Foreign.castPtr cString) cryptoShortHashSipHashX24KeyBytes+        pure $ Just $ ShortHashKey shortHashKeyFPtr++-- | Convert a strict hexadecimal-encoded 'Text' to a 'ShortHashKey'.+--+-- The input key, once decoded from base16, must be of length 'cryptoShortHashSipHashX24KeyBytes'+--+-- @since 0.0.1.0+hexTextToShortHashKey :: Text -> Maybe ShortHashKey+hexTextToShortHashKey = hexByteStringToShortHashKey . Text.encodeUtf8++-- | Convert a hexadecimal-encoded 'StrictByteString' to a 'ShortHashKey'.+--+-- The input key, once decoded from base16, must be of length 'cryptoShortHashSipHashX24KeyBytes'+--+-- @since 0.0.1.0+hexByteStringToShortHashKey :: StrictByteString -> Maybe ShortHashKey+hexByteStringToShortHashKey hexByteString =+  case Base16.decodeBase16Untyped hexByteString of+    Right binary -> binaryToShortHashKey binary+    Left _ -> Nothing++-- | Exception thrown upon error during hashing by+-- 'hashByteString' or 'hashText'.+--+-- @since 0.0.1.0+data ShortHashingException = ShortHashingException+  deriving stock+    ( Show+      -- ^ @since 0.0.1.0+    , Eq+      -- ^ @since 0.0.1.0+    , Ord+      -- ^ @since 0.0.1.0+    )+  deriving anyclass+    ( Exception+      -- ^ @since 0.0.1.0+    )+  deriving+    ( Display+      -- ^ @since 0.0.1.0+    )+    via (ShowInstance ShortHashingException)
+ src/Sel/Internal.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Sel.Internal where++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 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)++-- | 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++-- | 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 @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++foreignPtrShow :: ForeignPtr a -> CSize -> String+foreignPtrShow fptr size =+  BS.unpackChars . Base16.extractBase16 . Base16.encodeBase16' $+    BS.fromForeignPtr (Foreign.castForeignPtr fptr) 0 (fromIntegral @CSize @Int size)++-- | Securely allocate an amount of memory with 'sodiumMalloc' and pass+-- a pointer to the region to the provided action.+-- The region is deallocated with 'sodiumFree' afterwards.+-- Do not try to jailbreak the pointer outside of the action,+-- this will not be pleasant.+allocateWith+  :: forall (a :: Type) (b :: Type) (m :: Type -> Type)+   . MonadIO m+  => CSize+  -- ^ Amount of memory to allocate+  -> (Ptr a -> m b)+  -- ^ Action to perform on the memory+  -> m b+allocateWith size action = do+  !ptr <- liftIO $ sodiumMalloc size+  !result <- action ptr+  liftIO $ sodiumFree ptr+  pure result
+ src/Sel/PublicKey/Cipher.hs view
@@ -0,0 +1,533 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.PublicKey.Cipher+-- Description: Authenticated encryption with public and secret keys+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.PublicKey.Cipher+  ( -- ** Introduction+    -- $introduction++    -- ** Usage+    -- $usage++    -- ** Key pair generation+    newKeyPair+  , SecretKey (..)+  , unsafeSecretKeyToHexByteString+  , PublicKey (..)+  , publicKeyToHexByteString+  , keyPairFromHexByteStrings++    -- ** Nonce+  , Nonce (..)+  , nonceFromHexByteString+  , nonceToHexByteString++    -- ** Cipher text+  , CipherText (..)+  , cipherTextFromHexByteString+  , cipherTextToHexText+  , cipherTextToHexByteString+  , cipherTextToBinary++    -- ** Encryption and Decryption+  , encrypt+  , decrypt++    -- ** Errors+  , KeyPairGenerationException (..)+  , EncryptionError (..)+  ) where++import Control.Monad (when)+import Data.ByteString (StrictByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import Data.Text (Text)+import qualified Data.Text as Text+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+  , cryptoBoxMACBytes+  , cryptoBoxNonceBytes+  , cryptoBoxOpenEasy+  , cryptoBoxPublicKeyBytes+  , cryptoBoxSecretKeyBytes+  )+import LibSodium.Bindings.Random (randombytesBuf)+import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumFree, sodiumMalloc)+import Sel.Internal++-- $introduction+-- Public-key authenticated encryption allows a sender to encrypt a confidential message+-- specifically for the recipient, using the recipient's public key.++-- $usage+--+-- > import qualified Sel.PublicKey.Cipher as Cipher+-- >+-- > main = do+-- >   -- We get the sender their pair of keys:+-- >   (senderSecretKey, senderPublicKey) <- newKeyPair+-- >   -- We get the nonce from the other party with the message, or with 'encrypt' and our own message.+-- >   (nonce, encryptedMessage) <- Cipher.encrypt "hello hello" secretKey+-- >   let result = Cipher.decrypt encryptedMessage secretKey nonce+-- >   print result+-- >   -- "Just \"hello hello\""++-- | A secret key of size 'cryptoBoxSecretKeyBytes'.+--+-- @since 0.0.1.0+newtype SecretKey = SecretKey (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+      -- > display secretKey == "[REDACTED]"+    )+    via (OpaqueInstance "[REDACTED]" SecretKey)++-- |+--+-- @since 0.0.1.0+instance Eq SecretKey where+  (SecretKey hk1) == (SecretKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoBoxSecretKeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord SecretKey where+  compare (SecretKey hk1) (SecretKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoBoxSecretKeyBytes++-- | > show secretKey == "[REDACTED]"+--+-- @since 0.0.1.0+instance Show SecretKey where+  show _ = "[REDACTED]"++-- | A public key of size 'cryptoBoxPublicKeyBytes'.+--+-- @since 0.0.1.0+newtype PublicKey = PublicKey (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+    )+    via (ShowInstance PublicKey)++-- |+--+-- @since 0.0.1.0+instance Eq PublicKey where+  (PublicKey hk1) == (PublicKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoBoxPublicKeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord PublicKey where+  compare (PublicKey hk1) (PublicKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoBoxPublicKeyBytes++-- |+--+-- @since 0.0.1.0+instance Show PublicKey where+  show = BS.unpackChars . publicKeyToHexByteString++-- | Convert a 'PublicKey' to a hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+publicKeyToHexByteString :: PublicKey -> StrictByteString+publicKeyToHexByteString (PublicKey publicKeyForeignPtr) =+  Base16.extractBase16 . Base16.encodeBase16' $+    BS.fromForeignPtr0+      (Foreign.castForeignPtr @CUChar @Word8 publicKeyForeignPtr)+      (fromIntegral @CSize @Int cryptoBoxPublicKeyBytes)++-- | Generate a new random secret key.+--+-- May throw 'KeyPairGenerationException' if the generation fails.+--+-- @since 0.0.1.0+newKeyPair :: IO (PublicKey, SecretKey)+newKeyPair = newKeyPairWith $ \publicKeyPtr secretKeyPtr -> do+  result <- cryptoBoxKeyPair publicKeyPtr secretKeyPtr+  when (result /= 0) $ throw KeyPairGenerationException++-- | Create a pair of 'SecretKey' and 'PublicKey'  from hexadecimal-encoded+-- 'StrictByteString's that you have obtained on your own, usually from the network or disk.+--+-- The public and secret keys, once decoded from base16, must respectively+-- be at least of length 'cryptoBoxPublicKeyBytes' and 'cryptoBoxSecretKeyBytes.+--+-- @since 0.0.1.0+keyPairFromHexByteStrings+  :: StrictByteString+  -- ^ Public key+  -> StrictByteString+  -- ^ Secret key+  -> Either Text (PublicKey, SecretKey)+keyPairFromHexByteStrings publicByteStringHex secretByteStringHex =+  case (Base16.decodeBase16Untyped publicByteStringHex, Base16.decodeBase16Untyped secretByteStringHex) of+    (Right publicByteString, Right secretByteString) ->+      if BS.length publicByteString < fromIntegral cryptoBoxPublicKeyBytes+        || BS.length secretByteString < fromIntegral cryptoBoxSecretKeyBytes+        then Left (Text.pack "Input too short")+        else unsafeDupablePerformIO $+          BS.unsafeUseAsCString publicByteString $ \outsidePublicKeyPtr ->+            BS.unsafeUseAsCString secretByteString $ \outsideSecretKeyPtr ->+              fmap Right $+                newKeyPairWith $ \publicKeyPtr secretKeyPtr -> do+                  Foreign.copyArray+                    (Foreign.castPtr @CUChar @CChar publicKeyPtr)+                    outsidePublicKeyPtr+                    (fromIntegral cryptoBoxPublicKeyBytes)++                  Foreign.copyArray+                    (Foreign.castPtr @CUChar @CChar secretKeyPtr)+                    outsideSecretKeyPtr+                    (fromIntegral cryptoBoxSecretKeyBytes)+    (_, Left msg) -> Left msg+    (Left msg, _) -> Left msg++-- | Prepare memory for a 'SecretKey' and 'PublicKey' pair,+-- and use the provided action to fill it.+--+-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc'+-- (see the note attached there).+-- A finalizer is run when the key is goes out of scope.+newKeyPairWith+  :: ( Ptr CUChar+       -- \^ Public Key pointer+       -> Ptr CUChar+       -- \^ Secret Key pointer+       -> IO ()+     )+  -> IO (PublicKey, SecretKey)+newKeyPairWith action = do+  publicKeyPtr <- sodiumMalloc cryptoBoxPublicKeyBytes+  secretKeyPtr <- sodiumMalloc cryptoBoxSecretKeyBytes+  when (secretKeyPtr == Foreign.nullPtr || publicKeyPtr == Foreign.nullPtr) $ do+    sodiumFree secretKeyPtr+    sodiumFree publicKeyPtr+    Foreign.throwErrno "sodium_malloc failed to allocate memory"++  secretKeyForeignPtr <- Foreign.newForeignPtr_ secretKeyPtr+  Foreign.addForeignPtrFinalizer finalizerSodiumFree secretKeyForeignPtr+  publicKeyForeignPtr <- Foreign.newForeignPtr_ publicKeyPtr+  Foreign.addForeignPtrFinalizer finalizerSodiumFree publicKeyForeignPtr++  action publicKeyPtr secretKeyPtr+  pure (PublicKey publicKeyForeignPtr, SecretKey secretKeyForeignPtr)++-- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  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++-- | A random number that must only be used once per exchanged message.+-- It does not have to be confidential.+-- It is of size 'cryptoBoxNonceBytes'.+--+-- @since 0.0.1.0+newtype Nonce = Nonce (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+    )+    via (ShowInstance Nonce)++-- |+--+-- @since 0.0.1.0+instance Eq Nonce where+  (Nonce hk1) == (Nonce hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoBoxNonceBytes++-- |+--+-- @since 0.0.1.0+instance Ord Nonce where+  compare (Nonce hk1) (Nonce hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoBoxNonceBytes++-- |+--+-- @since 0.0.1.0+instance Show Nonce where+  show = show . nonceToHexByteString++-- | Generate a new random nonce.+-- Only use it once per exchanged message.+--+-- Do not use this outside of ciphertext creation!+newNonce :: IO Nonce+newNonce = do+  (fPtr :: ForeignPtr CUChar) <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoBoxNonceBytes)+  Foreign.withForeignPtr fPtr $ \ptr ->+    randombytesBuf (Foreign.castPtr @CUChar @Word8 ptr) cryptoBoxNonceBytes+  pure $ Nonce fPtr++-- | Create a 'Nonce' from a hexadecimal-encoded 'StrictByteString' that you have obtained+-- on your own, usually from the network or disk.+--+-- @since 0.0.1.0+nonceFromHexByteString :: StrictByteString -> Either Text Nonce+nonceFromHexByteString hexNonce = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexNonce of+    Right bytestring ->+      BS.unsafeUseAsCStringLen bytestring $ \(outsideNoncePtr, _) -> do+        nonceForeignPtr <-+          BS.mallocByteString+            @CChar+            (fromIntegral cryptoBoxNonceBytes)+        Foreign.withForeignPtr nonceForeignPtr $ \noncePtr ->+          Foreign.copyArray+            noncePtr+            outsideNoncePtr+            (fromIntegral cryptoBoxNonceBytes)+        pure $ Right $ Nonce (Foreign.castForeignPtr @CChar @CUChar nonceForeignPtr)+    Left msg -> pure $ Left msg++-- | Convert a 'Nonce' to a hexadecimal-encoded 'StrictByteString'.+--+-- @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)++-- | A ciphertext consisting of an encrypted message and an authentication tag.+--+-- @since 0.0.1.0+data CipherText = CipherText+  { messageLength :: CULLong+  , 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++-- |+--+-- @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++-- | ⚠️  Be prudent as to what you do with it!+--+-- @since 0.0.1.0+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++-- | 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 $+  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+          pure $+            Right $+              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'.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+cipherTextToHexText :: CipherText -> Text+cipherTextToHexText = Base16.extractBase16 . Base16.encodeBase16 . cipherTextToBinary++-- | Convert a 'CipherText' to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+cipherTextToHexByteString :: CipherText -> StrictByteString+cipherTextToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . cipherTextToBinary++-- | 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) =+  BS.fromForeignPtr0+    (Foreign.castForeignPtr fPtr)+    (fromIntegral messageLength + fromIntegral cryptoBoxMACBytes)++-- | 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.+--+-- @since 0.0.1.0+encrypt+  :: StrictByteString+  -- ^ Message to encrypt.+  -> PublicKey+  -- ^ Public key of the recipient+  -> SecretKey+  -- ^ Secret key of the sender+  -> 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 ->+      Foreign.withForeignPtr publicKeyForeignPtr $ \publicKeyPtr ->+        Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr ->+          Foreign.withForeignPtr nonceForeignPtr $ \noncePtr -> do+            result <-+              cryptoBoxEasy+                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)++-- | Decrypt a 'CipherText' and authenticated message with the shared+-- secret key and the one-time cryptographic nonce.+--+-- @since 0.0.1.0+decrypt+  :: CipherText+  -- ^ Encrypted message you want to decrypt.+  -> PublicKey+  -- ^ Public key of the sender.+  -> SecretKey+  -- ^ Secret key of the recipient.+  -> Nonce+  -- ^ Nonce used for encrypting the original message.+  -> Maybe StrictByteString+decrypt+  CipherText{messageLength, cipherTextForeignPtr}+  (PublicKey publicKeyForeignPtr)+  (SecretKey secretKeyForeignPtr)+  (Nonce nonceForeignPtr) = unsafeDupablePerformIO $ do+    messagePtr <- Foreign.mallocBytes (fromIntegral @CULLong @Int messageLength)+    Foreign.withForeignPtr cipherTextForeignPtr $ \cipherTextPtr ->+      Foreign.withForeignPtr publicKeyForeignPtr $ \publicKeyPtr ->+        Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr ->+          Foreign.withForeignPtr nonceForeignPtr $ \noncePtr -> do+            result <-+              cryptoBoxOpenEasy+                messagePtr+                cipherTextPtr+                (messageLength + fromIntegral @CSize @CULLong cryptoBoxMACBytes)+                noncePtr+                publicKeyPtr+                secretKeyPtr+            case result of+              (-1) -> pure Nothing+              _ -> do+                bsPtr <- Foreign.mallocBytes (fromIntegral messageLength)+                memcpy bsPtr (Foreign.castPtr messagePtr) (fromIntegral messageLength)+                Just+                  <$> BS.unsafePackMallocCStringLen+                    (Foreign.castPtr @CChar bsPtr, fromIntegral messageLength)++-- | Exception thrown upon error during the generation of+-- the key pair by 'newKeyPair'.+--+-- @since 0.0.1.0+data KeyPairGenerationException = KeyPairGenerationException+  deriving stock (Eq, Ord, Show)+  deriving anyclass (Exception)++-- | Exception thrown upon error during the encryption+-- of the message by 'encrypt'.+--+-- @since 0.0.1.0+data EncryptionError = EncryptionError+  deriving stock (Eq, Ord, Show)+  deriving anyclass (Exception)
+ src/Sel/PublicKey/Seal.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.PublicKey.Seal+-- Description: Anonymous ephemeral authenticated encryption with public and secret keys+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.PublicKey.Seal+  ( -- ** Introduction+    -- $introduction++    -- ** Usage+    -- $usage++    -- ** Keys+    PublicKey (..)+  , SecretKey (..)+  , newKeyPair++    -- ** Operations+  , seal+  , open++    -- ** Errors+  , KeyPairGenerationException+  , EncryptionError+  ) where++import Control.Exception (throw)+import Control.Monad (when)+import Data.ByteString (StrictByteString)+import qualified Data.ByteString.Unsafe as BS+import qualified Foreign+import Foreign.C (CChar, CSize, CUChar, CULLong)+import GHC.IO.Handle.Text (memcpy)+import System.IO.Unsafe (unsafeDupablePerformIO)++import LibSodium.Bindings.SealedBoxes (cryptoBoxSeal, cryptoBoxSealOpen, cryptoBoxSealbytes)+import Sel.PublicKey.Cipher (CipherText (CipherText), EncryptionError (..), KeyPairGenerationException, PublicKey (PublicKey), SecretKey (..), newKeyPair)++-- $introduction+-- Ephemeral authenticated encryption allows to anonymously send message to+-- a recipient given their public key.+--+-- Only the recipient can decrypt these messages using their own secret key.+-- While the recipient can verify the integrity of the message, they cannot+-- verify the identity of the sender.+--+-- A message is encrypted using an ephemeral key pair, with the secret key being erased+-- right after the encryption process.+--+-- Without knowing the secret key used for a given message, the sender cannot decrypt+-- their own message later. Furthermore, without additional data, a message cannot+-- be correlated with the identity of its sender.++-- $usage+--+-- > import qualified Sel.PublicKey.Seal as Seal+-- >+-- > main = do+-- >   -- We get the recipient their pair of keys:+-- > (recipientPublicKey, recipientSecretKey) <- newKeyPair+-- >   encryptedMessage <- Seal.encrypt "hello hello" recipientPublicKey+-- >   let result = Seal.open encryptedMessage recipientPublicKey recipientSecretKey+-- >   print result+-- >   -- "Just \"hello hello\""++-- | Encrypt a message with the recipient's public key. A key pair for the sender+-- is generated, and the public key of that pair is attached to the cipher text.+-- The secret key of the sender's pair is automatically destroyed.+--+-- @since 0.0.1.0+seal+  :: StrictByteString+  -- ^ Message to encrypt+  -> PublicKey+  -- ^ Public key of the recipient+  -> IO CipherText+seal messageByteString (PublicKey publicKeyFptr) = do+  BS.unsafeUseAsCStringLen messageByteString $ \(messagePtr, messageLen) -> do+    cipherTextForeignPtr <-+      Foreign.mallocForeignPtrBytes+        (messageLen + fromIntegral cryptoBoxSealbytes)+    Foreign.withForeignPtr publicKeyFptr $ \publicKeyPtr ->+      Foreign.withForeignPtr cipherTextForeignPtr $ \cipherTextPtr -> do+        result <-+          cryptoBoxSeal+            cipherTextPtr+            (Foreign.castPtr @CChar @CUChar messagePtr)+            (fromIntegral @Int @CULLong messageLen)+            publicKeyPtr+        when (result /= 0) $ throw EncryptionError+        pure $+          CipherText+            (fromIntegral @Int @CULLong messageLen)+            cipherTextForeignPtr++-- | Open a sealed message from an unknown sender.+-- You need your public and secret keys.+--+-- @since 0.0.1.0+open+  :: CipherText+  -- ^ Cipher to decrypt+  -> PublicKey+  -- ^ Public key of the recipient+  -> SecretKey+  -- ^ Secret key of the recipient+  -> Maybe StrictByteString+open+  (CipherText messageLen cipherForeignPtr)+  (PublicKey publicKeyFPtr)+  (SecretKey secretKeyFPtr) = unsafeDupablePerformIO $ do+    messagePtr <- Foreign.mallocBytes (fromIntegral @CULLong @Int messageLen)+    Foreign.withForeignPtr cipherForeignPtr $ \cipherTextPtr ->+      Foreign.withForeignPtr publicKeyFPtr $ \publicKeyPtr ->+        Foreign.withForeignPtr secretKeyFPtr $ \secretKeyPtr -> do+          result <-+            cryptoBoxSealOpen+              messagePtr+              cipherTextPtr+              (messageLen + fromIntegral @CSize @CULLong cryptoBoxSealbytes)+              publicKeyPtr+              secretKeyPtr+          case result of+            (-1) -> pure Nothing+            _ -> do+              bsPtr <- Foreign.mallocBytes (fromIntegral messageLen)+              memcpy bsPtr (Foreign.castPtr messagePtr) (fromIntegral messageLen)+              Just+                <$> BS.unsafePackMallocCStringLen+                  (Foreign.castPtr @CChar bsPtr, fromIntegral messageLen)
+ src/Sel/PublicKey/Signature.hs view
@@ -0,0 +1,240 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.PublicKey.Signature+-- Description: Public-key signatures with the Ed25519 algorithm+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.PublicKey.Signature+  ( -- ** Introduction+    -- $introduction+    PublicKey+  , SecretKey+  , SignedMessage++    -- ** Key Pair generation+  , generateKeyPair++    -- ** Message Signing+  , signMessage+  , openMessage++    -- ** Constructing and Deconstructing+  , getSignature+  , unsafeGetMessage+  , mkSignature+  )+where++import Control.Monad (void)+import Data.ByteString (StrictByteString)+import Data.ByteString.Unsafe (unsafePackMallocCStringLen)+import qualified Data.ByteString.Unsafe as ByteString+import Foreign+  ( ForeignPtr+  , Ptr+  , castPtr+  , mallocBytes+  , mallocForeignPtrBytes+  , withForeignPtr+  )+import Foreign.C (CChar, CSize, CUChar, CULLong)+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+  , cryptoSignKeyPair+  , cryptoSignPublicKeyBytes+  , cryptoSignSecretKeyBytes+  , cryptoSignVerifyDetached+  )+import Sel.Internal++-- $introduction+--+-- Public-key Signatures work with a 'SecretKey' and 'PublicKey'+--+-- * The 'SecretKey' is used to append a signature to any number of messages. It must stay private;+-- * The 'PublicKey' is used by third-parties to to verify that the signature appended to a message was+-- issued by the creator of the public key. It must be distributed to third-parties.+--+-- Verifiers need to already know and ultimately trust a public key before messages signed+-- using it can be verified.++-- |+--+-- @since 0.0.1.0+newtype PublicKey = PublicKey (ForeignPtr CUChar)++-- |+--+-- @since 0.0.1.0+instance Eq PublicKey where+  (PublicKey pk1) == (PublicKey pk2) =+    unsafeDupablePerformIO $+      foreignPtrEq pk1 pk2 cryptoSignPublicKeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord PublicKey where+  compare (PublicKey pk1) (PublicKey pk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd pk1 pk2 cryptoSignPublicKeyBytes++-- |+--+-- @since 0.0.1.0+newtype SecretKey = SecretKey (ForeignPtr CUChar)++-- |+--+-- @since 0.0.1.0+instance Eq SecretKey where+  (SecretKey sk1) == (SecretKey sk2) =+    unsafeDupablePerformIO $+      foreignPtrEq sk1 sk2 cryptoSignSecretKeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord SecretKey where+  compare (SecretKey sk1) (SecretKey sk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd sk1 sk2 cryptoSignSecretKeyBytes++-- |+--+-- @since 0.0.1.0+data SignedMessage = SignedMessage+  { messageLength :: CSize+  , messageForeignPtr :: ForeignPtr CUChar+  , signatureForeignPtr :: ForeignPtr CUChar+  }++-- |+--+-- @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++-- |+--+-- @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++-- | Generate a pair of public and secret key.+--+-- The length parameters used are 'cryptoSignPublicKeyBytes'+-- and 'cryptoSignSecretKeyBytes'.+--+-- @since 0.0.1.0+generateKeyPair :: IO (PublicKey, SecretKey)+generateKeyPair = do+  publicKeyForeignPtr <- mallocForeignPtrBytes (fromIntegral @CSize @Int cryptoSignPublicKeyBytes)+  secretKeyForeignPtr <- mallocForeignPtrBytes (fromIntegral @CSize @Int cryptoSignSecretKeyBytes)+  withForeignPtr publicKeyForeignPtr $ \pkPtr ->+    withForeignPtr secretKeyForeignPtr $ \skPtr ->+      void $+        cryptoSignKeyPair+          pkPtr+          skPtr+  pure (PublicKey publicKeyForeignPtr, SecretKey secretKeyForeignPtr)++-- | Sign a message.+--+-- @since 0.0.1.0+signMessage :: StrictByteString -> SecretKey -> IO SignedMessage+signMessage message (SecretKey skFPtr) =+  ByteString.unsafeUseAsCStringLen message $ \(cString, messageLength) -> do+    let sigLength = fromIntegral @CSize @Int cryptoSignBytes+    (messageForeignPtr :: ForeignPtr CUChar) <- Foreign.mallocForeignPtrBytes messageLength+    signatureForeignPtr <- Foreign.mallocForeignPtrBytes sigLength+    withForeignPtr messageForeignPtr $ \messagePtr ->+      withForeignPtr signatureForeignPtr $ \signaturePtr ->+        withForeignPtr skFPtr $ \skPtr -> do+          Foreign.copyArray messagePtr (Foreign.castPtr @CChar @CUChar cString) messageLength+          void $+            cryptoSignDetached+              signaturePtr+              Foreign.nullPtr -- Always of size 'cryptoSignBytes'+              (castPtr @CChar @CUChar cString)+              (fromIntegral @Int @CULLong messageLength)+              skPtr+    pure $ SignedMessage (fromIntegral @Int @CSize messageLength) messageForeignPtr signatureForeignPtr++-- | Open a signed message with the signatory's public key.+-- The function returns 'Nothing' if there is a key mismatch.+--+-- @since 0.0.1.0+openMessage :: SignedMessage -> PublicKey -> Maybe StrictByteString+openMessage SignedMessage{messageLength, messageForeignPtr, signatureForeignPtr} (PublicKey pkForeignPtr) = unsafeDupablePerformIO $+  withForeignPtr pkForeignPtr $ \publicKeyPtr ->+    withForeignPtr signatureForeignPtr $ \signaturePtr -> do+      withForeignPtr messageForeignPtr $ \messagePtr -> do+        result <-+          cryptoSignVerifyDetached+            signaturePtr+            messagePtr+            (fromIntegral @CSize @CULLong messageLength)+            publicKeyPtr+        case result of+          (-1) -> pure Nothing+          _ -> do+            bsPtr <- mallocBytes (fromIntegral messageLength)+            memcpy bsPtr (castPtr messagePtr) messageLength+            Just <$> unsafePackMallocCStringLen (castPtr bsPtr :: Ptr CChar, fromIntegral messageLength)++-- | Get the signature part of a 'SignedMessage'.+--+-- @since 0.0.1.0+getSignature :: SignedMessage -> StrictByteString+getSignature SignedMessage{signatureForeignPtr} = unsafeDupablePerformIO $+  withForeignPtr signatureForeignPtr $ \signaturePtr -> do+    bsPtr <- Foreign.mallocBytes (fromIntegral cryptoSignBytes)+    memcpy bsPtr signaturePtr cryptoSignBytes+    unsafePackMallocCStringLen (Foreign.castPtr bsPtr :: Ptr CChar, fromIntegral cryptoSignBytes)++-- | Get the message part of a 'SignedMessage' __without verifying the signature__.+--+-- @since 0.0.1.0+unsafeGetMessage :: SignedMessage -> StrictByteString+unsafeGetMessage SignedMessage{messageLength, messageForeignPtr} = unsafeDupablePerformIO $+  withForeignPtr messageForeignPtr $ \messagePtr -> do+    bsPtr <- Foreign.mallocBytes (fromIntegral messageLength)+    memcpy bsPtr messagePtr messageLength+    unsafePackMallocCStringLen (Foreign.castPtr bsPtr :: Ptr CChar, fromIntegral messageLength)++-- | Combine a message and a signature into a 'SignedMessage'.+--+-- @since 0.0.1.0+mkSignature :: StrictByteString -> StrictByteString -> SignedMessage+mkSignature message signature = unsafeDupablePerformIO $+  ByteString.unsafeUseAsCStringLen message $ \(messageStringPtr, messageLength) ->+    ByteString.unsafeUseAsCStringLen signature $ \(signatureStringPtr, _) -> do+      (messageForeignPtr :: ForeignPtr CUChar) <- Foreign.mallocForeignPtrBytes messageLength+      signatureForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoSignBytes)+      withForeignPtr messageForeignPtr $ \messagePtr ->+        withForeignPtr signatureForeignPtr $ \signaturePtr -> do+          Foreign.copyArray messagePtr (Foreign.castPtr messageStringPtr) messageLength+          Foreign.copyArray signaturePtr (Foreign.castPtr signatureStringPtr) (fromIntegral cryptoSignBytes)+      pure $ SignedMessage (fromIntegral @Int @CSize messageLength) messageForeignPtr signatureForeignPtr
+ src/Sel/Scrypt.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.Scrypt+-- Description: Hashing with the Scrypt algorithm.+-- Copyright: (C) Seth Paul Hubbard 2023+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Stability: Stable+-- Portability: GHC only+module Sel.Scrypt+  ( -- ** Introduction+    -- $introduction+    ScryptHash++    -- ** Password Hashing and Verifying.+  , scryptHashPassword+  , scryptVerifyPassword++    -- *** Conversion+  , scryptHashToByteString+  , scryptHashToText+  , asciiTextToScryptHash+  , asciiByteStringToScryptHash+  )+where++import Control.Monad (void)+import Data.ByteString (StrictByteString)+import qualified Data.ByteString.Internal as BS+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Text as Text+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)++-- $introduction+--+-- This API is used for hashing and verifying passwords using the Scrypt algorithm.+-- This module is provided for interoperability with other applications. If you do+-- not need to use Scrypt specifically, use "Sel.Hashing.Password".++-- | A hashed password from the Scrypt algorithm.+--+-- @since 0.0.1.0+newtype ScryptHash = ScryptHash (ForeignPtr CChar)++-- | @since 0.0.1.0+instance Eq ScryptHash where+  (ScryptHash sh1) == (ScryptHash sh2) =+    unsafeDupablePerformIO $+      foreignPtrEq sh1 sh2 cryptoPWHashScryptSalsa208SHA256StrBytes++-- | @since 0.0.1.0+instance Ord ScryptHash where+  compare (ScryptHash sh1) (ScryptHash sh2) =+    unsafeDupablePerformIO $+      foreignPtrOrd sh1 sh2 cryptoPWHashScryptSalsa208SHA256StrBytes++-- | @since 0.0.1.0+instance Show ScryptHash where+  show = Text.unpack . scryptHashToText++-- | @since 0.0.1.0+instance Display ScryptHash where+  displayBuilder = Builder.fromText . scryptHashToText++-- | Hash the password with the Scrypt algorithm and a set of pre-defined parameters.+--+-- The hash is encoded in a human-readable format that includes:+--+--   * The result of a memory-hard, CPU-intensive hash function applied to the password;+--   * The automatically generated salt used for the previous computation;+--   * The other parameters required to verify the password, including the algorithm+--     identifier, its version, opslimit, and memlimit.+--+-- Example output: "$7$C6..../....dLONLMz8YfO/.EKvzwOeqWVVLmXg62MC.hL1m1sYtO/$X9eNjVxdD4jHAhOVid3OLzNkpv6ADJSAXygOxXqGHg7\NUL"+--+-- @since 0.0.1.0+scryptHashPassword :: StrictByteString -> IO ScryptHash+scryptHashPassword bytestring = do+  unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do+    hashForeignPtr <- mallocForeignPtrBytes (fromIntegral cryptoPWHashScryptSalsa208SHA256StrBytes)+    withForeignPtr hashForeignPtr $ \hashPtr ->+      void $+        cryptoPWHashScryptSalsa208SHA256Str+          hashPtr+          cString+          (fromIntegral cStringLen)+          (fromIntegral cryptoPWHashScryptSalsa208SHA256OpsLimitInteractive)+          cryptoPWHashScryptSalsa208SHA256MemLimitInteractive+    pure $ ScryptHash hashForeignPtr++-- | Verify a hashed password against a password verification string.+-- This returns True if successful.+--+-- @since 0.0.1.0+scryptVerifyPassword :: StrictByteString -> ScryptHash -> IO Bool+scryptVerifyPassword bytestring (ScryptHash sh) = do+  unsafeUseAsCStringLen bytestring $ \(cString, cStringLen) -> do+    withForeignPtr sh $ \scryptHash -> do+      result <-+        cryptoPWHashScryptSalsa208SHA256StrVerify+          scryptHash+          cString+          (fromIntegral cStringLen)+      return (result == 0)++-- | Convert a 'ScryptHash' to a binary 'StrictByteString'.+--+-- @since 0.0.1.0+scryptHashToByteString :: ScryptHash -> StrictByteString+scryptHashToByteString (ScryptHash fPtr) =+  BS.fromForeignPtr0 (Foreign.castForeignPtr fPtr) (fromIntegral @CSize @Int cryptoPWHashScryptSalsa208SHA256StrBytes)++-- | Convert a 'ScryptHash' to a hexadecimal-encoded 'Text'.+--+-- @since 0.0.1.0+scryptHashToText :: ScryptHash -> Text+scryptHashToText = Text.decodeASCII . scryptHashToByteString++-- | Convert an ASCII-encoded password hash to a 'ScryptHash'+--+-- This function does not perform ASCII validation.+--+-- @since 0.0.1.0+asciiByteStringToScryptHash :: StrictByteString -> ScryptHash+asciiByteStringToScryptHash textualHash =+  let (fPtr, _length) = BS.toForeignPtr0 textualHash+   in ScryptHash (castForeignPtr @Word8 @CChar fPtr)++-- | Convert an ASCII-encoded password hash to a 'ScryptHash'+--+-- This function does not perform ASCII validation.+--+-- @since 0.0.1.0+asciiTextToScryptHash :: Text -> ScryptHash+asciiTextToScryptHash = asciiByteStringToScryptHash . Text.encodeUtf8
+ src/Sel/SecretKey/Authentication.hs view
@@ -0,0 +1,285 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.SecretKey.Authentication+-- Description: Authentication with HMAC-SHA512-256+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.SecretKey.Authentication+  ( -- ** Introduction+    -- $introduction++    -- ** Usage+    -- $usage++    -- ** Operations+    authenticate+  , verify++    -- ** Authentication key+  , AuthenticationKey+  , newAuthenticationKey+  , authenticationKeyFromHexByteString+  , unsafeAuthenticationKeyToHexByteString++    -- ** Authentication tag+  , AuthenticationTag+  , authenticationTagToHexByteString+  , authenticationTagFromHexByteString+  ) 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+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+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 LibSodium.Bindings.CryptoAuth+  ( cryptoAuth+  , cryptoAuthBytes+  , cryptoAuthKeyBytes+  , cryptoAuthKeygen+  , cryptoAuthVerify+  )+import LibSodium.Bindings.SecureMemory+import Sel.Internal++-- $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.+--+-- The function computing the tag deterministic: the same @(message, key)@ tuple will always+-- produce the same output. However, even if the message is public, knowing the key is required+-- in order to be able to compute a valid tag.+-- Therefore, the key should remain confidential. The tag, however, can be public.++-- $usage+--+-- > import Sel.SecretKey.Authentication qualified as Auth+-- >+-- > main = do+-- >   -- The parties agree on a shared secret key+-- >   authKey <- Auth.newAuthenticationKey+-- >   -- An authentication tag is computed for the message by the server+-- >   let message = "Hello, world!"+-- >   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+-- >   Auth.verify tag authKey message+-- >   -- => True++-- | Compute an authentication tag for a message with a secret key shared by all parties.+--+-- @since 0.0.1.0+authenticate+  :: StrictByteString+  -- ^ Message to authenticate+  -> AuthenticationKey+  -- ^ Secret key for authentication+  -> IO AuthenticationTag+  -- ^ Cryptographic tag for authentication+authenticate message (AuthenticationKey authenticationKeyForeignPtr) =+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    authenticationTagForeignPtr <-+      Foreign.mallocForeignPtrBytes+        (fromIntegral cryptoAuthBytes)+    Foreign.withForeignPtr authenticationTagForeignPtr $ \authTagPtr ->+      Foreign.withForeignPtr authenticationKeyForeignPtr $ \authKeyPtr ->+        void $+          cryptoAuth+            authTagPtr+            (Foreign.castPtr @CChar @CUChar cString)+            (fromIntegral @Int @CULLong cStringLen)+            authKeyPtr+    pure $ AuthenticationTag authenticationTagForeignPtr++-- | Verify that the tag is valid for the provided message and secret key.+--+-- @since 0.0.1.0+verify+  :: AuthenticationTag+  -> AuthenticationKey+  -> StrictByteString+  -> Bool+verify (AuthenticationTag tagForeignPtr) (AuthenticationKey keyForeignPtr) message = unsafeDupablePerformIO $+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) ->+    Foreign.withForeignPtr tagForeignPtr $ \authTagPtr ->+      Foreign.withForeignPtr keyForeignPtr $ \authKeyPtr -> do+        result <-+          cryptoAuthVerify+            authTagPtr+            (Foreign.castPtr @CChar @CUChar cString)+            (fromIntegral @Int @CULLong cStringLen)+            authKeyPtr+        pure $ result == 0++-- | A secret authentication key of size 'cryptoAuthKeyBytes'.+--+-- @since 0.0.1.0+newtype AuthenticationKey = AuthenticationKey (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+      -- > display authenticatonKey == "[REDACTED]"+    )+    via (OpaqueInstance "[REDACTED]" AuthenticationKey)++-- |+--+-- @since 0.0.1.0+instance Eq AuthenticationKey where+  (AuthenticationKey hk1) == (AuthenticationKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoAuthKeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord AuthenticationKey where+  compare (AuthenticationKey hk1) (AuthenticationKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoAuthKeyBytes++-- | > show authenticationKey == "[REDACTED]"+--+-- @since 0.0.1.0+instance Show AuthenticationKey where+  show _ = "[REDACTED]"++-- | Generate a new random secret key.+--+-- @since 0.0.1.0+newAuthenticationKey :: IO AuthenticationKey+newAuthenticationKey = newAuthenticationKeyWith cryptoAuthKeygen++-- | Prepare memory for a 'AuthenticationKey' and use the provided action to fill it.+--+-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc'+-- (see the note attached there).+-- A finalizer is run when the key is goes out of scope.+newAuthenticationKeyWith :: (Foreign.Ptr CUChar -> IO ()) -> IO AuthenticationKey+newAuthenticationKeyWith action = do+  ptr <- sodiumMalloc cryptoAuthKeyBytes+  when (ptr == Foreign.nullPtr) $ do+    throwErrno "sodium_malloc"++  fPtr <- Foreign.newForeignPtr_ ptr+  Foreign.addForeignPtrFinalizer finalizerSodiumFree fPtr+  action ptr+  pure $ AuthenticationKey fPtr++-- | Create an 'AuthenticationKey' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoAuthKeyBytes'.+--+-- @since 0.0.1.0+authenticationKeyFromHexByteString :: StrictByteString -> Either Text AuthenticationKey+authenticationKeyFromHexByteString hexKey = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexKey of+    Right bytestring ->+      if BS.length bytestring == fromIntegral cryptoAuthKeyBytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideAuthenticationKeyPtr, _) ->+          fmap Right $+            newAuthenticationKeyWith $ \authenticationKeyPtr ->+              Foreign.copyArray+                (Foreign.castPtr @CUChar @CChar authenticationKeyPtr)+                outsideAuthenticationKeyPtr+                (fromIntegral cryptoAuthKeyBytes)+        else pure $ Left $ Text.pack "Authentication Key is too short"+    Left msg -> pure $ Left msg++-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  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)++-- | A secret authentication key of size 'cryptoAuthBytes'.+--+-- @since 0.0.1.0+newtype AuthenticationTag = AuthenticationTag (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+    )+    via (ShowInstance AuthenticationTag)++-- |+--+-- @since 0.0.1.0+instance Eq AuthenticationTag where+  (AuthenticationTag hk1) == (AuthenticationTag hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoAuthBytes++-- |+--+-- @since 0.0.1.0+instance Ord AuthenticationTag where+  compare (AuthenticationTag hk1) (AuthenticationTag hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoAuthBytes++-- |+--+-- @since 0.0.1.0+instance Show AuthenticationTag where+  show = BS.unpackChars . authenticationTagToHexByteString++-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'.+--+-- @since 0.0.1.0+authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString+authenticationTagToHexByteString (AuthenticationTag fPtr) =+  Base16.extractBase16 $+    Base16.encodeBase16' $+      BS.fromForeignPtr0+        (Foreign.castForeignPtr fPtr)+        (fromIntegral cryptoAuthBytes)++-- | Create an 'AuthenticationTag' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoAuthBytes'.+--+-- @since 0.0.1.0+authenticationTagFromHexByteString :: StrictByteString -> Either Text AuthenticationTag+authenticationTagFromHexByteString hexTag = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexTag of+    Right bytestring ->+      if BS.length bytestring >= fromIntegral cryptoAuthBytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideTagPtr, outsideTagLength) -> do+          hashForeignPtr <- BS.mallocByteString @CChar outsideTagLength -- The foreign pointer that will receive the hash data.+          Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+            -- We copy bytes from 'outsideTagPtr' to 'hashPtr'.+            Foreign.copyArray hashPtr outsideTagPtr outsideTagLength+          pure $+            Right $+              AuthenticationTag+                (Foreign.castForeignPtr @CChar @CUChar hashForeignPtr)+        else pure $ Left $ Text.pack "Hash is too short"+    Left msg -> pure $ Left msg
+ src/Sel/SecretKey/Cipher.hs view
@@ -0,0 +1,418 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.SecretKey.Cipher+-- Description: Authenticated Encryption with Poly1305 MAC and XSalsa20+-- Copyright: (C) Hécate Moonlight 2022+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.SecretKey.Cipher+  ( -- ** Introduction+    -- $introduction++    -- ** Usage+    -- $usage++    -- ** Encryption and Decryption+    encrypt+  , decrypt++    -- ** Secret Key+  , SecretKey+  , newSecretKey+  , secretKeyFromHexByteString+  , unsafeSecretKeyToHexByteString++    -- ** Nonce+  , Nonce+  , nonceFromHexByteString+  , nonceToHexByteString++    -- ** Hash+  , Hash+  , hashFromHexByteString+  , hashToBinary+  , hashToHexByteString+  , hashToHexText+  ) 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+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import Data.Text (Text)+import qualified Data.Text as Text+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+  , cryptoSecretboxKeyBytes+  , cryptoSecretboxKeygen+  , cryptoSecretboxMACBytes+  , cryptoSecretboxNonceBytes+  , cryptoSecretboxOpenEasy+  )+import LibSodium.Bindings.SecureMemory+import Sel.Internal++-- $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.+--+-- Encryption is done with the XSalsa20 stream cipher and authentication is done with the+-- Poly1305 MAC hash.++-- $usage+--+-- > import qualified Sel.SecretKey.Cipher as Cipher+-- >+-- > main = do+-- >   -- We get the secretKey from the other party or with 'newSecretKey'.+-- >   -- We get the nonce from the other party with the message, or with 'encrypt' and our own message.+-- >   -- Do not reuse a nonce with the same secret key!+-- >   (nonce, encryptedMessage) <- Cipher.encrypt "hello hello" secretKey+-- >   let result = Cipher.decrypt encryptedMessage secretKey nonce+-- >   print result+-- >   -- "Just \"hello hello\""++-- | A secret key of size 'cryptoSecretboxKeyBytes'.+--+-- @since 0.0.1.0+newtype SecretKey = SecretKey (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+      -- > display secretKey == "[REDACTED]"+    )+    via (OpaqueInstance "[REDACTED]" SecretKey)++-- |+--+-- @since 0.0.1.0+instance Eq SecretKey where+  (SecretKey hk1) == (SecretKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoSecretboxKeyBytes++-- |+--+-- @since 0.0.1.0+instance Ord SecretKey where+  compare (SecretKey hk1) (SecretKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoSecretboxKeyBytes++-- | > show secretKey == "[REDACTED]"+--+-- @since 0.0.1.0+instance Show SecretKey where+  show _ = "[REDACTED]"++-- | Generate a new random secret key.+--+-- @since 0.0.1.0+newSecretKey :: IO SecretKey+newSecretKey = newSecretKeyWith cryptoSecretboxKeygen++-- | Create a 'SecretKey' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoSecretboxKeyBytes'.+--+-- @since 0.0.1.0+secretKeyFromHexByteString :: StrictByteString -> Either Text SecretKey+secretKeyFromHexByteString hexNonce = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexNonce of+    Right bytestring ->+      if BS.length bytestring == fromIntegral cryptoSecretboxKeyBytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideSecretKeyPtr, _) ->+          fmap Right $+            newSecretKeyWith $ \secretKeyPtr ->+              Foreign.copyArray+                (Foreign.castPtr @CUChar @CChar secretKeyPtr)+                outsideSecretKeyPtr+                (fromIntegral cryptoSecretboxKeyBytes)+        else pure $ Left $ Text.pack "Secret Key is too short"+    Left msg -> pure $ Left msg++-- | Prepare memory for a 'SecretKey' and use the provided action to fill it.+--+-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc' (see the note attached there).+-- A finalizer is run when the key is goes out of scope.+--+-- @since 0.0.1.0+newSecretKeyWith :: (Foreign.Ptr CUChar -> IO ()) -> IO SecretKey+newSecretKeyWith action = do+  ptr <- sodiumMalloc cryptoSecretboxKeyBytes+  when (ptr == Foreign.nullPtr) $ do+    throwErrno "sodium_malloc"++  fPtr <- Foreign.newForeignPtr finalizerSodiumFree ptr+  action ptr+  pure $ SecretKey fPtr++-- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  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)++-- | A random number that must only be used once per exchanged message.+-- It does not have to be confidential.+-- It is of size 'cryptoSecretboxNonceBytes'.+--+-- @since 0.0.1.0+newtype Nonce = Nonce (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+    )+    via (ShowInstance Nonce)++-- |+--+-- @since 0.0.1.0+instance Eq Nonce where+  (Nonce hk1) == (Nonce hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoSecretboxNonceBytes++-- |+--+-- @since 0.0.1.0+instance Ord Nonce where+  compare (Nonce hk1) (Nonce hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoSecretboxNonceBytes++-- |+--+-- @since 0.0.1.0+instance Show Nonce where+  show = show . nonceToHexByteString++-- | Generate a new random nonce.+-- Only use it once per exchanged message.+--+-- Do not use this outside of hash creation!+newNonce :: IO Nonce+newNonce = do+  (fPtr :: ForeignPtr CUChar) <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoSecretboxNonceBytes)+  Foreign.withForeignPtr fPtr $ \ptr ->+    randombytesBuf (Foreign.castPtr @CUChar @Word8 ptr) cryptoSecretboxNonceBytes+  pure $ Nonce fPtr++-- | Create a 'Nonce' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+-- Once decoded from hexadecimal, it must be of length 'cryptoSecretboxNonceBytes'.+--+-- @since 0.0.1.0+nonceFromHexByteString :: StrictByteString -> Either Text Nonce+nonceFromHexByteString hexNonce = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexNonce of+    Right bytestring ->+      if BS.length bytestring == fromIntegral @CSize @Int cryptoSecretboxNonceBytes+        then BS.unsafeUseAsCStringLen bytestring $ \(outsideNoncePtr, _) -> do+          nonceForeignPtr <-+            BS.mallocByteString+              @CChar+              (fromIntegral cryptoSecretboxNonceBytes)+          Foreign.withForeignPtr nonceForeignPtr $ \noncePtr ->+            Foreign.copyArray+              noncePtr+              outsideNoncePtr+              (fromIntegral cryptoSecretboxNonceBytes)+          pure $ Right $ Nonce (Foreign.castForeignPtr @CChar @CUChar nonceForeignPtr)+        else pure $ Left $ Text.pack "Nonce is too short"+    Left msg -> pure $ Left msg++-- | Convert a 'Nonce' to a hexadecimal-encoded 'StrictByteString'.+--+-- @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)++-- | A ciphertext consisting of an encrypted message and an authentication tag.+--+-- @since 0.0.1.0+data Hash = Hash+  { messageLength :: CULLong+  , hashForeignPtr :: ForeignPtr CUChar+  }++-- |+--+-- @since 0.0.1.0+instance Eq Hash where+  (Hash messageLength1 hk1) == (Hash messageLength2 hk2) =+    unsafeDupablePerformIO $ do+      result1 <-+        foreignPtrEq+          hk1+          hk2+          (fromIntegral messageLength1 + cryptoSecretboxMACBytes)+      pure $ (messageLength1 == messageLength2) && result1++-- |+--+-- @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++-- | ⚠️  Be prudent as to what you do with it!+--+-- @since 0.0.1.0+instance Display Hash where+  displayBuilder = Builder.fromText . hashToHexText++-- | ⚠️  Be prudent as to what you do with it!+--+-- @since 0.0.1.0+instance Show Hash where+  show = BS.unpackChars . hashToHexByteString++-- | 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.+--+-- The input hash must at least of length 'cryptoSecretboxMACBytes'+--+-- @since 0.0.1.0+hashFromHexByteString :: StrictByteString -> Either Text Hash+hashFromHexByteString hexHash = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped hexHash 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+          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"+    Left msg -> pure $ Left msg++-- | Convert a 'Hash' 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++-- | Convert a 'Hash' to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+hashToHexByteString :: Hash -> StrictByteString+hashToHexByteString = Base16.extractBase16 . Base16.encodeBase16' . hashToBinary++-- | Convert a 'Hash' to a binary 'StrictByteString'.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+hashToBinary :: Hash -> StrictByteString+hashToBinary (Hash messageLength fPtr) =+  BS.fromForeignPtr0+    (Foreign.castForeignPtr fPtr)+    (fromIntegral messageLength + fromIntegral cryptoSecretboxMACBytes)++-- | Create an authenticated hash 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.+--+-- @since 0.0.1.0+encrypt+  :: StrictByteString+  -- ^ Message to encrypt.+  -> SecretKey+  -- ^ Secret key generated with 'newSecretKey'.+  -> IO (Nonce, Hash)+encrypt message (SecretKey secretKeyForeignPtr) =+  BS.unsafeUseAsCStringLen message $ \(cString, cStringLen) -> do+    (Nonce nonceForeignPtr) <- newNonce+    hashForeignPtr <-+      Foreign.mallocForeignPtrBytes+        (cStringLen + fromIntegral cryptoSecretboxMACBytes)+    Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+      Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr ->+        Foreign.withForeignPtr nonceForeignPtr $ \noncePtr -> do+          void $+            cryptoSecretboxEasy+              hashPtr+              (Foreign.castPtr @CChar @CUChar cString)+              (fromIntegral @Int @CULLong cStringLen)+              noncePtr+              secretKeyPtr+    let hash = Hash (fromIntegral @Int @CULLong cStringLen) hashForeignPtr+    pure (Nonce nonceForeignPtr, hash)++-- | Decrypt a hashed and authenticated message with the shared secret key and the one-time cryptographic nonce.+--+-- @since 0.0.1.0+decrypt+  :: Hash+  -- ^ 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+  messagePtr <- Foreign.mallocBytes (fromIntegral @CULLong @Int messageLength)+  Foreign.withForeignPtr hashForeignPtr $ \hashPtr ->+    Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr ->+      Foreign.withForeignPtr nonceForeignPtr $ \noncePtr -> do+        result <-+          cryptoSecretboxOpenEasy+            messagePtr+            hashPtr+            (messageLength + fromIntegral cryptoSecretboxMACBytes)+            noncePtr+            secretKeyPtr+        case result of+          (-1) -> pure Nothing+          _ -> do+            bsPtr <- Foreign.mallocBytes (fromIntegral messageLength)+            memcpy bsPtr (Foreign.castPtr messagePtr) (fromIntegral messageLength)+            Just+              <$> BS.unsafePackMallocCStringLen+                (Foreign.castPtr @CChar bsPtr, fromIntegral messageLength)
+ src/Sel/SecretKey/Stream.hs view
@@ -0,0 +1,576 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+--+-- Module: Sel.SecretKey.Stream+-- Description: Encrypted Streams with ChaCha20Poly1305+-- Copyright: (C) Hécate Moonlight 2024+-- License: BSD-3-Clause+-- Maintainer: The Haskell Cryptography Group+-- Portability: GHC only+module Sel.SecretKey.Stream+  ( -- ** Introduction+    -- $introduction++    -- ** Usage+    -- $usage++    -- ** Stream operations++    -- *** Linked List operations+    encryptList+  , decryptList++    -- *** Chunk operations+  , Multipart+  , encryptStream+  , encryptChunk+  , decryptStream+  , decryptChunk++    -- ** Secret Key+  , SecretKey+  , newSecretKey+  , secretKeyFromHexByteString+  , unsafeSecretKeyToHexByteString++    -- ** Header+  , Header+  , headerToHexByteString+  , headerFromHexByteString++    -- ** Message Tags+  , MessageTag (..)++    -- ** CipherText+  , CipherText+  , ciphertextFromHexByteString+  , ciphertextToBinary+  , ciphertextToHexByteString+  , ciphertextToHexText++    -- ** Exceptions+  , StreamInitEncryptionException+  , StreamEncryptionException+  , StreamDecryptionException+  ) where++import Control.Exception (Exception, throw)+import Control.Monad (forM, when)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Base16.Types (Base16)+import qualified Data.Base16.Types as Base16+import Data.ByteString (StrictByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Internal as BSI+import qualified Data.ByteString.Unsafe as BSU+import Data.Kind (Type)+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 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+  , cryptoSecretStreamXChaCha20Poly1305HeaderBytes+  , cryptoSecretStreamXChaCha20Poly1305InitPull+  , cryptoSecretStreamXChaCha20Poly1305InitPush+  , cryptoSecretStreamXChaCha20Poly1305KeyBytes+  , cryptoSecretStreamXChaCha20Poly1305KeyGen+  , cryptoSecretStreamXChaCha20Poly1305Pull+  , cryptoSecretStreamXChaCha20Poly1305Push+  , cryptoSecretStreamXChaCha20Poly1305StateBytes+  , cryptoSecretStreamXChaCha20Poly1305TagFinal+  , cryptoSecretStreamXChaCha20Poly1305TagMessage+  , cryptoSecretStreamXChaCha20Poly1305TagPush+  , cryptoSecretStreamXChaCha20Poly1305TagRekey+  )+import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc)+import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd)++-- $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:+--+-- * Messages cannot be truncated, removed, reordered, duplicated or modified without this being detected by the decryption functions.+-- * The same sequence encrypted twice will produce different ciphertexts.+-- * An authentication tag is added to each encrypted message: stream corruption will be detected early, without having to read the stream until the end.+-- * Each message can include additional data (ex: timestamp, protocol version) in the computation of the authentication tag.+-- * Messages can have different sizes.+-- * There are no practical limits to the total length of the stream, or to the total number of individual messages.+--+-- It uses the [XChaCha20-Poly1305 algorithm](https://en.wikipedia.org/wiki/ChaCha20-Poly1305).++-- $usage+--+-- >>> secretKey <- Stream.newSecretKey+-- >>> (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++-- | 'Multipart' is the cryptographic context for stream encryption.+--+-- @since 0.0.1.0+newtype Multipart s = Multipart (Ptr CryptoSecretStreamXChaCha20Poly1305State)++type role Multipart nominal++-- | Perform streaming hashing with a 'Multipart' cryptographic context.+--+-- Use 'Stream.encryptChunk' within the continuation.+--+-- The context is safely allocated first, then the continuation is run+-- and then it is deallocated after that.+--+-- @since 0.0.1.0+encryptStream+  :: forall (a :: Type) (m :: Type -> Type)+   . MonadIO m+  => SecretKey+  -- ^ Generated with 'newSecretKey'.+  -> (forall s. Multipart s -> m a)+  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context+  -> m (Header, a)+encryptStream (SecretKey secretKeyForeignPtr) actions = allocateWith cryptoSecretStreamXChaCha20Poly1305StateBytes $ \statePtr -> do+  headerPtr <- liftIO $ sodiumMalloc cryptoSecretStreamXChaCha20Poly1305HeaderBytes+  headerForeignPtr <- liftIO $ Foreign.newForeignPtr finalizerSodiumFree headerPtr+  when (headerPtr == Foreign.nullPtr) $ liftIO (throwErrno "sodium_malloc")+  liftIO $ Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr -> do+    result <-+      cryptoSecretStreamXChaCha20Poly1305InitPush+        statePtr+        headerPtr+        secretKeyPtr+    when (result /= 0) $ throw StreamInitEncryptionException+  let part = Multipart statePtr+  let header = Header headerForeignPtr+  result <- actions part+  pure (header, result)++-- | Add a message portion (/chunk/) to be encrypted.+--+-- Use it within 'encryptStream'.+--+-- This function can throw 'StreamEncryptionException' upon an error in the underlying implementation.+--+-- @since 0.0.1.0+encryptChunk+  :: forall m s+   . MonadIO m+  => Multipart s+  -- ^ Cryptographic context+  -> MessageTag+  -- ^ Tag that will be associated with the message. See the documentation of 'MessageTag' to know which to choose when.+  -> 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++-- | 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 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+      pure $ List.reverse $ encryptedChunk : acc+    go multipart (msg : rest) acc = do+      encryptedChunk <- encryptChunk multipart Message msg+      go multipart rest (encryptedChunk : acc)+    go _ [] acc = pure acc++-- | Perform streaming decryption with a 'Multipart' cryptographic context.+--+-- Use 'Stream.decryptChunk' within the continuation.+--+-- The context is safely allocated first, then the continuation is run+-- and then it is deallocated after that.+--+-- @since 0.0.1.0+decryptStream+  :: forall (a :: Type) (m :: Type -> Type)+   . MonadIO m+  => SecretKey+  -> Header+  -- ^ Header used by the encrypting party. See its documentation+  -> (forall s. Multipart s -> m a)+  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context+  -> m (Maybe a)+decryptStream (SecretKey secretKeyForeignPtr) (Header headerForeignPtr) actions = allocateWith cryptoSecretStreamXChaCha20Poly1305StateBytes $ \statePtr -> do+  result <- liftIO $ Foreign.withForeignPtr secretKeyForeignPtr $ \secretKeyPtr -> do+    Foreign.withForeignPtr headerForeignPtr $ \headerPtr -> do+      cryptoSecretStreamXChaCha20Poly1305InitPull+        statePtr+        headerPtr+        secretKeyPtr+  if result /= 0+    then pure Nothing+    else do+      let part = Multipart statePtr+      Just <$> actions part++-- | Add a message portion (/chunk/) to be decrypted.+--+-- Use this function within 'decryptStream'.+--+-- This function can throw 'StreamDecryptionException' if the chunk is invalid, incomplete, or corrupted.+--+-- @since 0.0.1.0+decryptChunk+  :: forall m s+   . MonadIO m+  => Multipart s+  -- ^ Cryptographic context+  -> CipherText+  -- ^ Encrypted message portion to decrypt+  -> m StrictByteString+  -- ^ Decrypted message portion+decryptChunk (Multipart statePtr) 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)++-- | 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 secretKey header encryptedMessages =+  decryptStream secretKey header $ \multipart -> do+    forM encryptedMessages $ \cipherText -> do+      decryptChunk multipart cipherText++-- | A secret key of size 'cryptoSecretStreamXChaCha20Poly1305KeyBytes'.+--+-- @since 0.0.1.0+newtype SecretKey = SecretKey (ForeignPtr CUChar)+  deriving+    ( Display+      -- ^ @since 0.0.1.0+      -- > display secretKey == "[REDACTED]"+    )+    via (OpaqueInstance "[REDACTED]" SecretKey)++-- | @since 0.0.1.0+instance Eq SecretKey where+  (SecretKey hk1) == (SecretKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrEq hk1 hk2 cryptoSecretStreamXChaCha20Poly1305KeyBytes++-- | @since 0.0.1.0+instance Ord SecretKey where+  compare (SecretKey hk1) (SecretKey hk2) =+    unsafeDupablePerformIO $+      foreignPtrOrd hk1 hk2 cryptoSecretStreamXChaCha20Poly1305KeyBytes++-- | > show secretKey == "[REDACTED]"+--+-- @since 0.0.1.0+instance Show SecretKey where+  show _ = "[REDACTED]"++-- | Generate a new random secret key.+--+-- @since 0.0.1.0+newSecretKey :: IO SecretKey+newSecretKey = newSecretKeyWith cryptoSecretStreamXChaCha20Poly1305KeyGen++-- | Create a 'SecretKey' from a binary 'StrictByteString' that you have obtained on your own,+-- usually from the network or disk.+--+-- The input secret key, once decoded from base16, must be of length+-- 'cryptoSecretStreamXChaCha20Poly1305KeyBytes'.+--+-- @since 0.0.1.0+secretKeyFromHexByteString :: Base16 StrictByteString -> Either Text SecretKey+secretKeyFromHexByteString hexSecretKey = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped (Base16.extractBase16 hexSecretKey) of+    Right bytestring ->+      if BS.length bytestring == fromIntegral cryptoSecretStreamXChaCha20Poly1305KeyBytes+        then BSU.unsafeUseAsCStringLen bytestring $ \(outsideSecretKeyPtr, _) -> do+          secretKey <- newSecretKeyWith $ \secretKeyPtr ->+            Foreign.copyArray+              (Foreign.castPtr @CUChar @CChar secretKeyPtr)+              outsideSecretKeyPtr+              (fromIntegral cryptoSecretStreamXChaCha20Poly1305KeyBytes)+          pure $ Right secretKey+        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'.+--+-- ⚠️  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)++-- Prepare memory for a 'SecretKey' and use the provided action to fill it.+--+-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc' (see the note attached there).+-- A finalizer is run when the key is goes out of scope.+--+-- @since 0.0.1.0+newSecretKeyWith :: (Ptr CUChar -> IO ()) -> IO SecretKey+newSecretKeyWith action = do+  ptr <- sodiumMalloc cryptoSecretStreamXChaCha20Poly1305KeyBytes+  when (ptr == Foreign.nullPtr) $ throwErrno "sodium_malloc"+  fPtr <- Foreign.newForeignPtr finalizerSodiumFree ptr+  action ptr+  pure $ SecretKey fPtr++-- | An encrypted stream starts with a 'Header' of size 'cryptoSecretStreamXChaCha20Poly1305HeaderBytes'.+--+-- That header must be sent/stored before the sequence of encrypted messages, as it is required to decrypt the stream.+--+-- The header content doesn’t have to be secret and decryption with a different header will fail.+--+-- @since 0.0.1.0+newtype Header = Header (ForeignPtr CUChar)++-- | @since 0.0.1.0+instance Show Header where+  show = BSI.unpackChars . Base16.extractBase16 . headerToHexByteString++-- | @since 0.0.1.0+instance Display Header where+  displayBuilder = Builder.fromText . Base16.extractBase16 . headerToHexText++-- | @since 0.0.1.0+instance Eq Header where+  (Header header1) == (Header header2) =+    unsafeDupablePerformIO $+      foreignPtrEq header1 header2 cryptoSecretStreamXChaCha20Poly1305HeaderBytes++-- | @since 0.0.1.0+instance Ord Header where+  compare (Header header1) (Header header2) =+    unsafeDupablePerformIO $+      foreignPtrOrd header1 header2 cryptoSecretStreamXChaCha20Poly1305HeaderBytes++-- | Convert a 'Header' to a hexadecimal-encoded 'StrictByteString'+--+-- @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)++-- | Build a 'Header' from a base16-encoded 'StrictByteString'+--+-- @since 0.0.1.0+headerFromHexByteString :: Base16 StrictByteString -> Either Text Header+headerFromHexByteString hexHeader = unsafeDupablePerformIO $+  case Base16.decodeBase16Untyped (Base16.extractBase16 hexHeader) of+    Right bytestring ->+      if BS.length bytestring == fromIntegral cryptoSecretStreamXChaCha20Poly1305HeaderBytes+        then BSU.unsafeUseAsCStringLen bytestring $ \(outsideHeaderPtr, _) -> do+          let headerLength = fromIntegral cryptoSecretStreamXChaCha20Poly1305HeaderBytes+          headerForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoSecretStreamXChaCha20Poly1305HeaderBytes)+          Foreign.withForeignPtr headerForeignPtr $ \headerPtr -> do+            Foreign.copyBytes headerPtr (Foreign.castPtr outsideHeaderPtr) headerLength+            pure $ Right $ Header headerForeignPtr+        else pure $ Left $ Text.pack ("Secret Key is not of size " <> show cryptoSecretStreamXChaCha20Poly1305HeaderBytes)+    Left msg -> pure $ Left msg++-- | Convert a 'Header' to a hexadecimal-encoded 'Text'.+--+-- @since 0.0.1.0+headerToHexText :: Header -> Base16 Text+headerToHexText = Base16.encodeBase16 . Base16.extractBase16 . headerToHexByteString++-- | Each encrypted message is associated with a tag.+--+-- A typical encrypted stream simply attaches 'Message' as a tag to all messages,+-- except the last one which is tagged as 'Final'.+--+-- @since 0.0.1.0+data MessageTag+  = -- | The most common tag, that doesn’t add any information about the nature of the message.+    Message+  | -- | Indicates that the message marks the end of the stream, and erases the secret key used to encrypt the previous sequence.+    Final+  | -- | Indicates that the message marks the end of a set of messages, but not the end of the stream.+    Push+  | -- | “Forget” the key used to encrypt this message and the previous ones, and derive a new secret key.+    Rekey++-- | Convert a 'MessageTag' to its corresponding constant.+--+-- @since 0.0.1.0+messageTagToConstant :: MessageTag -> CUChar+messageTagToConstant = \case+  Message -> fromIntegral cryptoSecretStreamXChaCha20Poly1305TagMessage+  Final -> fromIntegral cryptoSecretStreamXChaCha20Poly1305TagFinal+  Push -> fromIntegral cryptoSecretStreamXChaCha20Poly1305TagPush+  Rekey -> fromIntegral cryptoSecretStreamXChaCha20Poly1305TagRekey++-- | An encrypted message. It is guaranteed to be of size:+--  @original_message_length + 'cryptoSecretStreamXChaCha20Poly1305ABytes'@+--+-- @since 0.0.1.0+data CipherText = CipherText+  { messageLength :: CULLong+  , cipherTextForeignPtr :: ForeignPtr CUChar+  }++-- |+--+-- @since 0.0.1.0+instance Eq CipherText where+  (CipherText cipherTextLength1 h1) == (CipherText cipherTextLength2 h2) =+    unsafeDupablePerformIO $ do+      result1 <-+        foreignPtrEq+          h1+          h2+          (fromIntegral cipherTextLength1 + cryptoSecretStreamXChaCha20Poly1305ABytes)+      pure $ cipherTextLength1 == cipherTextLength2 && result1++-- | @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++-- | @since 0.0.1.0+instance Display CipherText where+  displayBuilder = Builder.fromText . Base16.extractBase16 . ciphertextToHexText++-- | @since 0.0.1.0+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+-- of the encrypted message and the authentication tag.+--+-- The input hash 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+    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+          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"+    Left msg -> pure $ Left msg++-- | 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 = Base16.encodeBase16 . ciphertextToBinary++-- | Convert a 'CipherText' to a hexadecimal-encoded 'StrictByteString'.+--+-- ⚠️  Be prudent as to where you store it!+--+-- @since 0.0.1.0+ciphertextToHexByteString :: CipherText -> Base16 StrictByteString+ciphertextToHexByteString = Base16.encodeBase16' . ciphertextToBinary++-- | 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 cipherTextLength fPtr) =+  BSI.fromForeignPtr0+    (Foreign.castForeignPtr fPtr)+    (fromIntegral cipherTextLength + fromIntegral cryptoSecretStreamXChaCha20Poly1305ABytes)++-- | @since 0.0.1.0+data StreamEncryptionException = StreamEncryptionException+  deriving stock (Eq, Ord, Show)+  deriving anyclass (Exception)++-- | @since 0.0.1.0+data StreamInitEncryptionException = StreamInitEncryptionException+  deriving stock (Eq, Ord, Show)+  deriving anyclass (Exception)++-- | @since 0.0.1.0+data StreamDecryptionException = StreamDecryptionException+  deriving stock (Eq, Ord, Show)+  deriving anyclass (Exception)
+ test/Main.hs view
@@ -0,0 +1,38 @@+module Main where++import Test.Tasty++import LibSodium.Bindings.Main (sodiumInit)+import qualified Test.HMAC as HMAC+import qualified Test.Hashing as Hashing+import qualified Test.Hashing.Password as Password+import qualified Test.Hashing.SHA2 as Hashing.SHA2+import qualified Test.Hashing.Short as Short+import qualified Test.PublicKey.Cipher as PublicKey.Cipher+import qualified Test.PublicKey.Seal as PublicKey.Seal+import qualified Test.PublicKey.Signature as PublicKey.Signature+import qualified Test.Scrypt as Scrypt+import qualified Test.SecretKey.Authentication as SecretKey.Authentication+import qualified Test.SecretKey.Cipher as SecretKey.Cipher+import qualified Test.SecretKey.Stream as SecretKey.Stream++main :: IO ()+main = do+  sodiumInit+  defaultMain . testGroup "sel tests" $ specs++specs :: [TestTree]+specs =+  [ Hashing.spec+  , Password.spec+  , Short.spec+  , PublicKey.Signature.spec+  , PublicKey.Cipher.spec+  , PublicKey.Seal.spec+  , Hashing.SHA2.spec+  , SecretKey.Cipher.spec+  , SecretKey.Authentication.spec+  , SecretKey.Stream.spec+  , HMAC.spec+  , Scrypt.spec+  ]
+ test/Test/HMAC.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}++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 TestUtils (assertRight)++spec :: TestTree+spec =+  testGroup+    "HMAC-SHA2 hashing"+    [ testGroup+        "HMAC-SHA-256"+        [ testCase "Single-message hashing" testSingleHMACSHA256Hashing+        , testCase "Multiple-message hashing" testMultipleHMAC256Hashing+        , testCase "Round-trip authentication key serialisation" testHMAC256AuthenticationKeySerialisation+        , testCase "Round-trip tag serialisation" testHMAC256AuthenticationTagSerialisation+        ]+    , testGroup+        "HMAC-SHA-512"+        [ testCase "Single-message hashing" testSingleHMACSHA512Hashing+        , testCase "Multiple-message hashing" testMultipleHMAC512Hashing+        , testCase "Round-trip authentication key serialisation" testHMAC512AuthenticationKeySerialisation+        , testCase "Round-trip tag serialisation" testHMAC512AuthenticationTagSerialisation+        ]+    , testGroup+        "HMAC-SHA-512-256"+        [ testCase "Single-message hashing" testSingleHMACSHA512_256Hashing+        , testCase "Multiple-message hashing" testMultipleHMAC512_256Hashing+        , testCase "Round-trip authentication key serialisation" testHMAC512_256AuthenticationKeySerialisation+        , testCase "Round-trip tag serialisation" testHMAC512_256AuthenticationTagSerialisation+        ]+    ]++-- HMAC-SHA-256++testSingleHMACSHA256Hashing :: Assertion+testSingleHMACSHA256Hashing = do+  key <- SHA256.newAuthenticationKey+  tag <- SHA256.authenticate "Hello, world!" key+  assertBool "message is verified" $+    SHA256.verify tag key "Hello, world!"++testMultipleHMAC256Hashing :: Assertion+testMultipleHMAC256Hashing = do+  key <- assertRight $ SHA256.authenticationKeyFromHexByteString "d7fd28595f186884a88235d1d3c84f836303f58aa69496f2fd76e8a709d5224e"+  actual <- SHA256.withMultipart key $ \multipart -> do+    SHA256.updateMultipart multipart "hunter"+    SHA256.updateMultipart multipart "2"+  assertEqual+    "HMAC-SHA256 tag is consistent"+    "be884a372976dd92e819d55ea7090d0b87377b3ac0773a97a5fdc12523104c35"+    (SHA256.authenticationTagToHexByteString actual)++testHMAC256AuthenticationKeySerialisation :: Assertion+testHMAC256AuthenticationKeySerialisation = do+  key1 <- SHA256.newAuthenticationKey+  let hexKey = SHA256.unsafeAuthenticationKeyToHexByteString key1+  key2 <- assertRight $ SHA256.authenticationKeyFromHexByteString hexKey+  assertEqual "Roundtripping authentication key" key1 key2++testHMAC256AuthenticationTagSerialisation :: Assertion+testHMAC256AuthenticationTagSerialisation = do+  key <- SHA256.newAuthenticationKey+  tag1 <- SHA256.authenticate "Hello, world!" key+  let hexTag = SHA256.authenticationTagToHexByteString tag1+  tag2 <- assertRight $ SHA256.authenticationTagFromHexByteString hexTag+  assertEqual "Roundtripping authentication key" tag1 tag2++-- HMAC-SHA-512++testSingleHMACSHA512Hashing :: Assertion+testSingleHMACSHA512Hashing = do+  key <- SHA512.newAuthenticationKey+  tag <- SHA512.authenticate "Hello, world!" key+  assertBool "message is verified" $+    SHA512.verify tag key "Hello, world!"++testMultipleHMAC512Hashing :: Assertion+testMultipleHMAC512Hashing = do+  key <- assertRight $ SHA512.authenticationKeyFromHexByteString "d7fd28595f186884a88235d1d3c84f836303f58aa69496f2fd76e8a709d5224e"+  actual <- SHA512.withMultipart key $ \multipart -> do+    SHA512.updateMultipart multipart "hunter"+    SHA512.updateMultipart multipart "2"+  assertEqual+    "HMAC-SHA512 tag is consistent"+    "be884a372976dd92e819d55ea7090d0b87377b3ac0773a97a5fdc12523104c35"+    (SHA512.authenticationTagToHexByteString actual)++testHMAC512AuthenticationKeySerialisation :: Assertion+testHMAC512AuthenticationKeySerialisation = do+  key1 <- SHA512.newAuthenticationKey+  let hexKey = SHA512.unsafeAuthenticationKeyToHexByteString key1+  key2 <- assertRight $ SHA512.authenticationKeyFromHexByteString hexKey+  assertEqual "Roundtripping authentication key" key1 key2++testHMAC512AuthenticationTagSerialisation :: Assertion+testHMAC512AuthenticationTagSerialisation = do+  key <- SHA512.newAuthenticationKey+  tag1 <- SHA512.authenticate "Hello, world!" key+  let hexTag = SHA512.authenticationTagToHexByteString tag1+  tag2 <- assertRight $ SHA512.authenticationTagFromHexByteString hexTag+  assertEqual "Roundtripping authentication key" tag1 tag2++-- HMAC-SHA-512-256++testSingleHMACSHA512_256Hashing :: Assertion+testSingleHMACSHA512_256Hashing = do+  key <- SHA512_256.newAuthenticationKey+  tag <- SHA512_256.authenticate "Hello, world!" key+  assertBool "message is verified" $+    SHA512_256.verify tag key "Hello, world!"++testMultipleHMAC512_256Hashing :: Assertion+testMultipleHMAC512_256Hashing = do+  key <- assertRight $ SHA512_256.authenticationKeyFromHexByteString "d7fd28595f186884a88235d1d3c84f836303f58aa69496f2fd76e8a709d5224e"+  actual <- SHA512_256.withMultipart key $ \multipart -> do+    SHA512_256.updateMultipart multipart "hunter"+    SHA512_256.updateMultipart multipart "2"+  assertEqual+    "HMAC-SHA512_256 tag is consistent"+    "be884a372976dd92e819d55ea7090d0b87377b3ac0773a97a5fdc12523104c35"+    (SHA512_256.authenticationTagToHexByteString actual)++testHMAC512_256AuthenticationKeySerialisation :: Assertion+testHMAC512_256AuthenticationKeySerialisation = do+  key1 <- SHA512_256.newAuthenticationKey+  let hexKey = SHA512_256.unsafeAuthenticationKeyToHexByteString key1+  key2 <- assertRight $ SHA512_256.authenticationKeyFromHexByteString hexKey+  assertEqual "Roundtripping authentication key" key1 key2++testHMAC512_256AuthenticationTagSerialisation :: Assertion+testHMAC512_256AuthenticationTagSerialisation = do+  key <- SHA512_256.newAuthenticationKey+  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
+ test/Test/Hashing.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++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++spec :: TestTree+spec =+  testGroup+    "Generic hashing tests"+    [ testCase "cryptoGenericHash without key" testCryptoGenericHashWithoutKey+    , testCase "cryptoGenericHash with key" testCryptoGenericHashWithKey+    , testCase "Multi-part hashing" testMultipartHahsing+    ]++testCryptoGenericHashWithoutKey :: Assertion+testCryptoGenericHashWithoutKey = do+  expected <- Hashing.hashToHexByteString <$> Hashing.hashByteString Nothing "test test"+  assertEqual+    "Hashed test string is consistent without key"+    expected+    "7f3dc1170e7017a1643d84d102429c4c7aec4ca99c016c32af18af997fed51f1"++testCryptoGenericHashWithKey :: Assertion+testCryptoGenericHashWithKey =+  let key = "af7d1575690407317bf93723a8d1dca5"+      msg = "Test Test" :: String+   in withCStringLen msg $ \(cString, cstringLength) ->+        allocaBytes (fromIntegral cryptoGenericHashBytes) $ \outPtr ->+          BS.unsafeUseAsCStringLen key $ \(keyPtr, keyLength) -> do+            void $+              cryptoGenericHash+                outPtr+                cryptoGenericHashBytes+                (castPtr cString :: Ptr CUChar)+                (fromIntegral cstringLength)+                (castPtr keyPtr)+                (fromIntegral keyLength)+            out <- peekCStringLen (castPtr outPtr, cstringLength)+            assertEqual+              "Hashed test string is consistent with key"+              "<|1"+              out++testMultipartHahsing :: Assertion+testMultipartHahsing = do+  hashKey <- Hashing.newHashKey+  expectedHash <- Hashing.hashByteString (Just hashKey) "test test"+  actualHash <- Hashing.withMultipart (Just hashKey) $ \multipartState -> do+    let message1 = "test "+    Hashing.updateMultipart multipartState message1+    let message2 = "test"+    Hashing.updateMultipart multipartState message2+  assertEqual+    "Hash remains the same when using multipart"+    (Hashing.hashToHexByteString expectedHash)+    (Hashing.hashToHexByteString actualHash)
+ test/Test/Hashing/Password.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Hashing.Password where++import Data.Function (on)+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++spec :: TestTree+spec =+  testGroup+    "Password hashing tests"+    [ testCase "Round-trip test for password hashing" testRoundtripHash+    , testCase "Consistent password hashing with salt" testHashPasswordWSalt+    , testCase "ASCII representation" testASCIIRepresentation+    ]++testRoundtripHash :: Assertion+testRoundtripHash = do+  let password = "hunter2" :: Text+  passwordHash <- Sel.hashText password+  let passwordHash' = Sel.asciiByteStringToPasswordHash $ Sel.passwordHashToByteString passwordHash++  assertEqual+    "Original hash and hash from bytestring are the same"+    passwordHash+    passwordHash'++  assertBool+    "Password hashing is consistent"+    (Sel.verifyText passwordHash "hunter2")++  assertBool+    "Password hashing is consistent"+    (Sel.verifyText passwordHash' "hunter2")++testHashPasswordWSalt :: Assertion+testHashPasswordWSalt = do+  let hashWSalt s = Sel.hashByteStringWithParams Sel.defaultArgon2Params s+      password = "hunter2"+      cmpPWHashes = on (==) Sel.passwordHashToByteString++  salt1 <- Sel.genSalt+  hashOrig <- hashWSalt salt1 password+  hashOrig' <- hashWSalt salt1 password+  assertBool+    "Password hashing with salt is consistent"+    (cmpPWHashes hashOrig hashOrig')++  hashWoSalt <- Sel.hashByteString password+  assertBool+    "Password hashing with salt differs from without"+    (not $ cmpPWHashes hashOrig hashWoSalt)++  salt2 <- Sel.genSalt+  hashWNewSalt <- hashWSalt salt2 password+  assertBool+    "Password hashing differs with a new salt"+    (not $ cmpPWHashes hashOrig hashWNewSalt)++  assertBool+    "Bogus salt ByteString fails to generate Salt"+    (isNothing (Sel.hexByteStringToSalt "deadbeef"))++testASCIIRepresentation :: Assertion+testASCIIRepresentation = do+  hash <- Sel.hashByteString "hunter3"+  let textHash = Sel.passwordHashToText hash+  assertBool+    "Textual representation is stable using passwordHashToText"+    ("$argon2id$v=19$m=262144,t=3,p=1$" `Text.isPrefixOf` textHash)++  let bsHash = Sel.passwordHashToByteString hash+  let hash2 = Sel.asciiByteStringToPasswordHash bsHash+  assertEqual+    "Can import hash"+    hash2+    hash
+ test/Test/Hashing/SHA2.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}++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++spec :: TestTree+spec =+  testGroup+    "SHA2 hashing"+    [ testGroup+        "SHA-256"+        [ testCase "SHA-256 single-message hashing" testSingleHashSHA256+        , testCase "SHA-256 multi-part message hashing" testMultipartHashSH256+        ]+    , testGroup+        "SHA-512"+        [ testCase "SHA-512 single-message hashing" testSingleHashSHA512+        , testCase "SHA-512 multi-part message hashing" testMultipartHashSH512+        ]+    ]++testSingleHashSHA512 :: Assertion+testSingleHashSHA512 = do+  let password = "hunter2" :: Text+  actual <- SHA512.hashText password+  assertEqual+    "SHA-512 hashing is consistent"+    (SHA512.hashToHexByteString actual)+    "6b97ed68d14eb3f1aa959ce5d49c7dc612e1eb1dafd73b1e705847483fd6a6c809f2ceb4e8df6ff9984c6298ff0285cace6614bf8daa9f0070101b6c89899e22"++testMultipartHashSH512 :: Assertion+testMultipartHashSH512 = do+  actual <- SHA512.withMultipart $ \multipart -> do+    SHA512.updateMultipart multipart "hunter"+    SHA512.updateMultipart multipart "2"+  assertEqual+    "SHA-512 hashing is consistent"+    (SHA512.hashToHexByteString actual)+    "6b97ed68d14eb3f1aa959ce5d49c7dc612e1eb1dafd73b1e705847483fd6a6c809f2ceb4e8df6ff9984c6298ff0285cace6614bf8daa9f0070101b6c89899e22"++testSingleHashSHA256 :: Assertion+testSingleHashSHA256 = do+  let password = "hunter2" :: Text+  actual <- SHA256.hashText password+  assertEqual+    "SHA-256 hashing is consistent"+    (SHA256.hashToHexByteString actual)+    "f52fbd32b2b3b86ff88ef6c490628285f482af15ddcb29541f94bcf526a3f6c7"++testMultipartHashSH256 :: Assertion+testMultipartHashSH256 = do+  actual <- SHA256.withMultipart $ \multipart -> do+    SHA256.updateMultipart multipart "hunter"+    SHA256.updateMultipart multipart "2"+  assertEqual+    "SHA-256 hashing is consistent"+    (SHA256.hashToHexByteString actual)+    "f52fbd32b2b3b86ff88ef6c490628285f482af15ddcb29541f94bcf526a3f6c7"
+ test/Test/Hashing/Short.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Hashing.Short where++import Data.Maybe (fromJust)+import Data.Text (Text)+import qualified Sel.Hashing.Short as Short+import Test.Tasty+import Test.Tasty.HUnit++spec :: TestTree+spec =+  testGroup+    "Password hashing tests"+    [ testCase "Hash a short string with a known salt" testHashPassword+    ]++testHashPassword :: Assertion+testHashPassword = do+  let key = fromJust $ Short.hexTextToShortHashKey "9301a3c5eedf2d783b72dc41fb907964"+  let input = "kwak kwak" :: Text+  hash <- Short.hashText key input+  assertEqual+    "input hashing is consistent"+    (Short.shortHashToHexText hash)+    "d50bb18bee915f21a30e6ea555c34546"
+ test/Test/PublicKey/Cipher.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.PublicKey.Cipher where++import Sel.PublicKey.Cipher+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils++spec :: TestTree+spec =+  testGroup+    "Public Key Cipher tests"+    [ 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+    ]++testEncryptMessage :: Assertion+testEncryptMessage = do+  (senderPublicKey, senderSecretKey) <- newKeyPair++  (recipientPublicKey, recipientSecretKey) <- newKeyPair+  (nonce, encryptedMessage) <- encrypt "hello hello" recipientPublicKey senderSecretKey+  let result = decrypt encryptedMessage senderPublicKey recipientSecretKey nonce+  assertEqual+    "Message is well-opened with the correct key and nonce"+    (Just "hello hello")+    result++testNonceSerdeRoundtrip :: Assertion+testNonceSerdeRoundtrip = do+  (publicKey, secretKey) <- newKeyPair+  (nonce, _) <- encrypt "hello hello" publicKey secretKey+  let hexNonce = nonceToHexByteString nonce+  nonce2 <- assertRight $ nonceFromHexByteString hexNonce+  assertEqual "Roundtripping nonce serialisation" nonce nonce2++testKeysSerdeRoundtrip :: Assertion+testKeysSerdeRoundtrip = do+  (pk1, sk1) <- newKeyPair+  let hexPk = publicKeyToHexByteString pk1+  let hexSk = unsafeSecretKeyToHexByteString sk1+  (pk2, sk2) <- assertRight $ keyPairFromHexByteStrings hexPk hexSk+  assertEqual "Roundtripping keys serialisation" (pk1, sk1) (pk2, sk2)++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
+ test/Test/PublicKey/Seal.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.PublicKey.Seal where++import Sel.PublicKey.Cipher+import Sel.PublicKey.Seal+import Test.Tasty+import Test.Tasty.HUnit++spec :: TestTree+spec =+  testGroup+    "Public Key Anonymous Sealing tests"+    [ testCase "Encrypt an anonymous message with public-key encryption" testEncryptMessage+    ]++testEncryptMessage :: Assertion+testEncryptMessage = do+  (recipientPublicKey, recipientSecretKey) <- newKeyPair+  encryptedMessage <- seal "hello hello" recipientPublicKey+  let result = open encryptedMessage recipientPublicKey recipientSecretKey+  assertEqual+    "Message is well-opened"+    (Just "hello hello")+    result
+ test/Test/PublicKey/Signature.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.PublicKey.Signature where++import Sel.PublicKey.Signature+import Test.Tasty+import Test.Tasty.HUnit++spec :: TestTree+spec =+  testGroup+    "Signing tests"+    [ testCase "Sign a message with a public key and decrypt it with a secret key" testSignMessage+    ]++testSignMessage :: Assertion+testSignMessage = do+  (publicKey, secretKey) <- generateKeyPair+  signedMessage <- signMessage "hello hello" secretKey+  let result = openMessage signedMessage publicKey+  assertEqual+    "Message is well-opened with the correct key"+    (Just "hello hello")+    result
+ test/Test/Scrypt.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Scrypt where++import Data.ByteString+import Sel.Scrypt+import Test.Tasty+import Test.Tasty.HUnit++spec :: TestTree+spec =+  testGroup+    "Scrypt tests"+    [ testCase "Hash Scrypt password" testHashScrypt+    , testCase "Verify Scrypt password" testVerifyScrypt+    ]++testHashScrypt :: Assertion+testHashScrypt = do+  let hash = "This is not a real hash." :: StrictByteString+  scryptHashPassword hash+  return ()++testVerifyScrypt :: Assertion+testVerifyScrypt = do+  let hash = "This is not a real hash." :: StrictByteString+  sh <- scryptHashPassword hash+  res <- scryptVerifyPassword hash sh+  assertBool "Verifier failed." res
+ test/Test/SecretKey/Authentication.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.SecretKey.Authentication where++import Sel.SecretKey.Authentication+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils (assertRight)++spec :: TestTree+spec =+  testGroup+    "Secret Key Authentication tests"+    [ testCase "Authenticate a message with a fixed secret key" testAuthenticateMessage+    , testCase "Round-trip auth key serialisation" testAuthKeySerdeRoundtrip+    , testCase "Round-trip auth tag serialisation" testAuthTagSerdeRoundtrip+    ]++testAuthenticateMessage :: Assertion+testAuthenticateMessage = do+  key <- newAuthenticationKey+  tag <- authenticate "hello, world" key+  assertBool+    "Tag verified"+    (verify tag key "hello, world")++testAuthKeySerdeRoundtrip :: Assertion+testAuthKeySerdeRoundtrip = do+  expectedKey <- newAuthenticationKey+  let hexKey = unsafeAuthenticationKeyToHexByteString expectedKey+  actualKey <- assertRight $ authenticationKeyFromHexByteString hexKey+  assertEqual+    "Key is expected"+    expectedKey+    actualKey++testAuthTagSerdeRoundtrip :: Assertion+testAuthTagSerdeRoundtrip = do+  key <- newAuthenticationKey+  expectedTag <- authenticate "hello, world" key+  let hexTag = authenticationTagToHexByteString expectedTag+  actualTag <- assertRight $ authenticationTagFromHexByteString hexTag+  assertEqual+    "Tag is expected"+    expectedTag+    actualTag
+ test/Test/SecretKey/Cipher.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.SecretKey.Cipher where++import Sel.SecretKey.Cipher+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils (assertRight)++spec :: TestTree+spec =+  testGroup+    "Secret Key Authenticated Encryption tests"+    [ 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+    ]++testEncryptMessage :: Assertion+testEncryptMessage = do+  secretKey <- newSecretKey+  (nonce, encryptedMessage) <- encrypt "hello hello" secretKey+  let result = decrypt encryptedMessage secretKey nonce+  assertEqual+    "Message is well-opened with the correct key and nonce"+    (Just "hello hello")+    result++testNonceSerdeRoundtrip :: Assertion+testNonceSerdeRoundtrip = do+  secretKey <- newSecretKey+  (nonce, _) <- encrypt "hello hello" secretKey+  nonce2 <- assertRight $ nonceFromHexByteString . nonceToHexByteString $ nonce+  assertEqual "Roundtripping nonce" nonce nonce2++testSecretKeySerdeRoundtrip :: Assertion+testSecretKeySerdeRoundtrip = do+  secretKey <- newSecretKey+  secretKey2 <- assertRight $ secretKeyFromHexByteString . unsafeSecretKeyToHexByteString $ secretKey+  assertEqual "Roundtripping secret key" secretKey secretKey2++testHashSerdeRoundtrip :: Assertion+testHashSerdeRoundtrip = do+  secretKey <- newSecretKey+  (_, hash) <- encrypt "" secretKey+  hash2 <- assertRight $ hashFromHexByteString . hashToHexByteString $ hash+  assertEqual "Roundtripping hash" hash hash2
+ test/Test/SecretKey/Stream.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.SecretKey.Stream where++import Data.ByteString (StrictByteString)+import qualified Sel.SecretKey.Stream as Stream+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils++spec :: TestTree+spec =+  testGroup+    "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 header serialisation" testHeaderSerdeRoundtrip+    ]++testEncryptStream :: Assertion+testEncryptStream = do+  secretKey <- Stream.newSecretKey+  let messages = ["Hello", "abcdf", "world"]+  (header, cipherTexts) <- Stream.encryptList secretKey messages+  mResult <- Stream.decryptList secretKey header cipherTexts+  result <- assertJust mResult++  assertEqual+    "Expected result"+    result+    messages++testSecretKeySerdeRoundtrip :: Assertion+testSecretKeySerdeRoundtrip = do+  secretKey1 <- Stream.newSecretKey+  let hexSecretKey1 = Stream.unsafeSecretKeyToHexByteString secretKey1+  secretKey2 <- assertRight $ Stream.secretKeyFromHexByteString hexSecretKey1++  assertEqual+    "The keys remain equal"+    secretKey1+    secretKey2++testCipherTextSerdeRoundtrip :: Assertion+testCipherTextSerdeRoundtrip = do+  secretKey <- Stream.newSecretKey+  let message = "hello" :: StrictByteString+  (_, encryptedPayload1) <- Stream.encryptStream secretKey $ \multipart -> do+    Stream.encryptChunk multipart Stream.Final message++  let hexCipherText = Stream.ciphertextToHexByteString encryptedPayload1+  encryptedPayload2 <- assertRight $ Stream.ciphertextFromHexByteString hexCipherText++  assertEqual+    "The ciphertexts remain equal"+    encryptedPayload1+    encryptedPayload2
+ test/TestUtils.hs view
@@ -0,0 +1,13 @@+module TestUtils where++import Control.Monad.IO.Class (MonadIO, liftIO)+import GHC.Stack+import qualified Test.Tasty.HUnit as Test++assertRight :: MonadIO m => HasCallStack => Either a b -> m b+assertRight (Left _a) = liftIO $ Test.assertFailure "Test return Left instead of Right"+assertRight (Right b) = pure b++assertJust :: MonadIO m => HasCallStack => Maybe a -> m a+assertJust Nothing = liftIO $ Test.assertFailure "Test return Nothing instead of Just"+assertJust (Just b) = pure b