ask client for confirmation of sender; make establishment of connection asynchronous (#163)

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
2026-03-30 14:16:00 +00:00 · 2021-07-04 04:48:24 +10:00
parent daad3315eb
commit 3d9ceff691
11 changed files with 446 additions and 152 deletions
--- a/apps/smp-server/Main.hs
+++ b/apps/smp-server/Main.hs
@@ -222,7 +222,7 @@ confirm msg = do
  when (map toLower ok /= "y") exitFailure

 serverKeyHash :: C.FullPrivateKey -> B.ByteString
-serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey
+serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey'

 openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
 openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}
--- a/migrations/20210624_confirmations.sql
+++ b/migrations/20210624_confirmations.sql
@@ -0,0 +1,9 @@
+CREATE TABLE conn_confirmations (
+  confirmation_id BLOB NOT NULL PRIMARY KEY,
+  conn_alias BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
+  sender_key BLOB NOT NULL,
+  sender_conn_info BLOB NOT NULL,
+  accepted INTEGER NOT NULL,
+  own_conn_info BLOB,
+  created_at TEXT NOT NULL DEFAULT (datetime('now'))
+) WITHOUT ROWID;
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -39,6 +40,7 @@ module Simplex.Messaging.Agent
    getSMPAgentClient,
    createConnection,
    joinConnection,
+    allowConnection,
    sendIntroduction,
    acceptInvitation,
    subscribeConnection,
@@ -47,6 +49,7 @@ module Simplex.Messaging.Agent
    deleteConnection,
    createConnection',
    joinConnection',
+    allowConnection',
    sendIntroduction',
    acceptInvitation',
    subscribeConnection',
@@ -111,7 +114,7 @@ runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort} = runReader
      c <- getAgentClient
      logConnection c True
      race_ (connectClient h c) (runAgentClient c)
-        `E.finally` disconnectServers c
+        `E.finally` disconnectAgentClient c

 -- | Creates an SMP agent client instance
 getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> m AgentClient
@@ -119,11 +122,11 @@ getSMPAgentClient cfg = newSMPAgentEnv cfg >>= runReaderT runAgent
  where
    runAgent = do
      c <- getAgentClient
-      action <- async $ subscriber c `E.finally` disconnectServers c
+      action <- async $ subscriber c `E.finally` disconnectAgentClient c
      pure c {smpSubscriber = action}

-disconnectServers :: MonadUnliftIO m => AgentClient -> m ()
-disconnectServers c = closeSMPServerClients c >> logConnection c False
+disconnectAgentClient :: MonadUnliftIO m => AgentClient -> m ()
+disconnectAgentClient c = closeAgentClient c >> logConnection c False

 -- |
 type AgentErrorMonad m = (MonadUnliftIO m, MonadError AgentErrorType m)
@@ -137,12 +140,16 @@ createConnection :: AgentErrorMonad m => AgentClient -> Maybe ConnId -> m (ConnI
 createConnection c = (`runReaderT` agentEnv c) . createConnection' c

 -- | Join SMP agent connection (JOIN command) in Reader monad
-joinConnection' :: AgentMonad m => AgentClient -> Maybe ConnId -> SMPQueueInfo -> m ConnId
-joinConnection' c connId qInfo = joinConn c (fromMaybe "" connId) qInfo (ReplyMode On) Nothing 0
+joinConnection' :: AgentMonad m => AgentClient -> Maybe ConnId -> SMPQueueInfo -> ConnInfo -> m ConnId
+joinConnection' c connId qInfo cInfo = joinConn c (fromMaybe "" connId) qInfo cInfo Nothing 0

 -- | Join SMP agent connection (JOIN command)
-joinConnection :: AgentErrorMonad m => AgentClient -> Maybe ConnId -> SMPQueueInfo -> m ConnId
-joinConnection c = (`runReaderT` agentEnv c) .: joinConnection' c
+joinConnection :: AgentErrorMonad m => AgentClient -> Maybe ConnId -> SMPQueueInfo -> ConnInfo -> m ConnId
+joinConnection c = (`runReaderT` agentEnv c) .:. joinConnection' c
+
+-- | Approve confirmation (LET command)
+allowConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
+allowConnection c = (`runReaderT` agentEnv c) .:. allowConnection' c

 -- | Accept invitation (ACPT command) in Reader monad
 acceptInvitation' :: AgentMonad m => AgentClient -> InvitationId -> ConnInfo -> m ConnId
@@ -150,7 +157,7 @@ acceptInvitation' c = acceptInv c ""

 -- | Accept invitation (ACPT command)
 acceptInvitation :: AgentErrorMonad m => AgentClient -> InvitationId -> ConnInfo -> m ConnId
-acceptInvitation c = (`runReaderT` agentEnv c) .: acceptInvitation c
+acceptInvitation c = (`runReaderT` agentEnv c) .: acceptInvitation' c

 -- | Send introduction of the second connection the first (INTRO command)
 sendIntroduction :: AgentErrorMonad m => AgentClient -> ConnId -> ConnId -> ConnInfo -> m ()
@@ -244,7 +251,8 @@ withStore action = do
 processCommand :: forall m. AgentMonad m => AgentClient -> (ConnId, ACommand 'Client) -> m (ConnId, ACommand 'Agent)
 processCommand c (connId, cmd) = case cmd of
  NEW -> second INV <$> newConn c connId Nothing 0
-  JOIN smpQueueInfo replyMode -> (,OK) <$> joinConn c connId smpQueueInfo replyMode Nothing 0
+  JOIN smpQueueInfo connInfo -> (,OK) <$> joinConn c connId smpQueueInfo connInfo Nothing 0
+  LET confId ownConnInfo -> allowConnection' c connId confId ownConnInfo $> (connId, OK)
  INTRO reConnId reInfo -> sendIntroduction' c connId reConnId reInfo $> (connId, OK)
  ACPT invId connInfo -> (,OK) <$> acceptInv c connId invId connInfo
  SUB -> subscribeConnection' c connId $> (connId, OK)
@@ -255,31 +263,69 @@ processCommand c (connId, cmd) = case cmd of
 newConn :: AgentMonad m => AgentClient -> ConnId -> Maybe InvitationId -> Int -> m (ConnId, SMPQueueInfo)
 newConn c connId viaInv connLevel = do
  srv <- getSMPServer
-  (rq, qInfo) <- newReceiveQueue c srv
+  (rq, qInfo) <- newRcvQueue c srv
  g <- asks idsDrg
  let cData = ConnData {connId, viaInv, connLevel}
  connId' <- withStore $ \st -> createRcvConn st g cData rq
  addSubscription c rq connId'
  pure (connId', qInfo)

-joinConn :: forall m. AgentMonad m => AgentClient -> ConnId -> SMPQueueInfo -> ReplyMode -> Maybe InvitationId -> Int -> m ConnId
-joinConn c connId qInfo (ReplyMode replyMode) viaInv connLevel = do
-  (sq, senderKey, verifyKey) <- newSendQueue qInfo
+minute :: Int
+minute = 60_000_000
+
+onlineInterval :: RetryInterval
+onlineInterval =
+  RetryInterval
+    { initialInterval = 1_000_000,
+      increaseAfter = minute,
+      maxInterval = 10 * minute
+    }
+
+resumeInterval :: RetryInterval
+resumeInterval =
+  RetryInterval
+    { initialInterval = 5_000_000,
+      increaseAfter = 0,
+      maxInterval = 10 * minute
+    }
+
+joinConn :: AgentMonad m => AgentClient -> ConnId -> SMPQueueInfo -> ConnInfo -> Maybe InvitationId -> Int -> m ConnId
+joinConn c connId qInfo cInfo viaInv connLevel = do
+  (sq, senderKey, verifyKey) <- newSndQueue qInfo
  g <- asks idsDrg
  let cData = ConnData {connId, viaInv, connLevel}
  connId' <- withStore $ \st -> createSndConn st g cData sq
-  connectToSendQueue c sq senderKey verifyKey
-  when (replyMode == On) $ createReplyQueue connId' sq
+  confirmQueue c sq senderKey cInfo
+  activateQueueJoining c connId' sq verifyKey onlineInterval
  pure connId'
+
+activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
+activateQueueJoining c connId sq verifyKey retryInterval =
+  activateQueue c connId sq verifyKey retryInterval createReplyQueue
  where
-    createReplyQueue :: ConnId -> SndQueue -> m ()
-    createReplyQueue cId sq = do
+    createReplyQueue :: m ()
+    createReplyQueue = do
      srv <- getSMPServer
-      (rq, qInfo') <- newReceiveQueue c srv
-      addSubscription c rq cId
-      withStore $ \st -> upgradeSndConnToDuplex st cId rq
+      (rq, qInfo') <- newRcvQueue c srv
+      addSubscription c rq connId
+      withStore $ \st -> upgradeSndConnToDuplex st connId rq
      sendControlMessage c sq $ REPLY qInfo'

+-- | Approve confirmation (LET command) in Reader monad
+allowConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
+allowConnection' c connId confId ownConnInfo =
+  withStore (`getConn` connId) >>= \case
+    SomeConn SCRcv (RcvConnection _ rq) -> do
+      AcceptedConfirmation {senderKey} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
+      processConfirmation c rq senderKey
+    _ -> throwError $ CMD PROHIBITED
+
+processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
+processConfirmation c rq sndKey = do
+  withStore $ \st -> setRcvQueueStatus st rq Confirmed
+  secureQueue c rq sndKey
+  withStore $ \st -> setRcvQueueStatus st rq Secured
+
 -- | Send introduction of the second connection the first (INTRO command) in Reader monad
 sendIntroduction' :: AgentMonad m => AgentClient -> ConnId -> ConnId -> ConnInfo -> m ()
 sendIntroduction' c toConn reConn reInfo =
@@ -302,19 +348,40 @@ acceptInv c connId invId connInfo =
            sendControlMessage c sq $ A_INV externalIntroId qInfo' connInfo
            pure connId'
          Just qInfo' -> do
-            connId' <- joinConn c connId qInfo' (ReplyMode On) (Just invId) (connLevel + 1)
+            -- TODO remove invitations from protocol
+            connId' <- joinConn c connId qInfo' connInfo (Just invId) (connLevel + 1)
            withStore $ \st -> addInvitationConn st invId connId'
            pure connId'
        _ -> throwError $ CONN SIMPLEX
    _ -> throwError $ CMD PROHIBITED

 -- | Subscribe to receive connection messages (SUB command) in Reader monad
-subscribeConnection' :: AgentMonad m => AgentClient -> ConnId -> m ()
+subscribeConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m ()
 subscribeConnection' c connId =
  withStore (`getConn` connId) >>= \case
-    SomeConn _ (DuplexConnection _ rq _) -> subscribeQueue c rq connId
+    SomeConn _ (DuplexConnection _ rq sq) -> case status (sq :: SndQueue) of
+      Confirmed -> withVerifyKey sq $ \sndKey -> do
+        secureQueue c rq sndKey
+        withStore $ \st -> setRcvQueueStatus st rq Secured
+        activateSecuredQueue rq sq sndKey
+      Secured -> withVerifyKey sq $ activateSecuredQueue rq sq
+      Active -> subscribeQueue c rq connId
+      _ -> throwError $ INTERNAL "unexpected queue status"
+    SomeConn _ (SndConnection _ sq) -> case status (sq :: SndQueue) of
+      Confirmed -> withVerifyKey sq $ \sndKey ->
+        activateQueueJoining c connId sq sndKey resumeInterval
+      Active -> throwError $ CONN SIMPLEX
+      _ -> throwError $ INTERNAL "unexpected queue status"
    SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
-    _ -> throwError $ CONN SIMPLEX
+  where
+    withVerifyKey :: SndQueue -> (C.PublicKey -> m ()) -> m ()
+    withVerifyKey sq action =
+      let err = throwError $ INTERNAL "missing send queue public key"
+       in maybe err action . C.publicKey $ sndPrivateKey sq
+    activateSecuredQueue :: RcvQueue -> SndQueue -> C.PublicKey -> m ()
+    activateSecuredQueue rq sq sndKey = do
+      activateQueueInitiating c connId sq sndKey resumeInterval
+      subscribeQueue c rq connId

 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgBody -> m InternalId
@@ -408,7 +475,7 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
          let msgHash = C.sha256Hash msg
          case parseSMPMessage msg of
            Left e -> notify $ ERR e
-            Right (SMPConfirmation senderKey) -> smpConfirmation senderKey
+            Right (SMPConfirmation senderKey cInfo) -> smpConfirmation senderKey cInfo
            Right SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
              case agentMessage of
                HELLO verifyKey _ -> helloMsg verifyKey msgBody
@@ -434,17 +501,20 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
        prohibited :: m ()
        prohibited = notify . ERR $ AGENT A_PROHIBITED

-        smpConfirmation :: SenderPublicKey -> m ()
-        smpConfirmation senderKey = do
+        smpConfirmation :: SenderPublicKey -> ConnInfo -> m ()
+        smpConfirmation senderKey cInfo = do
          logServer "<--" c srv rId "MSG <KEY>"
          case status of
-            New -> do
-              -- TODO currently it automatically allows whoever sends the confirmation
-              -- TODO create invitation and send REQ
-              withStore $ \st -> setRcvQueueStatus st rq Confirmed
-              -- TODO update sender key in the store?
-              secureQueue c rq senderKey
-              withStore $ \st -> setRcvQueueStatus st rq Secured
+            New -> case cType of
+              SCRcv -> do
+                g <- asks idsDrg
+                let newConfirmation = NewConfirmation {connId, senderKey, senderConnInfo = cInfo}
+                confId <- withStore $ \st -> createConfirmation st g newConfirmation
+                notify $ CONF confId cInfo
+              SCDuplex -> do
+                notify $ INFO cInfo
+                processConfirmation c rq senderKey
+              _ -> prohibited
            _ -> prohibited

        helloMsg :: SenderPublicKey -> ByteString -> m ()
@@ -456,7 +526,7 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
              void $ verifyMessage (Just verifyKey) msgBody
              withStore $ \st -> setRcvQueueActive st rq verifyKey
              case cType of
-                SCDuplex -> connected
+                SCDuplex -> notifyConnected c connId
                _ -> pure ()

        replyMsg :: SMPQueueInfo -> m ()
@@ -464,21 +534,14 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
          logServer "<--" c srv rId "MSG <REPLY>"
          case cType of
            SCRcv -> do
-              (sq, senderKey, verifyKey) <- newSendQueue qInfo
+              AcceptedConfirmation {ownConnInfo} <- withStore (`getAcceptedConfirmation` connId)
+              (sq, senderKey, verifyKey) <- newSndQueue qInfo
              withStore $ \st -> upgradeRcvConnToDuplex st connId sq
-              connectToSendQueue c sq senderKey verifyKey
-              connected
+              confirmQueue c sq senderKey ownConnInfo
+              withStore (`removeConfirmations` connId)
+              activateQueueInitiating c connId sq verifyKey onlineInterval
            _ -> prohibited

-        connected :: m ()
-        connected = do
-          withStore (`getConnInvitation` connId) >>= \case
-            Just (Invitation {invId, externalIntroId}, DuplexConnection _ _ sq) -> do
-              withStore $ \st -> setInvitationStatus st invId InvCon
-              sendControlMessage c sq $ A_CON externalIntroId
-            _ -> pure ()
-          notify CON
-
        introMsg :: IntroId -> ConnInfo -> m ()
        introMsg introId reInfo = do
          logServer "<--" c srv rId "MSG <INTRO>"
@@ -557,16 +620,45 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
          | internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash
          | otherwise = MsgError MsgDuplicate -- this case is not possible

-connectToSendQueue :: AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> VerificationKey -> m ()
-connectToSendQueue c sq senderKey verifyKey = do
-  sendConfirmation c sq senderKey
+confirmQueue :: AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> ConnInfo -> m ()
+confirmQueue c sq senderKey cInfo = do
+  sendConfirmation c sq senderKey cInfo
  withStore $ \st -> setSndQueueStatus st sq Confirmed
-  sendHello c sq verifyKey
-  withStore $ \st -> setSndQueueStatus st sq Active

-newSendQueue ::
+activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
+activateQueueInitiating c connId sq verifyKey retryInterval =
+  activateQueue c connId sq verifyKey retryInterval $ notifyConnected c connId
+
+activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m () -> m ()
+activateQueue c connId sq verifyKey retryInterval afterActivation =
+  getActivation c connId >>= \case
+    Nothing -> async runActivation >>= addActivation c connId
+    Just _ -> pure ()
+  where
+    runActivation :: m ()
+    runActivation = do
+      sendHello c sq verifyKey retryInterval
+      withStore $ \st -> setSndQueueStatus st sq Active
+      removeActivation c connId
+      removeVerificationKey
+      afterActivation
+    removeVerificationKey :: m ()
+    removeVerificationKey =
+      let safeSignKey = C.removePublicKey $ signKey sq
+       in withStore $ \st -> updateSignKey st sq safeSignKey
+
+notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m ()
+notifyConnected c connId = do
+  withStore (`getConnInvitation` connId) >>= \case
+    Just (Invitation {invId, externalIntroId}, DuplexConnection _ _ sq) -> do
+      withStore $ \st -> setInvitationStatus st invId InvCon
+      sendControlMessage c sq $ A_CON externalIntroId
+    _ -> pure ()
+  atomically $ writeTBQueue (subQ c) ("", connId, CON)
+
+newSndQueue ::
  (MonadUnliftIO m, MonadReader Env m) => SMPQueueInfo -> m (SndQueue, SenderPublicKey, VerificationKey)
-newSendQueue (SMPQueueInfo smpServer senderId encryptKey) = do
+newSndQueue (SMPQueueInfo smpServer senderId encryptKey) = do
  size <- asks $ rsaKeySize . config
  (senderKey, sndPrivateKey) <- liftIO $ C.generateKeyPair size
  (verifyKey, signKey) <- liftIO $ C.generateKeyPair size
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -12,11 +12,12 @@ module Simplex.Messaging.Agent.Client
    newAgentClient,
    AgentMonad,
    getSMPServerClient,
-    closeSMPServerClients,
-    newReceiveQueue,
+    closeAgentClient,
+    newRcvQueue,
    subscribeQueue,
    addSubscription,
    sendConfirmation,
+    RetryInterval (..),
    sendHello,
    secureQueue,
    sendAgentMessage,
@@ -28,10 +29,13 @@ module Simplex.Messaging.Agent.Client
    logServer,
    removeSubscription,
    cryptoError,
+    addActivation,
+    getActivation,
+    removeActivation,
  )
 where

-import Control.Concurrent.Async (Async)
+import Control.Concurrent.Async (Async, uninterruptibleCancel)
 import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad.Except
@@ -66,6 +70,7 @@ data AgentClient = AgentClient
    smpClients :: TVar (Map SMPServer SMPClient),
    subscrSrvrs :: TVar (Map SMPServer (Set ConnId)),
    subscrConns :: TVar (Map ConnId SMPServer),
+    activations :: TVar (Map ConnId (Async ())), -- activations of send queues in progress
    clientId :: Int,
    agentEnv :: Env,
    smpSubscriber :: Async ()
@@ -80,8 +85,9 @@ newAgentClient agentEnv = do
  smpClients <- newTVar M.empty
  subscrSrvrs <- newTVar M.empty
  subscrConns <- newTVar M.empty
+  activations <- newTVar M.empty
  clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
-  return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, clientId, agentEnv, smpSubscriber = undefined}
+  return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, activations, clientId, agentEnv, smpSubscriber = undefined}

 -- | Agent monad with MonadReader Env and MonadError AgentErrorType
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)
@@ -126,8 +132,16 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
    notifySub :: ConnId -> IO ()
    notifySub connId = atomically $ writeTBQueue (subQ c) ("", connId, END)

-closeSMPServerClients :: MonadUnliftIO m => AgentClient -> m ()
-closeSMPServerClients c = liftIO $ readTVarIO (smpClients c) >>= mapM_ closeSMPClient
+closeAgentClient :: MonadUnliftIO m => AgentClient -> m ()
+closeAgentClient c = liftIO $ do
+  closeSMPServerClients c
+  cancelActivations c
+
+closeSMPServerClients :: AgentClient -> IO ()
+closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ closeSMPClient
+
+cancelActivations :: AgentClient -> IO ()
+cancelActivations c = readTVarIO (activations c) >>= mapM_ uninterruptibleCancel

 withSMP_ :: forall a m. AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> m a) -> m a
 withSMP_ c srv action =
@@ -164,8 +178,8 @@ smpClientError = \case
  SMPTransportError e -> BROKER $ TRANSPORT e
  e -> INTERNAL $ show e

-newReceiveQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueInfo)
-newReceiveQueue c srv = do
+newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueInfo)
+newRcvQueue c srv = do
  size <- asks $ rsaKeySize . config
  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateKeyPair size
  logServer "-->" c srv "" "NEW"
@@ -178,7 +192,6 @@ newReceiveQueue c srv = do
            rcvId,
            rcvPrivateKey,
            sndId = Just sId,
-            sndKey = Nothing,
            decryptKey,
            verifyKey = Nothing,
            status = New
@@ -213,6 +226,15 @@ removeSubscription AgentClient {subscrConns, subscrSrvrs} connId = atomically $
      let cs' = S.delete connId cs
       in if S.null cs' then Nothing else Just cs'

+addActivation :: MonadUnliftIO m => AgentClient -> ConnId -> Async () -> m ()
+addActivation c connId a = atomically . modifyTVar (activations c) $ M.insert connId a
+
+getActivation :: MonadUnliftIO m => AgentClient -> ConnId -> m (Maybe (Async ()))
+getActivation c connId = M.lookup connId <$> readTVarIO (activations c)
+
+removeActivation :: MonadUnliftIO m => AgentClient -> ConnId -> m ()
+removeActivation c connId = atomically . modifyTVar (activations c) $ M.delete connId
+
 logServer :: AgentMonad m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
 logServer dir AgentClient {clientId} srv qId cmdStr =
  logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
@@ -223,20 +245,26 @@ showServer srv = B.pack $ host srv <> maybe "" (":" <>) (port srv)
 logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs

-sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> m ()
-sendConfirmation c sq@SndQueue {server, sndId} senderKey =
+sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> ConnInfo -> m ()
+sendConfirmation c sq@SndQueue {server, sndId} senderKey cInfo =
  withLogSMP_ c server sndId "SEND <KEY>" $ \smp -> do
    msg <- mkConfirmation smp
    liftSMP $ sendSMPMessage smp Nothing sndId msg
  where
    mkConfirmation :: SMPClient -> m MsgBody
-    mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey
+    mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey cInfo

-sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> m ()
-sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey =
+data RetryInterval = RetryInterval
+  { initialInterval :: Int,
+    increaseAfter :: Int,
+    maxInterval :: Int
+  }
+
+sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> RetryInterval -> m ()
+sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey RetryInterval {initialInterval, increaseAfter, maxInterval} =
  withLogSMP_ c server sndId "SEND <HELLO> (retrying)" $ \smp -> do
    msg <- mkHello smp $ AckMode On
-    liftSMP $ send 8 100000 msg smp
+    liftSMP $ send 0 initialInterval msg smp
  where
    mkHello :: SMPClient -> AckMode -> m ByteString
    mkHello smp ackMode = do
@@ -250,12 +278,15 @@ sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey =
          }

    send :: Int -> Int -> ByteString -> SMPClient -> ExceptT SMPClientError IO ()
-    send 0 _ _ _ = throwE $ SMPServerError AUTH
-    send retry delay msg smp =
+    send elapsedTime delay msg smp =
      sendSMPMessage smp (Just sndPrivateKey) sndId msg `catchE` \case
        SMPServerError AUTH -> do
          threadDelay delay
-          send (retry - 1) (delay * 3 `div` 2) msg smp
+          let newDelay =
+                if elapsedTime < increaseAfter || delay == maxInterval
+                  then delay
+                  else min (delay * 3 `div` 2) maxInterval
+          send (elapsedTime + delay) newDelay msg smp
        e -> throwE e

 secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -46,9 +46,9 @@ module Simplex.Messaging.Agent.Protocol
    ATransmissionOrError,
    ARawTransmission,
    ConnId,
+    ConfirmationId,
    IntroId,
    InvitationId,
-    ReplyMode (..),
    AckMode (..),
    OnOff (..),
    MsgIntegrity (..),
@@ -155,10 +155,13 @@ type ConnInfo = ByteString
 data ACommand (p :: AParty) where
  NEW :: ACommand Client -- response INV
  INV :: SMPQueueInfo -> ACommand Agent
-  JOIN :: SMPQueueInfo -> ReplyMode -> ACommand Client -- response OK
+  JOIN :: SMPQueueInfo -> ConnInfo -> ACommand Client -- response OK
+  CONF :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
+  LET :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
  INTRO :: ConnId -> ConnInfo -> ACommand Client
  REQ :: InvitationId -> ConnInfo -> ACommand Agent
  ACPT :: InvitationId -> ConnInfo -> ACommand Client
+  INFO :: ConnInfo -> ACommand Agent
  CON :: ACommand Agent -- notification that connection is established
  ICON :: ConnId -> ACommand Agent
  SUB :: ACommand Client
@@ -192,7 +195,12 @@ data MsgMeta = MsgMeta
 data SMPMessage
  = -- | SMP confirmation
    -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message SMP protocol>)
-    SMPConfirmation SenderPublicKey
+    SMPConfirmation
+      { -- | sender's public key to use for authentication of sender's commands at the recepient's server
+        senderKey :: SenderPublicKey,
+        -- | sender's information to be associated with the connection, e.g. sender's profile information
+        connInfo :: ConnInfo
+      }
  | -- | Agent message header and envelope for client messages
    -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents SMP agent protocol>)
    SMPMessage
@@ -232,12 +240,10 @@ parseSMPMessage :: ByteString -> Either AgentErrorType SMPMessage
 parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
  where
    smpMessageP :: Parser SMPMessage
-    smpMessageP =
-      smpConfirmationP <* A.endOfLine
-        <|> A.endOfLine *> smpClientMessageP
+    smpMessageP = A.endOfLine *> smpClientMessageP <|> smpConfirmationP

    smpConfirmationP :: Parser SMPMessage
-    smpConfirmationP = SMPConfirmation <$> ("KEY " *> C.pubKeyP <* A.endOfLine)
+    smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.pubKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine)

    smpClientMessageP :: Parser SMPMessage
    smpClientMessageP =
@@ -252,7 +258,7 @@ parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
 -- | Serialize SMP message.
 serializeSMPMessage :: SMPMessage -> ByteString
 serializeSMPMessage = \case
-  SMPConfirmation sKey -> smpMessage ("KEY " <> C.serializePubKey sKey) "" ""
+  SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializePubKey sKey) "" (serializeBinary cInfo) <> "\n"
  SMPMessage {senderMsgId, senderTimestamp, previousMsgHash, agentMessage} ->
    let header = messageHeader senderMsgId senderTimestamp previousMsgHash
        body = serializeAgentMessage agentMessage
@@ -274,15 +280,12 @@ agentMessageP =
  where
    hello = HELLO <$> C.pubKeyP <*> ackMode
    reply = REPLY <$> smpQueueInfoP
-    a_msg = A_MSG <$> binaryBody
-    a_intro = A_INTRO <$> A.takeTill (== ' ') <* A.space <*> binaryBody
+    a_msg = A_MSG <$> binaryBodyP <* A.endOfLine
+    a_intro = A_INTRO <$> A.takeTill (== ' ') <* A.space <*> binaryBodyP <* A.endOfLine
    a_inv = invP A_INV
    a_req = invP A_REQ
    a_con = A_CON <$> A.takeTill wordEnd
-    invP f = f <$> A.takeTill (== ' ') <* A.space <*> smpQueueInfoP <* A.space <*> binaryBody
-    binaryBody = do
-      size :: Int <- A.decimal <* A.endOfLine
-      A.take size <* A.endOfLine
+    invP f = f <$> A.takeTill (== ' ') <* A.space <*> smpQueueInfoP <* A.space <*> binaryBodyP <* A.endOfLine
    ackMode = AckMode <$> (" NO_ACK" $> Off <|> pure On)

 -- | SMP queue information parser.
@@ -302,14 +305,14 @@ serializeAgentMessage :: AMessage -> ByteString
 serializeAgentMessage = \case
  HELLO verifyKey ackMode -> "HELLO " <> C.serializePubKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
  REPLY qInfo -> "REPLY " <> serializeSmpQueueInfo qInfo
-  A_MSG body -> "MSG " <> serializeMsg body <> "\n"
-  A_INTRO introId cInfo -> "INTRO " <> introId <> " " <> serializeMsg cInfo <> "\n"
+  A_MSG body -> "MSG " <> serializeBinary body <> "\n"
+  A_INTRO introId cInfo -> "INTRO " <> introId <> " " <> serializeBinary cInfo <> "\n"
  A_INV introId qInfo cInfo -> "INV " <> serializeInv introId qInfo cInfo
  A_REQ introId qInfo cInfo -> "REQ " <> serializeInv introId qInfo cInfo
  A_CON introId -> "CON " <> introId
  where
    serializeInv introId qInfo cInfo =
-      B.intercalate " " [introId, serializeSmpQueueInfo qInfo, serializeMsg cInfo] <> "\n"
+      B.intercalate " " [introId, serializeSmpQueueInfo qInfo, serializeBinary cInfo] <> "\n"

 -- | Serialize SMP queue information that is sent out-of-band.
 serializeSmpQueueInfo :: SMPQueueInfo -> ByteString
@@ -335,6 +338,8 @@ instance IsString SMPServer where
 -- | SMP agent connection alias.
 type ConnId = ByteString

+type ConfirmationId = ByteString
+
 type IntroId = ByteString

 type InvitationId = ByteString
@@ -351,9 +356,6 @@ newtype AckMode = AckMode OnOff deriving (Eq, Show)
 data SMPQueueInfo = SMPQueueInfo SMPServer SMP.SenderId EncryptionKey
  deriving (Eq, Show)

-- | Connection reply mode (used in JOIN command).
-newtype ReplyMode = ReplyMode OnOff deriving (Eq, Show)
-
 -- | Public key used to E2E encrypt SMP messages.
 type EncryptionKey = C.PublicKey

@@ -361,7 +363,7 @@ type EncryptionKey = C.PublicKey
 type DecryptionKey = C.SafePrivateKey

 -- | Private key used to sign SMP commands
-type SignatureKey = C.SafePrivateKey
+type SignatureKey = C.APrivateKey

 -- | Public key used by SMP server to authorize (verify) SMP commands.
 type VerificationKey = C.PublicKey
@@ -476,9 +478,12 @@ commandP =
  "NEW" $> ACmd SClient NEW
    <|> "INV " *> invResp
    <|> "JOIN " *> joinCmd
+    <|> "CONF " *> confCmd
+    <|> "LET " *> letCmd
    <|> "INTRO " *> introCmd
    <|> "REQ " *> reqCmd
    <|> "ACPT " *> acptCmd
+    <|> "INFO " *> infoCmd
    <|> "SUB" $> ACmd SClient SUB
    <|> "END" $> ACmd SAgent END
    <|> "SEND " *> sendCmd
@@ -492,10 +497,13 @@ commandP =
    <|> "OK" $> ACmd SAgent OK
  where
    invResp = ACmd SAgent . INV <$> smpQueueInfoP
-    joinCmd = ACmd SClient <$> (JOIN <$> smpQueueInfoP <*> replyMode)
+    joinCmd = ACmd SClient <$> (JOIN <$> smpQueueInfoP <* A.space <*> A.takeByteString)
+    confCmd = ACmd SAgent <$> (CONF <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    letCmd = ACmd SClient <$> (LET <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
    introCmd = ACmd SClient <$> introP INTRO
    reqCmd = ACmd SAgent <$> introP REQ
    acptCmd = ACmd SClient <$> introP ACPT
+    infoCmd = ACmd SAgent . INFO <$> A.takeByteString
    sendCmd = ACmd SClient . SEND <$> A.takeByteString
    sentResp = ACmd SAgent . SENT <$> A.decimal
    iconMsg = ACmd SAgent . ICON <$> A.takeTill wordEnd
@@ -507,7 +515,6 @@ commandP =
      sender <- " S=" *> partyMeta A.decimal
      pure MsgMeta {integrity, recipient, broker, sender}
    introP f = f <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString
-    replyMode = ReplyMode <$> (" NO_REPLY" $> Off <|> pure On)
    partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P
    agentError = ACmd SAgent . ERR <$> agentErrorTypeP

@@ -529,16 +536,19 @@ serializeCommand :: ACommand p -> ByteString
 serializeCommand = \case
  NEW -> "NEW"
  INV qInfo -> "INV " <> serializeSmpQueueInfo qInfo
-  JOIN qInfo rMode -> "JOIN " <> serializeSmpQueueInfo qInfo <> replyMode rMode
-  INTRO connId cInfo -> "INTRO " <> connId <> " " <> serializeMsg cInfo
-  REQ invId cInfo -> "REQ " <> invId <> " " <> serializeMsg cInfo
-  ACPT invId cInfo -> "ACPT " <> invId <> " " <> serializeMsg cInfo
+  JOIN qInfo cInfo -> "JOIN " <> serializeSmpQueueInfo qInfo <> " " <> serializeBinary cInfo
+  CONF confId cInfo -> "CONF " <> confId <> " " <> serializeBinary cInfo
+  LET confId cInfo -> "LET " <> confId <> " " <> serializeBinary cInfo
+  INTRO connId cInfo -> "INTRO " <> connId <> " " <> serializeBinary cInfo
+  REQ invId cInfo -> "REQ " <> invId <> " " <> serializeBinary cInfo
+  ACPT invId cInfo -> "ACPT " <> invId <> " " <> serializeBinary cInfo
+  INFO cInfo -> "INFO " <> serializeBinary cInfo
  SUB -> "SUB"
  END -> "END"
-  SEND msgBody -> "SEND " <> serializeMsg msgBody
+  SEND msgBody -> "SEND " <> serializeBinary msgBody
  SENT mId -> "SENT " <> bshow mId
  MSG msgMeta msgBody ->
-    "MSG " <> serializeMsgMeta msgMeta <> " " <> serializeMsg msgBody
+    "MSG " <> serializeMsgMeta msgMeta <> " " <> serializeBinary msgBody
  OFF -> "OFF"
  DEL -> "DEL"
  CON -> "CON"
@@ -546,10 +556,6 @@ serializeCommand = \case
  ERR e -> "ERR " <> serializeAgentError e
  OK -> "OK"
  where
-    replyMode :: ReplyMode -> ByteString
-    replyMode = \case
-      ReplyMode Off -> " NO_REPLY"
-      ReplyMode On -> ""
    showTs :: UTCTime -> ByteString
    showTs = B.pack . formatISO8601Millis
    serializeMsgMeta :: MsgMeta -> ByteString
@@ -590,8 +596,13 @@ serializeAgentError = \case
  BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
  e -> bshow e

-serializeMsg :: ByteString -> ByteString
-serializeMsg body = bshow (B.length body) <> "\n" <> body
+binaryBodyP :: Parser ByteString
+binaryBodyP = do
+  size :: Int <- A.decimal <* A.endOfLine
+  A.take size
+
+serializeBinary :: ByteString -> ByteString
+serializeBinary body = bshow (B.length body) <> "\n" <> body

 -- | Send raw (unparsed) SMP agent protocol transmission to TCP connection.
 tPutRaw :: Transport c => c -> ARawTransmission -> IO ()
@@ -639,17 +650,21 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody

    cmdWithMsgBody :: ACommand p -> m (Either AgentErrorType (ACommand p))
    cmdWithMsgBody = \case
-      SEND body -> SEND <$$> getMsgBody body
-      MSG msgMeta body -> MSG msgMeta <$$> getMsgBody body
-      INTRO introId cInfo -> INTRO introId <$$> getMsgBody cInfo
-      REQ introId cInfo -> REQ introId <$$> getMsgBody cInfo
-      ACPT introId cInfo -> ACPT introId <$$> getMsgBody cInfo
+      SEND body -> SEND <$$> getBody body
+      MSG msgMeta body -> MSG msgMeta <$$> getBody body
+      INTRO introId cInfo -> INTRO introId <$$> getBody cInfo
+      REQ introId cInfo -> REQ introId <$$> getBody cInfo
+      ACPT introId cInfo -> ACPT introId <$$> getBody cInfo
+      JOIN qInfo cInfo -> JOIN qInfo <$$> getBody cInfo
+      CONF confId cInfo -> CONF confId <$$> getBody cInfo
+      LET confId cInfo -> LET confId <$$> getBody cInfo
+      INFO cInfo -> INFO <$$> getBody cInfo
      cmd -> pure $ Right cmd

    -- TODO refactor with server
-    getMsgBody :: MsgBody -> m (Either AgentErrorType MsgBody)
-    getMsgBody msgBody =
-      case B.unpack msgBody of
+    getBody :: ByteString -> m (Either AgentErrorType ByteString)
+    getBody binary =
+      case B.unpack binary of
        ':' : body -> return . Right $ B.pack body
        str -> case readMaybe str :: Maybe Int of
          Just size -> liftIO $ do
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -46,14 +46,19 @@ class Monad m => MonadAgentStore s m where
  setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m ()
  setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m ()
  setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m ()
+  updateSignKey :: s -> SndQueue -> SignatureKey -> m ()
+
+  -- Confirmations
+  createConfirmation :: s -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
+  acceptConfirmation :: s -> ConfirmationId -> ConnInfo -> m AcceptedConfirmation
+  getAcceptedConfirmation :: s -> ConnId -> m AcceptedConfirmation
+  removeConfirmations :: s -> ConnId -> m ()

  -- Msg management
  updateRcvIds :: s -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
  createRcvMsg :: s -> ConnId -> RcvMsgData -> m ()
-
  updateSndIds :: s -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash)
  createSndMsg :: s -> ConnId -> SndMsgData -> m ()
-
  getMsg :: s -> ConnId -> InternalId -> m Msg

  -- Introductions
@@ -76,7 +81,6 @@ data RcvQueue = RcvQueue
    rcvId :: SMP.RecipientId,
    rcvPrivateKey :: RecipientPrivateKey,
    sndId :: Maybe SMP.SenderId,
-    sndKey :: Maybe SenderPublicKey,
    decryptKey :: DecryptionKey,
    verifyKey :: Maybe VerificationKey,
    status :: QueueStatus
@@ -152,6 +156,22 @@ deriving instance Show SomeConn
 data ConnData = ConnData {connId :: ConnId, viaInv :: Maybe InvitationId, connLevel :: Int}
  deriving (Eq, Show)

+-- * Confirmation types
+
+data NewConfirmation = NewConfirmation
+  { connId :: ConnId,
+    senderKey :: SenderPublicKey,
+    senderConnInfo :: ConnInfo
+  }
+
+data AcceptedConfirmation = AcceptedConfirmation
+  { confirmationId :: ConfirmationId,
+    connId :: ConnId,
+    senderKey :: SenderPublicKey,
+    senderConnInfo :: ConnInfo,
+    ownConnInfo :: ConnInfo
+  }
+
 -- * Message integrity validation types

 type MsgHash = ByteString
@@ -372,6 +392,8 @@ data StoreError
  | -- | Wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa.
    -- 'upgradeRcvConnToDuplex' and 'upgradeSndConnToDuplex' do not allow duplex connections - they would also return this error.
    SEBadConnType ConnType
+  | -- | Confirmation not found.
+    SEConfirmationNotFound
  | -- | Introduction ID not found.
    SEIntroNotFound
  | -- | Invitation ID not found.
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -184,7 +184,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto

  getAllConnIds :: SQLiteStore -> m [ConnId]
  getAllConnIds st =
-    liftIO . withConnection st $ \db -> do
+    liftIO . withConnection st $ \db ->
      concat <$> (DB.query_ db "SELECT conn_alias FROM connections;" :: IO [[ConnId]])

  getRcvConn :: SQLiteStore -> SMPServer -> SMP.RecipientId -> m SomeConn
@@ -278,6 +278,86 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
        |]
        [":status" := status, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]

+  updateSignKey :: SQLiteStore -> SndQueue -> SignatureKey -> m ()
+  updateSignKey st SndQueue {sndId, server = SMPServer {host, port}} signatureKey =
+    liftIO . withConnection st $ \db ->
+      DB.executeNamed
+        db
+        [sql|
+          UPDATE snd_queues
+          SET sign_key = :sign_key
+          WHERE host = :host AND port = :port AND snd_id = :snd_id;
+        |]
+        [":sign_key" := signatureKey, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]
+
+  createConfirmation :: SQLiteStore -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
+  createConfirmation st gVar NewConfirmation {connId, senderKey, senderConnInfo} =
+    liftIOEither . withTransaction st $ \db ->
+      createWithRandomId gVar $ \confirmationId ->
+        DB.execute
+          db
+          [sql|
+            INSERT INTO conn_confirmations
+            (confirmation_id, conn_alias, sender_key, sender_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
+          |]
+          (confirmationId, connId, senderKey, senderConnInfo)
+
+  acceptConfirmation :: SQLiteStore -> ConfirmationId -> ConnInfo -> m AcceptedConfirmation
+  acceptConfirmation st confirmationId ownConnInfo =
+    liftIOEither . withTransaction st $ \db -> do
+      DB.executeNamed
+        db
+        [sql|
+          UPDATE conn_confirmations
+          SET accepted = 1,
+              own_conn_info = :own_conn_info
+          WHERE confirmation_id = :confirmation_id;
+        |]
+        [ ":own_conn_info" := ownConnInfo,
+          ":confirmation_id" := confirmationId
+        ]
+      confirmation
+        <$> DB.query
+          db
+          [sql|
+            SELECT conn_alias, sender_key, sender_conn_info
+            FROM conn_confirmations
+            WHERE confirmation_id = ?;
+          |]
+          (Only confirmationId)
+    where
+      confirmation [(connId, senderKey, senderConnInfo)] =
+        Right $ AcceptedConfirmation {confirmationId, connId, senderKey, senderConnInfo, ownConnInfo}
+      confirmation _ = Left SEConfirmationNotFound
+
+  getAcceptedConfirmation :: SQLiteStore -> ConnId -> m AcceptedConfirmation
+  getAcceptedConfirmation st connId =
+    liftIOEither . withConnection st $ \db ->
+      confirmation
+        <$> DB.query
+          db
+          [sql|
+            SELECT confirmation_id, sender_key, sender_conn_info, own_conn_info
+            FROM conn_confirmations
+            WHERE conn_alias = ? AND accepted = 1;
+          |]
+          (Only connId)
+    where
+      confirmation [(confirmationId, senderKey, senderConnInfo, ownConnInfo)] =
+        Right $ AcceptedConfirmation {confirmationId, connId, senderKey, senderConnInfo, ownConnInfo}
+      confirmation _ = Left SEConfirmationNotFound
+
+  removeConfirmations :: SQLiteStore -> ConnId -> m ()
+  removeConfirmations st connId =
+    liftIO . withConnection st $ \db ->
+      DB.executeNamed
+        db
+        [sql|
+          DELETE FROM conn_confirmations
+          WHERE conn_alias = :conn_alias;
+        |]
+        [":conn_alias" := connId]
+
  updateRcvIds :: SQLiteStore -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
  updateRcvIds st connId =
    liftIO . withTransaction st $ \db -> do
@@ -548,9 +628,9 @@ insertRcvQueue_ dbConn connId RcvQueue {..} = do
    dbConn
    [sql|
      INSERT INTO rcv_queues
-        ( host, port, rcv_id, conn_alias, rcv_private_key, snd_id, snd_key, decrypt_key, verify_key, status)
+        ( host, port, rcv_id, conn_alias, rcv_private_key, snd_id, decrypt_key, verify_key, status)
      VALUES
-        (:host,:port,:rcv_id,:conn_alias,:rcv_private_key,:snd_id,:snd_key,:decrypt_key,:verify_key,:status);
+        (:host,:port,:rcv_id,:conn_alias,:rcv_private_key,:snd_id,:decrypt_key,:verify_key,:status);
    |]
    [ ":host" := host server,
      ":port" := port_,
@@ -558,7 +638,6 @@ insertRcvQueue_ dbConn connId RcvQueue {..} = do
      ":conn_alias" := connId,
      ":rcv_private_key" := rcvPrivateKey,
      ":snd_id" := sndId,
-      ":snd_key" := sndKey,
      ":decrypt_key" := decryptKey,
      ":verify_key" := verifyKey,
      ":status" := status
@@ -655,16 +734,16 @@ getRcvQueueByConnAlias_ dbConn connId =
      dbConn
      [sql|
        SELECT s.key_hash, q.host, q.port, q.rcv_id, q.rcv_private_key,
-          q.snd_id, q.snd_key, q.decrypt_key, q.verify_key, q.status
+          q.snd_id, q.decrypt_key, q.verify_key, q.status
        FROM rcv_queues q
        INNER JOIN servers s ON q.host = s.host AND q.port = s.port
        WHERE q.conn_alias = ?;
      |]
      (Only connId)
  where
-    rcvQueue [(keyHash, host, port, rcvId, rcvPrivateKey, sndId, sndKey, decryptKey, verifyKey, status)] =
+    rcvQueue [(keyHash, host, port, rcvId, rcvPrivateKey, sndId, decryptKey, verifyKey, status)] =
      let srv = SMPServer host (deserializePort_ port) keyHash
-       in Just $ RcvQueue srv rcvId rcvPrivateKey sndId sndKey decryptKey verifyKey status
+       in Just $ RcvQueue srv rcvId rcvPrivateKey sndId decryptKey verifyKey status
    rcvQueue _ = Nothing

 getSndQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe SndQueue)
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -20,18 +20,20 @@
 -- <https://hackage.haskell.org/package/cryptonite cryptonite package>.
 module Simplex.Messaging.Crypto
  ( -- * RSA keys
-    PrivateKey (rsaPrivateKey),
-    SafePrivateKey, -- constructor is not exported
+    PrivateKey (rsaPrivateKey, publicKey),
+    SafePrivateKey (..), -- constructor is not exported
    FullPrivateKey (..),
+    APrivateKey (..),
    PublicKey (..),
    SafeKeyPair,
    FullKeyPair,
    KeyHash (..),
    generateKeyPair,
-    publicKey,
+    publicKey',
    publicKeySize,
    validKeySize,
    safePrivateKey,
+    removePublicKey,

    -- * E2E hybrid encryption scheme
    encrypt,
@@ -121,6 +123,9 @@ newtype SafePrivateKey = SafePrivateKey {unPrivateKey :: R.PrivateKey} deriving
 -- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (with PublicKey inside).
 newtype FullPrivateKey = FullPrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show)

+-- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (PublicKey may be inside).
+newtype APrivateKey = APrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show)
+
 -- | Type-class used for both private key types: SafePrivateKey and FullPrivateKey.
 class PrivateKey k where
  -- unwraps 'Crypto.PubKey.RSA.PrivateKey'
@@ -132,16 +137,36 @@ class PrivateKey k where
  -- smart constructor removing public key from SafePrivateKey but keeping it in FullPrivateKey
  mkPrivateKey :: R.PrivateKey -> k

+  -- extracts public key from private key
+  publicKey :: k -> Maybe PublicKey
+
+-- | Remove public key exponent from APrivateKey.
+removePublicKey :: APrivateKey -> APrivateKey
+removePublicKey (APrivateKey R.PrivateKey {private_pub = k, private_d}) =
+  APrivateKey $ unPrivateKey (safePrivateKey (R.public_size k, R.public_n k, private_d) :: SafePrivateKey)
+
 instance PrivateKey SafePrivateKey where
  rsaPrivateKey = unPrivateKey
  _privateKey = SafePrivateKey
  mkPrivateKey R.PrivateKey {private_pub = k, private_d} =
    safePrivateKey (R.public_size k, R.public_n k, private_d)
+  publicKey _ = Nothing

 instance PrivateKey FullPrivateKey where
  rsaPrivateKey = unPrivateKey
  _privateKey = FullPrivateKey
  mkPrivateKey = FullPrivateKey
+  publicKey = Just . PublicKey . R.private_pub . rsaPrivateKey
+
+instance PrivateKey APrivateKey where
+  rsaPrivateKey = unPrivateKey
+  _privateKey = APrivateKey
+  mkPrivateKey = APrivateKey
+  publicKey pk =
+    let k = R.private_pub $ rsaPrivateKey pk
+     in if R.public_e k == 0
+          then Nothing
+          else Just $ PublicKey k

 instance IsString FullPrivateKey where
  fromString = parseString (decode >=> decodePrivKey)
@@ -151,10 +176,14 @@ instance IsString PublicKey where

 instance ToField SafePrivateKey where toField = toField . encodePrivKey

+instance ToField APrivateKey where toField = toField . encodePrivKey
+
 instance ToField PublicKey where toField = toField . encodePubKey

 instance FromField SafePrivateKey where fromField = blobFieldParser binaryPrivKeyP

+instance FromField APrivateKey where fromField = blobFieldParser binaryPrivKeyP
+
 instance FromField PublicKey where fromField = blobFieldParser binaryPubKeyP

 -- | Tuple of RSA 'PublicKey' and 'PrivateKey'.
@@ -217,8 +246,8 @@ generateKeyPair size = loop
 privateKeySize :: PrivateKey k => k -> Int
 privateKeySize = R.public_size . R.private_pub . rsaPrivateKey

-publicKey :: FullPrivateKey -> PublicKey
-publicKey = PublicKey . R.private_pub . rsaPrivateKey
+publicKey' :: FullPrivateKey -> PublicKey
+publicKey' = PublicKey . R.private_pub . rsaPrivateKey

 publicKeySize :: PublicKey -> Int
 publicKeySize = R.public_size . rsaPublicKey
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -86,7 +86,7 @@ newEnv config = do
  idsDrg <- drgNew >>= newTVarIO
  s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
  let pk = serverPrivateKey config
-      serverKeyPair = (C.publicKey pk, pk)
+      serverKeyPair = (C.publicKey' pk, pk)
  return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair, storeLog = s'}
  where
    restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)
--- a/tests/AgentTests.hs
+++ b/tests/AgentTests.hs
@@ -107,11 +107,14 @@ testDuplexConnection :: Transport c => TProxy c -> c -> c -> IO ()
 testDuplexConnection _ alice bob = do
  ("1", "bob", Right (INV qInfo)) <- alice #: ("1", "bob", "NEW")
  let qInfo' = serializeSmpQueueInfo qInfo
-  bob #: ("11", "alice", "JOIN " <> qInfo') #> ("11", "alice", OK)
+  bob #: ("11", "alice", "JOIN " <> qInfo' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
+  ("", "bob", Right (CONF confId "bob's connInfo")) <- (alice <#:)
+  alice #: ("2", "bob", "LET " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
+  bob <# ("", "alice", INFO "alice's connInfo")
  bob <# ("", "alice", CON)
  alice <# ("", "bob", CON)
-  alice #: ("2", "bob", "SEND :hello") #> ("2", "bob", SENT 1)
-  alice #: ("3", "bob", "SEND :how are you?") #> ("3", "bob", SENT 2)
+  alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", SENT 1)
+  alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", SENT 2)
  bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
  bob <#= \case ("", "alice", Msg "how are you?") -> True; _ -> False
  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", SENT 3)
@@ -129,8 +132,11 @@ testAgentClient = do
  bob <- getSMPAgentClient cfg {dbFile = testDB2}
  Right () <- runExceptT $ do
    (bobId, qInfo) <- createConnection alice Nothing
-    aliceId <- joinConnection bob Nothing qInfo
+    aliceId <- joinConnection bob Nothing qInfo "bob's connInfo"
+    ("", _, CONF confId "bob's connInfo") <- get alice
+    allowConnection alice bobId confId "alice's connInfo"
    get alice ##> ("", bobId, CON)
+    get bob ##> ("", aliceId, INFO "alice's connInfo")
    get bob ##> ("", aliceId, CON)
    InternalId 1 <- sendMessage alice bobId "hello"
    InternalId 2 <- sendMessage alice bobId "how are you?"
@@ -163,7 +169,11 @@ testDuplexConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
 testDuplexConnRandomIds _ alice bob = do
  ("1", bobConn, Right (INV qInfo)) <- alice #: ("1", "", "NEW")
  let qInfo' = serializeSmpQueueInfo qInfo
-  ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> qInfo')
+  ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> qInfo' <> " 14\nbob's connInfo")
+  ("", bobConn', Right (CONF confId "bob's connInfo")) <- (alice <#:)
+  bobConn' `shouldBe` bobConn
+  alice #: ("2", bobConn, "LET " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
+  bob <# ("", aliceConn, INFO "alice's connInfo")
  bob <# ("", aliceConn, CON)
  alice <# ("", bobConn, CON)
  alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, SENT 1)
@@ -209,11 +219,12 @@ testIntroduction _ alice bob tom = do
  ("", "alice", Right (REQ invId1 "meet tom")) <- (bob <#:)
  bob #: ("2", "tom_via_alice", "ACPT " <> invId1 <> " 7\nI'm bob") #> ("2", "tom_via_alice", OK)
  ("", "alice", Right (REQ invId2 "I'm bob")) <- (tom <#:)
-  -- TODO info "tom here" is not used, either JOIN command also should have eInfo parameter
-  -- or this should be another command, not ACPT
  tom #: ("3", "bob_via_alice", "ACPT " <> invId2 <> " 8\ntom here") #> ("3", "bob_via_alice", OK)
-  tom <# ("", "bob_via_alice", CON)
+  ("", "tom_via_alice", Right (CONF confId "tom here")) <- (bob <#:)
+  bob #: ("3.1", "tom_via_alice", "LET " <> confId <> " 7\nI'm bob") #> ("3.1", "tom_via_alice", OK)
  bob <# ("", "tom_via_alice", CON)
+  tom <# ("", "bob_via_alice", INFO "I'm bob")
+  tom <# ("", "bob_via_alice", CON)
  alice <# ("", "bob", ICON "tom")
  -- they can message each other now
  tom #: ("4", "bob_via_alice", "SEND :hello") #> ("4", "bob_via_alice", SENT 1)
@@ -230,14 +241,16 @@ testIntroductionRandomIds _ alice bob tom = do
  alice #: ("1", bobA, "INTRO " <> tomA <> " 8\nmeet tom") #> ("1", bobA, OK)
  ("", aliceB', Right (REQ invId1 "meet tom")) <- (bob <#:)
  aliceB' `shouldBe` aliceB
-  ("2", tomB, Right OK) <- bob #: ("2", "C:", "ACPT " <> invId1 <> " 7\nI'm bob")
+  ("2", tomB, Right OK) <- bob #: ("2", "", "ACPT " <> invId1 <> " 7\nI'm bob")
  ("", aliceT', Right (REQ invId2 "I'm bob")) <- (tom <#:)
  aliceT' `shouldBe` aliceT
-  -- TODO info "tom here" is not used, either JOIN command also should have eInfo parameter
-  -- or this should be another command, not ACPT
  ("3", bobT, Right OK) <- tom #: ("3", "", "ACPT " <> invId2 <> " 8\ntom here")
-  tom <# ("", bobT, CON)
+  ("", tomB', Right (CONF confId "tom here")) <- (bob <#:)
+  tomB' `shouldBe` tomB
+  bob #: ("3.1", tomB, "LET " <> confId <> " 7\nI'm bob") =#> \case ("3.1", c, OK) -> c == tomB; _ -> False
  bob <# ("", tomB, CON)
+  tom <# ("", bobT, INFO "I'm bob")
+  tom <# ("", bobT, CON)
  alice <# ("", bobA, ICON tomA)
  -- they can message each other now
  tom #: ("4", bobT, "SEND :hello") #> ("4", bobT, SENT 1)
@@ -249,7 +262,10 @@ connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO ()
 connect (h1, name1) (h2, name2) = do
  ("c1", _, Right (INV qInfo)) <- h1 #: ("c1", name2, "NEW")
  let qInfo' = serializeSmpQueueInfo qInfo
-  h2 #: ("c2", name1, "JOIN " <> qInfo') #> ("c2", name1, OK)
+  h2 #: ("c2", name1, "JOIN " <> qInfo' <> " 5\ninfo2") #> ("c2", name1, OK)
+  ("", _, Right (CONF connId "info2")) <- (h1 <#:)
+  h1 #: ("c3", name2, "LET " <> connId <> " 5\ninfo1") #> ("c3", name2, OK)
+  h2 <# ("", name1, INFO "info1")
  h2 <# ("", name1, CON)
  h1 <# ("", name2, CON)

@@ -257,7 +273,10 @@ connect' :: forall c. Transport c => c -> c -> IO (ByteString, ByteString)
 connect' h1 h2 = do
  ("c1", conn2, Right (INV qInfo)) <- h1 #: ("c1", "", "NEW")
  let qInfo' = serializeSmpQueueInfo qInfo
-  ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN " <> qInfo')
+  ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN " <> qInfo' <> " 5\ninfo2")
+  ("", _, Right (CONF connId "info2")) <- (h1 <#:)
+  h1 #: ("c3", conn2, "LET " <> connId <> " 5\ninfo1") =#> \case ("c3", c, OK) -> c == conn2; _ -> False
+  h2 <# ("", conn1, INFO "info1")
  h2 <# ("", conn1, CON)
  h1 <# ("", conn2, CON)
  pure (conn1, conn2)
@@ -281,7 +300,7 @@ syntaxTests t = do
      -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided)
      -- TODO: add tests with defined connection alias
      it "using same server as in invitation" $
-        ("311", "a", "JOIN smp::localhost:5000::1234::" <> samplePublicKey) >#> ("311", "a", "ERR SMP AUTH")
+        ("311", "a", "JOIN smp::localhost:5000::1234::" <> samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH")
    describe "invalid" do
      -- TODO: JOIN is not merged yet - to be added
      it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX")
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -156,7 +156,6 @@ rcvQueue1 =
      rcvId = "1234",
      rcvPrivateKey = C.safePrivateKey (1, 2, 3),
      sndId = Just "2345",
-      sndKey = Nothing,
      decryptKey = C.safePrivateKey (1, 2, 3),
      verifyKey = Nothing,
      status = New
@@ -169,7 +168,7 @@ sndQueue1 =
      sndId = "3456",
      sndPrivateKey = C.safePrivateKey (1, 2, 3),
      encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
-      signKey = C.safePrivateKey (1, 2, 3),
+      signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
      status = New
    }

@@ -309,7 +308,7 @@ testUpgradeRcvConnToDuplex =
              sndId = "2345",
              sndPrivateKey = C.safePrivateKey (1, 2, 3),
              encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
-              signKey = C.safePrivateKey (1, 2, 3),
+              signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
              status = New
            }
    upgradeRcvConnToDuplex store "conn1" anotherSndQueue
@@ -329,7 +328,6 @@ testUpgradeSndConnToDuplex =
              rcvId = "3456",
              rcvPrivateKey = C.safePrivateKey (1, 2, 3),
              sndId = Just "4567",
-              sndKey = Nothing,
              decryptKey = C.safePrivateKey (1, 2, 3),
              verifyKey = Nothing,
              status = New