diff --git a/migrations/20210101_initial.sql b/migrations/20210101_initial.sql index 75716865a..4c1e617c9 100644 --- a/migrations/20210101_initial.sql +++ b/migrations/20210101_initial.sql @@ -50,7 +50,7 @@ CREATE TABLE IF NOT EXISTS connections( snd_host TEXT, snd_port TEXT, snd_id BLOB, - last_internal_msg_id INTEGER NOT NULL, + last_internal_msg_id INTEGER NOT NULL, -- TODO add defauls here and below in the new schema last_internal_rcv_msg_id INTEGER NOT NULL, last_internal_snd_msg_id INTEGER NOT NULL, last_external_snd_msg_id INTEGER NOT NULL, diff --git a/migrations/20211202_connection_mode.sql b/migrations/20211202_connection_mode.sql new file mode 100644 index 000000000..d7e4e5ac6 --- /dev/null +++ b/migrations/20211202_connection_mode.sql @@ -0,0 +1,11 @@ +ALTER TABLE connections ADD conn_mode TEXT NOT NULL DEFAULT 'INV'; + +CREATE TABLE conn_invitations ( + invitation_id BLOB NOT NULL PRIMARY KEY, + contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, + cr_invitation BLOB NOT NULL, + recipient_conn_info BLOB NOT NULL, + accepted INTEGER NOT NULL DEFAULT 0, + own_conn_info BLOB, + created_at TEXT NOT NULL DEFAULT (datetime('now')) +) WITHOUT ROWID; diff --git a/protocol/agent-protocol.md b/protocol/agent-protocol.md index 00dbc873b..033763047 100644 --- a/protocol/agent-protocol.md +++ b/protocol/agent-protocol.md @@ -12,6 +12,10 @@ - [HELLO message](#hello-message) - [REPLY message](#reply-message) - [MSG message](#msg-message) + - [INV message](#inv-message) + - [ACK message](#ack-message) + - [NEW message](#new-message) + - [DEL message](#del-message) - [SMP agent commands](#smp-agent-commands) - [Client commands and server responses](#client-commands-and-server-responses) - [NEW command and INV response](#new-command-and-inv-response) @@ -133,7 +137,7 @@ previousMsgHash = encoded encoded = agentMessage = helloMsg / replyQueueMsg / - clientMsg / acknowledgeMsg / + clientMsg / invitationMsg/ acknowledgeMsg / newQueueMessage / deleteQueueMsg msgPadding = *OCTET ; optional random bytes to get messages to the same size (as defined in SMP message size) @@ -149,6 +153,9 @@ clientMsg = %s"MSG" SP size CRLF clientMsgBody CRLF ; CRLF is in addition to CRL size = 1*DIGIT clientMsgBody = *OCTET +invitationMsg = %s"INV" SP connReqInvitation SP connInfo +; `connReqInvitation` and `connInfo` are defined below + acknowledgeMsg = %s"ACK" SP agentMsgId SP msgHash SP ackStatus ; NOT SUPPORTED in the current implementation @@ -192,6 +199,10 @@ This is the message that is sent by the agent that received an out-of-band conne This is the agent envelope used to send client messages once the connection is established. Do not confuse it with the MSG response from SMP server to the agent and MSG response from SMP agent to the client that are sent in different contexts. +#### INV message + +This message is sent to the SMP queue(s) in `connReqContact`, to establish a new connection via existing unsecured queue, that acts as a permanent connection link of a user. + #### ACK message This message is sent to confirm the client message reception. It includes received message number, message hash and the reception status. @@ -225,17 +236,19 @@ agentCommand = (userCmd / agentMsg) CRLF userCmd = newCmd / joinCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd agentMsg = invitation / connRequest / connInfo / connected / unsubscribed / connDown / connUp / messageId / sent / messageError / message / received / ok / error -newCmd = %s"NEW" [SP %s"NO_ACK"] ; response is `invitation` or `error` +newCmd = %s"NEW" SP connectionMode [SP %s"NO_ACK"] ; response is `invitation` or `error` ; NO_ACK parameter currently not supported -invitation = %s"INV" SP ; `connectionRequest` is defined below +connectionMode = %s"INV" / %s"CON" -connRequest = %s"REQ" SP confirmationId SP msgBody +invitation = %s"INV" SP connectionRequest ; `connectionRequest` is defined below + +connRequest = %s"REQ" SP connectionMode SP confirmationId SP msgBody ; msgBody here is any binary information identifying connection request confirmationId = 1*DIGIT -acceptCmd = %s"ACPT" SP confirmationId SP msgBody +acceptCmd = %s"ACPT" SP connectionMode SP confirmationId SP msgBody ; msgBody here is any binary information identifying connecting party connInfo = %s"INFO" SP msgBody @@ -255,9 +268,10 @@ connDown = %s"DOWN" connUp = %s"UP" ; restored connection -joinCmd = %s"JOIN" SP [SP %s"NO_REPLY"] [SP %s"NO_ACK"] -; `connectionRequest` is defined below +joinCmd = %s"JOIN" SP connectionRequest SP connInfo [SP %s"NO_REPLY"] [SP %s"NO_ACK"] +; `connectionRequest` and `connInfo` are defined below ; response is `connected` or `error` +; parameters NO_REPLY and NO_ACK are currently not supported suspendCmd = %s"OFF" ; can be sent by either party, response `ok` or `error` @@ -318,6 +332,8 @@ error = %s"ERR" SP `INV` response is sent by the agent to the client of the initiating party. +`NEW` command has `connectionMode` parameter to define the connection mode - to be used to communicate with a single contact (invitation mode, `connectionMode` is `INV`) or to accept connection requests from anybody (contact mode, `connectionMode` is `CON`). The type of connection request is determined by `connectionMode` parameter. + #### JOIN command It is used to create a connection and accept the connection request received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party). @@ -382,9 +398,11 @@ Connection request `connectionRequest` is generated by SMP agent in response to Connection request syntax: ``` -connectionRequest = connectionProtocol "/" action "#/?smp=" smpQueues "&e2e=" e2eEncryption -action = %s"connect" -connectionProtocol = (%s"https://" clientAppServer) | %s"simplex:" +connectionRequest = connectionScheme "/" connReqType "#/?smp=" smpQueues "&e2e=" e2eEncryption +connReqType = %s"invitation" / %s"contact" +; this parameter has the same meaning as connectionMode in agent commands +; `NEW INV` creates `invitation` connection request, `NEW CON` - `contact` +connectionScheme = (%s"https://" clientAppServer) | %s"simplex:" clientAppServer = hostname [ ":" port ] ; client app server, e.g. simplex.chat e2eEncryption = encryptionScheme ":" publicKey diff --git a/rfcs/2021-05-17-open-connection.md b/rfcs/2021-05-17-open-connection.md new file mode 100644 index 000000000..fc83f137b --- /dev/null +++ b/rfcs/2021-05-17-open-connection.md @@ -0,0 +1,52 @@ +# Open connections + +## Problem + +This proposal describes how to create invitations that can be used multiple times. + +It can be used for: +- an open invitation to join a group. +- an open invitation to connect to a person - e.g. QR code/invitation link on a person's website, or passed from one person to another. +- part of the solution for public DNS-based addresses (when a directory server would map address in some domain name#example.tld to an open invitation). + +## Solution + +No changes to SMP protocol - a dedicated unsecured SMP queue is used to receive invitations to connect that are sent in encrypted agent message. An unsecured SMP queue is used as an out-of-band channel for establishing another SMP queue. + +Additional parameters in commands in SMP agent protocol: + +- `NEW` command will have a parameter `INV` or `CON` to create an invitation or a permanent contact connection. + +`conn_alias? OPEN` (or `PUB`, `NEWPUB`, tbc) - to create an "open"/"public" queue, the response is an invitation in a different format (TBC): + - should allow multiple servers (probably the original invitation should be extended to support it) + - should have a marker to indicate it's an open/public queue (probably the original invitation should be extended to include an invitation type). + +e.g. `smp:::/,/::` + +`queue_type`: + - `prv` - original invitation, should be accepted with KEY SMP message + - `pub` - open invitation, should be accepted with INV SMP message (to be added to SMP protocol) + +```mmd +A ->> AA: oidA? OPEN +AA ->> A: oidA INV pub_inv + +... + +B ->> BA: cidBA? JOIN pub_inv len CRLF meta_binary CRLF ; change command to require meta, len can be 0 for the current usage ; meta is used to send user profile +BA ->> B: cidBA OK +BA ->> SA ->> AA: INV prv_inv CRLF meta_binary +AA ->> A: oidA CONF invID len meta_binary +A ->> AA cidAB? LET invID + +establish connection as usual + +BA ->> B: cidBA CON +AA ->> A: cidAB CON +``` + +That protocol requires addressing the current problem when an invitation cannot be accepted when the party that generated the invitation is not online. + +Questions. + +1. Do we need to differentiate the semantics of the invitation on the syntax level, or should we allow to just manage it outside of protocol when the receiving agent decides which SMP messages to accept and which to ignore (KEY / INV). \ No newline at end of file diff --git a/rfcs/2021-01-20-logging.md b/rfcs/done/2021-01-20-logging.md similarity index 100% rename from rfcs/2021-01-20-logging.md rename to rfcs/done/2021-01-20-logging.md diff --git a/rfcs/2021-01-26-crypto.md b/rfcs/done/2021-01-26-crypto.md similarity index 100% rename from rfcs/2021-01-26-crypto.md rename to rfcs/done/2021-01-26-crypto.md diff --git a/rfcs/2021-01-26-messages.md b/rfcs/done/2021-01-26-messages.md similarity index 100% rename from rfcs/2021-01-26-messages.md rename to rfcs/done/2021-01-26-messages.md diff --git a/rfcs/2021-05-23-broadcast.md b/rfcs/rejected/2021-05-23-broadcast.md similarity index 100% rename from rfcs/2021-05-23-broadcast.md rename to rfcs/rejected/2021-05-23-broadcast.md diff --git a/rfcs/2021-05-23-groups2.md b/rfcs/rejected/2021-05-23-groups2.md similarity index 100% rename from rfcs/2021-05-23-groups2.md rename to rfcs/rejected/2021-05-23-groups2.md diff --git a/rfcs/2021-05-23-introduction.md b/rfcs/rejected/2021-05-23-introduction.md similarity index 100% rename from rfcs/2021-05-23-introduction.md rename to rfcs/rejected/2021-05-23-introduction.md diff --git a/simplexmq.cabal b/simplexmq.cabal index 4bd0b59f0..53291b95b 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: eac6184d7efe4fc07606d5f6bd75f1821af768a087526ff08749385844580cec +-- hash: 1e44584019db4d35d25a97c553870b0960fe7a18b5296f0e49b8084c343276ab name: simplexmq version: 0.4.1 @@ -31,6 +31,7 @@ extra-source-files: migrations/20210101_initial.sql migrations/20210624_confirmations.sql migrations/20210809_snd_messages.sql + migrations/20211202_connection_mode.sql migrations/README.md library diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 3c14cbbff..81b16f2ac 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/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 " 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 " + 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 diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index bc057b31f..e99486c7f 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/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 " $ \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 " $ \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 diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 8ae384ca5..706b638af 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/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 diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index fd8b3ced6..b387779e6 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/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, diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index e76729069..13d1819d9 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/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) diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 0777b7898..fc115b6d4 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -11,7 +11,7 @@ module AgentTests (agentTests) where import AgentTests.ConnectionRequestTests -import AgentTests.FunctionalAPITests (functionalAPITests) +import AgentTests.FunctionalAPITests (functionalAPITests, pattern REQ_CON, pattern REQ_INV) import AgentTests.SQLiteTests (storeTests) import Control.Concurrent import Data.ByteString.Char8 (ByteString) @@ -45,6 +45,11 @@ agentTests (ATransport t) = do smpAgentTest2_2_2 $ testDuplexConnection t it "should connect via 2 servers and 2 agents (random IDs)" $ smpAgentTest2_2_2 $ testDuplexConnRandomIds t + describe "Establishing two connections via `contact connection" do + it "should connect via contact contact with one server and 3 agents" $ + smpAgentTest3 $ testContactConnection t + it "should connect via contact contact with one server and 2 agents (random IDs)" $ + smpAgentTest2_2_1 $ testContactConnRandomIds t describe "Connection subscriptions" do it "should connect via one server and one agent" $ smpAgentTest3_1_1 $ testSubscription t @@ -101,11 +106,11 @@ pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody testDuplexConnection :: Transport c => TProxy c -> c -> c -> IO () testDuplexConnection _ alice bob = do - ("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW") + ("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW INV") let cReq' = serializeConnReq cReq bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK) - ("", "bob", Right (REQ confId "bob's connInfo")) <- (alice <#:) - alice #: ("2", "bob", "ACPT " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK) + ("", "bob", Right (REQ_INV confId "bob's connInfo")) <- (alice <#:) + alice #: ("2", "bob", "ACPT INV " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK) bob <# ("", "alice", INFO "alice's connInfo") bob <# ("", "alice", CON) alice <# ("", "bob", CON) @@ -133,12 +138,12 @@ testDuplexConnection _ alice bob = do testDuplexConnRandomIds :: Transport c => TProxy c -> c -> c -> IO () testDuplexConnRandomIds _ alice bob = do - ("1", bobConn, Right (INV cReq)) <- alice #: ("1", "", "NEW") + ("1", bobConn, Right (INV cReq)) <- alice #: ("1", "", "NEW INV") let cReq' = serializeConnReq cReq ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo") - ("", bobConn', Right (REQ confId "bob's connInfo")) <- (alice <#:) + ("", bobConn', Right (REQ_INV confId "bob's connInfo")) <- (alice <#:) bobConn' `shouldBe` bobConn - alice #: ("2", bobConn, "ACPT " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False + alice #: ("2", bobConn, "ACPT INV " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False bob <# ("", aliceConn, INFO "alice's connInfo") bob <# ("", aliceConn, CON) alice <# ("", bobConn, CON) @@ -164,6 +169,60 @@ testDuplexConnRandomIds _ alice bob = do alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK) alice #:# "nothing else should be delivered to alice" +testContactConnection :: Transport c => TProxy c -> c -> c -> c -> IO () +testContactConnection _ alice bob tom = do + ("1", "alice_contact", Right (INV cReq)) <- alice #: ("1", "alice_contact", "NEW CON") + let cReq' = serializeConnReq cReq + + bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK) + ("", "alice_contact", Right (REQ_CON aConfId "bob's connInfo")) <- (alice <#:) + alice #: ("2", "bob", "ACPT CON " <> aConfId <> " 16\nalice's connInfo") #> ("2", "bob", OK) + ("", "alice", Right (REQ_INV bConfId "alice's connInfo")) <- (bob <#:) + bob #: ("12", "alice", "ACPT INV " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", "alice", OK) + alice <# ("", "bob", INFO "bob's connInfo 2") + alice <# ("", "bob", CON) + bob <# ("", "alice", CON) + alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 1) + alice <# ("", "bob", SENT 1) + bob <#= \case ("", "alice", Msg "hi") -> True; _ -> False + bob #: ("13", "alice", "ACK 1") #> ("13", "alice", OK) + + tom #: ("21", "alice", "JOIN " <> cReq' <> " 14\ntom's connInfo") #> ("21", "alice", OK) + ("", "alice_contact", Right (REQ_CON aConfId' "tom's connInfo")) <- (alice <#:) + alice #: ("4", "tom", "ACPT CON " <> aConfId' <> " 16\nalice's connInfo") #> ("4", "tom", OK) + ("", "alice", Right (REQ_INV tConfId "alice's connInfo")) <- (tom <#:) + tom #: ("22", "alice", "ACPT INV " <> tConfId <> " 16\ntom's connInfo 2") #> ("22", "alice", OK) + alice <# ("", "tom", INFO "tom's connInfo 2") + alice <# ("", "tom", CON) + tom <# ("", "alice", CON) + alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 1) + alice <# ("", "tom", SENT 1) + tom <#= \case ("", "alice", Msg "hi there") -> True; _ -> False + tom #: ("23", "alice", "ACK 1") #> ("23", "alice", OK) + +testContactConnRandomIds :: Transport c => TProxy c -> c -> c -> IO () +testContactConnRandomIds _ alice bob = do + ("1", aliceContact, Right (INV cReq)) <- alice #: ("1", "", "NEW CON") + let cReq' = serializeConnReq cReq + + ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo") + ("", aliceContact', Right (REQ_CON aConfId "bob's connInfo")) <- (alice <#:) + aliceContact' `shouldBe` aliceContact + + ("2", bobConn, Right OK) <- alice #: ("2", "", "ACPT CON " <> aConfId <> " 16\nalice's connInfo") + ("", aliceConn', Right (REQ_INV bConfId "alice's connInfo")) <- (bob <#:) + aliceConn' `shouldBe` aliceConn + + bob #: ("12", aliceConn, "ACPT INV " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", aliceConn, OK) + alice <# ("", bobConn, INFO "bob's connInfo 2") + alice <# ("", bobConn, CON) + bob <# ("", aliceConn, CON) + + alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 1) + alice <# ("", bobConn, SENT 1) + bob <#= \case ("", c, Msg "hi") -> c == aliceConn; _ -> False + bob #: ("13", aliceConn, "ACK 1") #> ("13", aliceConn, OK) + testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO () testSubscription _ alice1 alice2 bob = do (alice1, "alice") `connect` (bob, "bob") @@ -185,7 +244,7 @@ testSubscription _ alice1 alice2 bob = do testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO () testSubscrNotification t (server, _) client = do - client #: ("1", "conn1", "NEW") =#> \case ("1", "conn1", INV {}) -> True; _ -> False + client #: ("1", "conn1", "NEW INV") =#> \case ("1", "conn1", INV {}) -> True; _ -> False client #:# "nothing should be delivered to client before the server is killed" killThread server client <# ("", "conn1", DOWN) @@ -253,18 +312,18 @@ testMsgDeliveryAgentRestart t bob = do connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO () connect (h1, name1) (h2, name2) = do - ("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW") + ("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW INV") let cReq' = serializeConnReq cReq h2 #: ("c2", name1, "JOIN " <> cReq' <> " 5\ninfo2") #> ("c2", name1, OK) - ("", _, Right (REQ connId "info2")) <- (h1 <#:) - h1 #: ("c3", name2, "ACPT " <> connId <> " 5\ninfo1") #> ("c3", name2, OK) + ("", _, Right (REQ_INV connId "info2")) <- (h1 <#:) + h1 #: ("c3", name2, "ACPT INV " <> connId <> " 5\ninfo1") #> ("c3", name2, OK) h2 <# ("", name1, INFO "info1") h2 <# ("", name1, CON) h1 <# ("", name2, CON) -- connect' :: forall c. Transport c => c -> c -> IO (ByteString, ByteString) -- connect' h1 h2 = do --- ("c1", conn2, Right (INV cReq)) <- h1 #: ("c1", "", "NEW") +-- ("c1", conn2, Right (INV cReq)) <- h1 #: ("c1", "", "NEW INV") -- let cReq' = serializeConnReq cReq -- ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN " <> cReq' <> " 5\ninfo2") -- ("", _, Right (REQ connId "info2")) <- (h1 <#:) @@ -283,17 +342,17 @@ syntaxTests t = do describe "NEW" do describe "valid" do -- TODO: add tests with defined connection alias - it "without parameters" $ ("211", "", "NEW") >#>= \case ("211", _, "INV" : _) -> True; _ -> False + it "with correct parameter" $ ("211", "", "NEW INV") >#>= \case ("211", _, "INV" : _) -> True; _ -> False describe "invalid" do -- TODO: add tests with defined connection alias - it "with parameters" $ ("222", "", "NEW hi") >#> ("222", "", "ERR CMD SYNTAX") + it "with incorrect parameter" $ ("222", "", "NEW hi") >#> ("222", "", "ERR CMD SYNTAX") describe "JOIN" do describe "valid" 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 https://simpex.chat/connect#/?smp=smp%3A%2F%2Flocalhost%3A5000%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH") + ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5000%2F1234-w%3D%3D%23&e2e=" <> urlEncode True 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") diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 2355b5931..a39c54ce1 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -30,14 +30,14 @@ queue = appServer :: ConnReqScheme appServer = CRSAppServer "simplex.chat" Nothing -connReq :: ConnectionRequest -connReq = - ConnectionRequest - { crScheme = appServer, - crAction = CRAConnect, - crSmpQueues = [queue], - crEncryptKey = reservedServerKey - } +connectionRequest :: AConnectionRequest +connectionRequest = + ACR SCMInvitation . CRInvitation $ + ConnReqData + { crScheme = appServer, + crSmpQueues = [queue], + crEncryptKey = reservedServerKey + } connectionRequestTests :: Spec connectionRequestTests = do @@ -61,9 +61,8 @@ connectionRequestTests = do parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im:5223/1234-w==#" `shouldBe` Right queue it "should serialize connection requests" $ do - serializeConnReq connReq - `shouldBe` "https://simplex.chat/connect#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D" + serializeConnReq connectionRequest + `shouldBe` "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D" it "should parse connection requests" $ do - -- print $ parseSMPMessage "\n0 2021-11-29T19:23:27.005Z \nREPLY simplex:/connect#/?smp=smp%3A%2F%2FKXNE1m2E1m0lm92WGKet9CL6-lO742Vy5G6nsrkvgs8%3D%40localhost%3A5000%2FoWWCE_5ug0t05K6X%23&e2e=rsa%3AMIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEA3O4frbgUMRO%2B8FIX2%2ByqB%2F1B5pXmt%2F%2FY0dFd2HCVxL31TJHc90HJp92Qb7Ni%2B1dI2Ka1Hb1Fvup897mmEcFhZStG0OB6jffvPyxXCas8Tov3l757qCUZKqgTxSJkL7JvLkIN9jMs50islvrSHCAj8VReh5oR%2B8OFp8ITd5MuMHYuR1bt0XLl1TwSIyfRSQqtHlt%2FEBbEbWcgJMsDXMi3o983nezvF9En9F7OCnasdzKAsgcN2%2FdWp3CPeuMNe9epzrirxGfCKU%2FlVyZ77e7NZMkSmeOIDPGuE4Fk8bweAYArV%2FrECBJGBQkGx3YtEh0kIbCakQ1ZnKY%2F%2FMq0ZHGPhQKBgGRKfJ7xXftoLdVJ7EOW%2FR5Y%2Bj%2F%2Bb9yZMbTCdZfkuroV9FH8GF5tS3PWuSAOFu42h7TiqFjXlvM6aYp%2FBXxCosZjBlB6mWCLyuY48ZszhtCpLSlbR2x%2FpGMUEgyOsefeMusrHEqFJAI%2Fhh8LljBGL%2BV08qcGFxVTwCVePIjDOo1H\n" - parseAll connReqP "https://simplex.chat/connect#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D" - `shouldBe` Right connReq + parseAll connReqP "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D" + `shouldBe` Right connectionRequest diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 008e0c14b..d0c701e56 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -5,7 +5,12 @@ {-# LANGUAGE PatternSynonyms #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -module AgentTests.FunctionalAPITests (functionalAPITests) where +module AgentTests.FunctionalAPITests + ( functionalAPITests, + pattern REQ_INV, + pattern REQ_CON, + ) +where import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.IO.Unlift @@ -32,6 +37,12 @@ get c = atomically (readTBQueue $ subQ c) pattern Msg :: MsgBody -> ACommand 'Agent pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody +pattern REQ_INV :: ConfirmationId -> ConnInfo -> ACommand 'Agent +pattern REQ_INV confId cInfo <- REQ (ACM SCMInvitation) confId cInfo + +pattern REQ_CON :: ConfirmationId -> ConnInfo -> ACommand 'Agent +pattern REQ_CON confId cInfo <- REQ (ACM SCMContact) confId cInfo + functionalAPITests :: ATransport -> Spec functionalAPITests t = do describe "Establishing duplex connection" $ @@ -53,9 +64,9 @@ testAgentClient = do alice <- getSMPAgentClient cfg bob <- getSMPAgentClient cfg {dbFile = testDB2} Right () <- runExceptT $ do - (bobId, qInfo) <- createConnection alice + (bobId, qInfo) <- createConnection alice SCMInvitation aliceId <- joinConnection bob qInfo "bob's connInfo" - ("", _, REQ confId "bob's connInfo") <- get alice + ("", _, REQ_INV confId "bob's connInfo") <- get alice acceptConnection alice bobId confId "alice's connInfo" get alice ##> ("", bobId, CON) get bob ##> ("", aliceId, INFO "alice's connInfo") @@ -96,12 +107,12 @@ testAsyncInitiatingOffline = do alice <- getSMPAgentClient cfg bob <- getSMPAgentClient cfg {dbFile = testDB2} Right () <- runExceptT $ do - (bobId, qInfo) <- createConnection alice + (bobId, cReq) <- createConnection alice SCMInvitation disconnectAgentClient alice - aliceId <- joinConnection bob qInfo "bob's connInfo" + aliceId <- joinConnection bob cReq "bob's connInfo" alice' <- liftIO $ getSMPAgentClient cfg subscribeConnection alice' bobId - ("", _, REQ confId "bob's connInfo") <- get alice' + ("", _, REQ_INV confId "bob's connInfo") <- get alice' acceptConnection alice' bobId confId "alice's connInfo" get alice' ##> ("", bobId, CON) get bob ##> ("", aliceId, INFO "alice's connInfo") @@ -114,10 +125,10 @@ testAsyncJoiningOfflineBeforeActivation = do alice <- getSMPAgentClient cfg bob <- getSMPAgentClient cfg {dbFile = testDB2} Right () <- runExceptT $ do - (bobId, qInfo) <- createConnection alice + (bobId, qInfo) <- createConnection alice SCMInvitation aliceId <- joinConnection bob qInfo "bob's connInfo" disconnectAgentClient bob - ("", _, REQ confId "bob's connInfo") <- get alice + ("", _, REQ_INV confId "bob's connInfo") <- get alice acceptConnection alice bobId confId "alice's connInfo" bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2} subscribeConnection bob' aliceId @@ -135,13 +146,13 @@ testAsyncBothOffline = do alice <- getSMPAgentClient cfg bob <- getSMPAgentClient cfg {dbFile = testDB2} Right () <- runExceptT $ do - (bobId, qInfo) <- createConnection alice + (bobId, cReq) <- createConnection alice SCMInvitation disconnectAgentClient alice - aliceId <- joinConnection bob qInfo "bob's connInfo" + aliceId <- joinConnection bob cReq "bob's connInfo" disconnectAgentClient bob alice' <- liftIO $ getSMPAgentClient cfg subscribeConnection alice' bobId - ("", _, REQ confId "bob's connInfo") <- get alice' + ("", _, REQ_INV confId "bob's connInfo") <- get alice' acceptConnection alice' bobId confId "alice's connInfo" bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2} subscribeConnection bob' aliceId diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 26d652ad9..725367235 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -114,7 +114,7 @@ testConcurrentWrites :: SpecWith (SQLiteStore, SQLiteStore) testConcurrentWrites = it "should complete multiple concurrent write transactions w/t sqlite busy errors" $ \(s1, s2) -> do g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn s1 g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn s1 g cData1 rcvQueue1 SCMInvitation let ConnData {connId} = cData1 concurrently_ (runTest s1 connId) (runTest s2 connId) where @@ -176,7 +176,7 @@ testCreateRcvConn :: SpecWith SQLiteStore testCreateRcvConn = it "should create RcvConnection and add SndQueue" $ \store -> do g <- newTVarIO =<< drgNew - createRcvConn store g cData1 rcvQueue1 + createRcvConn store g cData1 rcvQueue1 SCMInvitation `returnsResult` "conn1" getConn store "conn1" `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1) @@ -189,7 +189,7 @@ testCreateRcvConnRandomId :: SpecWith SQLiteStore testCreateRcvConnRandomId = it "should create RcvConnection and add SndQueue with random ID" $ \store -> do g <- newTVarIO =<< drgNew - Right connId <- runExceptT $ createRcvConn store g cData1 {connId = ""} rcvQueue1 + Right connId <- runExceptT $ createRcvConn store g cData1 {connId = ""} rcvQueue1 SCMInvitation getConn store connId `returnsResult` SomeConn SCRcv (RcvConnection cData1 {connId} rcvQueue1) upgradeRcvConnToDuplex store connId sndQueue1 @@ -201,8 +201,8 @@ testCreateRcvConnDuplicate :: SpecWith SQLiteStore testCreateRcvConnDuplicate = it "should throw error on attempt to create duplicate RcvConnection" $ \store -> do g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 - createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation + createRcvConn store g cData1 rcvQueue1 SCMInvitation `throwsError` SEConnDuplicate testCreateSndConn :: SpecWith SQLiteStore @@ -242,7 +242,7 @@ testGetAllConnIds :: SpecWith SQLiteStore testGetAllConnIds = it "should get all conn aliases" $ \store -> do g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation _ <- runExceptT $ createSndConn store g cData1 {connId = "conn2"} sndQueue1 getAllConnIds store `returnsResult` ["conn1" :: ConnId, "conn2" :: ConnId] @@ -253,7 +253,7 @@ testGetRcvConn = let smpServer = SMPServer "smp.simplex.im" (Just "5223") testKeyHash let recipientId = "1234" g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation getRcvConn store smpServer recipientId `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1) @@ -261,7 +261,7 @@ testDeleteRcvConn :: SpecWith SQLiteStore testDeleteRcvConn = it "should create RcvConnection and delete it" $ \store -> do g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation getConn store "conn1" `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1) deleteConn store "conn1" @@ -287,7 +287,7 @@ testDeleteDuplexConn :: SpecWith SQLiteStore testDeleteDuplexConn = it "should create DuplexConnection and delete it" $ \store -> do g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1 getConn store "conn1" `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1) @@ -321,7 +321,7 @@ testUpgradeSndConnToDuplex :: SpecWith SQLiteStore testUpgradeSndConnToDuplex = it "should throw error on attempt to add RcvQueue to RcvConnection or DuplexConnection" $ \store -> do g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation let anotherRcvQueue = RcvQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, @@ -342,7 +342,7 @@ testSetRcvQueueStatus :: SpecWith SQLiteStore testSetRcvQueueStatus = it "should update status of RcvQueue" $ \store -> do g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation getConn store "conn1" `returnsResult` SomeConn SCRcv (RcvConnection cData1 rcvQueue1) setRcvQueueStatus store rcvQueue1 Confirmed @@ -366,7 +366,7 @@ testSetQueueStatusDuplex :: SpecWith SQLiteStore testSetQueueStatusDuplex = it "should update statuses of RcvQueue and SndQueue in DuplexConnection" $ \store -> do g <- newTVarIO =<< drgNew - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1 getConn store "conn1" `returnsResult` SomeConn SCDuplex (DuplexConnection cData1 rcvQueue1 sndQueue1) @@ -426,7 +426,7 @@ testCreateRcvMsg = it "should reserve internal ids and create a RcvMsg" $ \st -> do g <- newTVarIO =<< drgNew let ConnData {connId} = cData1 - _ <- runExceptT $ createRcvConn st g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn st g cData1 rcvQueue1 SCMInvitation -- TODO getMsg to check message testCreateRcvMsg' st 0 "" connId $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "hash_dummy" testCreateRcvMsg' st 1 "hash_dummy" connId $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "new_hash_dummy" @@ -464,7 +464,7 @@ testCreateRcvAndSndMsgs = it "should create multiple RcvMsg and SndMsg, correctly ordering internal Ids and returning previous state" $ \store -> do g <- newTVarIO =<< drgNew let ConnData {connId} = cData1 - _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 + _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation _ <- runExceptT $ upgradeRcvConnToDuplex store "conn1" sndQueue1 testCreateRcvMsg' store 0 "" connId $ mkRcvMsgData (InternalId 1) (InternalRcvId 1) 1 "1" "rcv_hash_1" testCreateRcvMsg' store 1 "rcv_hash_1" connId $ mkRcvMsgData (InternalId 2) (InternalRcvId 2) 2 "2" "rcv_hash_2"