mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-30 16:26:02 +00:00
add CONF/LET for invitations, use REQ/ACPT only with contact connections (#212)
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
04c65d98da
commit
3e226fc3f2
@@ -20,6 +20,7 @@
|
||||
- [Client commands and server responses](#client-commands-and-server-responses)
|
||||
- [NEW command and INV response](#new-command-and-inv-response)
|
||||
- [JOIN command](#join-command)
|
||||
- [CONF notification and LET command](#conf-notification-and-let-command)
|
||||
- [REQ notification and ACPT command](#req-notification-and-acpt-command)
|
||||
- [INFO and CON notifications](#info-and-con-notifications)
|
||||
- [SUB command](#sub-command)
|
||||
@@ -233,8 +234,8 @@ cId = encoded
|
||||
cName = 1*(ALPHA / DIGIT / "_" / "-")
|
||||
|
||||
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
|
||||
userCmd = newCmd / joinCmd / letCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
|
||||
agentMsg = invitation / confMsg / connReqMsg / connInfo / connected / unsubscribed / connDown / connUp / messageId / sent / messageError / message / received / ok / error
|
||||
|
||||
newCmd = %s"NEW" SP connectionMode [SP %s"NO_ACK"] ; response is `invitation` or `error`
|
||||
; NO_ACK parameter currently not supported
|
||||
@@ -243,14 +244,22 @@ connectionMode = %s"INV" / %s"CON"
|
||||
|
||||
invitation = %s"INV" SP connectionRequest ; `connectionRequest` is defined below
|
||||
|
||||
connRequest = %s"REQ" SP connectionMode SP confirmationId SP msgBody
|
||||
confMsg = %s"CONF" SP confirmationId SP msgBody
|
||||
; msgBody here is any binary information identifying connection request
|
||||
|
||||
letCmd = %s"LET" SP confirmationId SP msgBody
|
||||
; msgBody here is any binary information identifying connecting party
|
||||
|
||||
confirmationId = 1*DIGIT
|
||||
|
||||
acceptCmd = %s"ACPT" SP connectionMode SP confirmationId SP msgBody
|
||||
connReqMsg = %s"REQ" SP invitationId SP msgBody
|
||||
; msgBody here is any binary information identifying connection request
|
||||
|
||||
acceptCmd = %s"ACPT" SP invitationId SP msgBody
|
||||
; msgBody here is any binary information identifying connecting party
|
||||
|
||||
invitationId = 1*DIGIT
|
||||
|
||||
connInfo = %s"INFO" SP msgBody
|
||||
; msgBody here is any binary information identifying connecting party
|
||||
|
||||
@@ -338,11 +347,17 @@ error = %s"ERR" SP <errorType>
|
||||
|
||||
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).
|
||||
|
||||
#### CONF notification and LET command
|
||||
|
||||
When the joining party uses `JOIN` command to accept connection invitation created with `NEW INV` command, the initiating party will receive `CONF` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
|
||||
|
||||
To continue with the connection the initiating party should use `LET` command.
|
||||
|
||||
#### REQ notification and ACPT command
|
||||
|
||||
When the joining party uses `JOIN` command, the initiating party will receive `REQ` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
|
||||
When the joining party uses `JOIN` command to connect to the contact created with `NEW CON` command, the initiating party will receive `REQ` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
|
||||
|
||||
To continue with the connection the initiating party should use `ACPT` command.
|
||||
To continue with the connection the party that created the contact should use `ACPT` command.
|
||||
|
||||
#### INFO and CON notifications
|
||||
|
||||
|
||||
@@ -45,7 +45,7 @@ module Simplex.Messaging.Agent
|
||||
withAgentLock,
|
||||
createConnection,
|
||||
joinConnection,
|
||||
acceptConnection,
|
||||
allowConnection,
|
||||
acceptContact,
|
||||
subscribeConnection,
|
||||
sendMessage,
|
||||
@@ -139,8 +139,8 @@ joinConnection :: AgentErrorMonad m => AgentClient -> ConnectionRequest c -> Con
|
||||
joinConnection c = withAgentEnv c .: joinConn c ""
|
||||
|
||||
-- | Approve confirmation (ACPT INV command)
|
||||
acceptConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
|
||||
acceptConnection c = withAgentEnv c .:. acceptConnection' c
|
||||
allowConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
|
||||
allowConnection c = withAgentEnv c .:. allowConnection' c
|
||||
|
||||
-- | Approve contact (ACPT CON command)
|
||||
acceptContact :: AgentErrorMonad m => AgentClient -> ConfirmationId -> ConnInfo -> m ConnId
|
||||
@@ -244,9 +244,8 @@ processCommand :: forall m. AgentMonad m => AgentClient -> (ConnId, ACommand 'Cl
|
||||
processCommand c (connId, cmd) = case cmd of
|
||||
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
|
||||
LET confId ownCInfo -> allowConnection' c connId confId ownCInfo $> (connId, OK)
|
||||
ACPT invId ownCInfo -> (,OK) <$> acceptContact' c connId invId ownCInfo
|
||||
SUB -> subscribeConnection' c connId $> (connId, OK)
|
||||
SEND msgBody -> (connId,) . MID <$> sendMessage' c connId msgBody
|
||||
ACK msgId -> ackMessage' c connId msgId $> (connId, OK)
|
||||
@@ -294,8 +293,8 @@ activateQueueJoining c connId sq verifyKey retryInterval =
|
||||
sendControlMessage c sq . REPLY $ CRInvitation $ ConnReqData CRSSimplex [qUri'] encryptKey
|
||||
|
||||
-- | Approve confirmation (ACPT INV command) in Reader monad
|
||||
acceptConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
|
||||
acceptConnection' c connId confId ownConnInfo = do
|
||||
allowConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
|
||||
allowConnection' c connId confId ownConnInfo = do
|
||||
withStore (`getConn` connId) >>= \case
|
||||
SomeConn _ (RcvConnection _ rq) -> do
|
||||
AcceptedConfirmation {senderKey} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo
|
||||
@@ -567,7 +566,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 cmInvitation confId cInfo
|
||||
notify $ CONF confId cInfo
|
||||
SCDuplex -> do
|
||||
notify $ INFO cInfo
|
||||
processConfirmation c rq senderKey
|
||||
@@ -620,7 +619,7 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
|
||||
g <- asks idsDrg
|
||||
let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo}
|
||||
invId <- withStore $ \st -> createInvitation st g newInv
|
||||
notify $ REQ cmContact invId cInfo
|
||||
notify $ REQ invId cInfo
|
||||
_ -> prohibited
|
||||
|
||||
checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
|
||||
|
||||
@@ -186,8 +186,10 @@ data ACommand (p :: AParty) where
|
||||
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
|
||||
CONF :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
|
||||
LET :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
|
||||
REQ :: InvitationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
|
||||
ACPT :: InvitationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
|
||||
INFO :: ConnInfo -> ACommand Agent
|
||||
CON :: ACommand Agent -- notification that connection is established
|
||||
SUB :: ACommand Client
|
||||
@@ -487,8 +489,6 @@ type ConfirmationId = ByteString
|
||||
|
||||
type InvitationId = ByteString
|
||||
|
||||
type ConfOrInvId = ByteString
|
||||
|
||||
-- | Connection modes.
|
||||
data OnOff = On | Off deriving (Eq, Show, Read)
|
||||
|
||||
@@ -657,7 +657,9 @@ commandP =
|
||||
"NEW " *> newCmd
|
||||
<|> "INV " *> invResp
|
||||
<|> "JOIN " *> joinCmd
|
||||
<|> "REQ " *> reqCmd
|
||||
<|> "CONF " *> confMsg
|
||||
<|> "LET " *> letCmd
|
||||
<|> "REQ " *> reqMsg
|
||||
<|> "ACPT " *> acptCmd
|
||||
<|> "INFO " *> infoCmd
|
||||
<|> "SUB" $> ACmd SClient SUB
|
||||
@@ -679,8 +681,10 @@ commandP =
|
||||
newCmd = ACmd SClient . NEW <$> connModeP
|
||||
invResp = ACmd SAgent . INV <$> connReqP
|
||||
joinCmd = ACmd SClient <$> (JOIN <$> connReqP <* 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)
|
||||
confMsg = ACmd SAgent <$> (CONF <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
|
||||
letCmd = ACmd SClient <$> (LET <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
|
||||
reqMsg = ACmd SAgent <$> (REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
|
||||
acptCmd = ACmd SClient <$> (ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
|
||||
infoCmd = ACmd SAgent . INFO <$> A.takeByteString
|
||||
sendCmd = ACmd SClient . SEND <$> A.takeByteString
|
||||
msgIdResp = ACmd SAgent . MID <$> A.decimal
|
||||
@@ -716,8 +720,10 @@ serializeCommand = \case
|
||||
NEW cMode -> "NEW " <> serializeConnMode cMode
|
||||
INV cReq -> "INV " <> serializeConnReq cReq
|
||||
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]
|
||||
CONF confId cInfo -> B.unwords ["CONF", confId, serializeBinary cInfo]
|
||||
LET confId cInfo -> B.unwords ["LET", confId, serializeBinary cInfo]
|
||||
REQ invId cInfo -> B.unwords ["REQ", invId, serializeBinary cInfo]
|
||||
ACPT invId cInfo -> B.unwords ["ACPT", invId, serializeBinary cInfo]
|
||||
INFO cInfo -> "INFO " <> serializeBinary cInfo
|
||||
SUB -> "SUB"
|
||||
END -> "END"
|
||||
@@ -832,8 +838,10 @@ 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 cMode confId cInfo -> REQ cMode confId <$$> getBody cInfo
|
||||
ACPT cMode confId cInfo -> ACPT cMode confId <$$> getBody cInfo
|
||||
CONF confId cInfo -> CONF confId <$$> getBody cInfo
|
||||
LET confId cInfo -> LET confId <$$> getBody cInfo
|
||||
REQ invId cInfo -> REQ invId <$$> getBody cInfo
|
||||
ACPT invId cInfo -> ACPT invId <$$> getBody cInfo
|
||||
INFO cInfo -> INFO <$$> getBody cInfo
|
||||
cmd -> pure $ Right cmd
|
||||
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
module AgentTests (agentTests) where
|
||||
|
||||
import AgentTests.ConnectionRequestTests
|
||||
import AgentTests.FunctionalAPITests (functionalAPITests, pattern REQ_CON, pattern REQ_INV)
|
||||
import AgentTests.FunctionalAPITests (functionalAPITests)
|
||||
import AgentTests.SQLiteTests (storeTests)
|
||||
import Control.Concurrent
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
@@ -109,8 +109,8 @@ testDuplexConnection _ alice bob = do
|
||||
("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_INV confId "bob's connInfo")) <- (alice <#:)
|
||||
alice #: ("2", "bob", "ACPT INV " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
|
||||
("", "bob", Right (CONF confId "bob's connInfo")) <- (alice <#:)
|
||||
alice #: ("2", "bob", "LET " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
|
||||
bob <# ("", "alice", INFO "alice's connInfo")
|
||||
bob <# ("", "alice", CON)
|
||||
alice <# ("", "bob", CON)
|
||||
@@ -141,9 +141,9 @@ testDuplexConnRandomIds _ alice bob = do
|
||||
("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_INV confId "bob's connInfo")) <- (alice <#:)
|
||||
("", bobConn', Right (CONF confId "bob's connInfo")) <- (alice <#:)
|
||||
bobConn' `shouldBe` bobConn
|
||||
alice #: ("2", bobConn, "ACPT INV " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
|
||||
alice #: ("2", bobConn, "LET " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False
|
||||
bob <# ("", aliceConn, INFO "alice's connInfo")
|
||||
bob <# ("", aliceConn, CON)
|
||||
alice <# ("", bobConn, CON)
|
||||
@@ -175,10 +175,10 @@ testContactConnection _ alice bob tom = do
|
||||
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_contact", Right (REQ aConfId "bob's connInfo")) <- (alice <#:)
|
||||
alice #: ("2", "bob", "ACPT " <> aConfId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
|
||||
("", "alice", Right (CONF bConfId "alice's connInfo")) <- (bob <#:)
|
||||
bob #: ("12", "alice", "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", "alice", OK)
|
||||
alice <# ("", "bob", INFO "bob's connInfo 2")
|
||||
alice <# ("", "bob", CON)
|
||||
bob <# ("", "alice", CON)
|
||||
@@ -188,10 +188,10 @@ testContactConnection _ alice bob tom = do
|
||||
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_contact", Right (REQ aConfId' "tom's connInfo")) <- (alice <#:)
|
||||
alice #: ("4", "tom", "ACPT " <> aConfId' <> " 16\nalice's connInfo") #> ("4", "tom", OK)
|
||||
("", "alice", Right (CONF tConfId "alice's connInfo")) <- (tom <#:)
|
||||
tom #: ("22", "alice", "LET " <> tConfId <> " 16\ntom's connInfo 2") #> ("22", "alice", OK)
|
||||
alice <# ("", "tom", INFO "tom's connInfo 2")
|
||||
alice <# ("", "tom", CON)
|
||||
tom <# ("", "alice", CON)
|
||||
@@ -206,14 +206,14 @@ testContactConnRandomIds _ alice bob = do
|
||||
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', Right (REQ 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 <#:)
|
||||
("2", bobConn, Right OK) <- alice #: ("2", "", "ACPT " <> aConfId <> " 16\nalice's connInfo")
|
||||
("", aliceConn', Right (CONF bConfId "alice's connInfo")) <- (bob <#:)
|
||||
aliceConn' `shouldBe` aliceConn
|
||||
|
||||
bob #: ("12", aliceConn, "ACPT INV " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", aliceConn, OK)
|
||||
bob #: ("12", aliceConn, "LET " <> bConfId <> " 16\nbob's connInfo 2") #> ("12", aliceConn, OK)
|
||||
alice <# ("", bobConn, INFO "bob's connInfo 2")
|
||||
alice <# ("", bobConn, CON)
|
||||
bob <# ("", aliceConn, CON)
|
||||
@@ -315,8 +315,8 @@ connect (h1, name1) (h2, name2) = do
|
||||
("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_INV connId "info2")) <- (h1 <#:)
|
||||
h1 #: ("c3", name2, "ACPT INV " <> connId <> " 5\ninfo1") #> ("c3", name2, OK)
|
||||
("", _, Right (CONF connId "info2")) <- (h1 <#:)
|
||||
h1 #: ("c3", name2, "LET " <> connId <> " 5\ninfo1") #> ("c3", name2, OK)
|
||||
h2 <# ("", name1, INFO "info1")
|
||||
h2 <# ("", name1, CON)
|
||||
h1 <# ("", name2, CON)
|
||||
|
||||
@@ -5,12 +5,7 @@
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
|
||||
|
||||
module AgentTests.FunctionalAPITests
|
||||
( functionalAPITests,
|
||||
pattern REQ_INV,
|
||||
pattern REQ_CON,
|
||||
)
|
||||
where
|
||||
module AgentTests.FunctionalAPITests (functionalAPITests) where
|
||||
|
||||
import Control.Monad.Except (ExceptT, runExceptT)
|
||||
import Control.Monad.IO.Unlift
|
||||
@@ -37,12 +32,6 @@ 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" $
|
||||
@@ -66,8 +55,8 @@ testAgentClient = do
|
||||
Right () <- runExceptT $ do
|
||||
(bobId, qInfo) <- createConnection alice SCMInvitation
|
||||
aliceId <- joinConnection bob qInfo "bob's connInfo"
|
||||
("", _, REQ_INV confId "bob's connInfo") <- get alice
|
||||
acceptConnection alice bobId confId "alice's connInfo"
|
||||
("", _, CONF confId "bob's connInfo") <- get alice
|
||||
allowConnection alice bobId confId "alice's connInfo"
|
||||
get alice ##> ("", bobId, CON)
|
||||
get bob ##> ("", aliceId, INFO "alice's connInfo")
|
||||
get bob ##> ("", aliceId, CON)
|
||||
@@ -112,8 +101,8 @@ testAsyncInitiatingOffline = do
|
||||
aliceId <- joinConnection bob cReq "bob's connInfo"
|
||||
alice' <- liftIO $ getSMPAgentClient cfg
|
||||
subscribeConnection alice' bobId
|
||||
("", _, REQ_INV confId "bob's connInfo") <- get alice'
|
||||
acceptConnection alice' bobId confId "alice's connInfo"
|
||||
("", _, CONF confId "bob's connInfo") <- get alice'
|
||||
allowConnection alice' bobId confId "alice's connInfo"
|
||||
get alice' ##> ("", bobId, CON)
|
||||
get bob ##> ("", aliceId, INFO "alice's connInfo")
|
||||
get bob ##> ("", aliceId, CON)
|
||||
@@ -128,8 +117,8 @@ testAsyncJoiningOfflineBeforeActivation = do
|
||||
(bobId, qInfo) <- createConnection alice SCMInvitation
|
||||
aliceId <- joinConnection bob qInfo "bob's connInfo"
|
||||
disconnectAgentClient bob
|
||||
("", _, REQ_INV confId "bob's connInfo") <- get alice
|
||||
acceptConnection alice bobId confId "alice's connInfo"
|
||||
("", _, CONF confId "bob's connInfo") <- get alice
|
||||
allowConnection alice bobId confId "alice's connInfo"
|
||||
bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
|
||||
subscribeConnection bob' aliceId
|
||||
get alice ##> ("", bobId, CON)
|
||||
@@ -152,8 +141,8 @@ testAsyncBothOffline = do
|
||||
disconnectAgentClient bob
|
||||
alice' <- liftIO $ getSMPAgentClient cfg
|
||||
subscribeConnection alice' bobId
|
||||
("", _, REQ_INV confId "bob's connInfo") <- get alice'
|
||||
acceptConnection alice' bobId confId "alice's connInfo"
|
||||
("", _, CONF confId "bob's connInfo") <- get alice'
|
||||
allowConnection alice' bobId confId "alice's connInfo"
|
||||
bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
|
||||
subscribeConnection bob' aliceId
|
||||
get alice' ##> ("", bobId, CON)
|
||||
|
||||
Reference in New Issue
Block a user