diff --git a/migrations/20210602_introductions.sql b/migrations/20210602_introductions.sql deleted file mode 100644 index 36bb7539c..000000000 --- a/migrations/20210602_introductions.sql +++ /dev/null @@ -1,27 +0,0 @@ -CREATE TABLE conn_intros ( - intro_id BLOB NOT NULL PRIMARY KEY, - to_conn BLOB NOT NULL REFERENCES connections (conn_alias) ON DELETE CASCADE, - to_info BLOB, -- info about "to" connection sent to "re" connection - to_status TEXT NOT NULL DEFAULT '', -- '', INV, CON - re_conn BLOB NOT NULL REFERENCES connections (conn_alias) ON DELETE CASCADE, - re_info BLOB NOT NULL, -- info about "re" connection sent to "to" connection - re_status TEXT NOT NULL DEFAULT '', -- '', INV, CON - queue_info BLOB -) WITHOUT ROWID; - -CREATE TABLE conn_invitations ( - inv_id BLOB NOT NULL PRIMARY KEY, - via_conn BLOB REFERENCES connections (conn_alias) ON DELETE SET NULL, - external_intro_id BLOB NOT NULL, - conn_info BLOB, -- info about another connection - queue_info BLOB, -- NULL if it's an initial introduction - conn_id BLOB REFERENCES connections (conn_alias) -- created connection - ON DELETE CASCADE - DEFERRABLE INITIALLY DEFERRED, - status TEXT NOT NULL DEFAULT '' -- '', 'ACPT', 'CON' -) WITHOUT ROWID; - -ALTER TABLE connections - ADD via_inv BLOB REFERENCES conn_invitations (inv_id) ON DELETE RESTRICT; -ALTER TABLE connections - ADD conn_level INTEGER NOT NULL DEFAULT 0; diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 69a3864c6..d66d2184e 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -41,22 +41,11 @@ module Simplex.Messaging.Agent disconnectAgentClient, -- used in tests createConnection, joinConnection, - allowConnection, - sendIntroduction, - acceptInvitation, + acceptConnection, subscribeConnection, sendMessage, suspendConnection, deleteConnection, - createConnection', - joinConnection', - allowConnection', - sendIntroduction', - acceptInvitation', - subscribeConnection', - sendMessage', - suspendConnection', - deleteConnection', ) where @@ -131,37 +120,17 @@ disconnectAgentClient c = closeAgentClient c >> logConnection c False -- | type AgentErrorMonad m = (MonadUnliftIO m, MonadError AgentErrorType m) --- | Create SMP agent connection (NEW command) in Reader monad -createConnection' :: AgentMonad m => AgentClient -> m (ConnId, SMPQueueInfo) -createConnection' c = newConn c "" Nothing 0 - -- | Create SMP agent connection (NEW command) createConnection :: AgentErrorMonad m => AgentClient -> m (ConnId, SMPQueueInfo) -createConnection c = (`runReaderT` agentEnv c) $ createConnection' c - --- | Join SMP agent connection (JOIN command) in Reader monad -joinConnection' :: AgentMonad m => AgentClient -> SMPQueueInfo -> ConnInfo -> m ConnId -joinConnection' c qInfo cInfo = joinConn c "" qInfo cInfo Nothing 0 +createConnection c = (`runReaderT` agentEnv c) $ newConn c "" -- | Join SMP agent connection (JOIN command) joinConnection :: AgentErrorMonad m => AgentClient -> SMPQueueInfo -> ConnInfo -> m ConnId -joinConnection c = (`runReaderT` agentEnv c) .: joinConnection' c +joinConnection c = (`runReaderT` agentEnv c) .: joinConn c "" -- | Approve confirmation (LET command) -allowConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m () -allowConnection c = (`runReaderT` agentEnv c) .:. allowConnection' c - --- | Accept invitation (ACPT command) in Reader monad -acceptInvitation' :: AgentMonad m => AgentClient -> InvitationId -> ConnInfo -> m ConnId -acceptInvitation' c = acceptInv c "" - --- | Accept invitation (ACPT command) -acceptInvitation :: AgentErrorMonad m => AgentClient -> InvitationId -> ConnInfo -> m ConnId -acceptInvitation c = (`runReaderT` agentEnv c) .: acceptInvitation' c - --- | Send introduction of the second connection the first (INTRO command) -sendIntroduction :: AgentErrorMonad m => AgentClient -> ConnId -> ConnId -> ConnInfo -> m () -sendIntroduction c = (`runReaderT` agentEnv c) .:. sendIntroduction' c +acceptConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m () +acceptConnection c = (`runReaderT` agentEnv c) .:. acceptConnection' c -- | Subscribe to receive connection messages (SUB command) subscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m () @@ -250,32 +219,30 @@ 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 Nothing 0 - JOIN smpQueueInfo connInfo -> (,OK) <$> joinConn c connId smpQueueInfo connInfo Nothing 0 - LET confId ownConnInfo -> allowConnection' c connId confId ownConnInfo $> (connId, OK) - INTRO reConnId reInfo -> sendIntroduction' c connId reConnId reInfo $> (connId, OK) - ACPT invId connInfo -> (,OK) <$> acceptInv c connId invId connInfo + NEW -> second INV <$> newConn c connId + JOIN smpQueueInfo connInfo -> (,OK) <$> joinConn c connId smpQueueInfo connInfo + ACPT confId ownConnInfo -> acceptConnection' c connId confId ownConnInfo $> (connId, OK) SUB -> subscribeConnection' c connId $> (connId, OK) SEND msgBody -> (connId,) . SENT . unId <$> sendMessage' c connId msgBody OFF -> suspendConnection' c connId $> (connId, OK) DEL -> deleteConnection' c connId $> (connId, OK) -newConn :: AgentMonad m => AgentClient -> ConnId -> Maybe InvitationId -> Int -> m (ConnId, SMPQueueInfo) -newConn c connId viaInv connLevel = do +newConn :: AgentMonad m => AgentClient -> ConnId -> m (ConnId, SMPQueueInfo) +newConn c connId = do srv <- getSMPServer (rq, qInfo) <- newRcvQueue c srv g <- asks idsDrg - let cData = ConnData {connId, viaInv, connLevel} + let cData = ConnData {connId} connId' <- withStore $ \st -> createRcvConn st g cData rq addSubscription c rq connId' pure (connId', qInfo) -joinConn :: AgentMonad m => AgentClient -> ConnId -> SMPQueueInfo -> ConnInfo -> Maybe InvitationId -> Int -> m ConnId -joinConn c connId qInfo cInfo viaInv connLevel = do +joinConn :: AgentMonad m => AgentClient -> ConnId -> SMPQueueInfo -> ConnInfo -> m ConnId +joinConn c connId qInfo cInfo = do (sq, senderKey, verifyKey) <- newSndQueue qInfo g <- asks idsDrg cfg <- asks config - let cData = ConnData {connId, viaInv, connLevel} + let cData = ConnData {connId} connId' <- withStore $ \st -> createSndConn st g cData sq confirmQueue c sq senderKey cInfo activateQueueJoining c connId' sq verifyKey $ retryInterval cfg @@ -294,8 +261,8 @@ activateQueueJoining c connId sq verifyKey retryInterval = sendControlMessage c sq $ REPLY qInfo' -- | Approve confirmation (LET command) in Reader monad -allowConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m () -allowConnection' c connId confId ownConnInfo = +acceptConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m () +acceptConnection' c connId confId ownConnInfo = withStore (`getConn` connId) >>= \case SomeConn SCRcv (RcvConnection _ rq) -> do AcceptedConfirmation {senderKey} <- withStore $ \st -> acceptConfirmation st confId ownConnInfo @@ -308,35 +275,6 @@ processConfirmation c rq sndKey = do secureQueue c rq sndKey withStore $ \st -> setRcvQueueStatus st rq Secured --- | Send introduction of the second connection the first (INTRO command) in Reader monad -sendIntroduction' :: AgentMonad m => AgentClient -> ConnId -> ConnId -> ConnInfo -> m () -sendIntroduction' c toConn reConn reInfo = - withStore (\st -> (,) <$> getConn st toConn <*> getConn st reConn) >>= \case - (SomeConn _ (DuplexConnection _ _ sq), SomeConn _ DuplexConnection {}) -> do - g <- asks idsDrg - introId <- withStore $ \st -> createIntro st g NewIntroduction {toConn, reConn, reInfo} - sendControlMessage c sq $ A_INTRO introId reInfo - _ -> throwError $ CONN SIMPLEX - -acceptInv :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> ConnInfo -> m ConnId -acceptInv c connId invId connInfo = - withStore (`getInvitation` invId) >>= \case - Invitation {viaConn, qInfo, externalIntroId, status = InvNew} -> - withStore (`getConn` viaConn) >>= \case - SomeConn _ (DuplexConnection ConnData {connLevel} _ sq) -> case qInfo of - Nothing -> do - (connId', qInfo') <- newConn c connId (Just invId) (connLevel + 1) - withStore $ \st -> addInvitationConn st invId connId' - sendControlMessage c sq $ A_INV externalIntroId qInfo' connInfo - pure connId' - Just qInfo' -> do - -- TODO remove invitations from protocol - connId' <- joinConn c connId qInfo' connInfo (Just invId) (connLevel + 1) - withStore $ \st -> addInvitationConn st invId connId' - pure connId' - _ -> throwError $ CONN SIMPLEX - _ -> throwError $ CMD PROHIBITED - -- | Subscribe to receive connection messages (SUB command) in Reader monad subscribeConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m () subscribeConnection' c connId = @@ -468,10 +406,6 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do HELLO verifyKey _ -> helloMsg verifyKey msgBody REPLY qInfo -> replyMsg qInfo A_MSG body -> agentClientMsg previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash - A_INTRO introId cInfo -> introMsg introId cInfo - A_INV introId qInfo cInfo -> invMsg introId qInfo cInfo - A_REQ introId qInfo cInfo -> reqMsg introId qInfo cInfo - A_CON introId -> conMsg introId sendAck c rq return () SMP.END -> do @@ -497,7 +431,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 $ CONF confId cInfo + notify $ REQ confId cInfo SCDuplex -> do notify $ INFO cInfo processConfirmation c rq senderKey @@ -530,60 +464,6 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do activateQueueInitiating c connId sq verifyKey $ retryInterval cfg _ -> prohibited - introMsg :: IntroId -> ConnInfo -> m () - introMsg introId reInfo = do - logServer "<--" c srv rId "MSG " - case cType of - SCDuplex -> createInv introId Nothing reInfo - _ -> prohibited - - invMsg :: IntroId -> SMPQueueInfo -> ConnInfo -> m () - invMsg introId qInfo toInfo = do - logServer "<--" c srv rId "MSG " - case cType of - SCDuplex -> - withStore (`getIntro` introId) >>= \case - Introduction {toConn, toStatus = IntroNew, reConn, reStatus = IntroNew} - | toConn /= connId -> prohibited - | otherwise -> - withStore (\st -> addIntroInvitation st introId toInfo qInfo >> getConn st reConn) >>= \case - SomeConn _ (DuplexConnection _ _ sq) -> do - sendControlMessage c sq $ A_REQ introId qInfo toInfo - withStore $ \st -> setIntroReStatus st introId IntroInv - _ -> prohibited - _ -> prohibited - _ -> prohibited - - reqMsg :: IntroId -> SMPQueueInfo -> ConnInfo -> m () - reqMsg introId qInfo connInfo = do - logServer "<--" c srv rId "MSG " - case cType of - SCDuplex -> createInv introId (Just qInfo) connInfo - _ -> prohibited - - createInv :: IntroId -> Maybe SMPQueueInfo -> ConnInfo -> m () - createInv externalIntroId qInfo connInfo = do - g <- asks idsDrg - let newInv = NewInvitation {viaConn = connId, externalIntroId, connInfo, qInfo} - invId <- withStore $ \st -> createInvitation st g newInv - notify $ REQ invId connInfo - - conMsg :: IntroId -> m () - conMsg introId = do - logServer "<--" c srv rId "MSG " - withStore (`getIntro` introId) >>= \case - Introduction {toConn, toStatus, reConn, reStatus} - | toConn == connId && toStatus == IntroInv -> do - withStore $ \st -> setIntroToStatus st introId IntroCon - when (reStatus == IntroCon) $ sendConMsg toConn reConn - | reConn == connId && reStatus == IntroInv -> do - withStore $ \st -> setIntroReStatus st introId IntroCon - when (toStatus == IntroCon) $ sendConMsg toConn reConn - | otherwise -> prohibited - where - sendConMsg :: ConnId -> ConnId -> m () - sendConMsg toConn reConn = atomically $ writeTBQueue subQ ("", toConn, ICON reConn) - agentClientMsg :: PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m () agentClientMsg externalPrevSndHash sender broker msgBody internalHash = do logServer "<--" c srv rId "MSG " @@ -636,13 +516,7 @@ activateQueue c connId sq verifyKey retryInterval afterActivation = in withStore $ \st -> updateSignKey st sq safeSignKey notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m () -notifyConnected c connId = do - withStore (`getConnInvitation` connId) >>= \case - Just (Invitation {invId, externalIntroId}, DuplexConnection _ _ sq) -> do - withStore $ \st -> setInvitationStatus st invId InvCon - sendControlMessage c sq $ A_CON externalIntroId - _ -> pure () - atomically $ writeTBQueue (subQ c) ("", connId, CON) +notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON) newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => SMPQueueInfo -> m (SndQueue, SenderPublicKey, VerificationKey) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 590ca63c5..b8f29e856 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -156,14 +156,10 @@ data ACommand (p :: AParty) where NEW :: ACommand Client -- response INV INV :: SMPQueueInfo -> ACommand Agent JOIN :: SMPQueueInfo -> ConnInfo -> ACommand Client -- response OK - CONF :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender - LET :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client - INTRO :: ConnId -> ConnInfo -> ACommand Client - REQ :: InvitationId -> ConnInfo -> ACommand Agent - ACPT :: InvitationId -> ConnInfo -> ACommand Client + REQ :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender + ACPT :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client INFO :: ConnInfo -> ACommand Agent CON :: ACommand Agent -- notification that connection is established - ICON :: ConnId -> ACommand Agent SUB :: ACommand Client END :: ACommand Agent -- QST :: QueueDirection -> ACommand Client @@ -225,14 +221,6 @@ data AMessage where REPLY :: SMPQueueInfo -> AMessage -- | agent envelope for the client message A_MSG :: MsgBody -> AMessage - -- | agent message for introduction - A_INTRO :: IntroId -> ConnInfo -> AMessage - -- | agent envelope for the sent invitation - A_INV :: IntroId -> SMPQueueInfo -> ConnInfo -> AMessage - -- | agent envelope for the forwarded invitation - A_REQ :: IntroId -> SMPQueueInfo -> ConnInfo -> AMessage - -- | agent message for intro/group request - A_CON :: IntroId -> AMessage deriving (Show) -- | Parse SMP message. @@ -273,19 +261,10 @@ agentMessageP = "HELLO " *> hello <|> "REPLY " *> reply <|> "MSG " *> a_msg - <|> "INTRO " *> a_intro - <|> "INV " *> a_inv - <|> "REQ " *> a_req - <|> "CON " *> a_con where hello = HELLO <$> C.pubKeyP <*> ackMode reply = REPLY <$> smpQueueInfoP a_msg = A_MSG <$> binaryBodyP <* A.endOfLine - a_intro = A_INTRO <$> A.takeTill (== ' ') <* A.space <*> binaryBodyP <* A.endOfLine - a_inv = invP A_INV - a_req = invP A_REQ - a_con = A_CON <$> A.takeTill wordEnd - invP f = f <$> A.takeTill (== ' ') <* A.space <*> smpQueueInfoP <* A.space <*> binaryBodyP <* A.endOfLine ackMode = AckMode <$> (" NO_ACK" $> Off <|> pure On) -- | SMP queue information parser. @@ -306,13 +285,6 @@ serializeAgentMessage = \case HELLO verifyKey ackMode -> "HELLO " <> C.serializePubKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else "" REPLY qInfo -> "REPLY " <> serializeSmpQueueInfo qInfo A_MSG body -> "MSG " <> serializeBinary body <> "\n" - A_INTRO introId cInfo -> "INTRO " <> introId <> " " <> serializeBinary cInfo <> "\n" - A_INV introId qInfo cInfo -> "INV " <> serializeInv introId qInfo cInfo - A_REQ introId qInfo cInfo -> "REQ " <> serializeInv introId qInfo cInfo - A_CON introId -> "CON " <> introId - where - serializeInv introId qInfo cInfo = - B.intercalate " " [introId, serializeSmpQueueInfo qInfo, serializeBinary cInfo] <> "\n" -- | Serialize SMP queue information that is sent out-of-band. serializeSmpQueueInfo :: SMPQueueInfo -> ByteString @@ -478,9 +450,6 @@ commandP = "NEW" $> ACmd SClient NEW <|> "INV " *> invResp <|> "JOIN " *> joinCmd - <|> "CONF " *> confCmd - <|> "LET " *> letCmd - <|> "INTRO " *> introCmd <|> "REQ " *> reqCmd <|> "ACPT " *> acptCmd <|> "INFO " *> infoCmd @@ -492,21 +461,16 @@ commandP = <|> "OFF" $> ACmd SClient OFF <|> "DEL" $> ACmd SClient DEL <|> "ERR " *> agentError - <|> "ICON " *> iconMsg <|> "CON" $> ACmd SAgent CON <|> "OK" $> ACmd SAgent OK where invResp = ACmd SAgent . INV <$> smpQueueInfoP joinCmd = ACmd SClient <$> (JOIN <$> smpQueueInfoP <* A.space <*> A.takeByteString) - confCmd = ACmd SAgent <$> (CONF <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString) - letCmd = ACmd SClient <$> (LET <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString) - introCmd = ACmd SClient <$> introP INTRO - reqCmd = ACmd SAgent <$> introP REQ - acptCmd = ACmd SClient <$> introP ACPT + reqCmd = 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 sentResp = ACmd SAgent . SENT <$> A.decimal - iconMsg = ACmd SAgent . ICON <$> A.takeTill wordEnd message = ACmd SAgent <$> (MSG <$> msgMetaP <* A.space <*> A.takeByteString) msgMetaP = do integrity <- msgIntegrityP @@ -514,7 +478,6 @@ commandP = broker <- " B=" *> partyMeta base64P sender <- " S=" *> partyMeta A.decimal pure MsgMeta {integrity, recipient, broker, sender} - introP f = f <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P agentError = ACmd SAgent . ERR <$> agentErrorTypeP @@ -537,11 +500,8 @@ serializeCommand = \case NEW -> "NEW" INV qInfo -> "INV " <> serializeSmpQueueInfo qInfo JOIN qInfo cInfo -> "JOIN " <> serializeSmpQueueInfo qInfo <> " " <> serializeBinary cInfo - CONF confId cInfo -> "CONF " <> confId <> " " <> serializeBinary cInfo - LET confId cInfo -> "LET " <> confId <> " " <> serializeBinary cInfo - INTRO connId cInfo -> "INTRO " <> connId <> " " <> serializeBinary cInfo - REQ invId cInfo -> "REQ " <> invId <> " " <> serializeBinary cInfo - ACPT invId cInfo -> "ACPT " <> invId <> " " <> serializeBinary cInfo + REQ confId cInfo -> "REQ " <> confId <> " " <> serializeBinary cInfo + ACPT confId cInfo -> "ACPT " <> confId <> " " <> serializeBinary cInfo INFO cInfo -> "INFO " <> serializeBinary cInfo SUB -> "SUB" END -> "END" @@ -552,7 +512,6 @@ serializeCommand = \case OFF -> "OFF" DEL -> "DEL" CON -> "CON" - ICON connId -> "ICON " <> connId ERR e -> "ERR " <> serializeAgentError e OK -> "OK" where @@ -640,7 +599,6 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody -- NEW, JOIN and ACPT have optional connId NEW -> Right cmd JOIN {} -> Right cmd - ACPT {} -> Right cmd -- ERROR response does not always have connId ERR _ -> Right cmd -- other responses must have connId @@ -652,12 +610,9 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody cmdWithMsgBody = \case SEND body -> SEND <$$> getBody body MSG msgMeta body -> MSG msgMeta <$$> getBody body - INTRO introId cInfo -> INTRO introId <$$> getBody cInfo - REQ introId cInfo -> REQ introId <$$> getBody cInfo - ACPT introId cInfo -> ACPT introId <$$> getBody cInfo JOIN qInfo cInfo -> JOIN qInfo <$$> getBody cInfo - CONF confId cInfo -> CONF confId <$$> getBody cInfo - LET confId cInfo -> LET confId <$$> getBody cInfo + REQ confId cInfo -> REQ confId <$$> getBody cInfo + ACPT confId cInfo -> ACPT 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 6b49ad280..72f157397 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -3,9 +3,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} @@ -17,7 +15,6 @@ import Crypto.Random (ChaChaDRG) import Data.ByteString.Char8 (ByteString) import Data.Int (Int64) import Data.Kind (Type) -import Data.Text (Text) import Data.Time (UTCTime) import Data.Type.Equality import Simplex.Messaging.Agent.Protocol @@ -61,18 +58,6 @@ class Monad m => MonadAgentStore s m where createSndMsg :: s -> ConnId -> SndMsgData -> m () getMsg :: s -> ConnId -> InternalId -> m Msg - -- Introductions - createIntro :: s -> TVar ChaChaDRG -> NewIntroduction -> m IntroId - getIntro :: s -> IntroId -> m Introduction - addIntroInvitation :: s -> IntroId -> ConnInfo -> SMPQueueInfo -> m () - setIntroToStatus :: s -> IntroId -> IntroStatus -> m () - setIntroReStatus :: s -> IntroId -> IntroStatus -> m () - createInvitation :: s -> TVar ChaChaDRG -> NewInvitation -> m InvitationId - getInvitation :: s -> InvitationId -> m Invitation - addInvitationConn :: s -> InvitationId -> ConnId -> m () - getConnInvitation :: s -> ConnId -> m (Maybe (Invitation, Connection CDuplex)) - setInvitationStatus :: s -> InvitationId -> InvitationStatus -> m () - -- * Queue types -- | A receive queue. SMP queue through which the agent receives messages from a sender. @@ -153,7 +138,7 @@ instance Eq SomeConn where deriving instance Show SomeConn -data ConnData = ConnData {connId :: ConnId, viaInv :: Maybe InvitationId, connLevel :: Int} +newtype ConnData = ConnData {connId :: ConnId} deriving (Eq, Show) -- * Confirmation types @@ -308,75 +293,6 @@ newtype InternalId = InternalId {unId :: Int64} deriving (Eq, Show) type InternalTs = UTCTime --- * Introduction types - -data NewIntroduction = NewIntroduction - { toConn :: ConnId, - reConn :: ConnId, - reInfo :: ByteString - } - -data Introduction = Introduction - { introId :: IntroId, - toConn :: ConnId, - toInfo :: Maybe ByteString, - toStatus :: IntroStatus, - reConn :: ConnId, - reInfo :: ByteString, - reStatus :: IntroStatus, - qInfo :: Maybe SMPQueueInfo - } - -data IntroStatus = IntroNew | IntroInv | IntroCon - deriving (Eq) - -serializeIntroStatus :: IntroStatus -> Text -serializeIntroStatus = \case - IntroNew -> "" - IntroInv -> "INV" - IntroCon -> "CON" - -introStatusT :: Text -> Maybe IntroStatus -introStatusT = \case - "" -> Just IntroNew - "INV" -> Just IntroInv - "CON" -> Just IntroCon - _ -> Nothing - -data NewInvitation = NewInvitation - { viaConn :: ConnId, - externalIntroId :: IntroId, - connInfo :: ConnInfo, - qInfo :: Maybe SMPQueueInfo - } - -data Invitation = Invitation - { invId :: InvitationId, - viaConn :: ConnId, - externalIntroId :: IntroId, - connInfo :: ConnInfo, - qInfo :: Maybe SMPQueueInfo, - connId :: Maybe ConnId, - status :: InvitationStatus - } - deriving (Show) - -data InvitationStatus = InvNew | InvAcpt | InvCon - deriving (Eq, Show) - -serializeInvStatus :: InvitationStatus -> Text -serializeInvStatus = \case - InvNew -> "" - InvAcpt -> "ACPT" - InvCon -> "CON" - -invStatusT :: Text -> Maybe InvitationStatus -invStatusT = \case - "" -> Just InvNew - "ACPT" -> Just InvAcpt - "CON" -> Just InvCon - _ -> Nothing - -- * Store errors -- | Agent store error. @@ -394,10 +310,6 @@ data StoreError SEBadConnType ConnType | -- | Confirmation not found. SEConfirmationNotFound - | -- | Introduction ID not found. - SEIntroNotFound - | -- | Invitation ID not found. - SEInvitationNotFound | -- | Currently not used. The intention was to pass current expected queue status in methods, -- as we always know what it should be at any stage of the protocol, -- and in case it does not match use this error. diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 6f18a9f8b..f6d2e2fd9 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -29,7 +29,7 @@ where import Control.Concurrent (threadDelay) import Control.Concurrent.STM import Control.Exception (bracket) -import Control.Monad (join, replicateM_, unless, when) +import Control.Monad (replicateM_, unless, when) import Control.Monad.Except (MonadError (throwError), MonadIO (liftIO)) import Control.Monad.IO.Unlift (MonadUnliftIO) import Crypto.Random (ChaChaDRG, randomBytesGenerate) @@ -395,151 +395,6 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto getMsg :: SQLiteStore -> ConnId -> InternalId -> m Msg getMsg _st _connAlias _id = throwError SENotImplemented - createIntro :: SQLiteStore -> TVar ChaChaDRG -> NewIntroduction -> m IntroId - createIntro st gVar NewIntroduction {toConn, reConn, reInfo} = - liftIOEither . withTransaction st $ \db -> - createWithRandomId gVar $ \introId -> - DB.execute - db - [sql| - INSERT INTO conn_intros - (intro_id, to_conn, re_conn, re_info) VALUES (?, ?, ?, ?); - |] - (introId, toConn, reConn, reInfo) - - getIntro :: SQLiteStore -> IntroId -> m Introduction - getIntro st introId = - liftIOEither . withConnection st $ \db -> - intro - <$> DB.query - db - [sql| - SELECT to_conn, to_info, to_status, re_conn, re_info, re_status, queue_info - FROM conn_intros - WHERE intro_id = ?; - |] - (Only introId) - where - intro [(toConn, toInfo, toStatus, reConn, reInfo, reStatus, qInfo)] = - Right $ Introduction {introId, toConn, toInfo, toStatus, reConn, reInfo, reStatus, qInfo} - intro _ = Left SEIntroNotFound - - addIntroInvitation :: SQLiteStore -> IntroId -> ConnInfo -> SMPQueueInfo -> m () - addIntroInvitation st introId toInfo qInfo = - liftIO . withTransaction st $ \db -> - DB.executeNamed - db - [sql| - UPDATE conn_intros - SET to_info = :to_info, - queue_info = :queue_info, - to_status = :to_status - WHERE intro_id = :intro_id; - |] - [ ":to_info" := toInfo, - ":queue_info" := Just qInfo, - ":to_status" := IntroInv, - ":intro_id" := introId - ] - - setIntroToStatus :: SQLiteStore -> IntroId -> IntroStatus -> m () - setIntroToStatus st introId toStatus = - liftIO . withTransaction st $ \db -> - DB.execute - db - [sql| - UPDATE conn_intros - SET to_status = ? - WHERE intro_id = ?; - |] - (toStatus, introId) - - setIntroReStatus :: SQLiteStore -> IntroId -> IntroStatus -> m () - setIntroReStatus st introId reStatus = - liftIO . withTransaction st $ \db -> - DB.execute - db - [sql| - UPDATE conn_intros - SET re_status = ? - WHERE intro_id = ?; - |] - (reStatus, introId) - - createInvitation :: SQLiteStore -> TVar ChaChaDRG -> NewInvitation -> m InvitationId - createInvitation st gVar NewInvitation {viaConn, externalIntroId, connInfo, qInfo} = - liftIOEither . withTransaction st $ \db -> - createWithRandomId gVar $ \invId -> - DB.execute - db - [sql| - INSERT INTO conn_invitations - (inv_id, via_conn, external_intro_id, conn_info, queue_info) VALUES (?, ?, ?, ?, ?); - |] - (invId, viaConn, externalIntroId, connInfo, qInfo) - - getInvitation :: SQLiteStore -> InvitationId -> m Invitation - getInvitation st invId = - liftIOEither . withConnection st $ \db -> - invitation - <$> DB.query - db - [sql| - SELECT via_conn, external_intro_id, conn_info, queue_info, conn_id, status - FROM conn_invitations - WHERE inv_id = ?; - |] - (Only invId) - where - invitation [(viaConn, externalIntroId, connInfo, qInfo, connId, status)] = - Right $ Invitation {invId, viaConn, externalIntroId, connInfo, qInfo, connId, status} - invitation _ = Left SEInvitationNotFound - - addInvitationConn :: SQLiteStore -> InvitationId -> ConnId -> m () - addInvitationConn st invId connId = - liftIO . withTransaction st $ \db -> - DB.executeNamed - db - [sql| - UPDATE conn_invitations - SET conn_id = :conn_id, status = :status - WHERE inv_id = :inv_id; - |] - [":conn_id" := connId, ":status" := InvAcpt, ":inv_id" := invId] - - getConnInvitation :: SQLiteStore -> ConnId -> m (Maybe (Invitation, Connection 'CDuplex)) - getConnInvitation st cId = - liftIO . withTransaction st $ \db -> - DB.query - db - [sql| - SELECT inv_id, via_conn, external_intro_id, conn_info, queue_info, status - FROM conn_invitations - WHERE conn_id = ?; - |] - (Only cId) - >>= fmap join . traverse (getViaConn db) . invitation - where - invitation [(invId, viaConn, externalIntroId, connInfo, qInfo, status)] = - Just $ Invitation {invId, viaConn, externalIntroId, connInfo, qInfo, connId = Just cId, status} - invitation _ = Nothing - getViaConn :: DB.Connection -> Invitation -> IO (Maybe (Invitation, Connection 'CDuplex)) - getViaConn db inv@Invitation {viaConn} = fmap (inv,) . duplexConn <$> getConn_ db viaConn - duplexConn :: Either StoreError SomeConn -> Maybe (Connection 'CDuplex) - duplexConn (Right (SomeConn SCDuplex conn)) = Just conn - duplexConn _ = Nothing - - setInvitationStatus :: SQLiteStore -> InvitationId -> InvitationStatus -> m () - setInvitationStatus st invId status = - liftIO . withTransaction st $ \db -> - DB.execute - db - [sql| - UPDATE conn_invitations - SET status = ? WHERE inv_id = ?; - |] - (status, invId) - -- * Auxiliary helpers -- ? replace with ToField? - it's easy to forget to use this @@ -574,14 +429,6 @@ instance ToField MsgIntegrity where toField = toField . serializeMsgIntegrity instance FromField MsgIntegrity where fromField = blobFieldParser msgIntegrityP -instance ToField IntroStatus where toField = toField . serializeIntroStatus - -instance FromField IntroStatus where fromField = fromTextField_ introStatusT - -instance ToField InvitationStatus where toField = toField . serializeInvStatus - -instance FromField InvitationStatus where fromField = fromTextField_ invStatusT - instance ToField SMPQueueInfo where toField = toField . serializeSmpQueueInfo instance FromField SMPQueueInfo where fromField = blobFieldParser smpQueueInfoP @@ -646,22 +493,20 @@ insertRcvQueue_ dbConn connId RcvQueue {..} = do ] insertRcvConnection_ :: DB.Connection -> ConnData -> RcvQueue -> IO () -insertRcvConnection_ dbConn ConnData {connId, viaInv, connLevel} RcvQueue {server, rcvId} = do +insertRcvConnection_ dbConn ConnData {connId} RcvQueue {server, rcvId} = 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, via_inv, conn_level, 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) VALUES - (:conn_alias,:rcv_host,:rcv_port,:rcv_id, NULL, NULL, NULL, :via_inv,:conn_level, 0, 0, 0, 0, x'', x''); + (:conn_alias,:rcv_host,:rcv_port,:rcv_id, NULL, NULL, NULL, 0, 0, 0, 0, x'', x''); |] [ ":conn_alias" := connId, ":rcv_host" := host server, ":rcv_port" := port_, - ":rcv_id" := rcvId, - ":via_inv" := viaInv, - ":conn_level" := connLevel + ":rcv_id" := rcvId ] -- * createSndConn helpers @@ -688,22 +533,20 @@ insertSndQueue_ dbConn connId SndQueue {..} = do ] insertSndConnection_ :: DB.Connection -> ConnData -> SndQueue -> IO () -insertSndConnection_ dbConn ConnData {connId, viaInv, connLevel} SndQueue {server, sndId} = do +insertSndConnection_ dbConn ConnData {connId} SndQueue {server, sndId} = 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, via_inv, conn_level, 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) VALUES - (:conn_alias, NULL, NULL, NULL, :snd_host,:snd_port,:snd_id,:via_inv,:conn_level, 0, 0, 0, 0, x'', x''); + (:conn_alias, NULL, NULL, NULL, :snd_host,:snd_port,:snd_id, 0, 0, 0, 0, x'', x''); |] [ ":conn_alias" := connId, ":snd_host" := host server, ":snd_port" := port_, - ":snd_id" := sndId, - ":via_inv" := viaInv, - ":conn_level" := connLevel + ":snd_id" := sndId ] -- * getConn helpers @@ -722,11 +565,11 @@ getConn_ dbConn connId = _ -> Left SEConnNotFound getConnData_ :: DB.Connection -> ConnId -> IO (Maybe ConnData) -getConnData_ dbConn connId = +getConnData_ dbConn connId' = connData - <$> DB.query dbConn "SELECT via_inv, conn_level FROM connections WHERE conn_alias = ?;" (Only connId) + <$> DB.query dbConn "SELECT conn_alias FROM connections WHERE conn_alias = ?;" (Only connId') where - connData [(viaInv, connLevel)] = Just ConnData {connId, viaInv, connLevel} + connData [Only connId] = Just ConnData {connId} connData _ = Nothing getRcvQueueByConnAlias_ :: DB.Connection -> ConnId -> IO (Maybe RcvQueue) diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index e8faf5ea9..59b4ceb49 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -45,11 +45,6 @@ agentTests (ATransport t) = do smpAgentTest3_1_1 $ testSubscription t it "should send notifications to client when server disconnects" $ smpAgentServerTest $ testSubscrNotification t - describe "Introduction" do - it "should send and accept introduction" $ - smpAgentTest3 $ testIntroduction t - it "should send and accept introduction (random IDs)" $ - smpAgentTest3 $ testIntroductionRandomIds t -- | receive message to handle `h` (<#:) :: Transport c => c -> IO (ATransmissionOrError 'Agent) @@ -99,8 +94,8 @@ testDuplexConnection _ alice bob = do ("1", "bob", Right (INV qInfo)) <- alice #: ("1", "bob", "NEW") let qInfo' = serializeSmpQueueInfo qInfo bob #: ("11", "alice", "JOIN " <> qInfo' <> " 14\nbob's connInfo") #> ("11", "alice", OK) - ("", "bob", Right (CONF confId "bob's connInfo")) <- (alice <#:) - alice #: ("2", "bob", "LET " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK) + ("", "bob", Right (REQ confId "bob's connInfo")) <- (alice <#:) + alice #: ("2", "bob", "ACPT " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK) bob <# ("", "alice", INFO "alice's connInfo") bob <# ("", "alice", CON) alice <# ("", "bob", CON) @@ -122,9 +117,9 @@ testDuplexConnRandomIds _ alice bob = do ("1", bobConn, Right (INV qInfo)) <- alice #: ("1", "", "NEW") let qInfo' = serializeSmpQueueInfo qInfo ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> qInfo' <> " 14\nbob's connInfo") - ("", bobConn', Right (CONF confId "bob's connInfo")) <- (alice <#:) + ("", bobConn', Right (REQ confId "bob's connInfo")) <- (alice <#:) bobConn' `shouldBe` bobConn - alice #: ("2", bobConn, "LET " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False + alice #: ("2", bobConn, "ACPT " <> confId <> " 16\nalice's connInfo") =#> \case ("2", c, OK) -> c == bobConn; _ -> False bob <# ("", aliceConn, INFO "alice's connInfo") bob <# ("", aliceConn, CON) alice <# ("", bobConn, CON) @@ -161,62 +156,13 @@ testSubscrNotification _ (server, _) client = do killThread server client <# ("", "conn1", END) -testIntroduction :: forall c. Transport c => TProxy c -> c -> c -> c -> IO () -testIntroduction _ alice bob tom = do - -- establish connections - (alice, "alice") `connect` (bob, "bob") - (alice, "alice") `connect` (tom, "tom") - -- send introduction of tom to bob - alice #: ("1", "bob", "INTRO tom 8\nmeet tom") #> ("1", "bob", OK) - ("", "alice", Right (REQ invId1 "meet tom")) <- (bob <#:) - bob #: ("2", "tom_via_alice", "ACPT " <> invId1 <> " 7\nI'm bob") #> ("2", "tom_via_alice", OK) - ("", "alice", Right (REQ invId2 "I'm bob")) <- (tom <#:) - tom #: ("3", "bob_via_alice", "ACPT " <> invId2 <> " 8\ntom here") #> ("3", "bob_via_alice", OK) - ("", "tom_via_alice", Right (CONF confId "tom here")) <- (bob <#:) - bob #: ("3.1", "tom_via_alice", "LET " <> confId <> " 7\nI'm bob") #> ("3.1", "tom_via_alice", OK) - bob <# ("", "tom_via_alice", CON) - tom <# ("", "bob_via_alice", INFO "I'm bob") - tom <# ("", "bob_via_alice", CON) - alice <# ("", "bob", ICON "tom") - -- they can message each other now - tom #: ("4", "bob_via_alice", "SEND :hello") #> ("4", "bob_via_alice", SENT 1) - bob <#= \case ("", "tom_via_alice", Msg "hello") -> True; _ -> False - bob #: ("5", "tom_via_alice", "SEND 9\nhello too") #> ("5", "tom_via_alice", SENT 2) - tom <#= \case ("", "bob_via_alice", Msg "hello too") -> True; _ -> False - -testIntroductionRandomIds :: forall c. Transport c => TProxy c -> c -> c -> c -> IO () -testIntroductionRandomIds _ alice bob tom = do - -- establish connections - (aliceB, bobA) <- alice `connect'` bob - (aliceT, tomA) <- alice `connect'` tom - -- send introduction of tom to bob - alice #: ("1", bobA, "INTRO " <> tomA <> " 8\nmeet tom") #> ("1", bobA, OK) - ("", aliceB', Right (REQ invId1 "meet tom")) <- (bob <#:) - aliceB' `shouldBe` aliceB - ("2", tomB, Right OK) <- bob #: ("2", "", "ACPT " <> invId1 <> " 7\nI'm bob") - ("", aliceT', Right (REQ invId2 "I'm bob")) <- (tom <#:) - aliceT' `shouldBe` aliceT - ("3", bobT, Right OK) <- tom #: ("3", "", "ACPT " <> invId2 <> " 8\ntom here") - ("", tomB', Right (CONF confId "tom here")) <- (bob <#:) - tomB' `shouldBe` tomB - bob #: ("3.1", tomB, "LET " <> confId <> " 7\nI'm bob") =#> \case ("3.1", c, OK) -> c == tomB; _ -> False - bob <# ("", tomB, CON) - tom <# ("", bobT, INFO "I'm bob") - tom <# ("", bobT, CON) - alice <# ("", bobA, ICON tomA) - -- they can message each other now - tom #: ("4", bobT, "SEND :hello") #> ("4", bobT, SENT 1) - bob <#= \case ("", c, Msg "hello") -> c == tomB; _ -> False - bob #: ("5", tomB, "SEND 9\nhello too") #> ("5", tomB, SENT 2) - tom <#= \case ("", c, Msg "hello too") -> c == bobT; _ -> False - connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO () connect (h1, name1) (h2, name2) = do ("c1", _, Right (INV qInfo)) <- h1 #: ("c1", name2, "NEW") let qInfo' = serializeSmpQueueInfo qInfo h2 #: ("c2", name1, "JOIN " <> qInfo' <> " 5\ninfo2") #> ("c2", name1, OK) - ("", _, Right (CONF connId "info2")) <- (h1 <#:) - h1 #: ("c3", name2, "LET " <> connId <> " 5\ninfo1") #> ("c3", name2, OK) + ("", _, Right (REQ connId "info2")) <- (h1 <#:) + h1 #: ("c3", name2, "ACPT " <> connId <> " 5\ninfo1") #> ("c3", name2, OK) h2 <# ("", name1, INFO "info1") h2 <# ("", name1, CON) h1 <# ("", name2, CON) @@ -226,8 +172,8 @@ connect' h1 h2 = do ("c1", conn2, Right (INV qInfo)) <- h1 #: ("c1", "", "NEW") let qInfo' = serializeSmpQueueInfo qInfo ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN " <> qInfo' <> " 5\ninfo2") - ("", _, Right (CONF connId "info2")) <- (h1 <#:) - h1 #: ("c3", conn2, "LET " <> connId <> " 5\ninfo1") =#> \case ("c3", c, OK) -> c == conn2; _ -> False + ("", _, Right (REQ connId "info2")) <- (h1 <#:) + h1 #: ("c3", conn2, "ACPT " <> connId <> " 5\ninfo1") =#> \case ("c3", c, OK) -> c == conn2; _ -> False h2 <# ("", conn1, INFO "info1") h2 <# ("", conn1, CON) h1 <# ("", conn2, CON) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index e2a25926e..4d945553d 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -56,8 +56,8 @@ testAgentClient = do Right () <- runExceptT $ do (bobId, qInfo) <- createConnection alice aliceId <- joinConnection bob qInfo "bob's connInfo" - ("", _, CONF confId "bob's connInfo") <- get alice - allowConnection alice bobId confId "alice's connInfo" + ("", _, REQ confId "bob's connInfo") <- get alice + acceptConnection alice bobId confId "alice's connInfo" get alice ##> ("", bobId, CON) get bob ##> ("", aliceId, INFO "alice's connInfo") get bob ##> ("", aliceId, CON) @@ -93,8 +93,8 @@ testAsyncInitiatingOffline = do aliceId <- joinConnection bob qInfo "bob's connInfo" alice' <- liftIO $ getSMPAgentClient cfg subscribeConnection alice' bobId - ("", _, CONF confId "bob's connInfo") <- get alice' - allowConnection alice' bobId confId "alice's connInfo" + ("", _, REQ confId "bob's connInfo") <- get alice' + acceptConnection alice' bobId confId "alice's connInfo" get alice' ##> ("", bobId, CON) get bob ##> ("", aliceId, INFO "alice's connInfo") get bob ##> ("", aliceId, CON) @@ -109,8 +109,8 @@ testAsyncJoiningOfflineBeforeActivation = do (bobId, qInfo) <- createConnection alice aliceId <- joinConnection bob qInfo "bob's connInfo" disconnectAgentClient bob - ("", _, CONF confId "bob's connInfo") <- get alice - allowConnection alice bobId confId "alice's connInfo" + ("", _, REQ confId "bob's connInfo") <- get alice + acceptConnection alice bobId confId "alice's connInfo" bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2} subscribeConnection bob' aliceId get alice ##> ("", bobId, CON) @@ -133,8 +133,8 @@ testAsyncBothOffline = do disconnectAgentClient bob alice' <- liftIO $ getSMPAgentClient cfg subscribeConnection alice' bobId - ("", _, CONF confId "bob's connInfo") <- get alice' - allowConnection alice' bobId confId "alice's connInfo" + ("", _, REQ confId "bob's connInfo") <- get alice' + acceptConnection alice' bobId confId "alice's connInfo" bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2} subscribeConnection bob' aliceId get alice' ##> ("", bobId, CON) diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 0f364c969..f5c64d923 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -147,7 +147,7 @@ testForeignKeysEnabled = `shouldThrow` (\e -> DB.sqlError e == DB.ErrorConstraint) cData1 :: ConnData -cData1 = ConnData {connId = "conn1", viaInv = Nothing, connLevel = 1} +cData1 = ConnData {connId = "conn1"} rcvQueue1 :: RcvQueue rcvQueue1 =