{-|
Module      : Botan.Low.KeyAgreement
Description : Key Agreement
Copyright   : (c) 2023-2024, Apotheca Labs
              (c) 2024-2025, Haskell Foundation
License     : BSD-3-Clause
Maintainer  : joris@well-typed.com, leo@apotheca.io
Stability   : experimental
Portability : POSIX
-}

module Botan.Low.PubKey.KeyAgreement (
    -- * PK Key Agreement
    -- $introduction

    -- * Usage
    -- $usage

    -- * Key agreement
    KeyAgreement(..)
  , withKeyAgreement
  , keyAgreementCreate
  , keyAgreementDestroy
  , keyAgreementExportPublic
  , keyAgreementSize
  , keyAgreement

  ) where

import           Botan.Bindings.ConstPtr (ConstPtr (..))
import           Botan.Bindings.PubKey.KeyAgreement
import           Botan.Low.Error.Internal
import           Botan.Low.Internal.ByteString
import           Botan.Low.KDF
import           Botan.Low.Make
import           Botan.Low.PubKey
import           Botan.Low.Remake
import           Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable

{- $introduction

Key agreement is a scheme where two parties exchange public keys, after which
it is possible for them to derive a secret key which is known only to the two
of them.

There are different approaches possible for key agreement. In many protocols,
both parties generate a new key, exchange public keys, and derive a secret,
after which they throw away their private keys, using them only the once.
However this requires the parties to both be online and able to communicate
with each other.

In other protocols, one of the parties publishes their public key online in
some way, and then it is possible for someone to send encrypted messages to
that recipient by generating a new keypair, performing key exchange with the
published public key, and then sending both the message along with their
ephemeral public key. Then the recipient uses the provided public key along
with their private key to complete the key exchange, recover the shared secret,
and decrypt the message.

Typically the raw output of the key agreement function is not uniformly
distributed, and may not be of an appropriate length to use as a key. To
resolve these problems, key agreement will use a Key Derivation Functions (KDF)
on the shared secret to produce an output of the desired length.

- ECDH over GF(p) Weierstrass curves
- ECDH over x25519
- DH over prime fields

-}

{- $usage

This is a simplified, executable example showing how Alice and Bob can derive the
same shared secret using key agreement.

>>> :{
{-# OPTIONS_GHC -Wall #-}
import Botan.Low.Hash
import Botan.Low.KDF
import Botan.Low.PubKey
import Botan.Low.PubKey.KeyAgreement
import Botan.Low.RNG
import Data.ByteString (ByteString)
:}

First, Alice and Bob generate their private keys:

>>> :{
generateKeys :: IO (PrivKey, PrivKey)
generateKeys = do
  rng <- rngInit UserRNG
  alicePrivKey <- privKeyCreate ECDH Secp521r1 rng
  bobPrivKey <- privKeyCreate ECDH Secp521r1 rng
  pure (alicePrivKey, bobPrivKey)
:}

Then, they exchange their public keys using any channel, private or public
and independently derive shared keys.

Alice and Bob exchange public keys:

>>> :{
deriveSharedKeys :: PrivKey -> PrivKey -> IO (ByteString, ByteString)
deriveSharedKeys alicePrivKey bobPrivKey = do
  rng <- rngInit UserRNG
  alicePubKey <- keyAgreementExportPublic alicePrivKey
  bobPubKey <- keyAgreementExportPublic bobPrivKey
  salt <- rngGet rng 4
  aliceKeyAgreement <- keyAgreementCreate alicePrivKey (kdf2 SHA256)
  aliceSharedKey <- keyAgreement aliceKeyAgreement bobPubKey salt
  bobKeyAgreement <- keyAgreementCreate bobPrivKey (kdf2 SHA256)
  bobSharedKey <- keyAgreement bobKeyAgreement alicePubKey salt
  pure (aliceSharedKey, bobSharedKey)
:}

Now we can check that both parties derive the same shared key using the same salt:

>>> :{
main :: IO ()
main = do
  (alicePrivKey, bobPrivKey) <- generateKeys
  (aliceSharedKey, bobSharedKey) <- deriveSharedKeys alicePrivKey bobPrivKey
  print (aliceSharedKey == bobSharedKey)
:}

>>> main
True

-}

newtype KeyAgreement = MkKeyAgreement { KeyAgreement -> ForeignPtr BotanPKOpKeyAgreementStruct
foreignPtr :: ForeignPtr BotanPKOpKeyAgreementStruct }

withKeyAgreement     :: KeyAgreement -> (BotanPKOpKeyAgreement -> IO a) -> IO a
keyAgreementDestroy  :: KeyAgreement -> IO ()
createKeyAgreement   :: (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement
(KeyAgreement -> (BotanPKOpKeyAgreement -> IO a) -> IO a
withKeyAgreement, KeyAgreement -> IO ()
keyAgreementDestroy, (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement
createKeyAgreement)
    = (Ptr BotanPKOpKeyAgreementStruct -> BotanPKOpKeyAgreement)
-> (BotanPKOpKeyAgreement -> Ptr BotanPKOpKeyAgreementStruct)
-> (ForeignPtr BotanPKOpKeyAgreementStruct -> KeyAgreement)
-> (KeyAgreement -> ForeignPtr BotanPKOpKeyAgreementStruct)
-> FinalizerPtr BotanPKOpKeyAgreementStruct
-> (KeyAgreement -> (BotanPKOpKeyAgreement -> IO a) -> IO a,
    KeyAgreement -> IO (),
    (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement)
forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (object -> (botan -> IO a) -> IO a, object -> IO (),
    (Ptr botan -> IO CInt) -> IO object)
mkBindings
        Ptr BotanPKOpKeyAgreementStruct -> BotanPKOpKeyAgreement
MkBotanPKOpKeyAgreement (.ptr)
        ForeignPtr BotanPKOpKeyAgreementStruct -> KeyAgreement
MkKeyAgreement (.foreignPtr)
        FinalizerPtr BotanPKOpKeyAgreementStruct
botan_pk_op_key_agreement_destroy

-- NOTE: Silently uses the system RNG
keyAgreementCreate ::
     PrivKey          -- ^ __key__
  -> KDFName          -- ^ __kdf__
  -> IO KeyAgreement  -- ^ __op__
keyAgreementCreate :: PrivKey -> KDFName -> IO KeyAgreement
keyAgreementCreate PrivKey
sk KDFName
algo =
    PrivKey -> (BotanPrivKey -> IO KeyAgreement) -> IO KeyAgreement
forall a. PrivKey -> (BotanPrivKey -> IO a) -> IO a
withPrivKey PrivKey
sk ((BotanPrivKey -> IO KeyAgreement) -> IO KeyAgreement)
-> (BotanPrivKey -> IO KeyAgreement) -> IO KeyAgreement
forall a b. (a -> b) -> a -> b
$ \ BotanPrivKey
skPtr ->
    KDFName -> (Ptr CChar -> IO KeyAgreement) -> IO KeyAgreement
forall a. KDFName -> (Ptr CChar -> IO a) -> IO a
asCString KDFName
algo ((Ptr CChar -> IO KeyAgreement) -> IO KeyAgreement)
-> (Ptr CChar -> IO KeyAgreement) -> IO KeyAgreement
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
algoPtr ->
    (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement
createKeyAgreement ((Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement)
-> (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanPKOpKeyAgreement
out ->
      Ptr BotanPKOpKeyAgreement
-> BotanPrivKey -> ConstPtr CChar -> Word32 -> IO CInt
botan_pk_op_key_agreement_create
        Ptr BotanPKOpKeyAgreement
out
        BotanPrivKey
skPtr
        (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
algoPtr)
        Word32
0

-- NOTE: I do not know if this provides a different functionality than just being
--  an alias for botan_privkey_export_pubkey / privKeyExportPubKey
--  Observe that it *does* just take a privkey, instead of a keyagreement
--  It may simply be here for convenience.
keyAgreementExportPublic ::
     PrivKey          -- ^ __key__
  -> IO ByteString    -- ^ __out[]__
keyAgreementExportPublic :: PrivKey -> IO KDFName
keyAgreementExportPublic PrivKey
sk =
    PrivKey -> (BotanPrivKey -> IO KDFName) -> IO KDFName
forall a. PrivKey -> (BotanPrivKey -> IO a) -> IO a
withPrivKey PrivKey
sk ((BotanPrivKey -> IO KDFName) -> IO KDFName)
-> (BotanPrivKey -> IO KDFName) -> IO KDFName
forall a b. (a -> b) -> a -> b
$ \ BotanPrivKey
skPtr ->
    (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO KDFName
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO KDFName
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO KDFName)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO KDFName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr Ptr CSize
outLen ->
      BotanPrivKey -> Ptr Word8 -> Ptr CSize -> IO CInt
botan_pk_op_key_agreement_export_public
        BotanPrivKey
skPtr
        Ptr Word8
outPtr
        Ptr CSize
outLen

keyAgreementSize ::
     KeyAgreement -- ^ __op__
  -> IO Int       -- ^ __out_len__
keyAgreementSize :: KeyAgreement -> IO Int
keyAgreementSize = WithPtr KeyAgreement BotanPKOpKeyAgreement
-> GetSize BotanPKOpKeyAgreement -> KeyAgreement -> IO Int
forall typ ptr. WithPtr typ ptr -> GetSize ptr -> typ -> IO Int
mkGetSize KeyAgreement -> (BotanPKOpKeyAgreement -> IO a) -> IO a
WithPtr KeyAgreement BotanPKOpKeyAgreement
withKeyAgreement GetSize BotanPKOpKeyAgreement
botan_pk_op_key_agreement_size

keyAgreement ::
     KeyAgreement     -- ^ __op__
  -> ByteString       -- ^ __out[]__
  -> ByteString       -- ^ __other_key[]__
  -> IO ByteString    -- ^ __salt[]__
keyAgreement :: KeyAgreement -> KDFName -> KDFName -> IO KDFName
keyAgreement KeyAgreement
ka KDFName
key KDFName
salt =
    KeyAgreement -> (BotanPKOpKeyAgreement -> IO KDFName) -> IO KDFName
WithPtr KeyAgreement BotanPKOpKeyAgreement
withKeyAgreement KeyAgreement
ka ((BotanPKOpKeyAgreement -> IO KDFName) -> IO KDFName)
-> (BotanPKOpKeyAgreement -> IO KDFName) -> IO KDFName
forall a b. (a -> b) -> a -> b
$ \ BotanPKOpKeyAgreement
kaPtr ->
    KDFName -> (Ptr Word8 -> CSize -> IO KDFName) -> IO KDFName
forall byte a. KDFName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen KDFName
key ((Ptr Word8 -> CSize -> IO KDFName) -> IO KDFName)
-> (Ptr Word8 -> CSize -> IO KDFName) -> IO KDFName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
keyPtr CSize
keyLen ->
    KDFName -> (Ptr Word8 -> CSize -> IO KDFName) -> IO KDFName
forall byte a. KDFName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen KDFName
salt ((Ptr Word8 -> CSize -> IO KDFName) -> IO KDFName)
-> (Ptr Word8 -> CSize -> IO KDFName) -> IO KDFName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
saltPtr CSize
saltLen -> do
      Int
outSz <- KeyAgreement -> IO Int
keyAgreementSize KeyAgreement
ka
      (Ptr CSize -> IO KDFName) -> IO KDFName
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO KDFName) -> IO KDFName)
-> (Ptr CSize -> IO KDFName) -> IO KDFName
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtr -> do
        Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
szPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outSz)
        KDFName
out <- Int -> (Ptr Word8 -> IO ()) -> IO KDFName
forall byte. Int -> (Ptr byte -> IO ()) -> IO KDFName
allocBytes Int
outSz ((Ptr Word8 -> IO ()) -> IO KDFName)
-> (Ptr Word8 -> IO ()) -> IO KDFName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr -> do
            HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanPKOpKeyAgreement
-> Ptr Word8
-> Ptr CSize
-> ConstPtr Word8
-> CSize
-> ConstPtr Word8
-> CSize
-> IO CInt
botan_pk_op_key_agreement
                BotanPKOpKeyAgreement
kaPtr
                Ptr Word8
outPtr
                Ptr CSize
szPtr
                (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
keyPtr)
                CSize
keyLen
                (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
saltPtr)
                CSize
saltLen
        Int
sz <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
szPtr
        KDFName -> IO KDFName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (KDFName -> IO KDFName) -> KDFName -> IO KDFName
forall a b. (a -> b) -> a -> b
$! Int -> KDFName -> KDFName
ByteString.take Int
sz KDFName
out