{-# 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

    -- ** Ciphertext
  , Ciphertext
  , ciphertextFromHexByteString
  , ciphertextToBinary
  , ciphertextToHexByteString
  , ciphertextToHexText
  ) 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 qualified Data.Text.Builder.Linear as Builder
import Data.Text.Display (Display (displayBuilder), OpaqueInstance (..), ShowInstance (..))
import Data.Word (Word8)
import Foreign (ForeignPtr)
import qualified Foreign
import Foreign.C (CChar, CSize, CUChar, CULLong, throwErrno)
import LibSodium.Bindings.Random (randombytesBuf)
import LibSodium.Bindings.Secretbox
  ( cryptoSecretboxEasy
  , cryptoSecretboxKeyBytes
  , cryptoSecretboxKeygen
  , cryptoSecretboxMACBytes
  , cryptoSecretboxNonceBytes
  , cryptoSecretboxOpenEasy
  )
import LibSodium.Bindings.SecureMemory
import System.IO.Unsafe (unsafeDupablePerformIO)

import Sel.Internal
import Sel.Internal.Sodium (binaryToHex)

-- $introduction
-- "Authenticated Encryption" uses a secret key along with a single-use number
-- called a "nonce" to encrypt a message.
-- The resulting ciphertext 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) =
    ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Bool
foreignPtrEqConstantTime 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) =
    ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Ordering
foreignPtrOrdConstantTime 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 <- CSize -> IO (Ptr CUChar)
forall a. CSize -> IO (Ptr a)
sodiumMalloc CSize
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' in constant time.
--
-- ⚠️  Be prudent as to where you store it!
--
-- @since 0.0.1.0
unsafeSecretKeyToHexByteString :: SecretKey -> StrictByteString
unsafeSecretKeyToHexByteString :: SecretKey -> StrictByteString
unsafeSecretKeyToHexByteString (SecretKey ForeignPtr CUChar
secretKeyForeignPtr) =
  ForeignPtr CUChar -> CSize -> StrictByteString
binaryToHex ForeignPtr CUChar
secretKeyForeignPtr 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) =
    ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> 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) =
    ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> 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 ciphertext creation!
newNonce :: IO Nonce
newNonce :: IO Nonce
newNonce = do
  (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)
  Foreign.withForeignPtr fPtr $ \Ptr CUChar
ptr ->
    Ptr Word8 -> CSize -> IO ()
randombytesBuf (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CUChar @Word8 Ptr CUChar
ptr) CSize
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 :: 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
          nonceForeignPtr <-
            forall a. Int -> IO (ForeignPtr a)
BS.mallocByteString
              @CChar
              (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSecretboxNonceBytes)
          Foreign.withForeignPtr nonceForeignPtr $ \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)
          pure $ Right $ Nonce (Foreign.castForeignPtr @CChar @CUChar 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' in constant time.
--
-- @since 0.0.1.0
nonceToHexByteString :: Nonce -> StrictByteString
nonceToHexByteString :: Nonce -> StrictByteString
nonceToHexByteString (Nonce ForeignPtr CUChar
nonceForeignPtr) =
  ForeignPtr CUChar -> CSize -> StrictByteString
binaryToHex ForeignPtr CUChar
nonceForeignPtr CSize
cryptoSecretboxNonceBytes

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

-- |
--
-- @since 0.0.1.0
instance Eq Ciphertext where
  (Ciphertext CULLong
messageLength1 ForeignPtr CUChar
hk1) == :: Ciphertext -> Ciphertext -> Bool
== (Ciphertext CULLong
messageLength2 ForeignPtr CUChar
hk2) =
    let
      messageLength :: Bool
messageLength = CULLong
messageLength1 CULLong -> CULLong -> Bool
forall a. Eq a => a -> a -> Bool
== CULLong
messageLength2
      content :: Bool
content =
        ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Bool
foreignPtrEqConstantTime
          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)
     in
      Bool
messageLength Bool -> Bool -> Bool
&& Bool
content

-- |
--
-- @since 0.0.1.0
instance Ord Ciphertext where
  compare :: Ciphertext -> Ciphertext -> Ordering
compare (Ciphertext CULLong
messageLength1 ForeignPtr CUChar
hk1) (Ciphertext CULLong
messageLength2 ForeignPtr CUChar
hk2) =
    let
      messageLength :: Ordering
messageLength = CULLong -> CULLong -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CULLong
messageLength1 CULLong
messageLength2
      content :: Ordering
content =
        ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Ordering
foreignPtrOrdConstantTime
          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)
     in
      Ordering
messageLength Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
content

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

-- | ⚠️  Be prudent as to what you do with it!
--
-- @since 0.0.1.0
instance Show Ciphertext where
  show :: Ciphertext -> String
show = StrictByteString -> String
BS.unpackChars (StrictByteString -> String)
-> (Ciphertext -> StrictByteString) -> Ciphertext -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ciphertext -> StrictByteString
ciphertextToHexByteString

-- | Create a 'Ciphertext' from a hexadecimal-encoded 'StrictByteString' that
-- you have obtained on your own, usually from the network or disk. It must be
-- a valid ciphertext built from the concatenation of the encrypted message and
-- the authentication tag.
--
-- The input ciphertext must at least of length 'cryptoSecretboxMACBytes'.
--
-- @since 0.0.1.0
ciphertextFromHexByteString :: StrictByteString -> Either Text Ciphertext
ciphertextFromHexByteString :: StrictByteString -> Either Text Ciphertext
ciphertextFromHexByteString StrictByteString
hexCiphertext = IO (Either Text Ciphertext) -> Either Text Ciphertext
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text Ciphertext) -> Either Text Ciphertext)
-> IO (Either Text Ciphertext) -> Either Text Ciphertext
forall a b. (a -> b) -> a -> b
$
  case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped StrictByteString
hexCiphertext 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 Ciphertext))
-> IO (Either Text Ciphertext)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text Ciphertext))
 -> IO (Either Text Ciphertext))
-> (CStringLen -> IO (Either Text Ciphertext))
-> IO (Either Text Ciphertext)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideCiphertextPtr, Int
outsideCiphertextLength) -> do
          ciphertextForeignPtr <- forall a. Int -> IO (ForeignPtr a)
BS.mallocByteString @CChar Int
outsideCiphertextLength -- The foreign pointer that will receive the ciphertext data.
          Foreign.withForeignPtr ciphertextForeignPtr $ \Ptr CChar
ciphertextPtr ->
            -- We copy bytes from 'outsideCiphertextPtr' to 'ciphertextPtr'.
            Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr CChar
ciphertextPtr Ptr CChar
outsideCiphertextPtr Int
outsideCiphertextLength
          pure $
            Right $
              Ciphertext
                (fromIntegral @Int @CULLong outsideCiphertextLength - fromIntegral @CSize @CULLong cryptoSecretboxMACBytes)
                (Foreign.castForeignPtr @CChar @CUChar ciphertextForeignPtr)
        else Either Text Ciphertext -> IO (Either Text Ciphertext)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Ciphertext -> IO (Either Text Ciphertext))
-> Either Text Ciphertext -> IO (Either Text Ciphertext)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Ciphertext
forall a b. a -> Either a b
Left (Text -> Either Text Ciphertext) -> Text -> Either Text Ciphertext
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"Ciphertext is too short"
    Left Text
msg -> Either Text Ciphertext -> IO (Either Text Ciphertext)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Ciphertext -> IO (Either Text Ciphertext))
-> Either Text Ciphertext -> IO (Either Text Ciphertext)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Ciphertext
forall a b. a -> Either a b
Left Text
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 :: Ciphertext -> Text
ciphertextToHexText = Base16 Text -> Text
forall a. Base16 a -> a
Base16.extractBase16 (Base16 Text -> Text)
-> (Ciphertext -> Base16 Text) -> Ciphertext -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 Text
Base16.encodeBase16 (StrictByteString -> Base16 Text)
-> (Ciphertext -> StrictByteString) -> Ciphertext -> Base16 Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ciphertext -> StrictByteString
ciphertextToBinary

-- | Convert a 'Ciphertext' to a hexadecimal-encoded 'StrictByteString' in constant time.
--
-- ⚠️  Be prudent as to where you store it!
--
-- @since 0.0.1.0
ciphertextToHexByteString :: Ciphertext -> StrictByteString
ciphertextToHexByteString :: Ciphertext -> StrictByteString
ciphertextToHexByteString (Ciphertext CULLong
messageLength ForeignPtr CUChar
fPtr) =
  ForeignPtr CUChar -> CSize -> StrictByteString
binaryToHex ForeignPtr CUChar
fPtr (CSize
cryptoSecretboxMACBytes CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CULLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength)

-- | 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 -> StrictByteString
ciphertextToBinary (Ciphertext 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 ciphertext from a message, a secret key,
-- and a one-time cryptographic nonce that must never be re-used with the same
-- secret key to encrypt another message.
--
-- @since 0.0.1.0
encrypt
  :: StrictByteString
  -- ^ Message to encrypt.
  -> SecretKey
  -- ^ Secret key generated with 'newSecretKey'.
  -> IO (Nonce, Ciphertext)
encrypt :: StrictByteString -> SecretKey -> IO (Nonce, Ciphertext)
encrypt StrictByteString
message (SecretKey ForeignPtr CUChar
secretKeyForeignPtr) =
  StrictByteString
-> (CStringLen -> IO (Nonce, Ciphertext)) -> IO (Nonce, Ciphertext)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
message ((CStringLen -> IO (Nonce, Ciphertext)) -> IO (Nonce, Ciphertext))
-> (CStringLen -> IO (Nonce, Ciphertext)) -> IO (Nonce, Ciphertext)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    (Nonce nonceForeignPtr) <- IO Nonce
newNonce
    ciphertextForeignPtr <-
      Foreign.mallocForeignPtrBytes
        (cStringLen + fromIntegral cryptoSecretboxMACBytes)
    Foreign.withForeignPtr ciphertextForeignPtr $ \Ptr CUChar
ciphertextPtr ->
      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
ciphertextPtr
              (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 ciphertext = CULLong -> ForeignPtr CUChar -> Ciphertext
Ciphertext (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen) ForeignPtr CUChar
ciphertextForeignPtr
    pure (Nonce nonceForeignPtr, ciphertext)

-- | Decrypt an encrypted 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.
  -> SecretKey
  -- ^ Secret key used for encrypting the original message.
  -> Nonce
  -- ^ Nonce used for encrypting the original message.
  -> Maybe StrictByteString
decrypt :: Ciphertext -> SecretKey -> Nonce -> Maybe StrictByteString
decrypt Ciphertext{CULLong
messageLength :: Ciphertext -> CULLong
messageLength :: CULLong
messageLength, ForeignPtr CUChar
ciphertextForeignPtr :: Ciphertext -> ForeignPtr CUChar
ciphertextForeignPtr :: ForeignPtr CUChar
ciphertextForeignPtr} (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
  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)
  Foreign.withForeignPtr ciphertextForeignPtr $ \Ptr CUChar
ciphertextPtr ->
    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
        result <-
          Ptr CUChar
-> Ptr CUChar -> CULLong -> Ptr CUChar -> Ptr CUChar -> IO CInt
cryptoSecretboxOpenEasy
            Ptr CUChar
messagePtr
            Ptr CUChar
ciphertextPtr
            (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 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
            bsPtr <- Int -> IO (Ptr CUChar)
forall a. Int -> IO (Ptr a)
Foreign.mallocBytes (CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
messageLength)
            Foreign.copyBytes bsPtr messagePtr (fromIntegral messageLength)
            Just
              <$> BS.unsafePackMallocCStringLen
                (Foreign.castPtr @CUChar @CChar bsPtr, fromIntegral messageLength)