{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Simplex.Messaging.Notifications.Transport
  ( NTFVersion,
    VersionRangeNTF,
    pattern VersionNTF,
    THandleNTF,
    invalidReasonNTFVersion,
    supportedClientNTFVRange,
    supportedServerNTFVRange,
    alpnSupportedNTFHandshakes,
    ntfServerHandshake,
    ntfClientHandshake,
  ) where

import Control.Monad (forM)
import Control.Monad.Except
import Control.Monad.Trans.Except
import Data.Attoparsec.ByteString.Char8 (Parser)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Word (Word16)
import qualified Data.X509 as X
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Transport
import Simplex.Messaging.Util (liftEitherWith)
import Simplex.Messaging.Version
import Simplex.Messaging.Version.Internal

ntfBlockSize :: Int
ntfBlockSize :: Int
ntfBlockSize = Int
512

data NTFVersion

instance VersionScope NTFVersion

type VersionNTF = Version NTFVersion

type VersionRangeNTF = VersionRange NTFVersion

pattern VersionNTF :: Word16 -> VersionNTF
pattern $mVersionNTF :: forall {r}. VersionNTF -> (Word16 -> r) -> ((# #) -> r) -> r
$bVersionNTF :: Word16 -> VersionNTF
VersionNTF v = Version v

initialNTFVersion :: VersionNTF
initialNTFVersion :: VersionNTF
initialNTFVersion = Word16 -> VersionNTF
VersionNTF Word16
1

authBatchCmdsNTFVersion :: VersionNTF
authBatchCmdsNTFVersion :: VersionNTF
authBatchCmdsNTFVersion = Word16 -> VersionNTF
VersionNTF Word16
2

invalidReasonNTFVersion :: VersionNTF
invalidReasonNTFVersion :: VersionNTF
invalidReasonNTFVersion = Word16 -> VersionNTF
VersionNTF Word16
3

currentClientNTFVersion :: VersionNTF
currentClientNTFVersion :: VersionNTF
currentClientNTFVersion = Word16 -> VersionNTF
VersionNTF Word16
3

currentServerNTFVersion :: VersionNTF
currentServerNTFVersion :: VersionNTF
currentServerNTFVersion = Word16 -> VersionNTF
VersionNTF Word16
3

supportedClientNTFVRange :: VersionRangeNTF
supportedClientNTFVRange :: VersionRangeNTF
supportedClientNTFVRange = VersionNTF -> VersionNTF -> VersionRangeNTF
forall v. Version v -> Version v -> VersionRange v
mkVersionRange VersionNTF
initialNTFVersion VersionNTF
currentClientNTFVersion

legacyServerNTFVRange :: VersionRangeNTF
legacyServerNTFVRange :: VersionRangeNTF
legacyServerNTFVRange = VersionNTF -> VersionNTF -> VersionRangeNTF
forall v. Version v -> Version v -> VersionRange v
mkVersionRange VersionNTF
initialNTFVersion VersionNTF
initialNTFVersion

supportedServerNTFVRange :: VersionRangeNTF
supportedServerNTFVRange :: VersionRangeNTF
supportedServerNTFVRange = VersionNTF -> VersionNTF -> VersionRangeNTF
forall v. Version v -> Version v -> VersionRange v
mkVersionRange VersionNTF
initialNTFVersion VersionNTF
currentServerNTFVersion

alpnSupportedNTFHandshakes :: [ALPN]
alpnSupportedNTFHandshakes :: [ALPN]
alpnSupportedNTFHandshakes = [ALPN
"ntf/1"]

type THandleNTF c p = THandle NTFVersion c p

data NtfServerHandshake = NtfServerHandshake
  { NtfServerHandshake -> VersionRangeNTF
ntfVersionRange :: VersionRangeNTF,
    NtfServerHandshake -> ALPN
sessionId :: SessionId,
    -- pub key to agree shared secrets for command authorization and entity ID encryption.
    NtfServerHandshake -> Maybe (SignedExact PubKey)
authPubKey :: Maybe (X.SignedExact X.PubKey)
  }

data NtfClientHandshake = NtfClientHandshake
  { -- | agreed SMP notifications server protocol version
    NtfClientHandshake -> VersionNTF
ntfVersion :: VersionNTF,
    -- | server identity - CA certificate fingerprint
    NtfClientHandshake -> KeyHash
keyHash :: C.KeyHash
  }

instance Encoding NtfServerHandshake where
  smpEncode :: NtfServerHandshake -> ALPN
smpEncode NtfServerHandshake {VersionRangeNTF
$sel:ntfVersionRange:NtfServerHandshake :: NtfServerHandshake -> VersionRangeNTF
ntfVersionRange :: VersionRangeNTF
ntfVersionRange, ALPN
$sel:sessionId:NtfServerHandshake :: NtfServerHandshake -> ALPN
sessionId :: ALPN
sessionId, Maybe (SignedExact PubKey)
$sel:authPubKey:NtfServerHandshake :: NtfServerHandshake -> Maybe (SignedExact PubKey)
authPubKey :: Maybe (SignedExact PubKey)
authPubKey} =
    [ALPN] -> ALPN
B.concat
      [ (VersionRangeNTF, ALPN) -> ALPN
forall a. Encoding a => a -> ALPN
smpEncode (VersionRangeNTF
ntfVersionRange, ALPN
sessionId),
        VersionNTF -> Maybe (SignedObject PubKey) -> ALPN
forall a. Encoding a => VersionNTF -> Maybe a -> ALPN
encodeAuthEncryptCmds (VersionRangeNTF -> VersionNTF
forall v. VersionRange v -> Version v
maxVersion VersionRangeNTF
ntfVersionRange) (Maybe (SignedObject PubKey) -> ALPN)
-> Maybe (SignedObject PubKey) -> ALPN
forall a b. (a -> b) -> a -> b
$ SignedExact PubKey -> SignedObject PubKey
forall a. SignedExact a -> SignedObject a
C.SignedObject (SignedExact PubKey -> SignedObject PubKey)
-> Maybe (SignedExact PubKey) -> Maybe (SignedObject PubKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SignedExact PubKey)
authPubKey
      ]

  smpP :: Parser NtfServerHandshake
smpP = do
    (VersionRangeNTF
ntfVersionRange, ALPN
sessionId) <- Parser (VersionRangeNTF, ALPN)
forall a. Encoding a => Parser a
smpP
    -- TODO drop SMP v6: remove special parser and make key non-optional
    Maybe (SignedExact PubKey)
authPubKey <- VersionNTF
-> Parser (SignedExact PubKey)
-> Parser (Maybe (SignedExact PubKey))
forall a. VersionNTF -> Parser a -> Parser (Maybe a)
authEncryptCmdsP (VersionRangeNTF -> VersionNTF
forall v. VersionRange v -> Version v
maxVersion VersionRangeNTF
ntfVersionRange) (Parser (SignedExact PubKey)
 -> Parser (Maybe (SignedExact PubKey)))
-> Parser (SignedExact PubKey)
-> Parser (Maybe (SignedExact PubKey))
forall a b. (a -> b) -> a -> b
$ SignedObject PubKey -> SignedExact PubKey
forall a. SignedObject a -> SignedExact a
C.getSignedExact (SignedObject PubKey -> SignedExact PubKey)
-> Parser ALPN (SignedObject PubKey) -> Parser (SignedExact PubKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ALPN (SignedObject PubKey)
forall a. Encoding a => Parser a
smpP
    NtfServerHandshake -> Parser NtfServerHandshake
forall a. a -> Parser ALPN a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NtfServerHandshake {VersionRangeNTF
$sel:ntfVersionRange:NtfServerHandshake :: VersionRangeNTF
ntfVersionRange :: VersionRangeNTF
ntfVersionRange, ALPN
$sel:sessionId:NtfServerHandshake :: ALPN
sessionId :: ALPN
sessionId, Maybe (SignedExact PubKey)
$sel:authPubKey:NtfServerHandshake :: Maybe (SignedExact PubKey)
authPubKey :: Maybe (SignedExact PubKey)
authPubKey}

encodeAuthEncryptCmds :: Encoding a => VersionNTF -> Maybe a -> ByteString
encodeAuthEncryptCmds :: forall a. Encoding a => VersionNTF -> Maybe a -> ALPN
encodeAuthEncryptCmds VersionNTF
v Maybe a
k
  | VersionNTF
v VersionNTF -> VersionNTF -> Bool
forall a. Ord a => a -> a -> Bool
>= VersionNTF
authBatchCmdsNTFVersion = ALPN -> (a -> ALPN) -> Maybe a -> ALPN
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ALPN
"" a -> ALPN
forall a. Encoding a => a -> ALPN
smpEncode Maybe a
k
  | Bool
otherwise = ALPN
""

authEncryptCmdsP :: VersionNTF -> Parser a -> Parser (Maybe a)
authEncryptCmdsP :: forall a. VersionNTF -> Parser a -> Parser (Maybe a)
authEncryptCmdsP VersionNTF
v Parser a
p = if VersionNTF
v VersionNTF -> VersionNTF -> Bool
forall a. Ord a => a -> a -> Bool
>= VersionNTF
authBatchCmdsNTFVersion then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser ALPN (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p else Maybe a -> Parser ALPN (Maybe a)
forall a. a -> Parser ALPN a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

instance Encoding NtfClientHandshake where
  smpEncode :: NtfClientHandshake -> ALPN
smpEncode NtfClientHandshake {VersionNTF
$sel:ntfVersion:NtfClientHandshake :: NtfClientHandshake -> VersionNTF
ntfVersion :: VersionNTF
ntfVersion, KeyHash
$sel:keyHash:NtfClientHandshake :: NtfClientHandshake -> KeyHash
keyHash :: KeyHash
keyHash} =
    (VersionNTF, KeyHash) -> ALPN
forall a. Encoding a => a -> ALPN
smpEncode (VersionNTF
ntfVersion, KeyHash
keyHash)
  smpP :: Parser NtfClientHandshake
smpP = do
    (VersionNTF
ntfVersion, KeyHash
keyHash) <- Parser (VersionNTF, KeyHash)
forall a. Encoding a => Parser a
smpP
    NtfClientHandshake -> Parser NtfClientHandshake
forall a. a -> Parser ALPN a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NtfClientHandshake {VersionNTF
$sel:ntfVersion:NtfClientHandshake :: VersionNTF
ntfVersion :: VersionNTF
ntfVersion, KeyHash
$sel:keyHash:NtfClientHandshake :: KeyHash
keyHash :: KeyHash
keyHash}

-- | Notifcations server transport handshake.
ntfServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c 'TServer -> C.KeyPairX25519 -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TServer)
ntfServerHandshake :: forall (c :: TransportPeer -> *).
Transport c =>
APrivateSignKey
-> c 'TServer
-> KeyPairX25519
-> KeyHash
-> VersionRangeNTF
-> ExceptT TransportError IO (THandleNTF c 'TServer)
ntfServerHandshake APrivateSignKey
serverSignKey c 'TServer
c (PublicKeyType (PrivateKey 'X25519)
k, PrivateKey 'X25519
pk) KeyHash
kh VersionRangeNTF
ntfVRange = do
  let th :: THandleNTF c 'TServer
th@THandle {$sel:params:THandle :: forall v (c :: TransportPeer -> *) (p :: TransportPeer).
THandle v c p -> THandleParams v p
params = THandleParams {ALPN
sessionId :: ALPN
$sel:sessionId:THandleParams :: forall v (p :: TransportPeer). THandleParams v p -> ALPN
sessionId}} = c 'TServer -> THandleNTF c 'TServer
forall (c :: TransportPeer -> *) (p :: TransportPeer).
Transport c =>
c p -> THandleNTF c p
ntfTHandle c 'TServer
c
  let sk :: SignedExact PubKey
sk = APrivateSignKey -> PubKey -> SignedExact PubKey
forall o.
(ASN1Object o, Eq o, Show o) =>
APrivateSignKey -> o -> SignedExact o
C.signX509 APrivateSignKey
serverSignKey (PubKey -> SignedExact PubKey) -> PubKey -> SignedExact PubKey
forall a b. (a -> b) -> a -> b
$ PublicKey 'X25519 -> PubKey
forall (a :: Algorithm). PublicKey a -> PubKey
C.publicToX509 PublicKeyType (PrivateKey 'X25519)
PublicKey 'X25519
k
  let ntfVersionRange :: VersionRangeNTF
ntfVersionRange = VersionRangeNTF
-> (ALPN -> VersionRangeNTF) -> Maybe ALPN -> VersionRangeNTF
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRangeNTF
legacyServerNTFVRange (VersionRangeNTF -> ALPN -> VersionRangeNTF
forall a b. a -> b -> a
const VersionRangeNTF
ntfVRange) (Maybe ALPN -> VersionRangeNTF) -> Maybe ALPN -> VersionRangeNTF
forall a b. (a -> b) -> a -> b
$ c 'TServer -> Maybe ALPN
forall (p :: TransportPeer). c p -> Maybe ALPN
forall (c :: TransportPeer -> *) (p :: TransportPeer).
Transport c =>
c p -> Maybe ALPN
getSessionALPN c 'TServer
c
  THandleNTF c 'TServer
-> NtfServerHandshake -> ExceptT TransportError IO ()
forall (c :: TransportPeer -> *) smp v (p :: TransportPeer).
(Transport c, Encoding smp) =>
THandle v c p -> smp -> ExceptT TransportError IO ()
sendHandshake THandleNTF c 'TServer
th (NtfServerHandshake -> ExceptT TransportError IO ())
-> NtfServerHandshake -> ExceptT TransportError IO ()
forall a b. (a -> b) -> a -> b
$ NtfServerHandshake {ALPN
$sel:sessionId:NtfServerHandshake :: ALPN
sessionId :: ALPN
sessionId, VersionRangeNTF
$sel:ntfVersionRange:NtfServerHandshake :: VersionRangeNTF
ntfVersionRange :: VersionRangeNTF
ntfVersionRange, $sel:authPubKey:NtfServerHandshake :: Maybe (SignedExact PubKey)
authPubKey = SignedExact PubKey -> Maybe (SignedExact PubKey)
forall a. a -> Maybe a
Just SignedExact PubKey
sk}
  THandleNTF c 'TServer
-> ExceptT TransportError IO NtfClientHandshake
forall (c :: TransportPeer -> *) smp v (p :: TransportPeer).
(Transport c, Encoding smp) =>
THandle v c p -> ExceptT TransportError IO smp
getHandshake THandleNTF c 'TServer
th ExceptT TransportError IO NtfClientHandshake
-> (NtfClientHandshake
    -> ExceptT TransportError IO (THandleNTF c 'TServer))
-> ExceptT TransportError IO (THandleNTF c 'TServer)
forall a b.
ExceptT TransportError IO a
-> (a -> ExceptT TransportError IO b)
-> ExceptT TransportError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    NtfClientHandshake {$sel:ntfVersion:NtfClientHandshake :: NtfClientHandshake -> VersionNTF
ntfVersion = VersionNTF
v, KeyHash
$sel:keyHash:NtfClientHandshake :: NtfClientHandshake -> KeyHash
keyHash :: KeyHash
keyHash}
      | KeyHash
keyHash KeyHash -> KeyHash -> Bool
forall a. Eq a => a -> a -> Bool
/= KeyHash
kh ->
          TransportError -> ExceptT TransportError IO (THandleNTF c 'TServer)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TransportError
 -> ExceptT TransportError IO (THandleNTF c 'TServer))
-> TransportError
-> ExceptT TransportError IO (THandleNTF c 'TServer)
forall a b. (a -> b) -> a -> b
$ HandshakeError -> TransportError
TEHandshake HandshakeError
IDENTITY
      | Bool
otherwise ->
          case VersionRangeNTF -> VersionNTF -> Maybe (Compatible VersionRangeNTF)
forall v a.
VersionRangeI v a =>
a -> Version v -> Maybe (Compatible a)
compatibleVRange' VersionRangeNTF
ntfVersionRange VersionNTF
v of
            Just (Compatible VersionRangeNTF
vr) -> THandleNTF c 'TServer
-> ExceptT TransportError IO (THandleNTF c 'TServer)
forall a. a -> ExceptT TransportError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (THandleNTF c 'TServer
 -> ExceptT TransportError IO (THandleNTF c 'TServer))
-> THandleNTF c 'TServer
-> ExceptT TransportError IO (THandleNTF c 'TServer)
forall a b. (a -> b) -> a -> b
$ THandleNTF c 'TServer
-> VersionNTF
-> VersionRangeNTF
-> PrivateKey 'X25519
-> THandleNTF c 'TServer
forall (c :: TransportPeer -> *).
THandleNTF c 'TServer
-> VersionNTF
-> VersionRangeNTF
-> PrivateKey 'X25519
-> THandleNTF c 'TServer
ntfThHandleServer THandleNTF c 'TServer
th VersionNTF
v VersionRangeNTF
vr PrivateKey 'X25519
pk
            Maybe (Compatible VersionRangeNTF)
Nothing -> TransportError -> ExceptT TransportError IO (THandleNTF c 'TServer)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TransportError
TEVersion

-- | Notifcations server client transport handshake.
ntfClientHandshake :: forall c. Transport c => c 'TClient -> C.KeyHash -> VersionRangeNTF -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandleNTF c 'TClient)
ntfClientHandshake :: forall (c :: TransportPeer -> *).
Transport c =>
c 'TClient
-> KeyHash
-> VersionRangeNTF
-> Bool
-> Maybe (ServiceCredentials, KeyPairEd25519)
-> ExceptT TransportError IO (THandleNTF c 'TClient)
ntfClientHandshake c 'TClient
c KeyHash
keyHash VersionRangeNTF
ntfVRange Bool
_proxyServer Maybe (ServiceCredentials, KeyPairEd25519)
_serviceKeys = do
  let th :: THandleNTF c 'TClient
th@THandle {$sel:params:THandle :: forall v (c :: TransportPeer -> *) (p :: TransportPeer).
THandle v c p -> THandleParams v p
params = THandleParams {ALPN
$sel:sessionId:THandleParams :: forall v (p :: TransportPeer). THandleParams v p -> ALPN
sessionId :: ALPN
sessionId}} = c 'TClient -> THandleNTF c 'TClient
forall (c :: TransportPeer -> *) (p :: TransportPeer).
Transport c =>
c p -> THandleNTF c p
ntfTHandle c 'TClient
c
  NtfServerHandshake {$sel:sessionId:NtfServerHandshake :: NtfServerHandshake -> ALPN
sessionId = ALPN
sessId, VersionRangeNTF
$sel:ntfVersionRange:NtfServerHandshake :: NtfServerHandshake -> VersionRangeNTF
ntfVersionRange :: VersionRangeNTF
ntfVersionRange, $sel:authPubKey:NtfServerHandshake :: NtfServerHandshake -> Maybe (SignedExact PubKey)
authPubKey = Maybe (SignedExact PubKey)
sk'} <- THandleNTF c 'TClient
-> ExceptT TransportError IO NtfServerHandshake
forall (c :: TransportPeer -> *) smp v (p :: TransportPeer).
(Transport c, Encoding smp) =>
THandle v c p -> ExceptT TransportError IO smp
getHandshake THandleNTF c 'TClient
th
  if ALPN
sessionId ALPN -> ALPN -> Bool
forall a. Eq a => a -> a -> Bool
/= ALPN
sessId
    then TransportError -> ExceptT TransportError IO (THandleNTF c 'TClient)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TransportError
TEBadSession
    else case VersionRangeNTF
ntfVersionRange VersionRangeNTF
-> VersionRangeNTF -> Maybe (Compatible VersionRangeNTF)
forall v a.
VersionRangeI v a =>
a -> VersionRange v -> Maybe (Compatible a)
`compatibleVRange` VersionRangeNTF
ntfVRange of
      Just (Compatible VersionRangeNTF
vr) -> do
        Maybe (PublicKey 'X25519, CertChainPubKey)
ck_ <- Maybe (SignedExact PubKey)
-> (SignedExact PubKey
    -> ExceptT TransportError IO (PublicKey 'X25519, CertChainPubKey))
-> ExceptT
     TransportError IO (Maybe (PublicKey 'X25519, CertChainPubKey))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (SignedExact PubKey)
sk' ((SignedExact PubKey
  -> ExceptT TransportError IO (PublicKey 'X25519, CertChainPubKey))
 -> ExceptT
      TransportError IO (Maybe (PublicKey 'X25519, CertChainPubKey)))
-> (SignedExact PubKey
    -> ExceptT TransportError IO (PublicKey 'X25519, CertChainPubKey))
-> ExceptT
     TransportError IO (Maybe (PublicKey 'X25519, CertChainPubKey))
forall a b. (a -> b) -> a -> b
$ \SignedExact PubKey
signedKey -> (String -> TransportError)
-> Either String (PublicKey 'X25519, CertChainPubKey)
-> ExceptT TransportError IO (PublicKey 'X25519, CertChainPubKey)
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> Either e a -> ExceptT e' m a
liftEitherWith (TransportError -> String -> TransportError
forall a b. a -> b -> a
const (TransportError -> String -> TransportError)
-> TransportError -> String -> TransportError
forall a b. (a -> b) -> a -> b
$ HandshakeError -> TransportError
TEHandshake HandshakeError
BAD_AUTH) (Either String (PublicKey 'X25519, CertChainPubKey)
 -> ExceptT TransportError IO (PublicKey 'X25519, CertChainPubKey))
-> Either String (PublicKey 'X25519, CertChainPubKey)
-> ExceptT TransportError IO (PublicKey 'X25519, CertChainPubKey)
forall a b. (a -> b) -> a -> b
$ do
          APublicVerifyKey
serverKey <- c 'TClient -> Either String APublicVerifyKey
forall (c :: TransportPeer -> *).
Transport c =>
c 'TClient -> Either String APublicVerifyKey
getServerVerifyKey c 'TClient
c
          PubKey
pubKey <- APublicVerifyKey -> SignedExact PubKey -> Either String PubKey
forall o.
(ASN1Object o, Eq o, Show o) =>
APublicVerifyKey -> SignedExact o -> Either String o
C.verifyX509 APublicVerifyKey
serverKey SignedExact PubKey
signedKey
          (,CertificateChain -> SignedExact PubKey -> CertChainPubKey
CertChainPubKey (c 'TClient -> CertificateChain
forall (p :: TransportPeer). c p -> CertificateChain
forall (c :: TransportPeer -> *) (p :: TransportPeer).
Transport c =>
c p -> CertificateChain
getPeerCertChain c 'TClient
c) SignedExact PubKey
signedKey) (PublicKey 'X25519 -> (PublicKey 'X25519, CertChainPubKey))
-> Either String (PublicKey 'X25519)
-> Either String (PublicKey 'X25519, CertChainPubKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PubKey -> Either String (PublicKey 'X25519)
forall k. CryptoPublicKey k => PubKey -> Either String k
C.x509ToPublic' PubKey
pubKey
        let v :: VersionNTF
v = VersionRangeNTF -> VersionNTF
forall v. VersionRange v -> Version v
maxVersion VersionRangeNTF
vr
        THandleNTF c 'TClient
-> NtfClientHandshake -> ExceptT TransportError IO ()
forall (c :: TransportPeer -> *) smp v (p :: TransportPeer).
(Transport c, Encoding smp) =>
THandle v c p -> smp -> ExceptT TransportError IO ()
sendHandshake THandleNTF c 'TClient
th (NtfClientHandshake -> ExceptT TransportError IO ())
-> NtfClientHandshake -> ExceptT TransportError IO ()
forall a b. (a -> b) -> a -> b
$ NtfClientHandshake {$sel:ntfVersion:NtfClientHandshake :: VersionNTF
ntfVersion = VersionNTF
v, KeyHash
$sel:keyHash:NtfClientHandshake :: KeyHash
keyHash :: KeyHash
keyHash}
        THandleNTF c 'TClient
-> ExceptT TransportError IO (THandleNTF c 'TClient)
forall a. a -> ExceptT TransportError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (THandleNTF c 'TClient
 -> ExceptT TransportError IO (THandleNTF c 'TClient))
-> THandleNTF c 'TClient
-> ExceptT TransportError IO (THandleNTF c 'TClient)
forall a b. (a -> b) -> a -> b
$ THandleNTF c 'TClient
-> VersionNTF
-> VersionRangeNTF
-> Maybe (PublicKey 'X25519, CertChainPubKey)
-> THandleNTF c 'TClient
forall (c :: TransportPeer -> *).
THandleNTF c 'TClient
-> VersionNTF
-> VersionRangeNTF
-> Maybe (PublicKey 'X25519, CertChainPubKey)
-> THandleNTF c 'TClient
ntfThHandleClient THandleNTF c 'TClient
th VersionNTF
v VersionRangeNTF
vr Maybe (PublicKey 'X25519, CertChainPubKey)
ck_
      Maybe (Compatible VersionRangeNTF)
Nothing -> TransportError -> ExceptT TransportError IO (THandleNTF c 'TClient)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TransportError
TEVersion

ntfThHandleServer :: forall c. THandleNTF c 'TServer -> VersionNTF -> VersionRangeNTF -> C.PrivateKeyX25519 -> THandleNTF c 'TServer
ntfThHandleServer :: forall (c :: TransportPeer -> *).
THandleNTF c 'TServer
-> VersionNTF
-> VersionRangeNTF
-> PrivateKey 'X25519
-> THandleNTF c 'TServer
ntfThHandleServer THandleNTF c 'TServer
th VersionNTF
v VersionRangeNTF
vr PrivateKey 'X25519
pk =
  let thAuth :: THandleAuth 'TServer
thAuth = THAuthServer {$sel:serverPrivKey:THAuthClient :: PrivateKey 'X25519
serverPrivKey = PrivateKey 'X25519
pk, $sel:peerClientService:THAuthClient :: Maybe THPeerClientService
peerClientService = Maybe THPeerClientService
forall a. Maybe a
Nothing, $sel:sessSecret':THAuthClient :: Maybe DhSecretX25519
sessSecret' = Maybe DhSecretX25519
forall a. Maybe a
Nothing}
   in THandleNTF c 'TServer
-> VersionNTF
-> VersionRangeNTF
-> Maybe (THandleAuth 'TServer)
-> THandleNTF c 'TServer
forall (c :: TransportPeer -> *) (p :: TransportPeer).
THandleNTF c p
-> VersionNTF
-> VersionRangeNTF
-> Maybe (THandleAuth p)
-> THandleNTF c p
ntfThHandle_ THandleNTF c 'TServer
th VersionNTF
v VersionRangeNTF
vr (THandleAuth 'TServer -> Maybe (THandleAuth 'TServer)
forall a. a -> Maybe a
Just THandleAuth 'TServer
thAuth)

ntfThHandleClient :: forall c. THandleNTF c 'TClient -> VersionNTF -> VersionRangeNTF -> Maybe (C.PublicKeyX25519, CertChainPubKey) -> THandleNTF c 'TClient
ntfThHandleClient :: forall (c :: TransportPeer -> *).
THandleNTF c 'TClient
-> VersionNTF
-> VersionRangeNTF
-> Maybe (PublicKey 'X25519, CertChainPubKey)
-> THandleNTF c 'TClient
ntfThHandleClient THandleNTF c 'TClient
th VersionNTF
v VersionRangeNTF
vr Maybe (PublicKey 'X25519, CertChainPubKey)
ck_ =
  let thAuth :: Maybe (THandleAuth 'TClient)
thAuth = (PublicKey 'X25519, CertChainPubKey) -> THandleAuth 'TClient
clientTHParams ((PublicKey 'X25519, CertChainPubKey) -> THandleAuth 'TClient)
-> Maybe (PublicKey 'X25519, CertChainPubKey)
-> Maybe (THandleAuth 'TClient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PublicKey 'X25519, CertChainPubKey)
ck_
      clientTHParams :: (PublicKey 'X25519, CertChainPubKey) -> THandleAuth 'TClient
clientTHParams (PublicKey 'X25519
k, CertChainPubKey
ck) = THAuthClient {$sel:peerServerPubKey:THAuthClient :: PublicKey 'X25519
peerServerPubKey = PublicKey 'X25519
k, $sel:peerServerCertKey:THAuthClient :: CertChainPubKey
peerServerCertKey = CertChainPubKey
ck, $sel:clientService:THAuthClient :: Maybe THClientService
clientService = Maybe THClientService
forall a. Maybe a
Nothing, $sel:sessSecret:THAuthClient :: Maybe DhSecretX25519
sessSecret = Maybe DhSecretX25519
forall a. Maybe a
Nothing}
   in THandleNTF c 'TClient
-> VersionNTF
-> VersionRangeNTF
-> Maybe (THandleAuth 'TClient)
-> THandleNTF c 'TClient
forall (c :: TransportPeer -> *) (p :: TransportPeer).
THandleNTF c p
-> VersionNTF
-> VersionRangeNTF
-> Maybe (THandleAuth p)
-> THandleNTF c p
ntfThHandle_ THandleNTF c 'TClient
th VersionNTF
v VersionRangeNTF
vr Maybe (THandleAuth 'TClient)
thAuth

ntfThHandle_ :: forall c p. THandleNTF c p -> VersionNTF -> VersionRangeNTF -> Maybe (THandleAuth p) -> THandleNTF c p
ntfThHandle_ :: forall (c :: TransportPeer -> *) (p :: TransportPeer).
THandleNTF c p
-> VersionNTF
-> VersionRangeNTF
-> Maybe (THandleAuth p)
-> THandleNTF c p
ntfThHandle_ th :: THandleNTF c p
th@THandle {THandleParams NTFVersion p
$sel:params:THandle :: forall v (c :: TransportPeer -> *) (p :: TransportPeer).
THandle v c p -> THandleParams v p
params :: THandleParams NTFVersion p
params} VersionNTF
v VersionRangeNTF
vr Maybe (THandleAuth p)
thAuth =
  -- TODO drop SMP v6: make thAuth non-optional
  let v3 :: Bool
v3 = VersionNTF
v VersionNTF -> VersionNTF -> Bool
forall a. Ord a => a -> a -> Bool
>= VersionNTF
authBatchCmdsNTFVersion
      params' :: THandleParams NTFVersion p
params' = THandleParams NTFVersion p
params {thVersion = v, thServerVRange = vr, thAuth, implySessId = v3, batch = v3}
   in (THandleNTF c p
th :: THandleNTF c p) {params = params'}

ntfTHandle :: Transport c => c p -> THandleNTF c p
ntfTHandle :: forall (c :: TransportPeer -> *) (p :: TransportPeer).
Transport c =>
c p -> THandleNTF c p
ntfTHandle c p
c = THandle {$sel:connection:THandle :: c p
connection = c p
c, THandleParams NTFVersion p
forall {p :: TransportPeer}. THandleParams NTFVersion p
$sel:params:THandle :: THandleParams NTFVersion p
params :: forall {p :: TransportPeer}. THandleParams NTFVersion p
params}
  where
    v :: VersionNTF
v = Word16 -> VersionNTF
VersionNTF Word16
0
    params :: THandleParams NTFVersion p
params =
      THandleParams
        { $sel:sessionId:THandleParams :: ALPN
sessionId = c p -> ALPN
forall (p :: TransportPeer). c p -> ALPN
forall (c :: TransportPeer -> *) (p :: TransportPeer).
Transport c =>
c p -> ALPN
tlsUnique c p
c,
          $sel:blockSize:THandleParams :: Int
blockSize = Int
ntfBlockSize,
          $sel:thVersion:THandleParams :: VersionNTF
thVersion = VersionNTF
v,
          $sel:thServerVRange:THandleParams :: VersionRangeNTF
thServerVRange = VersionNTF -> VersionRangeNTF
forall v. Version v -> VersionRange v
versionToRange VersionNTF
v,
          $sel:thAuth:THandleParams :: Maybe (THandleAuth p)
thAuth = Maybe (THandleAuth p)
forall a. Maybe a
Nothing,
          $sel:implySessId:THandleParams :: Bool
implySessId = Bool
False,
          $sel:encryptBlock:THandleParams :: Maybe TSbChainKeys
encryptBlock = Maybe TSbChainKeys
forall a. Maybe a
Nothing,
          $sel:batch:THandleParams :: Bool
batch = Bool
False,
          $sel:serviceAuth:THandleParams :: Bool
serviceAuth = Bool
False
        }