parameterize THandle

2026-03-30 14:16:00 +00:00 · 2024-02-13 20:06:42 +00:00
parent f21b4310ed
commit 75adfc94fb
15 changed files with 152 additions and 152 deletions
--- a/src/Simplex/FileTransfer/Client.hs
+++ b/src/Simplex/FileTransfer/Client.hs
@@ -45,7 +45,7 @@ import Simplex.Messaging.Protocol
    RecipientId,
    SenderId,
  )
-import Simplex.Messaging.Transport (THandleParams (..), supportedParameters)
+import Simplex.Messaging.Transport (THandleParams (..), TransportPeer (..), supportedParameters)
 import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.Client
@@ -57,7 +57,7 @@ import UnliftIO.Directory
 data XFTPClient = XFTPClient
  { http2Client :: HTTP2Client,
    transportSession :: TransportSession FileResponse,
-    thParams :: THandleParams,
+    thParams :: THandleParams 'TClient,
    config :: XFTPClientConfig
  }

@@ -138,7 +138,7 @@ sendXFTPCommand :: forall p. FilePartyI p => XFTPClient -> C.APrivateAuthKey ->
 sendXFTPCommand c@XFTPClient {thParams} pKey fId cmd chunkSpec_ = do
  t <-
    liftEither . first PCETransportError $
-      xftpEncodeTransmission thParams (Just pKey) ("", fId, FileCmd (sFileParty @p) cmd)
+      xftpEncodeClntTransmission thParams (Just pKey) ("", fId, FileCmd (sFileParty @p) cmd)
  sendXFTPTransmission c t chunkSpec_

 sendXFTPTransmission :: XFTPClient -> ByteString -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
@@ -218,7 +218,7 @@ pingXFTP :: XFTPClient -> ExceptT XFTPClientError IO ()
 pingXFTP c@XFTPClient {thParams} = do
  t <-
    liftEither . first PCETransportError $
-      xftpEncodeTransmission thParams Nothing ("", "", FileCmd SFRecipient PING)
+      xftpEncodeClntTransmission thParams Nothing ("", "", FileCmd SFRecipient PING)
  (r, _) <- sendXFTPTransmission c t Nothing
  case r of
    FRPong -> pure ()
--- a/src/Simplex/FileTransfer/Protocol.hs
+++ b/src/Simplex/FileTransfer/Protocol.hs
@@ -49,12 +49,13 @@ import Simplex.Messaging.Protocol
    Transmission,
    ClntTransmission (..),
    encodeClntTransmission,
+    encodeSrvTransmission,
    messageTagP,
    tDecodeParseValidate,
    tEncodeBatch1,
    tParse,
  )
-import Simplex.Messaging.Transport (THandleParams (..), TransportError (..))
+import Simplex.Messaging.Transport (THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Util (bshow, (<$?>))
 import Simplex.Messaging.Version

@@ -396,16 +397,21 @@ checkParty' c = case testEquality (sFileParty @p) (sFileParty @p') of
  Just Refl -> Just c
  _ -> Nothing

-xftpEncodeTransmission :: ProtocolEncoding e c => THandleParams -> Maybe C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
-xftpEncodeTransmission thParams pKey (corrId, fId, msg) = do
+xftpEncodeClntTransmission :: ProtocolEncoding e c => THandleParams 'TClient -> Maybe C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
+xftpEncodeClntTransmission thParams pKey (corrId, fId, msg) = do
  let ClntTransmission {tForAuth, tToSend} = encodeClntTransmission thParams (corrId, fId, msg)
  xftpEncodeBatch1 . (,tToSend) =<< authTransmission Nothing pKey corrId tForAuth

+xftpEncodeSrvTransmission :: ProtocolEncoding e c => THandleParams 'TServer -> Transmission c -> Either TransportError ByteString
+xftpEncodeSrvTransmission thParams (corrId, fId, msg) = do
+  let t = encodeSrvTransmission thParams (corrId, fId, msg)
+  xftpEncodeBatch1 (Nothing, t)
+
 -- this function uses batch syntax but puts only one transmission in the batch
 xftpEncodeBatch1 :: SentRawTransmission -> Either TransportError ByteString
 xftpEncodeBatch1 t = first (const TELargeMsg) $ C.pad (tEncodeBatch1 t) xftpBlockSize

-xftpDecodeTransmission :: ProtocolEncoding e c => THandleParams -> ByteString -> Either XFTPErrorType (SignedTransmission e c)
+xftpDecodeTransmission :: ProtocolEncoding e c => THandleParams p -> ByteString -> Either XFTPErrorType (SignedTransmission e c)
 xftpDecodeTransmission thParams t = do
  t' <- first (const BLOCK) $ C.unPad t
  case tParse thParams t' of
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -51,7 +51,7 @@ import Simplex.Messaging.Protocol (CorrId, RcvPublicDhKey, RcvPublicAuthKey, Rec
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Stats
-import Simplex.Messaging.Transport (THandleParams (..))
+import Simplex.Messaging.Transport (THandleParams (..), TransportPeer (..))
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.Server
@@ -69,7 +69,7 @@ type M a = ReaderT XFTPEnv IO a

 data XFTPTransportRequest =
  XFTPTransportRequest
-    { thParams :: THandleParams,
+    { thParams :: THandleParams 'TServer,
      reqBody :: HTTP2Body,
      request :: H.Request,
      sendResponse :: H.Response -> IO ()
@@ -243,7 +243,7 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
  where
    sendXFTPResponse :: (CorrId, XFTPFileId, FileResponse) -> Maybe ServerFile -> M ()
    sendXFTPResponse (corrId, fId, resp) serverFile_ = do
-      let t_ = xftpEncodeTransmission thParams Nothing (corrId, fId, resp)
+      let t_ = xftpEncodeSrvTransmission thParams (corrId, fId, resp)
      liftIO $ sendResponse $ H.responseStreaming N.ok200 [] $ streamBody t_
      where
        streamBody t_ send done = do
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -119,7 +119,7 @@ import System.Timeout (timeout)
 -- Use 'getSMPClient' to connect to an SMP server and create a client handle.
 data ProtocolClient err msg = ProtocolClient
  { action :: Maybe (Async ()),
-    thParams :: THandleParams,
+    thParams :: THandleParams 'TClient,
    sessionTs :: UTCTime,
    timeoutPerBlock :: Int,
    client_ :: PClient err msg
@@ -139,7 +139,7 @@ data PClient err msg = PClient
    msgQ :: Maybe (TBQueue (ServerTransmission msg))
  }

-clientStub :: TVar ChaChaDRG -> ByteString -> Version -> Maybe THandleAuth -> STM (ProtocolClient err msg)
+clientStub :: TVar ChaChaDRG -> ByteString -> Version -> Maybe (THandleAuth 'TClient) -> STM (ProtocolClient err msg)
 clientStub g sessionId thVersion thAuth = do
  connected <- newTVar False
  clientCorrId <- C.newRandomDRG g
@@ -369,9 +369,8 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
      p -> (p, transport @TLS)

    client :: forall c. Transport c => TProxy c -> PClient err msg -> TMVar (Either (ProtocolClientError err) (ProtocolClient err msg)) -> c -> IO ()
-    client _ c cVar h = do
-      ks <- atomically $ C.generateKeyPair g
-      runExceptT (protocolClientHandshake @err @msg h ks (keyHash srv) serverVRange) >>= \case
+    client _ c cVar h =
+      runExceptT (protocolClientHandshake @err @msg h (keyHash srv) serverVRange) >>= \case
        Left e -> atomically . putTMVar cVar . Left $ PCETransportError e
        Right th@THandle {params} -> do
          sessionTs <- getCurrentTime
@@ -383,10 +382,10 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
          raceAny_ ([send c' th, process c', receive c' th] <> [ping c' | smpPingInterval > 0])
            `finally` disconnected c'

-    send :: Transport c => ProtocolClient err msg -> THandle c -> IO ()
+    send :: Transport c => ProtocolClient err msg -> THandle c 'TClient -> IO ()
    send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= tPutLog h

-    receive :: Transport c => ProtocolClient err msg -> THandle c -> IO ()
+    receive :: Transport c => ProtocolClient err msg -> THandle c 'TClient -> IO ()
    receive ProtocolClient {client_ = PClient {rcvQ}} h = forever $ tGet h >>= atomically . writeTBQueue rcvQ

    ping :: ProtocolClient err msg -> IO ()
@@ -717,13 +716,13 @@ mkTransmission ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCo
      TM.insert corrId r sentCommands
      pure r

-authTransmission :: Maybe THandleAuth -> Maybe C.APrivateAuthKey -> CorrId -> ByteString -> Either TransportError (Maybe TransmissionAuth)
+authTransmission :: Maybe (THandleAuth 'TClient) -> Maybe C.APrivateAuthKey -> CorrId -> ByteString -> Either TransportError (Maybe TransmissionAuth)
 authTransmission thAuth pKey_ (CorrId corrId) t = traverse authenticate pKey_
  where
    authenticate :: C.APrivateAuthKey -> Either TransportError TransmissionAuth
    authenticate (C.APrivateAuthKey a pk) = case a of
      C.SX25519 -> case thAuth of
-        Just THandleAuth {peerPubKey} -> Right $ TAAuthenticator $ C.cbAuthenticate peerPubKey pk (C.cbNonce corrId) t
+        Just THClientAuth {srvPubKey} -> Right $ TAAuthenticator $ C.cbAuthenticate srvPubKey pk (C.cbNonce corrId) t
        Nothing -> Left TENoServerAuth
      C.SEd25519 -> sign pk
      C.SEd448 -> sign pk
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -48,7 +48,7 @@ import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
 import Simplex.Messaging.Server.Stats
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..))
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..), TransportPeer (..))
 import Simplex.Messaging.Transport.Server (runTransportServer, tlsServerCredentials)
 import Simplex.Messaging.Util
 import System.Exit (exitFailure)
@@ -338,7 +338,7 @@ updateTknStatus NtfTknData {ntfTknId, tknStatus} status = do
  old <- atomically $ stateTVar tknStatus (,status)
  when (old /= status) $ withNtfLog $ \sl -> logTokenStatus sl ntfTknId status

-runNtfClientTransport :: Transport c => THandle c -> M ()
+runNtfClientTransport :: Transport c => THandle c 'TServer -> M ()
 runNtfClientTransport th@THandle {params} = do
  qSize <- asks $ clientQSize . config
  ts <- liftIO getSystemTime
@@ -355,7 +355,7 @@ runNtfClientTransport th@THandle {params} = do
 clientDisconnected :: NtfServerClient -> IO ()
 clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connected False

-receive :: Transport c => THandle c -> NtfServerClient -> M ()
+receive :: Transport c => THandle c 'TServer -> NtfServerClient -> M ()
 receive th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
  ts <- liftIO $ tGet th
  forM_ ts $ \t@(_, _, (corrId, entId, cmdOrError)) -> do
@@ -370,7 +370,7 @@ receive th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ
  where
    write q t = atomically $ writeTBQueue q t

-send :: Transport c => THandle c -> NtfServerClient -> IO ()
+send :: Transport c => THandle c 'TServer -> NtfServerClient -> IO ()
 send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do
  t <- atomically $ readTBQueue sndQ
  void . liftIO $ tPut h [Right (Nothing, encodeSrvTransmission params t)]
@@ -381,7 +381,7 @@ send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do

 data VerificationResult = VRVerified NtfRequest | VRFailed

-verifyNtfTransmission :: Maybe (THandleAuth, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> M VerificationResult
+verifyNtfTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> M VerificationResult
 verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
  st <- asks store
  case cmd of
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -32,7 +32,7 @@ import Simplex.Messaging.Protocol (CorrId, SMPServer, Transmission)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (ATransport, THandleParams)
+import Simplex.Messaging.Transport (ATransport, THandleParams, TransportPeer (..))
 import Simplex.Messaging.Transport.Server (TransportServerConfig, loadFingerprint, loadTLSServerParams)
 import Simplex.Messaging.Version (VersionRange)
 import System.IO (IOMode (..))
@@ -159,13 +159,13 @@ data NtfRequest
 data NtfServerClient = NtfServerClient
  { rcvQ :: TBQueue NtfRequest,
    sndQ :: TBQueue (Transmission NtfResponse),
-    ntfThParams :: THandleParams,
+    ntfThParams :: THandleParams 'TServer,
    connected :: TVar Bool,
    rcvActiveAt :: TVar SystemTime,
    sndActiveAt :: TVar SystemTime
  }

-newNtfServerClient :: Natural -> THandleParams -> SystemTime -> STM NtfServerClient
+newNtfServerClient :: Natural -> THandleParams 'TServer -> SystemTime -> STM NtfServerClient
 newNtfServerClient qSize ntfThParams ts = do
  rcvQ <- newTBQueue qSize
  sndQ <- newTBQueue qSize
--- a/src/Simplex/Messaging/Notifications/Transport.hs
+++ b/src/Simplex/Messaging/Notifications/Transport.hs
@@ -48,9 +48,7 @@ data NtfClientHandshake = NtfClientHandshake
  { -- | agreed SMP notifications server protocol version
    ntfVersion :: Version,
    -- | server identity - CA certificate fingerprint
-    keyHash :: C.KeyHash,
-    -- pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys.
-    authPubKey :: Maybe C.PublicKeyX25519
+    keyHash :: C.KeyHash
  }

 instance Encoding NtfServerHandshake where
@@ -75,13 +73,11 @@ authEncryptCmdsP :: Version -> Parser a -> Parser (Maybe a)
 authEncryptCmdsP v p = if v >= authEncryptCmdsNTFVersion then Just <$> p else pure Nothing

 instance Encoding NtfClientHandshake where
-  smpEncode NtfClientHandshake {ntfVersion, keyHash, authPubKey} =
-    smpEncode (ntfVersion, keyHash) <> encodeNtfAuthPubKey ntfVersion authPubKey
+  smpEncode NtfClientHandshake {ntfVersion, keyHash} =
+    smpEncode (ntfVersion, keyHash)
  smpP = do
    (ntfVersion, keyHash) <- smpP
-    -- TODO drop SMP v6: remove special parser and make key non-optional
-    authPubKey <- ntfAuthPubKeyP ntfVersion
-    pure NtfClientHandshake {ntfVersion, keyHash, authPubKey}
+    pure NtfClientHandshake {ntfVersion, keyHash}

 ntfAuthPubKeyP :: Version -> Parser (Maybe C.PublicKeyX25519)
 ntfAuthPubKeyP v = if v >= authEncryptCmdsNTFVersion then Just <$> smpP else pure Nothing
@@ -92,44 +88,45 @@ encodeNtfAuthPubKey v k
  | otherwise = ""

 -- | Notifcations server transport handshake.
-ntfServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
+ntfServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c 'TServer)
 ntfServerHandshake serverSignKey c (k, pk) kh ntfVRange = do
  let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c
  let sk = C.signX509 serverSignKey $ C.publicToX509 k
  sendHandshake th $ NtfServerHandshake {sessionId, ntfVersionRange = ntfVRange, authPubKey = Just sk}
  getHandshake th >>= \case
-    NtfClientHandshake {ntfVersion = v, keyHash, authPubKey = k'}
+    NtfClientHandshake {ntfVersion = v, keyHash}
      | keyHash /= kh ->
          throwError $ TEHandshake IDENTITY
      | v `isCompatible` ntfVRange ->
-          pure $ ntfThHandle th v pk k'
+          pure $ ntfThHandle th v (Just $ THServerAuth pk)
      | otherwise -> throwError $ TEHandshake VERSION

 -- | Notifcations server client transport handshake.
-ntfClientHandshake :: forall c. Transport c => c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
-ntfClientHandshake c (k, pk) keyHash ntfVRange = do
+ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c 'TClient)
+ntfClientHandshake c keyHash ntfVRange = do
  let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c
  NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey = sk'} <- getHandshake th
  if sessionId /= sessId
    then throwError TEBadSession
    else case ntfVersionRange `compatibleVersion` ntfVRange of
      Just (Compatible v) -> do
-        sk_ <- forM sk' $ \exact -> liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
+        k_ <- forM sk' $ \exact -> liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
          serverKey <- getServerVerifyKey c
          pubKey <- C.verifyX509 serverKey exact
          C.x509ToPublic (pubKey, []) >>= C.pubKey
-        sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash, authPubKey = Just k}
-        pure $ ntfThHandle th v pk sk_
+        sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash}
+        pure $ ntfThHandle th v (THClientAuth <$> k_)
      Nothing -> throwError $ TEHandshake VERSION

-ntfThHandle :: forall c. THandle c -> Version -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandle c
-ntfThHandle th@THandle {params} v privKey k_ =
+ntfThHandle :: forall c p. THandle c p -> Version -> Maybe (THandleAuth p) -> THandle c p
+ntfThHandle th@THandle {params} v thAuth_ =
  -- TODO drop SMP v6: make thAuth non-optional
-  let thAuth = (\k -> THandleAuth {peerPubKey = k, privKey}) <$> k_
+  let encrypt = v >= authEncryptCmdsNTFVersion
+      thAuth = if encrypt then thAuth_ else Nothing
      params' = params {thVersion = v, thAuth, encrypt = v >= authEncryptCmdsNTFVersion}
-   in (th :: THandle c) {params = params'}
+   in (th :: THandle c p) {params = params'}

-ntfTHandle :: Transport c => c -> THandle c
+ntfTHandle :: Transport c => c -> THandle c p
 ntfTHandle c = THandle {connection = c, params}
  where
    params = THandleParams {sessionId = tlsUnique c, blockSize = ntfBlockSize, thVersion = 0, thAuth = Nothing, encrypt = False, batch = False}
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -1068,7 +1068,7 @@ data CommandError
  deriving (Eq, Read, Show)

 -- | SMP transmission parser.
-transmissionP :: THandleParams -> Parser RawTransmission
+transmissionP :: THandleParams p -> Parser RawTransmission
 transmissionP THandleParams {sessionId, encrypt} = do
  authenticator <- smpP
  authorized <- A.takeByteString
@@ -1085,7 +1085,7 @@ transmissionP THandleParams {sessionId, encrypt} = do
 class (ProtocolEncoding err msg, ProtocolEncoding err (ProtoCommand msg), Show err, Show msg) => Protocol err msg | msg -> err where
  type ProtoCommand msg = cmd | cmd -> msg
  type ProtoType msg = (sch :: ProtocolType) | sch -> msg
-  protocolClientHandshake :: forall c. Transport c => c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
+  protocolClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c 'TClient)
  protocolPing :: ProtoCommand msg
  protocolError :: msg -> Maybe err

@@ -1314,7 +1314,7 @@ instance Encoding CommandError where
      _ -> fail "bad command error type"

 -- | Send signed SMP transmission to TCP transport.
-tPut :: Transport c => THandle c -> NonEmpty (Either TransportError SentRawTransmission) -> IO [Either TransportError ()]
+tPut :: Transport c => THandle c p -> NonEmpty (Either TransportError SentRawTransmission) -> IO [Either TransportError ()]
 tPut th@THandle {params} = fmap concat . mapM tPutBatch . batchTransmissions (batch params) (blockSize params)
  where
    tPutBatch :: TransportBatch () -> IO [Either TransportError ()]
@@ -1323,7 +1323,7 @@ tPut th@THandle {params} = fmap concat . mapM tPutBatch . batchTransmissions (ba
      TBTransmissions s n _ -> replicate n <$> tPutLog th s
      TBTransmission s _ -> (: []) <$> tPutLog th s

-tPutLog :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
+tPutLog :: Transport c => THandle c p -> ByteString -> IO (Either TransportError ())
 tPutLog th s = do
  r <- tPutBlock th s
  case r of
@@ -1385,7 +1385,7 @@ tEncodeBatch1 t = lenEncode 1 `B.cons` tEncodeForBatch t
 -- tForAuth is lazy to avoid computing it when there is no key to sign
 data ClntTransmission = ClntTransmission {tForAuth :: ~ByteString, tToSend :: ByteString}

-encodeClntTransmission :: ProtocolEncoding e c => THandleParams -> Transmission c -> ClntTransmission
+encodeClntTransmission :: ProtocolEncoding e c => THandleParams 'TClient -> Transmission c -> ClntTransmission
 encodeClntTransmission THandleParams {thVersion = v, sessionId, encrypt} t =
  ClntTransmission {tForAuth, tToSend = if encrypt then t' else tForAuth}
  where
@@ -1393,7 +1393,7 @@ encodeClntTransmission THandleParams {thVersion = v, sessionId, encrypt} t =
    t' = encodeTransmission_ v t
 {-# INLINE encodeClntTransmission #-}

-encodeSrvTransmission :: ProtocolEncoding e c => THandleParams -> Transmission c -> ByteString
+encodeSrvTransmission :: ProtocolEncoding e c => THandleParams 'TServer -> Transmission c -> ByteString
 encodeSrvTransmission THandleParams {thVersion = v, sessionId, encrypt} t =
  if encrypt then t' else smpEncode sessionId <> t'
  where
@@ -1406,11 +1406,11 @@ encodeTransmission_ v (CorrId corrId, queueId, command) =
 {-# INLINE encodeTransmission_ #-}

 -- | Receive and parse transmission from the TCP transport (ignoring any trailing padding).
-tGetParse :: Transport c => THandle c -> IO (NonEmpty (Either TransportError RawTransmission))
+tGetParse :: Transport c => THandle c p -> IO (NonEmpty (Either TransportError RawTransmission))
 tGetParse th@THandle {params} = eitherList (tParse params) <$> tGetBlock th
 {-# INLINE tGetParse #-}

-tParse :: THandleParams -> ByteString -> NonEmpty (Either TransportError RawTransmission)
+tParse :: THandleParams p -> ByteString -> NonEmpty (Either TransportError RawTransmission)
 tParse thParams@THandleParams {batch} s
  | batch = eitherList (L.map (\(Large t) -> tParse1 t)) ts
  | otherwise = [tParse1 s]
@@ -1422,10 +1422,10 @@ eitherList :: (a -> NonEmpty (Either e b)) -> Either e a -> NonEmpty (Either e b
 eitherList = either (\e -> [Left e])

 -- | Receive client and server transmissions (determined by `cmd` type).
-tGet :: forall err cmd c. (ProtocolEncoding err cmd, Transport c) => THandle c -> IO (NonEmpty (SignedTransmission err cmd))
+tGet :: forall err cmd c p. (ProtocolEncoding err cmd, Transport c) => THandle c p -> IO (NonEmpty (SignedTransmission err cmd))
 tGet th@THandle {params} = L.map (tDecodeParseValidate params) <$> tGetParse th

-tDecodeParseValidate :: forall err cmd. ProtocolEncoding err cmd => THandleParams -> Either TransportError RawTransmission -> SignedTransmission err cmd
+tDecodeParseValidate :: forall err cmd p. ProtocolEncoding err cmd => THandleParams p -> Either TransportError RawTransmission -> SignedTransmission err cmd
 tDecodeParseValidate THandleParams {sessionId, thVersion = v, encrypt} = \case
  Right RawTransmission {authenticator, authorized, sessId, corrId, entityId, command}
    | encrypt || sessId == sessionId ->
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -372,7 +372,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
              CPQuit -> pure ()
              CPSkip -> pure ()

-runClientTransport :: Transport c => THandle c -> M ()
+runClientTransport :: Transport c => THandle c 'TServer -> M ()
 runClientTransport th@THandle {params = THandleParams {thVersion, sessionId}} = do
  q <- asks $ tbqSize . config
  ts <- liftIO getSystemTime
@@ -417,7 +417,7 @@ cancelSub sub =
    Sub {subThread = SubThread t} -> liftIO $ deRefWeak t >>= mapM_ killThread
    _ -> return ()

-receive :: Transport c => THandle c -> Client -> M ()
+receive :: Transport c => THandle c 'TServer -> Client -> M ()
 receive th@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
  forever $ do
@@ -438,7 +438,7 @@ receive th@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActi
              VRFailed -> Left (corrId, queueId, ERR AUTH)
    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty

-send :: Transport c => THandle c -> Client -> IO ()
+send :: Transport c => THandle c 'TServer-> Client -> IO ()
 send h@THandle {params} Client {sndQ, sessionId, sndActiveAt} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
  forever $ do
@@ -453,7 +453,7 @@ send h@THandle {params} Client {sndQ, sessionId, sndActiveAt} = do
      NMSG {} -> 0
      _ -> 1

-disconnectTransport :: Transport c => THandle c -> TVar SystemTime -> TVar SystemTime -> ExpirationConfig -> IO Bool -> IO ()
+disconnectTransport :: Transport c => THandle c 'TServer -> TVar SystemTime -> TVar SystemTime -> ExpirationConfig -> IO Bool -> IO ()
 disconnectTransport THandle {connection, params = THandleParams {sessionId}} rcvActiveAt sndActiveAt expCfg noSubscriptions = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disconnectTransport"
  loop
@@ -474,7 +474,7 @@ data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
 -- - the queue or party key do not exist.
 -- In all cases, the time of the verification should depend only on the provided authorization type,
 -- a dummy key is used to run verification in the last two cases, and failure is returned irrespective of the result.
-verifyTransmission :: Maybe (THandleAuth, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
+verifyTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
 verifyTransmission auth_ tAuth authorized queueId cmd =
  case cmd of
    Cmd SRecipient (NEW k _ _ _) -> pure $ Nothing `verifiedWith` k
@@ -496,7 +496,7 @@ verifyTransmission auth_ tAuth authorized queueId cmd =
      st <- asks queueStore
      atomically $ getQueue st party queueId

-verifyCmdAuthorization :: Maybe (THandleAuth, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
+verifyCmdAuthorization :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
 verifyCmdAuthorization auth_ tAuth authorized key = maybe False (verify key) tAuth
  where
    verify :: C.APublicAuthKey -> TransmissionAuth -> Bool
@@ -508,12 +508,12 @@ verifyCmdAuthorization auth_ tAuth authorized key = maybe False (verify key) tAu
        C.SX25519 -> verifyCmdAuth auth_ k s authorized
        _ -> verifyCmdAuth auth_ dummyKeyX25519 s authorized `seq` False

-verifyCmdAuth :: Maybe (THandleAuth, C.CbNonce) -> C.PublicKeyX25519 -> C.CbAuthenticator -> ByteString -> Bool
+verifyCmdAuth :: Maybe (THandleAuth 'TServer, C.CbNonce) -> C.PublicKeyX25519 -> C.CbAuthenticator -> ByteString -> Bool
 verifyCmdAuth auth_ k authenticator authorized = case auth_ of
-  Just (THandleAuth {privKey}, nonce) -> C.cbVerify k privKey nonce authenticator authorized
+  Just (THServerAuth {privKey}, nonce) -> C.cbVerify k privKey nonce authenticator authorized
  Nothing -> False

-dummyVerifyCmd :: Maybe (THandleAuth, C.CbNonce) -> ByteString -> TransmissionAuth -> Bool
+dummyVerifyCmd :: Maybe (THandleAuth 'TServer, C.CbNonce) -> ByteString -> TransmissionAuth -> Bool
 dummyVerifyCmd auth_ authorized = \case
  TASignature (C.ASignature a s) -> C.verify' (dummySignKey a) s authorized
  TAAuthenticator s -> verifyCmdAuth auth_ dummyKeyX25519 s authorized
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -55,6 +55,7 @@ module Simplex.Messaging.Transport

    -- * SMP transport
    THandle (..),
+    TClientHandle,
    THandleParams (..),
    THandleAuth (..),
    TransportError (..),
@@ -287,18 +288,20 @@ instance Transport TLS where
 -- * SMP transport

 -- | The handle for SMP encrypted transport connection over Transport.
-data THandle c = THandle
+data THandle c p = THandle
  { connection :: c,
-    params :: THandleParams
+    params :: THandleParams p
  }

-data THandleParams = THandleParams
+type TClientHandle c = THandle c 'TClient
+
+data THandleParams p = THandleParams
  { sessionId :: SessionId,
    blockSize :: Int,
    -- | agreed server protocol version
    thVersion :: Version,
    -- | peer public key for command authorization and shared secrets for entity ID encryption
-    thAuth :: Maybe THandleAuth,
+    thAuth :: Maybe (THandleAuth p),
    -- | additionally encrypt transmission inside transport protocol
    -- to protect transmission from sending proxies
    -- based on protocol version
@@ -308,10 +311,11 @@ data THandleParams = THandleParams
    batch :: Bool
  }

-data THandleAuth = THandleAuth
-  { peerPubKey :: C.PublicKeyX25519, -- used only in the client to combine with per-queue key
-    privKey :: C.PrivateKeyX25519 -- used to combine with peer's per-queue key (currently only in the server)
-  }
+data THandleAuth (p :: TransportPeer) where
+  -- used in the server (combined with client public per-queue or per-command keys)
+  THServerAuth :: {privKey :: C.PrivateKeyX25519} -> THandleAuth 'TServer
+  -- used in the client (combined with client private per-queue or per-command key)
+  THClientAuth :: {srvPubKey :: C.PublicKeyX25519} -> THandleAuth 'TClient

 -- | TLS-unique channel binding
 type SessionId = ByteString
@@ -327,19 +331,15 @@ data ClientHandshake = ClientHandshake
  { -- | agreed SMP server protocol version
    smpVersion :: Version,
    -- | server identity - CA certificate fingerprint
-    keyHash :: C.KeyHash,
-    -- pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys.
-    authPubKey :: Maybe C.PublicKeyX25519
+    keyHash :: C.KeyHash
  }

 instance Encoding ClientHandshake where
-  smpEncode ClientHandshake {smpVersion, keyHash, authPubKey} =
-    smpEncode (smpVersion, keyHash) <> encodeAuthEncryptCmds smpVersion authPubKey
+  smpEncode ClientHandshake {smpVersion, keyHash} =
+    smpEncode (smpVersion, keyHash)
  smpP = do
    (smpVersion, keyHash) <- smpP
-    -- TODO drop SMP v6: remove special parser and make key non-optional
-    authPubKey <- authEncryptCmdsP smpVersion smpP
-    pure ClientHandshake {smpVersion, keyHash, authPubKey}
+    pure ClientHandshake {smpVersion, keyHash}

 instance Encoding ServerHandshake where
  smpEncode ServerHandshake {smpVersionRange, sessionId, authPubKey} =
@@ -413,13 +413,13 @@ serializeTransportError = \case
  TEHandshake e -> "HANDSHAKE " <> bshow e

 -- | Pad and send block to SMP transport.
-tPutBlock :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
+tPutBlock :: Transport c => THandle c p -> ByteString -> IO (Either TransportError ())
 tPutBlock THandle {connection = c, params = THandleParams {blockSize}} block =
  bimapM (const $ pure TELargeMsg) (cPut c) $
    C.pad block blockSize

 -- | Receive block from SMP transport.
-tGetBlock :: Transport c => THandle c -> IO (Either TransportError ByteString)
+tGetBlock :: Transport c => THandle c p -> IO (Either TransportError ByteString)
 tGetBlock THandle {connection = c, params = THandleParams {blockSize}} = do
  msg <- cGet c blockSize
  if B.length msg == blockSize
@@ -429,32 +429,32 @@ tGetBlock THandle {connection = c, params = THandleParams {blockSize}} = do
 -- | Server SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-smpServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
+smpServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c 'TServer)
 smpServerHandshake serverSignKey c (k, pk) kh smpVRange = do
  let th@THandle {params = THandleParams {sessionId}} = smpTHandle c
      sk = C.signX509 serverSignKey $ C.publicToX509 k
      certChain = getServerCerts c
  sendHandshake th $ ServerHandshake {sessionId, smpVersionRange = smpVRange, authPubKey = Just (certChain, sk)}
  getHandshake th >>= \case
-    ClientHandshake {smpVersion = v, keyHash, authPubKey = k'}
+    ClientHandshake {smpVersion = v, keyHash}
      | keyHash /= kh ->
          throwE $ TEHandshake IDENTITY
      | v `isCompatible` smpVRange ->
-          pure $ smpThHandle th v pk k'
+          pure $ smpThHandle th v (Just $ THServerAuth pk)
      | otherwise -> throwE $ TEHandshake VERSION

 -- | Client SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-smpClientHandshake :: forall c. Transport c => c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c)
-smpClientHandshake c (k, pk) keyHash@(C.KeyHash kh) smpVRange = do
+smpClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c 'TClient)
+smpClientHandshake c keyHash@(C.KeyHash kh) smpVRange = do
  let th@THandle {params = THandleParams {sessionId}} = smpTHandle c
  ServerHandshake {sessionId = sessId, smpVersionRange, authPubKey} <- getHandshake th
  if sessionId /= sessId
    then throwE TEBadSession
    else case smpVersionRange `compatibleVersion` smpVRange of
      Just (Compatible v) -> do
-        sk_ <- forM authPubKey $ \(X.CertificateChain cert, exact) ->
+        k_ <- forM authPubKey $ \(X.CertificateChain cert, exact) ->
          liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
            case cert of
              [_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure ()
@@ -462,25 +462,26 @@ smpClientHandshake c (k, pk) keyHash@(C.KeyHash kh) smpVRange = do
            serverKey <- getServerVerifyKey c
            pubKey <- C.verifyX509 serverKey exact
            C.x509ToPublic (pubKey, []) >>= C.pubKey
-        sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = Just k}
-        pure $ smpThHandle th v pk sk_
+        sendHandshake th $ ClientHandshake {smpVersion = v, keyHash}
+        pure $ smpThHandle th v (THClientAuth <$> k_)
      Nothing -> throwE $ TEHandshake VERSION

-smpThHandle :: forall c. THandle c -> Version -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandle c
-smpThHandle th@THandle {params} v privKey k_ =
+smpThHandle :: forall c p. THandle c p -> Version -> Maybe (THandleAuth p) -> THandle c p
+smpThHandle th@THandle {params} v thAuth_ =
  -- TODO drop SMP v6: make thAuth non-optional
-  let thAuth = (\k -> THandleAuth {peerPubKey = k, privKey}) <$> k_
-      params' = params {thVersion = v, thAuth, encrypt = v >= authEncryptCmdsSMPVersion, batch = v >= batchCmdsSMPVersion}
-   in (th :: THandle c) {params = params'}
+  let encrypt = v >= authEncryptCmdsSMPVersion
+      thAuth = if encrypt then thAuth_ else Nothing
+      params' = params {thVersion = v, thAuth, encrypt, batch = v >= batchCmdsSMPVersion}
+   in (th :: THandle c p) {params = params'}

-sendHandshake :: (Transport c, Encoding smp) => THandle c -> smp -> ExceptT TransportError IO ()
+sendHandshake :: (Transport c, Encoding smp) => THandle c p -> smp -> ExceptT TransportError IO ()
 sendHandshake th = ExceptT . tPutBlock th . smpEncode

 -- ignores tail bytes to allow future extensions
-getHandshake :: (Transport c, Encoding smp) => THandle c -> ExceptT TransportError IO smp
+getHandshake :: (Transport c, Encoding smp) => THandle c p -> ExceptT TransportError IO smp
 getHandshake th = ExceptT $ (first (\_ -> TEHandshake PARSE) . A.parseOnly smpP =<<) <$> tGetBlock th

-smpTHandle :: Transport c => c -> THandle c
+smpTHandle :: Transport c => c -> THandle c p
 smpTHandle c = THandle {connection = c, params}
  where
    params = THandleParams {sessionId = tlsUnique c, blockSize = smpBlockSize, thVersion = 0, thAuth = Nothing, encrypt = False, batch = False}
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -7,7 +8,6 @@ module CoreTests.BatchingTests (batchingTests) where

 import Control.Concurrent.STM
 import Control.Monad
-import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString as B
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.List.NonEmpty as L
@@ -264,7 +264,7 @@ clientStubV7 = do
  g <- C.newRandom
  sessId <- atomically $ C.randomBytes 32 g
  (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
-  thAuth_ <- testTHandleAuth authEncryptCmdsSMPVersion g rKey
+  thAuth_ <- testTHandleAuth authEncryptCmdsSMPVersion rKey
  atomically $ clientStub g sessId authEncryptCmdsSMPVersion thAuth_

 randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
@@ -279,7 +279,7 @@ randomSUB_ a v sessId = do
  rId <- atomically $ C.randomBytes 24 g
  corrId <- atomically $ CorrId <$> C.randomBytes 24 g
  (rKey, rpKey) <- atomically $ C.generateAuthKeyPair a g
-  thAuth_ <- testTHandleAuth v g rKey
+  thAuth_ <- testTHandleAuth v rKey
  let thParams = testTHandleParams v sessId
      ClntTransmission {tForAuth, tToSend} = encodeClntTransmission thParams (corrId, rId, Cmd SRecipient SUB)
  pure $ (,tToSend) <$> authTransmission thAuth_ (Just rpKey) corrId tForAuth
@@ -309,13 +309,13 @@ randomSEND_ a v sessId len = do
  sId <- atomically $ C.randomBytes 24 g
  corrId <- atomically $ CorrId <$> C.randomBytes 3 g
  (sKey, spKey) <- atomically $ C.generateAuthKeyPair a g
-  thAuth_ <- testTHandleAuth v g sKey
+  thAuth_ <- testTHandleAuth v sKey
  msg <- atomically $ C.randomBytes len g
  let thParams = testTHandleParams v sessId
      ClntTransmission {tForAuth, tToSend} = encodeClntTransmission thParams (corrId, sId, Cmd SSender $ SEND noMsgFlags msg)
  pure $ (,tToSend) <$> authTransmission thAuth_ (Just spKey) corrId tForAuth

-testTHandleParams :: Version -> ByteString -> THandleParams
+testTHandleParams :: Version -> ByteString -> THandleParams 'TClient
 testTHandleParams v sessionId =
  THandleParams
    { sessionId,
@@ -326,11 +326,10 @@ testTHandleParams v sessionId =
      batch = True
    }

-testTHandleAuth :: Version -> TVar ChaChaDRG -> C.APublicAuthKey -> IO (Maybe THandleAuth)
-testTHandleAuth v g (C.APublicAuthKey a k) = case a of
-  C.SX25519 | v >= authEncryptCmdsSMPVersion -> do
-    (_, privKey) <- atomically $ C.generateKeyPair g
-    pure $ Just THandleAuth {peerPubKey = k, privKey}
+testTHandleAuth :: Version -> C.APublicAuthKey -> IO (Maybe (THandleAuth 'TClient))
+testTHandleAuth v (C.APublicAuthKey a k) = case a of
+  C.SX25519 | v >= authEncryptCmdsSMPVersion ->
+    pure $ Just THClientAuth {srvPubKey = k}
  _ -> pure Nothing

 randomSENDCmd :: ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -70,13 +70,12 @@ testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 ntfTestStoreLogFile :: FilePath
 ntfTestStoreLogFile = "tests/tmp/ntf-server-store.log"

-testNtfClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandle c -> m a) -> m a
+testNtfClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (TClientHandle c -> m a) -> m a
 testNtfClient client = do
  Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost
  runTransportClient defaultTransportClientConfig Nothing host ntfTestPort (Just testKeyHash) $ \h -> do
    g <- liftIO C.newRandom
-    ks <- atomically $ C.generateKeyPair g
-    liftIO (runExceptT $ ntfClientHandshake h ks testKeyHash supportedClientNTFVRange) >>= \case
+    liftIO (runExceptT $ ntfClientHandshake h testKeyHash supportedClientNTFVRange) >>= \case
      Right th -> client th
      Left e -> error $ show e

@@ -139,7 +138,7 @@ withNtfServerOn t port' = withNtfServerThreadOn t port' . const
 withNtfServer :: ATransport -> IO a -> IO a
 withNtfServer t = withNtfServerOn t ntfTestPort

-runNtfTest :: forall c a. Transport c => (THandle c -> IO a) -> IO a
+runNtfTest :: forall c a. Transport c => (TClientHandle c -> IO a) -> IO a
 runNtfTest test = withNtfServer (transport @c) $ testNtfClient test

 ntfServerTest ::
@@ -150,7 +149,7 @@ ntfServerTest ::
  IO (Maybe TransmissionAuth, ByteString, ByteString, BrokerMsg)
 ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
  where
-    tPut' :: THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
+    tPut' :: TClientHandle c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
    tPut' h@THandle {params = THandleParams {sessionId}} (sig, corrId, queueId, smp) = do
      let t' = smpEncode (sessionId, corrId, queueId, smp)
      [Right ()] <- tPut h [Right (sig, t')]
@@ -159,7 +158,7 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
      pure (Nothing, corrId, qId, cmd)

-ntfTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
+ntfTest :: Transport c => TProxy c -> (TClientHandle c -> IO ()) -> Expectation
 ntfTest _ test' = runNtfTest test' `shouldReturn` ()

 data APNSMockRequest = APNSMockRequest
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -67,13 +67,13 @@ ntfSyntaxTests (ATransport t) = do
 pattern RespNtf :: CorrId -> QueueId -> NtfResponse -> SignedTransmission ErrorType NtfResponse
 pattern RespNtf corrId queueId command <- (_, _, (corrId, queueId, Right command))

-sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
+sendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => TClientHandle c -> (Maybe TransmissionAuth, ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
 sendRecvNtf h@THandle {params} (sgn, corrId, qId, cmd) = do
  let ClntTransmission {tToSend} = encodeClntTransmission params (CorrId corrId, qId, cmd)
  Right () <- tPut1 h (sgn, tToSend)
  tGet1 h

-signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => THandle c -> C.APrivateAuthKey -> (ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
+signSendRecvNtf :: forall c e. (Transport c, NtfEntityI e) => TClientHandle c -> C.APrivateAuthKey -> (ByteString, ByteString, NtfCommand e) -> IO (SignedTransmission ErrorType NtfResponse)
 signSendRecvNtf h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
  let ClntTransmission {tForAuth, tToSend} = encodeClntTransmission params (CorrId corrId, qId, cmd)
  Right () <- tPut1 h (authorize tForAuth, tToSend)
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -67,16 +67,15 @@ xit'' d t = do
  ci <- runIO $ lookupEnv "CI"
  (if ci == Just "true" then xit else it) d t

-testSMPClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (THandle c -> m a) -> m a
+testSMPClient :: (Transport c, MonadUnliftIO m, MonadFail m) => (TClientHandle c -> m a) -> m a
 testSMPClient = testSMPClientVR supportedClientSMPRelayVRange

-testSMPClientVR :: (Transport c, MonadUnliftIO m, MonadFail m) => VersionRange -> (THandle c -> m a) -> m a
+testSMPClientVR :: (Transport c, MonadUnliftIO m, MonadFail m) => VersionRange -> (TClientHandle c -> m a) -> m a
 testSMPClientVR vr client = do
  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
  runTransportClient defaultTransportClientConfig Nothing useHost testPort (Just testKeyHash) $ \h -> do
    g <- liftIO C.newRandom
-    ks <- atomically $ C.generateKeyPair g
-    liftIO (runExceptT $ smpClientHandshake h ks testKeyHash vr) >>= \case
+    liftIO (runExceptT $ smpClientHandshake h testKeyHash vr) >>= \case
      Right th -> client th
      Left e -> error $ show e

@@ -148,16 +147,16 @@ withSmpServer t = withSmpServerOn t testPort
 withSmpServerV7 :: HasCallStack => ATransport -> IO a -> IO a
 withSmpServerV7 t = withSmpServerConfigOn t cfgV7 testPort . const

-runSmpTest :: forall c a. (HasCallStack, Transport c) => (HasCallStack => THandle c -> IO a) -> IO a
+runSmpTest :: forall c a. (HasCallStack, Transport c) => (HasCallStack => TClientHandle c -> IO a) -> IO a
 runSmpTest test = withSmpServer (transport @c) $ testSMPClient test

-runSmpTestN :: forall c a. (HasCallStack, Transport c) => Int -> (HasCallStack => [THandle c] -> IO a) -> IO a
+runSmpTestN :: forall c a. (HasCallStack, Transport c) => Int -> (HasCallStack => [TClientHandle c] -> IO a) -> IO a
 runSmpTestN = runSmpTestNCfg cfg supportedClientSMPRelayVRange

-runSmpTestNCfg :: forall c a. (HasCallStack, Transport c) => ServerConfig -> VersionRange -> Int -> (HasCallStack => [THandle c] -> IO a) -> IO a
+runSmpTestNCfg :: forall c a. (HasCallStack, Transport c) => ServerConfig -> VersionRange -> Int -> (HasCallStack => [TClientHandle c] -> IO a) -> IO a
 runSmpTestNCfg srvCfg clntVR nClients test = withSmpServerConfigOn (transport @c) srvCfg testPort $ \_ -> run nClients []
  where
-    run :: Int -> [THandle c] -> IO a
+    run :: Int -> [TClientHandle c] -> IO a
    run 0 hs = test hs
    run n hs = testSMPClientVR clntVR $ \h -> run (n - 1) (h : hs)

@@ -169,7 +168,7 @@ smpServerTest ::
  IO (Maybe TransmissionAuth, ByteString, ByteString, BrokerMsg)
 smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
  where
-    tPut' :: THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
+    tPut' :: TClientHandle c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO ()
    tPut' h@THandle {params = THandleParams {sessionId}} (sig, corrId, queueId, smp) = do
      let t' = smpEncode (sessionId,corrId, queueId, smp)
      [Right ()] <- tPut h [Right (sig, t')]
@@ -178,33 +177,33 @@ smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
      [(Nothing, _, (CorrId corrId, qId, Right cmd))] <- tGet h
      pure (Nothing, corrId, qId, cmd)

-smpTest :: (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> IO ()) -> Expectation
+smpTest :: (HasCallStack, Transport c) => TProxy c -> (HasCallStack => TClientHandle c -> IO ()) -> Expectation
 smpTest _ test' = runSmpTest test' `shouldReturn` ()

-smpTestN :: (HasCallStack, Transport c) => Int -> (HasCallStack => [THandle c] -> IO ()) -> Expectation
+smpTestN :: (HasCallStack, Transport c) => Int -> (HasCallStack => [TClientHandle c] -> IO ()) -> Expectation
 smpTestN n test' = runSmpTestN n test' `shouldReturn` ()

-smpTest2 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> THandle c -> IO ()) -> Expectation
+smpTest2 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => TClientHandle c -> TClientHandle c -> IO ()) -> Expectation
 smpTest2 = smpTest2Cfg cfg supportedClientSMPRelayVRange

-smpTest2Cfg :: forall c. (HasCallStack, Transport c) => ServerConfig -> VersionRange -> TProxy c -> (HasCallStack => THandle c -> THandle c -> IO ()) -> Expectation
+smpTest2Cfg :: forall c. (HasCallStack, Transport c) => ServerConfig -> VersionRange -> TProxy c -> (HasCallStack => TClientHandle c -> TClientHandle c -> IO ()) -> Expectation
 smpTest2Cfg srvCfg clntVR _ test' = runSmpTestNCfg srvCfg clntVR 2 _test `shouldReturn` ()
  where
-    _test :: HasCallStack => [THandle c] -> IO ()
+    _test :: HasCallStack => [TClientHandle c] -> IO ()
    _test [h1, h2] = test' h1 h2
    _test _ = error "expected 2 handles"

-smpTest3 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> THandle c -> THandle c -> IO ()) -> Expectation
+smpTest3 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => TClientHandle c -> TClientHandle c -> TClientHandle c -> IO ()) -> Expectation
 smpTest3 _ test' = smpTestN 3 _test
  where
-    _test :: HasCallStack => [THandle c] -> IO ()
+    _test :: HasCallStack => [TClientHandle c] -> IO ()
    _test [h1, h2, h3] = test' h1 h2 h3
    _test _ = error "expected 3 handles"

-smpTest4 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> THandle c -> THandle c -> THandle c -> IO ()) -> Expectation
+smpTest4 :: forall c. (HasCallStack, Transport c) => TProxy c -> (HasCallStack => TClientHandle c -> TClientHandle c -> TClientHandle c -> TClientHandle c -> IO ()) -> Expectation
 smpTest4 _ test' = smpTestN 4 _test
  where
-    _test :: HasCallStack => [THandle c] -> IO ()
+    _test :: HasCallStack => [TClientHandle c] -> IO ()
    _test [h1, h2, h3, h4] = test' h1 h2 h3 h4
    _test _ = error "expected 4 handles"

--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -74,13 +74,13 @@ pattern Ids rId sId srvDh <- IDS (QIK rId sId srvDh)
 pattern Msg :: MsgId -> MsgBody -> BrokerMsg
 pattern Msg msgId body <- MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body}

-sendRecv :: forall c p. (Transport c, PartyI p) => THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
+sendRecv :: forall c p. (Transport c, PartyI p) => TClientHandle c -> (Maybe TransmissionAuth, ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
 sendRecv h@THandle {params} (sgn, corrId, qId, cmd) = do
  let ClntTransmission {tToSend} = encodeClntTransmission params (CorrId corrId, qId, cmd)
  Right () <- tPut1 h (sgn, tToSend)
  tGet1 h

-signSendRecv :: forall c p. (Transport c, PartyI p) => THandle c -> C.APrivateAuthKey -> (ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
+signSendRecv :: forall c p. (Transport c, PartyI p) => TClientHandle c -> C.APrivateAuthKey -> (ByteString, ByteString, Command p) -> IO (SignedTransmission ErrorType BrokerMsg)
 signSendRecv h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
  let ClntTransmission {tForAuth, tToSend} = encodeClntTransmission params (CorrId corrId, qId, cmd)
  Right () <- tPut1 h (authorize tForAuth, tToSend)
@@ -89,17 +89,17 @@ signSendRecv h@THandle {params} (C.APrivateAuthKey a pk) (corrId, qId, cmd) = do
    authorize t = case a of
      C.SEd25519 -> Just . TASignature . C.ASignature C.SEd25519 $ C.sign' pk t
      C.SEd448 -> Just . TASignature . C.ASignature C.SEd448 $ C.sign' pk t
-      C.SX25519 -> (\THandleAuth {peerPubKey} -> TAAuthenticator $ C.cbAuthenticate peerPubKey pk (C.cbNonce corrId) t) <$> thAuth params
+      C.SX25519 -> (\THClientAuth {srvPubKey} -> TAAuthenticator $ C.cbAuthenticate srvPubKey pk (C.cbNonce corrId) t) <$> thAuth params
 #if !MIN_VERSION_base(4,18,0)
      _sx448 -> undefined -- ghc8107 fails to the branch excluded by types
 #endif

-tPut1 :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
+tPut1 :: Transport c => TClientHandle c -> SentRawTransmission -> IO (Either TransportError ())
 tPut1 h t = do
  [r] <- tPut h [Right t]
  pure r

-tGet1 :: (ProtocolEncoding err cmd, Transport c, MonadIO m, MonadFail m) => THandle c -> m (SignedTransmission err cmd)
+tGet1 :: (ProtocolEncoding err cmd, Transport c, MonadIO m, MonadFail m) => TClientHandle c -> m (SignedTransmission err cmd)
 tGet1 h = do
  [r] <- liftIO $ tGet h
  pure r
@@ -551,12 +551,12 @@ testWithStoreLog at@(ATransport t) =
    logSize testStoreLogFile `shouldReturn` 1
    removeFile testStoreLogFile
  where
-    runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
+    runTest :: Transport c => TProxy c -> (TClientHandle c -> IO ()) -> ThreadId -> Expectation
    runTest _ test' server = do
      testSMPClient test' `shouldReturn` ()
      killThread server

-    runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
+    runClient :: Transport c => TProxy c -> (TClientHandle c -> IO ()) -> Expectation
    runClient _ test' = testSMPClient test' `shouldReturn` ()

 logSize :: FilePath -> IO Int
@@ -649,12 +649,12 @@ testRestoreMessages at@(ATransport t) =
    removeFile testStoreMsgsFile
    removeFile testServerStatsBackupFile
  where
-    runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
+    runTest :: Transport c => TProxy c -> (TClientHandle c -> IO ()) -> ThreadId -> Expectation
    runTest _ test' server = do
      testSMPClient test' `shouldReturn` ()
      killThread server

-    runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
+    runClient :: Transport c => TProxy c -> (TClientHandle c -> IO ()) -> Expectation
    runClient _ test' = testSMPClient test' `shouldReturn` ()

 checkStats :: ServerStatsData -> [RecipientId] -> Int -> Int -> Expectation
@@ -721,15 +721,15 @@ testRestoreExpireMessages at@(ATransport t) =
    Right ServerStatsData {_msgExpired} <- strDecode <$> B.readFile testServerStatsBackupFile
    _msgExpired `shouldBe` 2
  where
-    runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
+    runTest :: Transport c => TProxy c -> (TClientHandle c -> IO ()) -> ThreadId -> Expectation
    runTest _ test' server = do
      testSMPClient test' `shouldReturn` ()
      killThread server

-    runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
+    runClient :: Transport c => TProxy c -> (TClientHandle c -> IO ()) -> Expectation
    runClient _ test' = testSMPClient test' `shouldReturn` ()

-createAndSecureQueue :: Transport c => THandle c -> SndPublicAuthKey -> IO (SenderId, RecipientId, RcvPrivateAuthKey, RcvDhSecret)
+createAndSecureQueue :: Transport c => TClientHandle c -> SndPublicAuthKey -> IO (SenderId, RecipientId, RcvPrivateAuthKey, RcvDhSecret)
 createAndSecureQueue h sPub = do
  g <- C.newRandom
  (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
@@ -764,7 +764,7 @@ testTiming (ATransport t) =
      ]
    timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
    similarTime t1 t2 = abs (t2 / t1 - 1) < 0.15 -- normally the difference between "no queue" and "wrong key" is less than 5%
-    testSameTiming :: forall c. Transport c => THandle c -> THandle c -> (C.AuthAlg, C.AuthAlg, Int) -> Expectation
+    testSameTiming :: forall c. Transport c => TClientHandle c -> TClientHandle c -> (C.AuthAlg, C.AuthAlg, Int) -> Expectation
    testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) = do
      g <- C.newRandom
      (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
@@ -785,7 +785,7 @@ testTiming (ATransport t) =

      runTimingTest sh badKey sId $ _SEND "hello"
      where
-        runTimingTest :: PartyI p => THandle c -> C.APrivateAuthKey -> ByteString -> Command p -> IO ()
+        runTimingTest :: PartyI p => TClientHandle c -> C.APrivateAuthKey -> ByteString -> Command p -> IO ()
        runTimingTest h badKey qId cmd = do
          threadDelay 100000
          _ <- timeRepeat n $ do -- "warm up" the server