support permanent connection link ("contact") in SMP agent protocols (#143)

* open/public queue extension for SMP and SMP agent protocols

* add connection mode - invitation or contact

* use ConnectionMode with REQ and ACPT agent notification/command

* parameterize ConnectionRequest with ConnectionMode

* implement Contact connection mode for permanent connection links

* tests for contact connections

src/Simplex/Messaging/Agent.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
@@ -45,6 +46,7 @@ module Simplex.Messaging.Agent
     createConnection,
     joinConnection,
     acceptConnection,
+    acceptContact,
     subscribeConnection,
     sendMessage,
     ackMessage,
@@ -129,17 +131,21 @@ disconnectAgentClient c = closeAgentClient c >> logConnection c False
 type AgentErrorMonad m = (MonadUnliftIO m, MonadError AgentErrorType m)
 
 -- | Create SMP agent connection (NEW command)
-createConnection :: AgentErrorMonad m => AgentClient -> m (ConnId, ConnectionRequest)
-createConnection c = withAgentEnv c $ newConn c ""
+createConnection :: AgentErrorMonad m => AgentClient -> SConnectionMode c -> m (ConnId, ConnectionRequest c)
+createConnection c cMode = withAgentEnv c $ newConn c "" cMode
 
 -- | Join SMP agent connection (JOIN command)
-joinConnection :: AgentErrorMonad m => AgentClient -> ConnectionRequest -> ConnInfo -> m ConnId
+joinConnection :: AgentErrorMonad m => AgentClient -> ConnectionRequest c -> ConnInfo -> m ConnId
 joinConnection c = withAgentEnv c .: joinConn c ""
 
--- | Approve confirmation (LET command)
+-- | Approve confirmation (ACPT INV command)
 acceptConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
 acceptConnection c = withAgentEnv c .:. acceptConnection' c
 
+-- | Approve contact (ACPT CON command)
+acceptContact :: AgentErrorMonad m => AgentClient -> ConfirmationId -> ConnInfo -> m ConnId
+acceptContact c = withAgentEnv c .: acceptContact' c ""
+
 -- | Subscribe to receive connection messages (SUB command)
 subscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
 subscribeConnection c = withAgentEnv c . subscribeConnection' c
@@ -236,27 +242,32 @@ withStore action = do
 -- | execute any SMP agent command
 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
-  JOIN smpQueueUri connInfo -> (,OK) <$> joinConn c connId smpQueueUri connInfo
-  ACPT confId ownConnInfo -> acceptConnection' c connId confId ownConnInfo $> (connId, OK)
+  NEW (ACM cMode) -> second (INV . ACR cMode) <$> newConn c connId cMode
+  JOIN (ACR _ cReq) connInfo -> (,OK) <$> joinConn c connId cReq connInfo
+  ACPT (ACM cMode) confInvId ownConnInfo -> case cMode of
+    SCMInvitation -> acceptConnection' c connId confInvId ownConnInfo $> (connId, OK)
+    SCMContact -> (,OK) <$> acceptContact' c connId confInvId ownConnInfo
   SUB -> subscribeConnection' c connId $> (connId, OK)
   SEND msgBody -> (connId,) . MID <$> sendMessage' c connId msgBody
   ACK msgId -> ackMessage' c connId msgId $> (connId, OK)
   OFF -> suspendConnection' c connId $> (connId, OK)
   DEL -> deleteConnection' c connId $> (connId, OK)
 
-newConn :: AgentMonad m => AgentClient -> ConnId -> m (ConnId, ConnectionRequest)
-newConn c connId = do
+newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequest c)
+newConn c connId cMode = do
   srv <- getSMPServer
   (rq, qUri, encryptKey) <- newRcvQueue c srv
   g <- asks idsDrg
   let cData = ConnData {connId}
-  connId' <- withStore $ \st -> createRcvConn st g cData rq
+  connId' <- withStore $ \st -> createRcvConn st g cData rq cMode
   addSubscription c rq connId'
-  pure (connId', ConnectionRequest simplexChat CRAConnect [qUri] encryptKey)
+  let crData = ConnReqData simplexChat [qUri] encryptKey
+  pure . (connId',) $ case cMode of
+    SCMInvitation -> CRInvitation crData
+    SCMContact -> CRContact crData
 
-joinConn :: AgentMonad m => AgentClient -> ConnId -> ConnectionRequest -> ConnInfo -> m ConnId
-joinConn c connId (ConnectionRequest _ CRAConnect (qUri :| _) encryptKey) cInfo = do
+joinConn :: AgentMonad m => AgentClient -> ConnId -> ConnectionRequest c -> ConnInfo -> m ConnId
+joinConn c connId (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
   (sq, senderKey, verifyKey) <- newSndQueue qUri encryptKey
   g <- asks idsDrg
   cfg <- asks config
@@ -265,6 +276,10 @@ joinConn c connId (ConnectionRequest _ CRAConnect (qUri :| _) encryptKey) cInfo
   confirmQueue c sq senderKey cInfo
   activateQueueJoining c connId' sq verifyKey $ retryInterval cfg
   pure connId'
+joinConn c connId (CRContact (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
+  (connId', cReq) <- newConn c connId SCMInvitation
+  sendInvitation c qUri encryptKey cReq cInfo
+  pure connId'
 
 activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
 activateQueueJoining c connId sq verifyKey retryInterval =
@@ -276,17 +291,27 @@ activateQueueJoining c connId sq verifyKey retryInterval =
       (rq, qUri', encryptKey) <- newRcvQueue c srv
       addSubscription c rq connId
       withStore $ \st -> upgradeSndConnToDuplex st connId rq
-      sendControlMessage c sq . REPLY $ ConnectionRequest CRSSimplex CRAConnect [qUri'] encryptKey
+      sendControlMessage c sq . REPLY $ CRInvitation $ ConnReqData CRSSimplex [qUri'] encryptKey
 
--- | Approve confirmation (LET command) in Reader monad
+-- | Approve confirmation (ACPT INV command) in Reader monad
 acceptConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
-acceptConnection' c connId confId ownConnInfo =
+acceptConnection' c connId confId ownConnInfo = do
   withStore (`getConn` connId) >>= \case
-    SomeConn SCRcv (RcvConnection _ rq) -> do
+    SomeConn _ (RcvConnection _ rq) -> do
       AcceptedConfirmation {senderKey} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
       processConfirmation c rq senderKey
     _ -> throwError $ CMD PROHIBITED
 
+-- | Accept contact (ACPT CON command) in Reader monad
+acceptContact' :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> ConnInfo -> m ConnId
+acceptContact' c connId invId ownConnInfo = do
+  Invitation {contactConnId, connReq} <- withStore (`getInvitation` invId)
+  withStore (`getConn` contactConnId) >>= \case
+    SomeConn _ ContactConnection {} -> do
+      withStore $ \st -> acceptInvitation st invId ownConnInfo
+      joinConn c connId connReq ownConnInfo
+    _ -> throwError $ CMD PROHIBITED
+
 processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
 processConfirmation c rq sndKey = do
   withStore $ \st -> setRcvQueueStatus st rq Confirmed
@@ -316,6 +341,7 @@ subscribeConnection' c connId =
         Active -> throwError $ CONN SIMPLEX
         _ -> throwError $ INTERNAL "unexpected queue status"
     SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
+    SomeConn _ (ContactConnection _ _rq) -> pure ()
   where
     resumeDelivery :: SndQueue -> m ()
     resumeDelivery SndQueue {server} = do
@@ -499,6 +525,7 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
   withStore (\st -> getRcvConn st srv rId) >>= \case
     SomeConn SCDuplex (DuplexConnection cData rq _) -> processSMP SCDuplex cData rq
     SomeConn SCRcv (RcvConnection cData rq) -> processSMP SCRcv cData rq
+    SomeConn SCContact (ContactConnection cData rq) -> processSMP SCContact cData rq
     _ -> atomically $ writeTBQueue subQ ("", "", ERR $ CONN NOT_FOUND)
   where
     processSMP :: SConnType c -> ConnData -> RcvQueue -> m ()
@@ -509,13 +536,14 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
           msg <- decryptAndVerify rq msgBody
           let msgHash = C.sha256Hash msg
           case parseSMPMessage msg of
-            Left e -> notify $ ERR e
+            Left e -> notify (ERR e) >> sendAck c rq
             Right (SMPConfirmation senderKey cInfo) -> smpConfirmation senderKey cInfo >> sendAck c rq
             Right SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} ->
               case agentMessage of
                 HELLO verifyKey _ -> helloMsg verifyKey msgBody >> sendAck c rq
                 REPLY cReq -> replyMsg cReq >> sendAck c rq
                 A_MSG body -> agentClientMsg previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash
+                A_INV cReq cInfo -> smpInvitation cReq cInfo >> sendAck c rq
         SMP.END -> do
           removeSubscription c connId
           logServer "<--" c srv rId "END"
@@ -539,7 +567,7 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
                 g <- asks idsDrg
                 let newConfirmation = NewConfirmation {connId, senderKey, senderConnInfo = cInfo}
                 confId <- withStore $ \st -> createConfirmation st g newConfirmation
-                notify $ REQ confId cInfo
+                notify $ REQ cmInvitation confId cInfo
               SCDuplex -> do
                 notify $ INFO cInfo
                 processConfirmation c rq senderKey
@@ -558,8 +586,8 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
                 SCDuplex -> notifyConnected c connId
                 _ -> pure ()
 
-        replyMsg :: ConnectionRequest -> m ()
-        replyMsg (ConnectionRequest _ CRAConnect (qUri :| _) encryptKey) = do
+        replyMsg :: ConnectionRequest 'CMInvitation -> m ()
+        replyMsg (CRInvitation (ConnReqData _ (qUri :| _) encryptKey)) = do
           logServer "<--" c srv rId "MSG <REPLY>"
           case cType of
             SCRcv -> do
@@ -584,6 +612,17 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
           withStore $ \st -> createRcvMsg st connId rcvMsg
           notify $ MSG msgMeta msgBody
 
+        smpInvitation :: ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
+        smpInvitation connReq cInfo = do
+          logServer "<--" c srv rId "MSG <KEY>"
+          case cType of
+            SCContact -> do
+              g <- asks idsDrg
+              let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo}
+              invId <- withStore $ \st -> createInvitation st g newInv
+              notify $ REQ cmContact invId cInfo
+            _ -> prohibited
+
         checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
         checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash
           | extSndId == prevExtSndId + 1 && internalPrevMsgHash == receivedPrevMsgHash = MsgOk

src/Simplex/Messaging/Agent/Client.hs

@@ -17,6 +17,7 @@ module Simplex.Messaging.Agent.Client
     subscribeQueue,
     addSubscription,
     sendConfirmation,
+    sendInvitation,
     RetryInterval (..),
     sendHello,
     secureQueue,
@@ -322,6 +323,23 @@ sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey ri =
             agentMessage = HELLO verifyKey ackMode
           }
 
+sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> EncryptionKey -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
+sendInvitation c SMPQueueUri {smpServer, senderId} encryptKey cReq connInfo = do
+  withLogSMP_ c smpServer senderId "SEND <INV>" $ \smp -> do
+    msg <- mkInvitation smp
+    liftSMP $ sendSMPMessage smp Nothing senderId msg
+  where
+    mkInvitation :: SMPClient -> m ByteString
+    mkInvitation smp = do
+      senderTimestamp <- liftIO getCurrentTime
+      encryptUnsigned smp encryptKey . serializeSMPMessage $
+        SMPMessage
+          { senderMsgId = 0,
+            senderTimestamp,
+            previousMsgHash = "",
+            agentMessage = A_INV cReq connInfo
+          }
+
 secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
 secureQueue c RcvQueue {server, rcvId, rcvPrivateKey} senderKey =
   withLogSMP c server rcvId "KEY <key>" $ \smp ->
@@ -361,6 +379,15 @@ decryptAndVerify RcvQueue {decryptKey, verifyKey} msg =
   verifyMessage verifyKey msg
     >>= liftError cryptoError . C.decrypt decryptKey
 
+encryptUnsigned :: AgentMonad m => SMPClient -> EncryptionKey -> ByteString -> m ByteString
+encryptUnsigned smp encryptKey msg = do
+  paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
+  size <- asks $ rsaKeySize . config
+  liftError cryptoError $ do
+    enc <- C.encrypt encryptKey paddedSize msg
+    let sig = B.replicate size ' '
+    pure $ sig <> enc
+
 verifyMessage :: AgentMonad m => Maybe VerificationKey -> ByteString -> m ByteString
 verifyMessage verifyKey msg = do
   size <- asks $ rsaKeySize . config

src/Simplex/Messaging/Agent/Protocol.hs

@@ -10,6 +10,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
@@ -38,10 +39,17 @@ module Simplex.Messaging.Agent.Protocol
     AMessage (..),
     SMPServer (..),
     SMPQueueUri (..),
+    ConnectionMode (..),
+    SConnectionMode (..),
+    AConnectionMode (..),
+    cmInvitation,
+    cmContact,
+    ConnectionModeI (..),
     ConnectionRequest (..),
+    AConnectionRequest (..),
+    ConnReqData (..),
     ConnReqScheme (..),
     simplexChat,
-    ConnReqAction (..),
     AgentErrorType (..),
     CommandErrorType (..),
     ConnectionErrorType (..),
@@ -52,7 +60,6 @@ module Simplex.Messaging.Agent.Protocol
     ARawTransmission,
     ConnId,
     ConfirmationId,
-    IntroId,
     InvitationId,
     AckMode (..),
     OnOff (..),
@@ -73,13 +80,20 @@ module Simplex.Messaging.Agent.Protocol
     serializeServer,
     serializeSMPQueueUri,
     reservedServerKey, -- TODO remove
+    serializeConnMode,
+    serializeConnMode',
+    connMode,
+    connMode',
     serializeConnReq,
+    serializeConnReq',
     serializeAgentError,
     commandP,
     parseSMPMessage,
     smpServerP,
     smpQueueUriP,
+    connModeT,
     connReqP,
+    connReqP',
     msgIntegrityP,
     agentErrorTypeP,
     agentMessageP,
@@ -106,7 +120,9 @@ import Data.Int (Int64)
 import Data.Kind (Type)
 import Data.List (find)
 import qualified Data.List.NonEmpty as L
+import Data.Maybe (isJust)
 import Data.String (IsString (..))
+import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601
 import Data.Type.Equality
@@ -128,7 +144,7 @@ import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTra
 import Simplex.Messaging.Util
 import Test.QuickCheck (Arbitrary (..))
 import Text.Read
-import UnliftIO.Exception
+import UnliftIO.Exception (Exception)
 
 -- | Raw (unparsed) SMP agent protocol transmission.
 type ARawTransmission = (ByteString, ByteString, ByteString)
@@ -167,11 +183,11 @@ type ConnInfo = ByteString
 
 -- | Parameterized type for SMP agent protocol commands and responses from all participants.
 data ACommand (p :: AParty) where
-  NEW :: ACommand Client -- response INV
-  INV :: ConnectionRequest -> ACommand Agent
-  JOIN :: ConnectionRequest -> ConnInfo -> ACommand Client -- response OK
-  REQ :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
-  ACPT :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
+  NEW :: AConnectionMode -> ACommand Client -- response INV
+  INV :: AConnectionRequest -> ACommand Agent
+  JOIN :: AConnectionRequest -> ConnInfo -> ACommand Client -- response OK
+  REQ :: AConnectionMode -> ConfOrInvId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
+  ACPT :: AConnectionMode -> ConfOrInvId -> ConnInfo -> ACommand Client -- ConnInfo is from client
   INFO :: ConnInfo -> ACommand Agent
   CON :: ACommand Agent -- notification that connection is established
   SUB :: ACommand Client
@@ -196,6 +212,49 @@ deriving instance Eq (ACommand p)
 
 deriving instance Show (ACommand p)
 
+data ConnectionMode = CMInvitation | CMContact
+  deriving (Eq, Show)
+
+data SConnectionMode (m :: ConnectionMode) where
+  SCMInvitation :: SConnectionMode CMInvitation
+  SCMContact :: SConnectionMode CMContact
+
+deriving instance Eq (SConnectionMode m)
+
+deriving instance Show (SConnectionMode m)
+
+instance TestEquality SConnectionMode where
+  testEquality SCMInvitation SCMInvitation = Just Refl
+  testEquality SCMContact SCMContact = Just Refl
+  testEquality _ _ = Nothing
+
+data AConnectionMode = forall m. ACM (SConnectionMode m)
+
+instance Eq AConnectionMode where
+  ACM m == ACM m' = isJust $ testEquality m m'
+
+cmInvitation :: AConnectionMode
+cmInvitation = ACM SCMInvitation
+
+cmContact :: AConnectionMode
+cmContact = ACM SCMContact
+
+deriving instance Show AConnectionMode
+
+connMode :: SConnectionMode m -> ConnectionMode
+connMode SCMInvitation = CMInvitation
+connMode SCMContact = CMContact
+
+connMode' :: ConnectionMode -> AConnectionMode
+connMode' CMInvitation = cmInvitation
+connMode' CMContact = cmContact
+
+class ConnectionModeI (m :: ConnectionMode) where sConnectionMode :: SConnectionMode m
+
+instance ConnectionModeI CMInvitation where sConnectionMode = SCMInvitation
+
+instance ConnectionModeI CMContact where sConnectionMode = SCMContact
+
 type MsgHash = ByteString
 
 -- | Agent message metadata sent to the client
@@ -238,9 +297,11 @@ data AMessage where
   -- | the first message in the queue to validate it is secured
   HELLO :: VerificationKey -> AckMode -> AMessage
   -- | reply queue information
-  REPLY :: ConnectionRequest -> AMessage
+  REPLY :: ConnectionRequest CMInvitation -> AMessage
   -- | agent envelope for the client message
   A_MSG :: MsgBody -> AMessage
+  -- | connection request with the invitation to connect
+  A_INV :: ConnectionRequest CMInvitation -> ConnInfo -> AMessage
   deriving (Show)
 
 -- | Parse SMP message.
@@ -281,10 +342,12 @@ agentMessageP =
   "HELLO " *> hello
     <|> "REPLY " *> reply
     <|> "MSG " *> a_msg
+    <|> "INV " *> a_inv
   where
     hello = HELLO <$> C.pubKeyP <*> ackMode
-    reply = REPLY <$> connReqP
+    reply = REPLY <$> connReqP'
     a_msg = A_MSG <$> binaryBodyP <* A.endOfLine
+    a_inv = A_INV <$> connReqP' <* A.space <*> binaryBodyP <* A.endOfLine
     ackMode = AckMode <$> (" NO_ACK" $> Off <|> pure On)
 
 -- | SMP server location parser.
@@ -298,8 +361,9 @@ smpServerP = SMPServer <$> server <*> optional port <*> optional kHash
 serializeAgentMessage :: AMessage -> ByteString
 serializeAgentMessage = \case
   HELLO verifyKey ackMode -> "HELLO " <> C.serializePubKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
-  REPLY cReq -> "REPLY " <> serializeConnReq cReq
+  REPLY cReq -> "REPLY " <> serializeConnReq' cReq
   A_MSG body -> "MSG " <> serializeBinary body <> "\n"
+  A_INV cReq cInfo -> B.unwords ["INV", serializeConnReq' cReq, serializeBinary cInfo] <> "\n"
 
 -- | Serialize SMP queue information that is sent out-of-band.
 serializeSMPQueueUri :: SMPQueueUri -> ByteString
@@ -314,31 +378,50 @@ smpQueueUriP =
 reservedServerKey :: C.PublicKey
 reservedServerKey = C.PublicKey $ R.PublicKey 1 0 0
 
-serializeConnReq :: ConnectionRequest -> ByteString
-serializeConnReq (ConnectionRequest scheme action smpQueues encryptionKey) =
-  sch <> "/" <> act <> "#/" <> queryStr
-  where
-    sch = case scheme of
-      CRSSimplex -> "simplex:"
-      CRSAppServer host port -> B.pack $ "https://" <> host <> maybe "" (':' :) port
-    act = case action of
-      CRAConnect -> "connect"
-    queryStr = renderSimpleQuery True [("smp", queues), ("e2e", key)]
-    queues = B.intercalate "," . map serializeSMPQueueUri $ L.toList smpQueues
-    key = C.serializePubKey encryptionKey
+serializeConnReq :: AConnectionRequest -> ByteString
+serializeConnReq (ACR _ cr) = serializeConnReq' cr
 
-connReqP :: Parser ConnectionRequest
+serializeConnReq' :: ConnectionRequest m -> ByteString
+serializeConnReq' = \case
+  CRInvitation crData -> serialize CMInvitation crData
+  CRContact crData -> serialize CMContact crData
+  where
+    serialize crMode ConnReqData {crScheme, crSmpQueues, crEncryptKey} =
+      sch <> "/" <> m <> "#/" <> queryStr
+      where
+        sch = case crScheme of
+          CRSSimplex -> "simplex:"
+          CRSAppServer host port -> B.pack $ "https://" <> host <> maybe "" (':' :) port
+        m = case crMode of
+          CMInvitation -> "invitation"
+          CMContact -> "contact"
+        queryStr = renderSimpleQuery True [("smp", queues), ("e2e", key)]
+        queues = B.intercalate "," . map serializeSMPQueueUri $ L.toList crSmpQueues
+        key = C.serializePubKey crEncryptKey
+
+connReqP' :: forall m. ConnectionModeI m => Parser (ConnectionRequest m)
+connReqP' = do
+  ACR m cr <- connReqP
+  case testEquality m $ sConnectionMode @m of
+    Just Refl -> pure cr
+    _ -> fail "bad connection request mode"
+
+connReqP :: Parser AConnectionRequest
 connReqP = do
   crScheme <- "simplex:" $> CRSSimplex <|> "https://" *> appServer
-  crAction <- "/" *> ("connect" $> CRAConnect) <* "#/?"
+  crMode <- "/" *> mode <* "#/?"
   query <- parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
   crSmpQueues <- paramP "smp" smpQueues query
   crEncryptKey <- paramP "e2e" C.pubKeyP query
-  pure ConnectionRequest {crScheme, crAction, crSmpQueues, crEncryptKey}
+  let cReq = ConnReqData {crScheme, crSmpQueues, crEncryptKey}
+  pure $ case crMode of
+    CMInvitation -> ACR SCMInvitation $ CRInvitation cReq
+    CMContact -> ACR SCMContact $ CRContact cReq
   where
     appServer = CRSAppServer <$> host <*> optional port
     host = B.unpack <$> A.takeTill (\c -> c == ':' || c == '/')
     port = B.unpack <$> (A.char ':' *> A.takeTill (== '/'))
+    mode = "invitation" $> CMInvitation <|> "contact" $> CMContact
     paramP param parser query =
       let p = maybe (fail "") (pure . snd) $ find ((== param) . fst) query
        in parseAll parser <$?> p
@@ -366,6 +449,26 @@ smpServerUriP = do
   port <- optional $ B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit)
   pure SMPServer {host, port, keyHash}
 
+serializeConnMode :: AConnectionMode -> ByteString
+serializeConnMode (ACM cMode) = serializeConnMode' $ connMode cMode
+
+serializeConnMode' :: ConnectionMode -> ByteString
+serializeConnMode' = \case
+  CMInvitation -> "INV"
+  CMContact -> "CON"
+
+connModeP' :: Parser ConnectionMode
+connModeP' = "INV" $> CMInvitation <|> "CON" $> CMContact
+
+connModeP :: Parser AConnectionMode
+connModeP = connMode' <$> connModeP'
+
+connModeT :: Text -> Maybe ConnectionMode
+connModeT = \case
+  "INV" -> Just CMInvitation
+  "CON" -> Just CMContact
+  _ -> Nothing
+
 -- | SMP server location and transport key digest (hash).
 data SMPServer = SMPServer
   { host :: HostName,
@@ -382,10 +485,10 @@ type ConnId = ByteString
 
 type ConfirmationId = ByteString
 
-type IntroId = ByteString
-
 type InvitationId = ByteString
 
+type ConfOrInvId = ByteString
+
 -- | Connection modes.
 data OnOff = On | Off deriving (Eq, Show, Read)
 
@@ -402,9 +505,25 @@ data SMPQueueUri = SMPQueueUri
   }
   deriving (Eq, Show)
 
-data ConnectionRequest = ConnectionRequest
+data ConnectionRequest (m :: ConnectionMode) where
+  CRInvitation :: ConnReqData -> ConnectionRequest CMInvitation
+  CRContact :: ConnReqData -> ConnectionRequest CMContact
+
+deriving instance Eq (ConnectionRequest m)
+
+deriving instance Show (ConnectionRequest m)
+
+data AConnectionRequest = forall m. ACR (SConnectionMode m) (ConnectionRequest m)
+
+instance Eq AConnectionRequest where
+  ACR m cr == ACR m' cr' = case testEquality m m' of
+    Just Refl -> cr == cr'
+    _ -> False
+
+deriving instance Show AConnectionRequest
+
+data ConnReqData = ConnReqData
   { crScheme :: ConnReqScheme,
-    crAction :: ConnReqAction,
     crSmpQueues :: L.NonEmpty SMPQueueUri,
     crEncryptKey :: EncryptionKey
   }
@@ -416,8 +535,6 @@ data ConnReqScheme = CRSSimplex | CRSAppServer HostName (Maybe ServiceName)
 simplexChat :: ConnReqScheme
 simplexChat = CRSAppServer "simplex.chat" Nothing
 
-data ConnReqAction = CRAConnect deriving (Eq, Show)
-
 -- | Public key used to E2E encrypt SMP messages.
 type EncryptionKey = C.PublicKey
 
@@ -537,7 +654,7 @@ instance Arbitrary SMPAgentError where arbitrary = genericArbitraryU
 -- | SMP agent command and response parser
 commandP :: Parser ACmd
 commandP =
-  "NEW" $> ACmd SClient NEW
+  "NEW " *> newCmd
     <|> "INV " *> invResp
     <|> "JOIN " *> joinCmd
     <|> "REQ " *> reqCmd
@@ -559,10 +676,11 @@ commandP =
     <|> "CON" $> ACmd SAgent CON
     <|> "OK" $> ACmd SAgent OK
   where
+    newCmd = ACmd SClient . NEW <$> connModeP
     invResp = ACmd SAgent . INV <$> connReqP
     joinCmd = ACmd SClient <$> (JOIN <$> connReqP <* A.space <*> A.takeByteString)
-    reqCmd = ACmd SAgent <$> (REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
-    acptCmd = ACmd SClient <$> (ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    reqCmd = ACmd SAgent <$> (REQ <$> connModeP <* A.space <*> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    acptCmd = ACmd SClient <$> (ACPT <$> connModeP <* A.space <*> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
     infoCmd = ACmd SAgent . INFO <$> A.takeByteString
     sendCmd = ACmd SClient . SEND <$> A.takeByteString
     msgIdResp = ACmd SAgent . MID <$> A.decimal
@@ -595,11 +713,11 @@ parseCommand = parse commandP $ CMD SYNTAX
 -- | Serialize SMP agent command.
 serializeCommand :: ACommand p -> ByteString
 serializeCommand = \case
-  NEW -> "NEW"
+  NEW cMode -> "NEW " <> serializeConnMode cMode
   INV cReq -> "INV " <> serializeConnReq cReq
-  JOIN cReq cInfo -> "JOIN " <> serializeConnReq cReq <> " " <> serializeBinary cInfo
-  REQ confId cInfo -> "REQ " <> confId <> " " <> serializeBinary cInfo
-  ACPT confId cInfo -> "ACPT " <> confId <> " " <> serializeBinary cInfo
+  JOIN cReq cInfo -> B.unwords ["JOIN", serializeConnReq cReq, serializeBinary cInfo]
+  REQ cMode confId cInfo -> B.unwords ["REQ", serializeConnMode cMode, confId, serializeBinary cInfo]
+  ACPT cMode confId cInfo -> B.unwords ["ACPT", serializeConnMode cMode, confId, serializeBinary cInfo]
   INFO cInfo -> "INFO " <> serializeBinary cInfo
   SUB -> "SUB"
   END -> "END"
@@ -608,9 +726,8 @@ serializeCommand = \case
   SEND msgBody -> "SEND " <> serializeBinary msgBody
   MID mId -> "MID " <> bshow mId
   SENT mId -> "SENT " <> bshow mId
-  MERR mId e -> "MERR " <> bshow mId <> " " <> serializeAgentError e
-  MSG msgMeta msgBody ->
-    "MSG " <> serializeMsgMeta msgMeta <> " " <> serializeBinary msgBody
+  MERR mId e -> B.unwords ["MERR", bshow mId, serializeAgentError e]
+  MSG msgMeta msgBody -> B.unwords ["MSG", serializeMsgMeta msgMeta, serializeBinary msgBody]
   ACK mId -> "ACK " <> bshow mId
   OFF -> "OFF"
   DEL -> "DEL"
@@ -700,8 +817,9 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
     tConnId :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p)
     tConnId (_, connId, _) cmd = case cmd of
       -- NEW, JOIN and ACPT have optional connId
-      NEW -> Right cmd
+      NEW _ -> Right cmd
       JOIN {} -> Right cmd
+      ACPT {} -> Right cmd
       -- ERROR response does not always have connId
       ERR _ -> Right cmd
       -- other responses must have connId
@@ -714,8 +832,8 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
       SEND body -> SEND <$$> getBody body
       MSG msgMeta body -> MSG msgMeta <$$> getBody body
       JOIN qUri cInfo -> JOIN qUri <$$> getBody cInfo
-      REQ confId cInfo -> REQ confId <$$> getBody cInfo
-      ACPT confId cInfo -> ACPT confId <$$> getBody cInfo
+      REQ cMode confId cInfo -> REQ cMode confId <$$> getBody cInfo
+      ACPT cMode confId cInfo -> ACPT cMode confId <$$> getBody cInfo
       INFO cInfo -> INFO <$$> getBody cInfo
       cmd -> pure $ Right cmd
 

src/Simplex/Messaging/Agent/Store.hs

@@ -32,7 +32,7 @@ import qualified Simplex.Messaging.Protocol as SMP
 -- | Store class type. Defines store access methods for implementations.
 class Monad m => MonadAgentStore s m where
   -- Queue and Connection management
-  createRcvConn :: s -> TVar ChaChaDRG -> ConnData -> RcvQueue -> m ConnId
+  createRcvConn :: s -> TVar ChaChaDRG -> ConnData -> RcvQueue -> SConnectionMode c -> m ConnId
   createSndConn :: s -> TVar ChaChaDRG -> ConnData -> SndQueue -> m ConnId
   getConn :: s -> ConnId -> m SomeConn
   getAllConnIds :: s -> m [ConnId] -- TODO remove - hack for subscribing to all
@@ -51,6 +51,11 @@ class Monad m => MonadAgentStore s m where
   getAcceptedConfirmation :: s -> ConnId -> m AcceptedConfirmation
   removeConfirmations :: s -> ConnId -> m ()
 
+  -- Invitations - sent via Contact connections
+  createInvitation :: s -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
+  getInvitation :: s -> InvitationId -> m Invitation
+  acceptInvitation :: s -> InvitationId -> ConnInfo -> m ()
+
   -- Msg management
   updateRcvIds :: s -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
   createRcvMsg :: s -> ConnId -> RcvMsgData -> m ()
@@ -91,7 +96,7 @@ data SndQueue = SndQueue
 -- * Connection types
 
 -- | Type of a connection.
-data ConnType = CRcv | CSnd | CDuplex deriving (Eq, Show)
+data ConnType = CRcv | CSnd | CDuplex | CContact deriving (Eq, Show)
 
 -- | Connection of a specific type.
 --
@@ -107,6 +112,7 @@ data Connection (d :: ConnType) where
   RcvConnection :: ConnData -> RcvQueue -> Connection CRcv
   SndConnection :: ConnData -> SndQueue -> Connection CSnd
   DuplexConnection :: ConnData -> RcvQueue -> SndQueue -> Connection CDuplex
+  ContactConnection :: ConnData -> RcvQueue -> Connection CContact
 
 deriving instance Eq (Connection d)
 
@@ -116,11 +122,13 @@ data SConnType :: ConnType -> Type where
   SCRcv :: SConnType CRcv
   SCSnd :: SConnType CSnd
   SCDuplex :: SConnType CDuplex
+  SCContact :: SConnType CContact
 
 connType :: SConnType c -> ConnType
 connType SCRcv = CRcv
 connType SCSnd = CSnd
 connType SCDuplex = CDuplex
+connType SCContact = CContact
 
 deriving instance Eq (SConnType d)
 
@@ -130,6 +138,7 @@ instance TestEquality SConnType where
   testEquality SCRcv SCRcv = Just Refl
   testEquality SCSnd SCSnd = Just Refl
   testEquality SCDuplex SCDuplex = Just Refl
+  testEquality SCContact SCContact = Just Refl
   testEquality _ _ = Nothing
 
 -- | Connection of an unknown type.
@@ -162,6 +171,23 @@ data AcceptedConfirmation = AcceptedConfirmation
     ownConnInfo :: ConnInfo
   }
 
+-- * Invitations
+
+data NewInvitation = NewInvitation
+  { contactConnId :: ConnId,
+    connReq :: ConnectionRequest 'CMInvitation,
+    recipientConnInfo :: ConnInfo
+  }
+
+data Invitation = Invitation
+  { invitationId :: InvitationId,
+    contactConnId :: ConnId,
+    connReq :: ConnectionRequest 'CMInvitation,
+    recipientConnInfo :: ConnInfo,
+    ownConnInfo :: Maybe ConnInfo,
+    accepted :: Bool
+  }
+
 -- * Message integrity validation types
 
 -- | Corresponds to `last_external_snd_msg_id` in `connections` table
@@ -320,6 +346,8 @@ data StoreError
     SEBadConnType ConnType
   | -- | Confirmation not found.
     SEConfirmationNotFound
+  | -- | Invitation not found
+    SEInvitationNotFound
   | -- | Message not found
     SEMsgNotFound
   | -- | Currently not used. The intention was to pass current expected queue status in methods,

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -39,6 +39,7 @@ import Data.List (find)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1)
 import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, field)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.FromField
@@ -150,8 +151,8 @@ withTransaction st action = withConnection st $ loop 100 100_000
           else E.throwIO e
 
 instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteStore m where
-  createRcvConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> RcvQueue -> m ConnId
-  createRcvConn st gVar cData q@RcvQueue {server} =
+  createRcvConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> RcvQueue -> SConnectionMode c -> m ConnId
+  createRcvConn st gVar cData q@RcvQueue {server} cMode =
     -- TODO if schema has to be restarted, this function can be refactored
     -- to create connection first using createWithRandomId
     liftIOEither . checkConstraint SEConnDuplicate . withTransaction st $ \db ->
@@ -161,7 +162,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
       create db connId = do
         upsertServer_ db server
         insertRcvQueue_ db connId q
-        insertRcvConnection_ db cData {connId} q
+        insertRcvConnection_ db cData {connId} q cMode
         pure connId
 
   createSndConn :: SQLiteStore -> TVar ChaChaDRG -> ConnData -> SndQueue -> m ConnId
@@ -359,6 +360,50 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         |]
         [":conn_alias" := connId]
 
+  createInvitation :: SQLiteStore -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
+  createInvitation st gVar NewInvitation {contactConnId, connReq, recipientConnInfo} =
+    liftIOEither . withTransaction st $ \db ->
+      createWithRandomId gVar $ \invitationId ->
+        DB.execute
+          db
+          [sql|
+            INSERT INTO conn_invitations
+            (invitation_id,  contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0);
+          |]
+          (invitationId, contactConnId, connReq, recipientConnInfo)
+
+  getInvitation :: SQLiteStore -> InvitationId -> m Invitation
+  getInvitation st invitationId =
+    liftIOEither . withTransaction st $ \db ->
+      invitation
+        <$> DB.query
+          db
+          [sql|
+            SELECT contact_conn_id, cr_invitation, recipient_conn_info, own_conn_info, accepted
+            FROM conn_invitations
+            WHERE invitation_id = ?
+          |]
+          (Only invitationId)
+    where
+      invitation [(contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted)] =
+        Right Invitation {invitationId, contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted}
+      invitation _ = Left SEInvitationNotFound
+
+  acceptInvitation :: SQLiteStore -> InvitationId -> ConnInfo -> m ()
+  acceptInvitation st invitationId ownConnInfo =
+    liftIO . withTransaction st $ \db -> do
+      DB.executeNamed
+        db
+        [sql|
+          UPDATE conn_invitations
+          SET accepted = 1,
+              own_conn_info = :own_conn_info
+          WHERE invitation_id = :invitation_id
+        |]
+        [ ":own_conn_info" := ownConnInfo,
+          ":invitation_id" := invitationId
+        ]
+
   updateRcvIds :: SQLiteStore -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
   updateRcvIds st connId =
     liftIO . withTransaction st $ \db -> do
@@ -505,9 +550,21 @@ instance ToField SMPQueueUri where toField = toField . serializeSMPQueueUri
 
 instance FromField SMPQueueUri where fromField = blobFieldParser smpQueueUriP
 
-instance ToField ConnectionRequest where toField = toField . serializeConnReq
+instance ToField AConnectionRequest where toField = toField . serializeConnReq
 
-instance FromField ConnectionRequest where fromField = blobFieldParser connReqP
+instance FromField AConnectionRequest where fromField = blobFieldParser connReqP
+
+instance ToField (ConnectionRequest c) where toField = toField . serializeConnReq'
+
+instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequest c) where fromField = blobFieldParser connReqP'
+
+instance ToField ConnectionMode where toField = toField . decodeLatin1 . serializeConnMode'
+
+instance FromField ConnectionMode where fromField = fromTextField_ connModeT
+
+instance ToField (SConnectionMode c) where toField = toField . connMode
+
+instance FromField AConnectionMode where fromField = fromTextField_ $ fmap connMode' . connModeT
 
 fromTextField_ :: (E.Typeable a) => (Text -> Maybe a) -> Field -> Ok a
 fromTextField_ fromText = \case
@@ -568,21 +625,24 @@ insertRcvQueue_ dbConn connId RcvQueue {..} = do
       ":status" := status
     ]
 
-insertRcvConnection_ :: DB.Connection -> ConnData -> RcvQueue -> IO ()
-insertRcvConnection_ dbConn ConnData {connId} RcvQueue {server, rcvId} = do
+insertRcvConnection_ :: DB.Connection -> ConnData -> RcvQueue -> SConnectionMode c -> IO ()
+insertRcvConnection_ dbConn ConnData {connId} RcvQueue {server, rcvId} cMode = do
   let port_ = serializePort_ $ port server
   DB.executeNamed
     dbConn
     [sql|
       INSERT INTO connections
-        ( conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id, last_internal_msg_id, last_internal_rcv_msg_id, last_internal_snd_msg_id, last_external_snd_msg_id, last_rcv_msg_hash, last_snd_msg_hash)
+        ( conn_alias, rcv_host, rcv_port, rcv_id, snd_host, snd_port, snd_id, last_internal_msg_id, last_internal_rcv_msg_id, last_internal_snd_msg_id, last_external_snd_msg_id, last_rcv_msg_hash, last_snd_msg_hash,
+          conn_mode )
       VALUES
-        (:conn_alias,:rcv_host,:rcv_port,:rcv_id, NULL,     NULL,     NULL, 0, 0, 0, 0, x'', x'');
+        (:conn_alias,:rcv_host,:rcv_port,:rcv_id, NULL,     NULL,     NULL, 0, 0, 0, 0, x'', x'',
+         :conn_mode );
     |]
     [ ":conn_alias" := connId,
       ":rcv_host" := host server,
       ":rcv_port" := port_,
-      ":rcv_id" := rcvId
+      ":rcv_id" := rcvId,
+      ":conn_mode" := cMode
     ]
 
 -- * createSndConn helpers
@@ -631,21 +691,22 @@ getConn_ :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getConn_ dbConn connId =
   getConnData_ dbConn connId >>= \case
     Nothing -> pure $ Left SEConnNotFound
-    Just connData -> do
+    Just (connData, cMode) -> do
       rQ <- getRcvQueueByConnAlias_ dbConn connId
       sQ <- getSndQueueByConnAlias_ dbConn connId
-      pure $ case (rQ, sQ) of
-        (Just rcvQ, Just sndQ) -> Right $ SomeConn SCDuplex (DuplexConnection connData rcvQ sndQ)
-        (Just rcvQ, Nothing) -> Right $ SomeConn SCRcv (RcvConnection connData rcvQ)
-        (Nothing, Just sndQ) -> Right $ SomeConn SCSnd (SndConnection connData sndQ)
+      pure $ case (rQ, sQ, cMode) of
+        (Just rcvQ, Just sndQ, CMInvitation) -> Right $ SomeConn SCDuplex (DuplexConnection connData rcvQ sndQ)
+        (Just rcvQ, Nothing, CMInvitation) -> Right $ SomeConn SCRcv (RcvConnection connData rcvQ)
+        (Nothing, Just sndQ, CMInvitation) -> Right $ SomeConn SCSnd (SndConnection connData sndQ)
+        (Just rcvQ, Nothing, CMContact) -> Right $ SomeConn SCContact (ContactConnection connData rcvQ)
         _ -> Left SEConnNotFound
 
-getConnData_ :: DB.Connection -> ConnId -> IO (Maybe ConnData)
+getConnData_ :: DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode))
 getConnData_ dbConn connId' =
   connData
-    <$> DB.query dbConn "SELECT conn_alias FROM connections WHERE conn_alias = ?;" (Only connId')
+    <$> DB.query dbConn "SELECT conn_alias, conn_mode FROM connections WHERE conn_alias = ?;" (Only connId')
   where
-    connData [Only connId] = Just ConnData {connId}
+    connData [(connId, cMode)] = Just (ConnData {connId}, cMode)
     connData _ = Nothing
 
 getRcvQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe RcvQueue)