{-# 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
-- > import Sel (secureMain)
-- >
-- > main = secureMain $ 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
    ( Int -> SecretKey -> Builder
[SecretKey] -> Builder
SecretKey -> Builder
(SecretKey -> Builder)
-> ([SecretKey] -> Builder)
-> (Int -> SecretKey -> Builder)
-> Display SecretKey
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
$cdisplayBuilder :: SecretKey -> Builder
displayBuilder :: SecretKey -> Builder
$cdisplayList :: [SecretKey] -> Builder
displayList :: [SecretKey] -> Builder
$cdisplayPrec :: Int -> SecretKey -> Builder
displayPrec :: Int -> SecretKey -> Builder
Display
      -- ^ @since 0.0.1.0
      -- > display secretKey == "[REDACTED]"
    )
    via (OpaqueInstance "[REDACTED]" SecretKey)

-- |
--
-- @since 0.0.1.0
instance Eq SecretKey where
  (SecretKey ForeignPtr CUChar
hk1) == :: SecretKey -> SecretKey -> Bool
== (SecretKey ForeignPtr CUChar
hk2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoSecretboxKeyBytes

-- |
--
-- @since 0.0.1.0
instance Ord SecretKey where
  compare :: SecretKey -> SecretKey -> Ordering
compare (SecretKey ForeignPtr CUChar
hk1) (SecretKey ForeignPtr CUChar
hk2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoSecretboxKeyBytes

-- | > show secretKey == "[REDACTED]"
--
-- @since 0.0.1.0
instance Show SecretKey where
  show :: SecretKey -> String
show SecretKey
_ = String
"[REDACTED]"

-- | Generate a new random secret key.
--
-- @since 0.0.1.0
newSecretKey :: IO SecretKey
newSecretKey :: IO SecretKey
newSecretKey = (Ptr CUChar -> IO ()) -> IO SecretKey
newSecretKeyWith Ptr CUChar -> IO ()
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 :: StrictByteString -> Either Text SecretKey
secretKeyFromHexByteString StrictByteString
hexNonce = IO (Either Text SecretKey) -> Either Text SecretKey
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text SecretKey) -> Either Text SecretKey)
-> IO (Either Text SecretKey) -> Either Text SecretKey
forall a b. (a -> b) -> a -> b
$
  case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped StrictByteString
hexNonce of
    Right StrictByteString
bytestring ->
      if StrictByteString -> Int
BS.length StrictByteString
bytestring Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxKeyBytes
        then StrictByteString
-> (CStringLen -> IO (Either Text SecretKey))
-> IO (Either Text SecretKey)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text SecretKey))
 -> IO (Either Text SecretKey))
-> (CStringLen -> IO (Either Text SecretKey))
-> IO (Either Text SecretKey)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideSecretKeyPtr, Int
_) ->
          (SecretKey -> Either Text SecretKey)
-> IO SecretKey -> IO (Either Text SecretKey)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> Either Text SecretKey
forall a b. b -> Either a b
Right (IO SecretKey -> IO (Either Text SecretKey))
-> IO SecretKey -> IO (Either Text SecretKey)
forall a b. (a -> b) -> a -> b
$
            (Ptr CUChar -> IO ()) -> IO SecretKey
newSecretKeyWith ((Ptr CUChar -> IO ()) -> IO SecretKey)
-> (Ptr CUChar -> IO ()) -> IO SecretKey
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
secretKeyPtr ->
              Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray
                (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CUChar @CChar Ptr CUChar
secretKeyPtr)
                Ptr CChar
outsideSecretKeyPtr
                (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxKeyBytes)
        else Either Text SecretKey -> IO (Either Text SecretKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text SecretKey -> IO (Either Text SecretKey))
-> Either Text SecretKey -> IO (Either Text SecretKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text SecretKey
forall a b. a -> Either a b
Left (Text -> Either Text SecretKey) -> Text -> Either Text SecretKey
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"Secret Key is too short"
    Left Text
msg -> Either Text SecretKey -> IO (Either Text SecretKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text SecretKey -> IO (Either Text SecretKey))
-> Either Text SecretKey -> IO (Either Text SecretKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text SecretKey
forall a b. a -> Either a b
Left Text
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 :: (Ptr CUChar -> IO ()) -> IO SecretKey
newSecretKeyWith Ptr CUChar -> IO ()
action = do
  Ptr CUChar
ptr <- CSize -> IO (Ptr CUChar)
forall a. CSize -> IO (Ptr a)
sodiumMalloc CSize
cryptoSecretboxKeyBytes
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr CUChar
ptr Ptr CUChar -> Ptr CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CUChar
forall a. Ptr a
Foreign.nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
forall a. String -> IO a
throwErrno String
"sodium_malloc"

  ForeignPtr CUChar
fPtr <- FinalizerPtr CUChar -> Ptr CUChar -> IO (ForeignPtr CUChar)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
Foreign.newForeignPtr FinalizerPtr CUChar
forall a. FinalizerPtr a
finalizerSodiumFree Ptr CUChar
ptr
  Ptr CUChar -> IO ()
action Ptr CUChar
ptr
  SecretKey -> IO SecretKey
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecretKey -> IO SecretKey) -> SecretKey -> IO SecretKey
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> SecretKey
SecretKey ForeignPtr CUChar
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 -> StrictByteString
unsafeSecretKeyToHexByteString (SecretKey ForeignPtr CUChar
secretKeyForeignPtr) =
  Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (StrictByteString -> Base16 StrictByteString)
-> StrictByteString
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 StrictByteString
Base16.encodeBase16' (StrictByteString -> StrictByteString)
-> StrictByteString -> StrictByteString
forall a b. (a -> b) -> a -> b
$
    ForeignPtr Word8 -> Int -> StrictByteString
BS.fromForeignPtr0
      (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CUChar @Word8 ForeignPtr CUChar
secretKeyForeignPtr)
      (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int CSize
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
    ( Int -> Nonce -> Builder
[Nonce] -> Builder
Nonce -> Builder
(Nonce -> Builder)
-> ([Nonce] -> Builder)
-> (Int -> Nonce -> Builder)
-> Display Nonce
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
$cdisplayBuilder :: Nonce -> Builder
displayBuilder :: Nonce -> Builder
$cdisplayList :: [Nonce] -> Builder
displayList :: [Nonce] -> Builder
$cdisplayPrec :: Int -> Nonce -> Builder
displayPrec :: Int -> Nonce -> Builder
Display
      -- ^ @since 0.0.1.0
    )
    via (ShowInstance Nonce)

-- |
--
-- @since 0.0.1.0
instance Eq Nonce where
  (Nonce ForeignPtr CUChar
hk1) == :: Nonce -> Nonce -> Bool
== (Nonce ForeignPtr CUChar
hk2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoSecretboxNonceBytes

-- |
--
-- @since 0.0.1.0
instance Ord Nonce where
  compare :: Nonce -> Nonce -> Ordering
compare (Nonce ForeignPtr CUChar
hk1) (Nonce ForeignPtr CUChar
hk2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoSecretboxNonceBytes

-- |
--
-- @since 0.0.1.0
instance Show Nonce where
  show :: Nonce -> String
show = StrictByteString -> String
forall a. Show a => a -> String
show (StrictByteString -> String)
-> (Nonce -> StrictByteString) -> Nonce -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nonce -> StrictByteString
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 :: IO Nonce
newNonce = do
  (ForeignPtr CUChar
fPtr :: ForeignPtr CUChar) <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxNonceBytes)
  ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
fPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
ptr ->
    Ptr Word8 -> CSize -> IO ()
randombytesBuf (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CUChar @Word8 Ptr CUChar
ptr) CSize
cryptoSecretboxNonceBytes
  Nonce -> IO Nonce
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nonce -> IO Nonce) -> Nonce -> IO Nonce
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> Nonce
Nonce ForeignPtr CUChar
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 :: StrictByteString -> Either Text Nonce
nonceFromHexByteString StrictByteString
hexNonce = IO (Either Text Nonce) -> Either Text Nonce
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text Nonce) -> Either Text Nonce)
-> IO (Either Text Nonce) -> Either Text Nonce
forall a b. (a -> b) -> a -> b
$
  case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped StrictByteString
hexNonce of
    Right StrictByteString
bytestring ->
      if StrictByteString -> Int
BS.length StrictByteString
bytestring Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int CSize
cryptoSecretboxNonceBytes
        then StrictByteString
-> (CStringLen -> IO (Either Text Nonce)) -> IO (Either Text Nonce)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text Nonce)) -> IO (Either Text Nonce))
-> (CStringLen -> IO (Either Text Nonce)) -> IO (Either Text Nonce)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideNoncePtr, Int
_) -> do
          ForeignPtr CChar
nonceForeignPtr <-
            forall a. Int -> IO (ForeignPtr a)
BS.mallocByteString
              @CChar
              (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxNonceBytes)
          ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CChar
nonceForeignPtr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
noncePtr ->
            Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray
              Ptr CChar
noncePtr
              Ptr CChar
outsideNoncePtr
              (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxNonceBytes)
          Either Text Nonce -> IO (Either Text Nonce)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Nonce -> IO (Either Text Nonce))
-> Either Text Nonce -> IO (Either Text Nonce)
forall a b. (a -> b) -> a -> b
$ Nonce -> Either Text Nonce
forall a b. b -> Either a b
Right (Nonce -> Either Text Nonce) -> Nonce -> Either Text Nonce
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> Nonce
Nonce (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CChar @CUChar ForeignPtr CChar
nonceForeignPtr)
        else Either Text Nonce -> IO (Either Text Nonce)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Nonce -> IO (Either Text Nonce))
-> Either Text Nonce -> IO (Either Text Nonce)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Nonce
forall a b. a -> Either a b
Left (Text -> Either Text Nonce) -> Text -> Either Text Nonce
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"Nonce is too short"
    Left Text
msg -> Either Text Nonce -> IO (Either Text Nonce)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Nonce -> IO (Either Text Nonce))
-> Either Text Nonce -> IO (Either Text Nonce)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Nonce
forall a b. a -> Either a b
Left Text
msg

-- | Convert a 'Nonce' to a hexadecimal-encoded 'StrictByteString'.
--
-- @since 0.0.1.0
nonceToHexByteString :: Nonce -> StrictByteString
nonceToHexByteString :: Nonce -> StrictByteString
nonceToHexByteString (Nonce ForeignPtr CUChar
nonceForeignPtr) =
  Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (StrictByteString -> Base16 StrictByteString)
-> StrictByteString
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 StrictByteString
Base16.encodeBase16' (StrictByteString -> StrictByteString)
-> StrictByteString -> StrictByteString
forall a b. (a -> b) -> a -> b
$
    ForeignPtr Word8 -> Int -> StrictByteString
BS.fromForeignPtr0
      (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CUChar @Word8 ForeignPtr CUChar
nonceForeignPtr)
      (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int CSize
cryptoSecretboxNonceBytes)

-- | A ciphertext consisting of an encrypted message and an authentication tag.
--
-- @since 0.0.1.0
data Hash = Hash
  { Hash -> CULLong
messageLength :: CULLong
  , Hash -> ForeignPtr CUChar
hashForeignPtr :: ForeignPtr CUChar
  }

-- |
--
-- @since 0.0.1.0
instance Eq Hash where
  (Hash CULLong
messageLength1 ForeignPtr CUChar
hk1) == :: Hash -> Hash -> Bool
== (Hash CULLong
messageLength2 ForeignPtr CUChar
hk2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
      Bool
result1 <-
        ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq
          ForeignPtr CUChar
hk1
          ForeignPtr CUChar
hk2
          (CULLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength1 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
cryptoSecretboxMACBytes)
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (CULLong
messageLength1 CULLong -> CULLong -> Bool
forall a. Eq a => a -> a -> Bool
== CULLong
messageLength2) Bool -> Bool -> Bool
&& Bool
result1

-- |
--
-- @since 0.0.1.0
instance Ord Hash where
  compare :: Hash -> Hash -> Ordering
compare (Hash CULLong
messageLength1 ForeignPtr CUChar
hk1) (Hash CULLong
messageLength2 ForeignPtr CUChar
hk2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ do
      Ordering
result1 <- ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 (CULLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength1 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
cryptoSecretboxMACBytes)
      Ordering -> IO Ordering
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> IO Ordering) -> Ordering -> IO Ordering
forall a b. (a -> b) -> a -> b
$ CULLong -> CULLong -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CULLong
messageLength1 CULLong
messageLength2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
result1

-- | ⚠️  Be prudent as to what you do with it!
--
-- @since 0.0.1.0
instance Display Hash where
  displayBuilder :: Hash -> Builder
displayBuilder = Text -> Builder
Builder.fromText (Text -> Builder) -> (Hash -> Text) -> Hash -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Text
hashToHexText

-- | ⚠️  Be prudent as to what you do with it!
--
-- @since 0.0.1.0
instance Show Hash where
  show :: Hash -> String
show = StrictByteString -> String
BS.unpackChars (StrictByteString -> String)
-> (Hash -> StrictByteString) -> Hash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> StrictByteString
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 :: StrictByteString -> Either Text Hash
hashFromHexByteString StrictByteString
hexHash = IO (Either Text Hash) -> Either Text Hash
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text Hash) -> Either Text Hash)
-> IO (Either Text Hash) -> Either Text Hash
forall a b. (a -> b) -> a -> b
$
  case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped StrictByteString
hexHash of
    Right StrictByteString
bytestring ->
      if StrictByteString -> Int
BS.length StrictByteString
bytestring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxMACBytes
        then StrictByteString
-> (CStringLen -> IO (Either Text Hash)) -> IO (Either Text Hash)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text Hash)) -> IO (Either Text Hash))
-> (CStringLen -> IO (Either Text Hash)) -> IO (Either Text Hash)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideHashPtr, Int
outsideHashLength) -> do
          ForeignPtr CChar
hashForeignPtr <- forall a. Int -> IO (ForeignPtr a)
BS.mallocByteString @CChar Int
outsideHashLength -- The foreign pointer that will receive the hash data.
          ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CChar
hashForeignPtr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
hashPtr ->
            -- We copy bytes from 'outsideHashPtr' to 'hashPtr'.
            Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr CChar
hashPtr Ptr CChar
outsideHashPtr Int
outsideHashLength
          Either Text Hash -> IO (Either Text Hash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Hash -> IO (Either Text Hash))
-> Either Text Hash -> IO (Either Text Hash)
forall a b. (a -> b) -> a -> b
$
            Hash -> Either Text Hash
forall a b. b -> Either a b
Right (Hash -> Either Text Hash) -> Hash -> Either Text Hash
forall a b. (a -> b) -> a -> b
$
              CULLong -> ForeignPtr CUChar -> Hash
Hash
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
outsideHashLength CULLong -> CULLong -> CULLong
forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @CULLong CSize
cryptoSecretboxMACBytes)
                (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CChar @CUChar ForeignPtr CChar
hashForeignPtr)
        else Either Text Hash -> IO (Either Text Hash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Hash -> IO (Either Text Hash))
-> Either Text Hash -> IO (Either Text Hash)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Hash
forall a b. a -> Either a b
Left (Text -> Either Text Hash) -> Text -> Either Text Hash
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"Hash is too short"
    Left Text
msg -> Either Text Hash -> IO (Either Text Hash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Hash -> IO (Either Text Hash))
-> Either Text Hash -> IO (Either Text Hash)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Hash
forall a b. a -> Either a b
Left Text
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 :: Hash -> Text
hashToHexText = Base16 Text -> Text
forall a. Base16 a -> a
Base16.extractBase16 (Base16 Text -> Text) -> (Hash -> Base16 Text) -> Hash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 Text
Base16.encodeBase16 (StrictByteString -> Base16 Text)
-> (Hash -> StrictByteString) -> Hash -> Base16 Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> StrictByteString
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 :: Hash -> StrictByteString
hashToHexByteString = Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (Hash -> Base16 StrictByteString) -> Hash -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 StrictByteString
Base16.encodeBase16' (StrictByteString -> Base16 StrictByteString)
-> (Hash -> StrictByteString) -> Hash -> Base16 StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> StrictByteString
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 -> StrictByteString
hashToBinary (Hash CULLong
messageLength ForeignPtr CUChar
fPtr) =
  ForeignPtr Word8 -> Int -> StrictByteString
BS.fromForeignPtr0
    (ForeignPtr CUChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr ForeignPtr CUChar
fPtr)
    (CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
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 :: StrictByteString -> SecretKey -> IO (Nonce, Hash)
encrypt StrictByteString
message (SecretKey ForeignPtr CUChar
secretKeyForeignPtr) =
  StrictByteString
-> (CStringLen -> IO (Nonce, Hash)) -> IO (Nonce, Hash)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
message ((CStringLen -> IO (Nonce, Hash)) -> IO (Nonce, Hash))
-> (CStringLen -> IO (Nonce, Hash)) -> IO (Nonce, Hash)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    (Nonce ForeignPtr CUChar
nonceForeignPtr) <- IO Nonce
newNonce
    ForeignPtr CUChar
hashForeignPtr <-
      Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes
        (Int
cStringLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxMACBytes)
    ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
hashForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
hashPtr ->
      ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
secretKeyForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
secretKeyPtr ->
        ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
nonceForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
noncePtr -> do
          IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CUChar
-> Ptr CUChar -> CULLong -> Ptr CUChar -> Ptr CUChar -> IO CInt
cryptoSecretboxEasy
              Ptr CUChar
hashPtr
              (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
cString)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen)
              Ptr CUChar
noncePtr
              Ptr CUChar
secretKeyPtr
    let hash :: Hash
hash = CULLong -> ForeignPtr CUChar -> Hash
Hash (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen) ForeignPtr CUChar
hashForeignPtr
    (Nonce, Hash) -> IO (Nonce, Hash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr CUChar -> Nonce
Nonce ForeignPtr CUChar
nonceForeignPtr, Hash
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 -> SecretKey -> Nonce -> Maybe StrictByteString
decrypt Hash{CULLong
messageLength :: Hash -> CULLong
messageLength :: CULLong
messageLength, ForeignPtr CUChar
hashForeignPtr :: Hash -> ForeignPtr CUChar
hashForeignPtr :: ForeignPtr CUChar
hashForeignPtr} (SecretKey ForeignPtr CUChar
secretKeyForeignPtr) (Nonce ForeignPtr CUChar
nonceForeignPtr) = IO (Maybe StrictByteString) -> Maybe StrictByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe StrictByteString) -> Maybe StrictByteString)
-> IO (Maybe StrictByteString) -> Maybe StrictByteString
forall a b. (a -> b) -> a -> b
$ do
  Ptr CUChar
messagePtr <- Int -> IO (Ptr CUChar)
forall a. Int -> IO (Ptr a)
Foreign.mallocBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CULLong @Int CULLong
messageLength)
  ForeignPtr CUChar
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
hashForeignPtr ((Ptr CUChar -> IO (Maybe StrictByteString))
 -> IO (Maybe StrictByteString))
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
hashPtr ->
    ForeignPtr CUChar
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
secretKeyForeignPtr ((Ptr CUChar -> IO (Maybe StrictByteString))
 -> IO (Maybe StrictByteString))
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
secretKeyPtr ->
      ForeignPtr CUChar
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
nonceForeignPtr ((Ptr CUChar -> IO (Maybe StrictByteString))
 -> IO (Maybe StrictByteString))
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
noncePtr -> do
        CInt
result <-
          Ptr CUChar
-> Ptr CUChar -> CULLong -> Ptr CUChar -> Ptr CUChar -> IO CInt
cryptoSecretboxOpenEasy
            Ptr CUChar
messagePtr
            Ptr CUChar
hashPtr
            (CULLong
messageLength CULLong -> CULLong -> CULLong
forall a. Num a => a -> a -> a
+ CSize -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxMACBytes)
            Ptr CUChar
noncePtr
            Ptr CUChar
secretKeyPtr
        case CInt
result of
          (-1) -> Maybe StrictByteString -> IO (Maybe StrictByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StrictByteString
forall a. Maybe a
Nothing
          CInt
_ -> do
            Ptr CChar
bsPtr <- Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
Foreign.mallocBytes (CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength)
            Ptr CChar -> Ptr CChar -> CSize -> IO (Ptr ())
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr ())
memcpy Ptr CChar
bsPtr (Ptr CUChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CUChar
messagePtr) (CULLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength)
            StrictByteString -> Maybe StrictByteString
forall a. a -> Maybe a
Just
              (StrictByteString -> Maybe StrictByteString)
-> IO StrictByteString -> IO (Maybe StrictByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO StrictByteString
BS.unsafePackMallocCStringLen
                (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar Ptr CChar
bsPtr, CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength)