{-# 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 LibSodium.Bindings.SealedBoxes
  ( cryptoBoxSeal
  , cryptoBoxSealOpen
  , cryptoBoxSealbytes
  )
import System.IO.Unsafe (unsafeDupablePerformIO)

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
-- > import Sel (secureMain)
-- >
-- > main = secureMain $ 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 :: StrictByteString -> PublicKey -> IO Ciphertext
seal StrictByteString
messageByteString (PublicKey ForeignPtr CUChar
publicKeyFptr) = do
  StrictByteString -> (CStringLen -> IO Ciphertext) -> IO Ciphertext
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
messageByteString ((CStringLen -> IO Ciphertext) -> IO Ciphertext)
-> (CStringLen -> IO Ciphertext) -> IO Ciphertext
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
messagePtr, Int
messageLen) -> do
    ciphertextForeignPtr <-
      Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes
        (Int
messageLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoBoxSealbytes)
    Foreign.withForeignPtr publicKeyFptr $ \Ptr CUChar
publicKeyPtr ->
      ForeignPtr CUChar -> (Ptr CUChar -> IO Ciphertext) -> IO Ciphertext
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
ciphertextForeignPtr ((Ptr CUChar -> IO Ciphertext) -> IO Ciphertext)
-> (Ptr CUChar -> IO Ciphertext) -> IO Ciphertext
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
ciphertextPtr -> do
        result <-
          Ptr CUChar -> Ptr CUChar -> CULLong -> Ptr CUChar -> IO CInt
cryptoBoxSeal
            Ptr CUChar
ciphertextPtr
            (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
messagePtr)
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
messageLen)
            Ptr CUChar
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 -> PublicKey -> SecretKey -> Maybe StrictByteString
open
  (Ciphertext CULLong
messageLen ForeignPtr CUChar
cipherForeignPtr)
  (PublicKey ForeignPtr CUChar
publicKeyFPtr)
  (SecretKey ForeignPtr CUChar
secretKeyFPtr) = 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
messageLen)
    Foreign.withForeignPtr cipherForeignPtr $ \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
publicKeyFPtr ((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
publicKeyPtr ->
        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
secretKeyFPtr ((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 -> do
          result <-
            Ptr CUChar
-> Ptr CUChar -> CULLong -> Ptr CUChar -> Ptr CUChar -> IO CInt
cryptoBoxSealOpen
              Ptr CUChar
messagePtr
              Ptr CUChar
ciphertextPtr
              (CULLong
messageLen CULLong -> CULLong -> CULLong
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @CULLong CSize
cryptoBoxSealbytes)
              Ptr CUChar
publicKeyPtr
              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
messageLen)
              Foreign.copyBytes bsPtr messagePtr (fromIntegral messageLen)
              Just
                <$> BS.unsafePackMallocCStringLen
                  (Foreign.castPtr @CUChar @CChar bsPtr, fromIntegral messageLen)