{-|
Module      : Botan.Low.KeyAgreement
Description : Key Agreement
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : 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 qualified Data.ByteString as ByteString

import Botan.Bindings.PubKey.KeyAgreement

import Botan.Low.Error
import Botan.Low.KDF
import Botan.Low.Make
import Botan.Low.Prelude
import Botan.Low.PubKey
import Botan.Low.Remake

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

First, Alice and Bob generate their private keys:

> import Botan.Low.PubKey
> import Botan.Low.PubKey.KeyAgreement
> import Botan.Low.RNG
> import Botan.Low.Hash
> import Botan.Low.KDF
> rng <- rngInit "system"
> -- Alice creates her private key
> alicePrivKey <- privKeyCreate ECDH Secp521r1 rng 
> -- Bob creates his private key
> bobPrivKey <-  privKeyCreate ECDH Secp521r1 rng 

Then, they exchange their public keys using any channel, private or public:

> -- Alice and Bob exchange public keys
> alicePubKey <- keyAgreementExportPublic alicePrivKey
> bobPubKey <- keyAgreementExportPublic bobPrivKey
> -- ...

Then, they may separately generate the same agreed-upon key and a randomized,
agreed-upon salt:

> salt <- rngGet rng 4
> -- Alice generates her shared key:
> aliceKeyAgreement <- keyAgreementCreate alicePrivKey (kdf2 SHA256)
> aliceSharedKey    <- keyAgreement aliceKeyAgreement bobPubKey salt
> -- Bob generates his shared key:
> bobKeyAgreement   <- keyAgreementCreate bobPrivKey (kdf2 SHA256)
> bobSharedKey      <- keyAgreement bobKeyAgreement alicePubKey salt
> -- They are the same
> aliceSharedKey == bobSharedKey
> -- True

> WARNING: There used to be a memory leak in keyAgreement. Please
> report this bug to the maintainers if it returns.

-}

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

newKeyAgreement      :: BotanPKOpKeyAgreement -> IO KeyAgreement
withKeyAgreement     :: KeyAgreement -> (BotanPKOpKeyAgreement -> IO a) -> IO a
keyAgreementDestroy  :: KeyAgreement -> IO ()
createKeyAgreement   :: (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement
(BotanPKOpKeyAgreement -> IO KeyAgreement
newKeyAgreement, KeyAgreement -> (BotanPKOpKeyAgreement -> IO a) -> IO a
withKeyAgreement, KeyAgreement -> IO ()
keyAgreementDestroy, (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement
createKeyAgreement, (Ptr BotanPKOpKeyAgreement -> Ptr CSize -> IO CInt)
-> IO [KeyAgreement]
_)
    = (Ptr BotanPKOpKeyAgreementStruct -> BotanPKOpKeyAgreement)
-> (BotanPKOpKeyAgreement -> Ptr BotanPKOpKeyAgreementStruct)
-> (ForeignPtr BotanPKOpKeyAgreementStruct -> KeyAgreement)
-> (KeyAgreement -> ForeignPtr BotanPKOpKeyAgreementStruct)
-> FinalizerPtr BotanPKOpKeyAgreementStruct
-> (BotanPKOpKeyAgreement -> IO KeyAgreement,
    KeyAgreement -> (BotanPKOpKeyAgreement -> IO a) -> IO a,
    KeyAgreement -> IO (),
    (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement,
    (Ptr BotanPKOpKeyAgreement -> Ptr CSize -> 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
-> (botan -> IO object, object -> (botan -> IO a) -> IO a,
    object -> IO (), (Ptr botan -> IO CInt) -> IO object,
    (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
mkBindings
        Ptr BotanPKOpKeyAgreementStruct -> BotanPKOpKeyAgreement
MkBotanPKOpKeyAgreement BotanPKOpKeyAgreement -> Ptr BotanPKOpKeyAgreementStruct
runBotanPKOpKeyAgreement
        ForeignPtr BotanPKOpKeyAgreementStruct -> KeyAgreement
MkKeyAgreement KeyAgreement -> ForeignPtr BotanPKOpKeyAgreementStruct
getKeyAgreementForeignPtr
        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 -> do
    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 -> do
        (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

-- WARNING: withFooInit-style limited lifetime functions moved to high-level botan
withKeyAgreementCreate :: PrivKey -> KDFName -> (KeyAgreement -> IO a) -> IO a
withKeyAgreementCreate :: forall a. PrivKey -> KDFName -> (KeyAgreement -> IO a) -> IO a
withKeyAgreementCreate = (PrivKey -> KDFName -> IO KeyAgreement)
-> (KeyAgreement -> IO ())
-> PrivKey
-> KDFName
-> (KeyAgreement -> IO a)
-> IO a
forall x y t a.
(x -> y -> IO t) -> (t -> IO ()) -> x -> y -> (t -> IO a) -> IO a
mkWithTemp2 PrivKey -> KDFName -> IO KeyAgreement
keyAgreementCreate KeyAgreement -> IO ()
keyAgreementDestroy

-- 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.
{-
int botan_pk_op_key_agreement_export_public(botan_privkey_t key, uint8_t out[], size_t* out_len) {
   return copy_view_bin(out, out_len, botan_pk_op_key_agreement_view_public, key);
}

int botan_pk_op_key_agreement_view_public(botan_privkey_t key, botan_view_ctx ctx, botan_view_bin_fn view) {
   return BOTAN_FFI_VISIT(key, [=](const auto& k) -> int {
      if(auto kak = dynamic_cast<const Botan::PK_Key_Agreement_Key*>(&k))
         return invoke_view_callback(view, ctx, kak->public_value());
      else
         return BOTAN_FFI_ERROR_INVALID_INPUT;
   });
}
-}
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 -> do
    (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

{-# WARNING keyAgreement "This function was leaking memory and causing crashes. Please observe carefully and report any future leaks." #-}
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 -> do
    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 -> do
        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
                -- NOTE: This poke was necessary to stop a memory leak
                -- Similar pokes have been needed elsewere
                -- TODO: Ensure that all alloca szPtr elsewhere are properly poked
                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