diff --git a/simplexmq.cabal b/simplexmq.cabal index 3665cb0f7..a7f130e9f 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -40,6 +40,7 @@ library Simplex.Messaging.Agent.Store.SQLite Simplex.Messaging.Agent.Store.SQLite.Migrations Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial + Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys Simplex.Messaging.Client Simplex.Messaging.Crypto Simplex.Messaging.Crypto.Ratchet diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 8f28adda5..7b4e202bd 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -234,16 +234,20 @@ joinConn c connId (CRInvitationUri (ConnReqUriData _ agentVRange (qUri :| _)) e2 (pk1, pk2, e2eSndParams) <- liftIO . CR.generateE2EParams $ version e2eRcvParams (_, rcDHRs) <- liftIO C.generateKeyPair' let rc = CR.initSndRatchet rcDHRr rcDHRs $ CR.x3dhSnd pk1 pk2 e2eRcvParams - (sq, smpConf) <- newSndQueue qInfo cInfo + sq <- newSndQueue qInfo g <- asks idsDrg let cData = ConnData {connId} connId' <- withStore $ \st -> do connId' <- createSndConn st g cData sq createRatchet st connId' rc pure connId' - confirmQueue c connId' sq smpConf $ Just e2eSndParams - void $ enqueueMessage c connId' sq HELLO - pure connId' + tryError (confirmQueue c connId' sq cInfo $ Just e2eSndParams) >>= \case + Right _ -> do + void $ enqueueMessage c connId' sq HELLO + pure connId' + Left e -> do + withStore (`deleteConn` connId') + throwError e _ -> throwError $ AGENT A_VERSION joinConn c connId (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInfo = case ( qUri `compatibleVersion` SMP.smpClientVRange, @@ -337,12 +341,12 @@ enqueueMessage c connId sq aMessage = do internalTs <- liftIO getCurrentTime (internalId, internalSndId, prevMsgHash) <- withStore (`updateSndIds` connId) let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash - agentMessage = smpEncode $ AgentMessage privHeader aMessage - internalHash = C.sha256Hash agentMessage - - encAgentMessage <- agentRatchetEncrypt connId agentMessage e2eEncUserMsgLength + agentMsg = AgentMessage privHeader aMessage + agentMsgStr = smpEncode agentMsg + internalHash = C.sha256Hash agentMsgStr + encAgentMessage <- agentRatchetEncrypt connId agentMsgStr e2eEncUserMsgLength let msgBody = smpEncode $ AgentMsgEnvelope {agentVersion = smpAgentVersion, encAgentMessage} - msgType = aMessageType aMessage + msgType = agentMessageType agentMsg msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, internalHash, prevMsgHash} withStore $ \st -> createSndMsg st connId msgData pure internalId @@ -392,30 +396,38 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} connId sq = do notify $ MERR mId (INTERNAL $ show e) Right (rq_, (msgType, msgBody, internalTs)) -> withRetryInterval ri $ \loop -> - tryError (sendAgentMessage c sq msgBody) >>= \case + tryError (send msgType c sq msgBody) >>= \case Left e -> do + let err = if msgType == AM_CONN_INFO then ERR e else MERR mId e case e of - SMP SMP.QUOTA -> loop + SMP SMP.QUOTA -> case msgType of + AM_CONN_INFO -> connError msgId NOT_AVAILABLE + _ -> loop SMP SMP.AUTH -> case msgType of - HELLO_ -> do + AM_CONN_INFO -> connError msgId NOT_AVAILABLE + AM_HELLO_ -> do helloTimeout <- asks $ helloTimeout . config currentTime <- liftIO getCurrentTime if diffUTCTime currentTime internalTs > helloTimeout then case rq_ of -- party initiating connection - Just _ -> notifyDel msgId . ERR $ CONN NOT_AVAILABLE + Just _ -> connError msgId NOT_AVAILABLE -- party joining connection - _ -> notifyDel msgId . ERR $ CONN NOT_ACCEPTED + _ -> connError msgId NOT_ACCEPTED else loop - REPLY_ -> notifyDel msgId $ ERR e - A_MSG_ -> notifyDel msgId $ MERR mId e - SMP (SMP.CMD _) -> notifyDel msgId $ MERR mId e - SMP SMP.LARGE_MSG -> notifyDel msgId $ MERR mId e - SMP {} -> notify (MERR mId e) >> loop + AM_REPLY_ -> notifyDel msgId $ ERR e + AM_A_MSG_ -> notifyDel msgId $ MERR mId e + SMP (SMP.CMD _) -> notifyDel msgId err + SMP SMP.LARGE_MSG -> notifyDel msgId err + SMP {} -> notify err >> loop _ -> loop Right () -> do case msgType of - HELLO_ -> do + AM_CONN_INFO -> do + withStore $ \st -> setSndQueueStatus st sq Confirmed + when (isJust rq_) $ withStore (`removeConfirmations` connId) + void $ enqueueMessage c connId sq HELLO + AM_HELLO_ -> do withStore $ \st -> setSndQueueStatus st sq Active case rq_ of -- party initiating connection @@ -424,16 +436,20 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} connId sq = do notify CON -- party joining connection _ -> createReplyQueue c connId sq - A_MSG_ -> notify $ SENT mId + AM_A_MSG_ -> notify $ SENT mId _ -> pure () delMsg msgId where + send = \case + AM_CONN_INFO -> sendConfirmation + _ -> sendAgentMessage delMsg :: InternalId -> m () delMsg msgId = withStore $ \st -> deleteMsg st connId msgId notify :: ACommand 'Agent -> m () notify cmd = atomically $ writeTBQueue subQ ("", connId, cmd) notifyDel :: InternalId -> ACommand 'Agent -> m () notifyDel msgId cmd = notify cmd >> delMsg msgId + connError msgId = notifyDel msgId . ERR . CONN ackMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> AgentMsgId -> m () ackMessage' c connId msgId = do @@ -519,8 +535,9 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do (SMP.PHEmpty, AgentMsgEnvelope _ encAgentMsg) -> do agentMsgBody <- agentRatchetDecrypt connId encAgentMsg parseMessage agentMsgBody >>= \case - AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage -> do - (msgId, msgMeta) <- agentClientMsg prevMsgHash sndMsgId (srvMsgId, systemToUTCTime srvTs) agentMsgBody aMessage + agentMsg@(AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage) -> do + let msgType = agentMessageType agentMsg + (msgId, msgMeta) <- agentClientMsg prevMsgHash sndMsgId (srvMsgId, systemToUTCTime srvTs) agentMsgBody msgType case aMessage of HELLO -> helloMsg >> ack >> withStore (\st -> deleteMsg st connId msgId) REPLY cReq -> replyMsg cReq >> ack >> withStore (\st -> deleteMsg st connId msgId) @@ -610,15 +627,13 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do case qInfo `proveCompatible` SMP.smpClientVRange of Nothing -> notify . ERR $ AGENT A_VERSION Just qInfo' -> do - (sq, smpConf) <- newSndQueue qInfo' ownConnInfo + sq <- newSndQueue qInfo' withStore $ \st -> upgradeRcvConnToDuplex st connId sq - confirmQueue c connId sq smpConf Nothing - withStore (`removeConfirmations` connId) - void $ enqueueMessage c connId sq HELLO + enqueueConfirmation c connId sq ownConnInfo Nothing _ -> prohibited - agentClientMsg :: PrevRcvMsgHash -> ExternalSndId -> (BrokerId, BrokerTs) -> MsgBody -> AMessage -> m (InternalId, MsgMeta) - agentClientMsg externalPrevSndHash sndMsgId broker msgBody aMessage = do + agentClientMsg :: PrevRcvMsgHash -> ExternalSndId -> (BrokerId, BrokerTs) -> MsgBody -> AgentMessageType -> m (InternalId, MsgMeta) + agentClientMsg externalPrevSndHash sndMsgId broker msgBody msgType = do logServer "<--" c srv rId "MSG " let internalHash = C.sha256Hash msgBody internalTs <- liftIO getCurrentTime @@ -626,7 +641,6 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do let integrity = checkMsgIntegrity prevExtSndId sndMsgId prevRcvMsgHash externalPrevSndHash recipient = (unId internalId, internalTs) msgMeta = MsgMeta {integrity, recipient, broker, sndMsgId} - msgType = aMessageType aMessage rcvMsg = RcvMsgData {msgMeta, msgType, msgBody, internalRcvId, internalHash, externalPrevSndHash} withStore $ \st -> createRcvMsg st connId rcvMsg pure (internalId, msgMeta) @@ -651,8 +665,9 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do | internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash | otherwise = MsgError MsgDuplicate -- this case is not possible -confirmQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> SMPConfirmation -> Maybe (CR.E2ERatchetParams 'C.X448) -> m () -confirmQueue c connId sq SMPConfirmation {senderKey, e2ePubKey, connInfo} e2eEncryption = do +confirmQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m () +confirmQueue c connId sq connInfo e2eEncryption = do + _ <- withStore (`updateSndIds` connId) msg <- mkConfirmation sendConfirmation c sq msg withStore $ \st -> setSndQueueStatus st sq Confirmed @@ -660,9 +675,27 @@ confirmQueue c connId sq SMPConfirmation {senderKey, e2ePubKey, connInfo} e2eEnc mkConfirmation :: m MsgBody mkConfirmation = do encConnInfo <- agentRatchetEncrypt connId (smpEncode $ AgentConnInfo connInfo) e2eEncConnInfoLength - let agentEnvelope = AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo} - agentCbEncrypt sq (Just e2ePubKey) . smpEncode $ - SMP.ClientMessage (SMP.PHConfirmation senderKey) $ smpEncode agentEnvelope + pure . smpEncode $ AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo} + +enqueueConfirmation :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m () +enqueueConfirmation c connId sq connInfo e2eEncryption = do + resumeMsgDelivery c connId sq + msgId <- storeConfirmation + queuePendingMsgs c connId sq [msgId] + where + storeConfirmation :: m InternalId + storeConfirmation = do + internalTs <- liftIO getCurrentTime + (internalId, internalSndId, prevMsgHash) <- withStore (`updateSndIds` connId) + let agentMsg = AgentConnInfo connInfo + agentMsgStr = smpEncode agentMsg + internalHash = C.sha256Hash agentMsgStr + encConnInfo <- agentRatchetEncrypt connId agentMsgStr e2eEncConnInfoLength + let msgBody = smpEncode $ AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo} + msgType = agentMessageType agentMsg + msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, internalHash, prevMsgHash} + withStore $ \st -> createSndMsg st connId msgData + pure internalId -- encoded AgentMessage -> encoded EncAgentMessage agentRatchetEncrypt :: AgentMonad m => ConnId -> ByteString -> Int -> m ByteString @@ -684,27 +717,27 @@ agentRatchetDecrypt connId encAgentMsg = do notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m () notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON) -newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => Compatible SMPQueueInfo -> ConnInfo -> m (SndQueue, SMPConfirmation) -newSndQueue qInfo cInfo = +newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => Compatible SMPQueueInfo -> m SndQueue +newSndQueue qInfo = asks (cmdSignAlg . config) >>= \case - C.SignAlg a -> newSndQueue_ a qInfo cInfo + C.SignAlg a -> newSndQueue_ a qInfo newSndQueue_ :: (C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m) => C.SAlgorithm a -> Compatible SMPQueueInfo -> - ConnInfo -> - m (SndQueue, SMPConfirmation) -newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2ePubDhKey)) cInfo = do + m SndQueue +newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2ePubDhKey)) = do -- this function assumes clientVersion is compatible - it was tested before - (senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a + (sndPublicKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a (e2ePubKey, e2ePrivKey) <- liftIO C.generateKeyPair' - let sndQueue = - SndQueue - { server = smpServer, - sndId = senderId, - sndPrivateKey, - e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey, - status = New - } - pure (sndQueue, SMPConfirmation senderKey e2ePubKey cInfo) + pure + SndQueue + { server = smpServer, + sndId = senderId, + sndPublicKey = Just sndPublicKey, + sndPrivateKey, + e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey, + e2ePubKey = Just e2ePubKey, + status = New + } diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 6afc456cc..c2f87f764 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -381,11 +381,13 @@ showServer SMPServer {host, port} = logSecret :: ByteString -> ByteString logSecret bs = encode $ B.take 3 bs --- TODO maybe package E2ERatchetParams into SMPConfirmation sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> ByteString -> m () -sendConfirmation c SndQueue {server, sndId} encConfirmation = - withLogSMP_ c server sndId "SEND " $ \smp -> - liftSMP $ sendSMPMessage smp Nothing sndId encConfirmation +sendConfirmation c sq@SndQueue {server, sndId, sndPublicKey = Just sndPublicKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation = + withLogSMP_ c server sndId "SEND " $ \smp -> do + let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation + msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg + liftSMP $ sendSMPMessage smp Nothing sndId msg +sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database" sendInvitation :: forall m. AgentMonad m => AgentClient -> Compatible SMPQueueInfo -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> m () sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) connReq connInfo = diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index ab3931a1f..b38410d1e 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -46,9 +46,9 @@ module Simplex.Messaging.Agent.Protocol SMPConfirmation (..), AgentMsgEnvelope (..), AgentMessage (..), + AgentMessageType (..), APrivHeader (..), AMessage (..), - AMsgType (..), SMPServer (..), SrvLoc (..), SMPQueueUri (..), @@ -89,7 +89,7 @@ module Simplex.Messaging.Agent.Protocol connModeT, serializeQueueStatus, queueStatusT, - aMessageType, + agentMessageType, -- * TCP transport functions tPut, @@ -343,6 +343,31 @@ instance Encoding AgentMessage where 'M' -> AgentMessage <$> smpP <*> smpP _ -> fail "bad AgentMessage" +data AgentMessageType = AM_CONN_INFO | AM_HELLO_ | AM_REPLY_ | AM_A_MSG_ + deriving (Eq, Show) + +instance Encoding AgentMessageType where + smpEncode = \case + AM_CONN_INFO -> "C" + AM_HELLO_ -> "H" + AM_REPLY_ -> "R" + AM_A_MSG_ -> "M" + smpP = + A.anyChar >>= \case + 'C' -> pure AM_CONN_INFO + 'H' -> pure AM_HELLO_ + 'R' -> pure AM_REPLY_ + 'M' -> pure AM_A_MSG_ + _ -> fail "bad AgentMessageType" + +agentMessageType :: AgentMessage -> AgentMessageType +agentMessageType = \case + AgentConnInfo _ -> AM_CONN_INFO + AgentMessage _ aMsg -> case aMsg of + HELLO -> AM_HELLO_ + REPLY _ -> AM_REPLY_ + A_MSG _ -> AM_A_MSG_ + data APrivHeader = APrivHeader { -- | sequential ID assigned by the sending agent sndMsgId :: AgentMsgId, @@ -371,12 +396,6 @@ instance Encoding AMsgType where 'M' -> pure A_MSG_ _ -> fail "bad AMsgType" -aMessageType :: AMessage -> AMsgType -aMessageType = \case - HELLO -> HELLO_ - REPLY _ -> REPLY_ - A_MSG _ -> A_MSG_ - -- | Messages sent between SMP agents once SMP queue is secured. -- -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents @@ -705,7 +724,7 @@ data ConnectionErrorType SIMPLEX | -- | connection not accepted on join HELLO after timeout NOT_ACCEPTED - | -- | connection not available on reply HELLO after timeout + | -- | connection not available on reply confirmation/HELLO after timeout NOT_AVAILABLE deriving (Eq, Generic, Read, Show, Exception) diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 89afa2dba..4e20594a8 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -62,7 +62,7 @@ class Monad m => MonadAgentStore s m where createRcvMsg :: s -> ConnId -> RcvMsgData -> m () updateSndIds :: s -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash) createSndMsg :: s -> ConnId -> SndMsgData -> m () - getPendingMsgData :: s -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody, InternalTs)) + getPendingMsgData :: s -> ConnId -> InternalId -> m (Maybe RcvQueue, (AgentMessageType, MsgBody, InternalTs)) getPendingMsgs :: s -> ConnId -> m [InternalId] checkRcvMsg :: s -> ConnId -> InternalId -> m () deleteMsg :: s -> ConnId -> InternalId -> m () @@ -102,8 +102,11 @@ data SndQueue = SndQueue { server :: SMPServer, -- | sender queue ID sndId :: SMP.SenderId, - -- | key used by the sender to sign transmissions + -- | key pair used by the sender to sign transmissions + sndPublicKey :: Maybe C.APublicVerifyKey, sndPrivateKey :: SndPrivateSignKey, + -- | DH public key used to negotiate per-queue e2e encryption + e2ePubKey :: Maybe C.PublicKeyX25519, -- | shared DH secret agreed for simple per-queue e2e encryption e2eDhSecret :: C.DhSecretX25519, -- | queue status @@ -221,7 +224,7 @@ type PrevSndMsgHash = MsgHash data RcvMsgData = RcvMsgData { msgMeta :: MsgMeta, - msgType :: AMsgType, + msgType :: AgentMessageType, msgBody :: MsgBody, internalRcvId :: InternalRcvId, internalHash :: MsgHash, @@ -232,7 +235,7 @@ data SndMsgData = SndMsgData { internalId :: InternalId, internalSndId :: InternalSndId, internalTs :: InternalTs, - msgType :: AMsgType, + msgType :: AgentMessageType, msgBody :: MsgBody, internalHash :: MsgHash, prevMsgHash :: MsgHash diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index d4579c8cc..295e28620 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -441,7 +441,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto insertSndMsgDetails_ db connId sndMsgData updateHashSnd_ db connId sndMsgData - getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody, InternalTs)) + getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (Maybe RcvQueue, (AgentMessageType, MsgBody, InternalTs)) getPendingMsgData st connId msgId = liftIOEither . withTransaction st $ \db -> runExceptT $ do rq_ <- liftIO $ getRcvQueueByConnId_ db connId @@ -566,9 +566,9 @@ instance ToField InternalId where toField (InternalId x) = toField x instance FromField InternalId where fromField x = InternalId <$> fromField x -instance ToField AMsgType where toField = toField . smpEncode +instance ToField AgentMessageType where toField = toField . smpEncode -instance FromField AMsgType where fromField = blobFieldParser smpP +instance FromField AgentMessageType where fromField = blobFieldParser smpP instance ToField MsgIntegrity where toField = toField . strEncode @@ -656,46 +656,25 @@ upsertServer_ dbConn SMPServer {host, port, keyHash} = do insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO () insertRcvQueue_ dbConn connId RcvQueue {..} = do - DB.executeNamed + DB.execute dbConn [sql| INSERT INTO rcv_queues - ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status) - VALUES - (:host,:port,:rcv_id,:conn_id,:rcv_private_key,:rcv_dh_secret,:e2e_priv_key,:e2e_dh_secret,:snd_id,:status); + ( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status) VALUES (?,?,?,?,?,?,?,?,?,?); |] - [ ":host" := host server, - ":port" := port server, - ":rcv_id" := rcvId, - ":conn_id" := connId, - ":rcv_private_key" := rcvPrivateKey, - ":rcv_dh_secret" := rcvDhSecret, - ":e2e_priv_key" := e2ePrivKey, - ":e2e_dh_secret" := e2eDhSecret, - ":snd_id" := sndId, - ":status" := status - ] + (host server, port server, rcvId, connId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status) -- * createSndConn helpers insertSndQueue_ :: DB.Connection -> ConnId -> SndQueue -> IO () insertSndQueue_ dbConn connId SndQueue {..} = do - DB.executeNamed + DB.execute dbConn [sql| INSERT INTO snd_queues - ( host, port, snd_id, conn_id, snd_private_key, e2e_dh_secret, status) - VALUES - (:host,:port,:snd_id,:conn_id,:snd_private_key,:e2e_dh_secret,:status); + (host, port, snd_id, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status) VALUES (?,?,?,?,?, ?,?, ?,?); |] - [ ":host" := host server, - ":port" := port server, - ":snd_id" := sndId, - ":conn_id" := connId, - ":snd_private_key" := sndPrivateKey, - ":e2e_dh_secret" := e2eDhSecret, - ":status" := status - ] + (host server, port server, sndId, connId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status) -- * getConn helpers @@ -746,16 +725,16 @@ getSndQueueByConnId_ dbConn connId = <$> DB.query dbConn [sql| - SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.e2e_dh_secret, q.status + SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status FROM snd_queues q INNER JOIN servers s ON q.host = s.host AND q.port = s.port WHERE q.conn_id = ?; |] (Only connId) where - sndQueue [(keyHash, host, port, sndId, sndPrivateKey, e2eDhSecret, status)] = + sndQueue [(keyHash, host, port, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)] = let server = SMPServer host port keyHash - in Just SndQueue {server, sndId, sndPrivateKey, e2eDhSecret, status} + in Just SndQueue {server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status} sndQueue _ = Nothing -- * updateRcvIds helpers diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs index cceac62fc..96891bc52 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs @@ -25,13 +25,15 @@ import qualified Database.SQLite.Simple as DB import Database.SQLite.Simple.QQ (sql) import qualified Database.SQLite3 as SQLite3 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial +import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys data Migration = Migration {name :: String, up :: Text} deriving (Show) schemaMigrations :: [(String, Query)] schemaMigrations = - [ ("20220101_initial", m20220101_initial) + [ ("20220101_initial", m20220101_initial), + ("20220301_snd_queue_keys", m20220301_snd_queue_keys) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220301_snd_queue_keys.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220301_snd_queue_keys.hs new file mode 100644 index 000000000..810dedbd5 --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220301_snd_queue_keys.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20220301_snd_queue_keys :: Query +m20220301_snd_queue_keys = + [sql| +ALTER TABLE snd_queues ADD COLUMN snd_public_key BLOB; +ALTER TABLE snd_queues ADD COLUMN e2e_pub_key BLOB; +|] diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 422065ac3..6885fa8e6 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -128,25 +128,25 @@ testDuplexConnection _ alice bob = do bob <# ("", "alice", CON) alice <# ("", "bob", CON) -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4 - alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 4) - alice <# ("", "bob", SENT 4) - bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False - bob #: ("12", "alice", "ACK 4") #> ("12", "alice", OK) - alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 5) + alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 5) alice <# ("", "bob", SENT 5) + bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False + bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK) + alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 6) + alice <# ("", "bob", SENT 6) bob <#= \case ("", "alice", Msg "how are you?") -> True; _ -> False - bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK) - bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 6) - bob <# ("", "alice", SENT 6) - alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False - alice #: ("3a", "bob", "ACK 6") #> ("3a", "bob", OK) - bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 7) + bob #: ("13", "alice", "ACK 6") #> ("13", "alice", OK) + bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 7) bob <# ("", "alice", SENT 7) + alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False + alice #: ("3a", "bob", "ACK 7") #> ("3a", "bob", OK) + bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 8) + bob <# ("", "alice", SENT 8) alice <#= \case ("", "bob", Msg "message 1") -> True; _ -> False - alice #: ("4a", "bob", "ACK 7") #> ("4a", "bob", OK) + alice #: ("4a", "bob", "ACK 8") #> ("4a", "bob", OK) alice #: ("5", "bob", "OFF") #> ("5", "bob", OK) - bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 8) - bob <# ("", "alice", MERR 8 (SMP AUTH)) + bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 9) + bob <# ("", "alice", MERR 9 (SMP AUTH)) alice #: ("6", "bob", "DEL") #> ("6", "bob", OK) alice #:# "nothing else should be delivered to alice" @@ -161,25 +161,25 @@ testDuplexConnRandomIds _ alice bob = do bob <# ("", aliceConn, INFO "alice's connInfo") bob <# ("", aliceConn, CON) alice <# ("", bobConn, CON) - alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 4) - alice <# ("", bobConn, SENT 4) - bob <#= \case ("", c, Msg "hello") -> c == aliceConn; _ -> False - bob #: ("12", aliceConn, "ACK 4") #> ("12", aliceConn, OK) - alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 5) + alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 5) alice <# ("", bobConn, SENT 5) + bob <#= \case ("", c, Msg "hello") -> c == aliceConn; _ -> False + bob #: ("12", aliceConn, "ACK 5") #> ("12", aliceConn, OK) + alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 6) + alice <# ("", bobConn, SENT 6) bob <#= \case ("", c, Msg "how are you?") -> c == aliceConn; _ -> False - bob #: ("13", aliceConn, "ACK 5") #> ("13", aliceConn, OK) - bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 6) - bob <# ("", aliceConn, SENT 6) - alice <#= \case ("", c, Msg "hello too") -> c == bobConn; _ -> False - alice #: ("3a", bobConn, "ACK 6") #> ("3a", bobConn, OK) - bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 7) + bob #: ("13", aliceConn, "ACK 6") #> ("13", aliceConn, OK) + bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 7) bob <# ("", aliceConn, SENT 7) + alice <#= \case ("", c, Msg "hello too") -> c == bobConn; _ -> False + alice #: ("3a", bobConn, "ACK 7") #> ("3a", bobConn, OK) + bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 8) + bob <# ("", aliceConn, SENT 8) alice <#= \case ("", c, Msg "message 1") -> c == bobConn; _ -> False - alice #: ("4a", bobConn, "ACK 7") #> ("4a", bobConn, OK) + alice #: ("4a", bobConn, "ACK 8") #> ("4a", bobConn, OK) alice #: ("5", bobConn, "OFF") #> ("5", bobConn, OK) - bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 8) - bob <# ("", aliceConn, MERR 8 (SMP AUTH)) + bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 9) + bob <# ("", aliceConn, MERR 9 (SMP AUTH)) alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK) alice #:# "nothing else should be delivered to alice" @@ -196,10 +196,10 @@ testContactConnection _ alice bob tom = do alice <# ("", "bob", INFO "bob's connInfo 2") alice <# ("", "bob", CON) bob <# ("", "alice", CON) - alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 4) - alice <# ("", "bob", SENT 4) + alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 5) + alice <# ("", "bob", SENT 5) bob <#= \case ("", "alice", Msg "hi") -> True; _ -> False - bob #: ("13", "alice", "ACK 4") #> ("13", "alice", OK) + bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK) tom #: ("21", "alice", "JOIN " <> cReq' <> " 14\ntom's connInfo") #> ("21", "alice", OK) ("", "alice_contact", Right (REQ aInvId' "tom's connInfo")) <- (alice <#:) @@ -209,10 +209,10 @@ testContactConnection _ alice bob tom = do alice <# ("", "tom", INFO "tom's connInfo 2") alice <# ("", "tom", CON) tom <# ("", "alice", CON) - alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 4) - alice <# ("", "tom", SENT 4) + alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 5) + alice <# ("", "tom", SENT 5) tom <#= \case ("", "alice", Msg "hi there") -> True; _ -> False - tom #: ("23", "alice", "ACK 4") #> ("23", "alice", OK) + tom #: ("23", "alice", "ACK 5") #> ("23", "alice", OK) testContactConnRandomIds :: Transport c => TProxy c -> c -> c -> IO () testContactConnRandomIds _ alice bob = do @@ -232,10 +232,10 @@ testContactConnRandomIds _ alice bob = do alice <# ("", bobConn, CON) bob <# ("", aliceConn, CON) - alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 4) - alice <# ("", bobConn, SENT 4) + alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 5) + alice <# ("", bobConn, SENT 5) bob <#= \case ("", c, Msg "hi") -> c == aliceConn; _ -> False - bob #: ("13", aliceConn, "ACK 4") #> ("13", aliceConn, OK) + bob #: ("13", aliceConn, "ACK 5") #> ("13", aliceConn, OK) testRejectContactRequest :: Transport c => TProxy c -> c -> c -> IO () testRejectContactRequest _ alice bob = do @@ -252,20 +252,20 @@ testRejectContactRequest _ alice bob = do testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO () testSubscription _ alice1 alice2 bob = do (alice1, "alice") `connect` (bob, "bob") - bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 4) - bob <# ("", "alice", SENT 4) - alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False - alice1 #: ("1", "bob", "ACK 4") #> ("1", "bob", OK) - bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 5) + bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 5) bob <# ("", "alice", SENT 5) + alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False + alice1 #: ("1", "bob", "ACK 5") #> ("1", "bob", OK) + bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 6) + bob <# ("", "alice", SENT 6) alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False - alice1 #: ("2", "bob", "ACK 5") #> ("2", "bob", OK) + alice1 #: ("2", "bob", "ACK 6") #> ("2", "bob", OK) alice2 #: ("21", "bob", "SUB") #> ("21", "bob", OK) alice1 <# ("", "bob", END) - bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 6) - bob <# ("", "alice", SENT 6) + bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 7) + bob <# ("", "alice", SENT 7) alice2 <#= \case ("", "bob", Msg "hi") -> True; _ -> False - alice2 #: ("22", "bob", "ACK 6") #> ("22", "bob", OK) + alice2 #: ("22", "bob", "ACK 7") #> ("22", "bob", OK) alice1 #:# "nothing else should be delivered to alice1" testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO () @@ -281,22 +281,22 @@ testMsgDeliveryServerRestart :: Transport c => TProxy c -> c -> c -> IO () testMsgDeliveryServerRestart t alice bob = do withServer $ do connect (alice, "alice") (bob, "bob") - bob #: ("1", "alice", "SEND 2\nhi") #> ("1", "alice", MID 4) - bob <# ("", "alice", SENT 4) + bob #: ("1", "alice", "SEND 2\nhi") #> ("1", "alice", MID 5) + bob <# ("", "alice", SENT 5) alice <#= \case ("", "bob", Msg "hi") -> True; _ -> False - alice #: ("11", "bob", "ACK 4") #> ("11", "bob", OK) + alice #: ("11", "bob", "ACK 5") #> ("11", "bob", OK) alice #:# "nothing else delivered before the server is killed" alice <# ("", "bob", DOWN) - bob #: ("2", "alice", "SEND 11\nhello again") #> ("2", "alice", MID 5) + bob #: ("2", "alice", "SEND 11\nhello again") #> ("2", "alice", MID 6) bob #:# "nothing else delivered before the server is restarted" alice #:# "nothing else delivered before the server is restarted" withServer $ do - bob <# ("", "alice", SENT 5) + bob <# ("", "alice", SENT 6) alice <# ("", "bob", UP) alice <#= \case ("", "bob", Msg "hello again") -> True; _ -> False - alice #: ("12", "bob", "ACK 5") #> ("12", "bob", OK) + alice #: ("12", "bob", "ACK 6") #> ("12", "bob", OK) removeFile testStoreLogFile where @@ -311,7 +311,7 @@ testServerConnectionAfterError t _ = do bob <# ("", "alice", DOWN) alice <# ("", "bob", DOWN) - alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 4) + alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 5) alice #:# "nothing else delivered before the server is restarted" bob #:# "nothing else delivered before the server is restarted" @@ -320,13 +320,13 @@ testServerConnectionAfterError t _ = do bob #: ("1", "alice", "SUB") #> ("1", "alice", ERR (BROKER NETWORK)) alice #: ("1", "bob", "SUB") #> ("1", "bob", ERR (BROKER NETWORK)) withServer $ do - alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 4; _ -> False - alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 4; _ -> False + alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 5; _ -> False + alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 5; _ -> False bob <# ("", "alice", UP) bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False - bob #: ("2", "alice", "ACK 4") #> ("2", "alice", OK) - alice #: ("1", "bob", "SEND 11\nhello again") #> ("1", "bob", MID 5) - alice <# ("", "bob", SENT 5) + bob #: ("2", "alice", "ACK 5") #> ("2", "alice", OK) + alice #: ("1", "bob", "SEND 11\nhello again") #> ("1", "bob", MID 6) + alice <# ("", "bob", SENT 6) bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False removeFile testStoreLogFile @@ -344,14 +344,14 @@ testMsgDeliveryAgentRestart t bob = do withAgent $ \alice -> do withServer $ do connect (bob, "bob") (alice, "alice") - alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 4) - alice <# ("", "bob", SENT 4) + alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 5) + alice <# ("", "bob", SENT 5) bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False - bob #: ("11", "alice", "ACK 4") #> ("11", "alice", OK) + bob #: ("11", "alice", "ACK 5") #> ("11", "alice", OK) bob #:# "nothing else delivered before the server is down" bob <# ("", "alice", DOWN) - alice #: ("2", "bob", "SEND 11\nhello again") #> ("2", "bob", MID 5) + alice #: ("2", "bob", "SEND 11\nhello again") #> ("2", "bob", MID 6) alice #:# "nothing else delivered before the server is restarted" bob #:# "nothing else delivered before the server is restarted" @@ -361,11 +361,11 @@ testMsgDeliveryAgentRestart t bob = do alice <#= \case (corrId, "bob", cmd) -> (corrId == "3" && cmd == OK) - || (corrId == "" && cmd == SENT 5) + || (corrId == "" && cmd == SENT 6) _ -> False bob <# ("", "alice", UP) bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False - bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK) + bob #: ("12", "alice", "ACK 6") #> ("12", "alice", OK) removeFile testStoreLogFile removeFile testDB @@ -393,11 +393,11 @@ testConcurrentMsgDelivery _ alice bob = do -- alice <# ("", "bob", SENT 1) -- bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False -- bob #: ("12", "alice", "ACK 1") #> ("12", "alice", OK) - bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 5) - bob <# ("", "alice", SENT 5) + bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 6) + bob <# ("", "alice", SENT 6) -- if delivery is blocked it won't go further alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False - alice #: ("3", "bob", "ACK 5") #> ("3", "bob", OK) + alice #: ("3", "bob", "ACK 6") #> ("3", "bob", OK) testMsgDeliveryQuotaExceeded :: Transport c => TProxy c -> c -> c -> IO () testMsgDeliveryQuotaExceeded _ alice bob = do @@ -410,9 +410,9 @@ testMsgDeliveryQuotaExceeded _ alice bob = do alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False (_, "bob", Right (MID _)) <- alice #: ("5", "bob", "SEND :over quota") - alice #: ("1", "bob2", "SEND :hello") #> ("1", "bob2", MID 4) + alice #: ("1", "bob2", "SEND :hello") #> ("1", "bob2", MID 5) -- if delivery is blocked it won't go further - alice <# ("", "bob2", SENT 4) + alice <# ("", "bob2", SENT 5) connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO () connect (h1, name1) (h2, name2) = do diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 116a38b55..1ebe91f24 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -10,7 +10,7 @@ module AgentTests.FunctionalAPITests (functionalAPITests) where import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.IO.Unlift import SMPAgentClient -import SMPClient (withSmpServer) +import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn) import Simplex.Messaging.Agent import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..)) import Simplex.Messaging.Agent.Protocol @@ -44,6 +44,8 @@ functionalAPITests t = do withSmpServer t testAsyncJoiningOfflineBeforeActivation it "should connect with both clients going offline" $ withSmpServer t testAsyncBothOffline + it "should connect on the second attempt if server was offline" $ + testAsyncServerOffline t it "should notify after HELLO timeout" $ withSmpServer t testAsyncHelloTimeout @@ -59,26 +61,26 @@ testAgentClient = do get alice ##> ("", bobId, CON) get bob ##> ("", aliceId, INFO "alice's connInfo") get bob ##> ("", aliceId, CON) - -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4 - 4 <- sendMessage alice bobId "hello" - get alice ##> ("", bobId, SENT 4) - 5 <- sendMessage alice bobId "how are you?" + -- message IDs 1 to 4 get assigned to control messages, so first MSG is assigned ID 5 + 5 <- sendMessage alice bobId "hello" get alice ##> ("", bobId, SENT 5) + 6 <- sendMessage alice bobId "how are you?" + get alice ##> ("", bobId, SENT 6) get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False - ackMessage bob aliceId 4 - get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False ackMessage bob aliceId 5 - 6 <- sendMessage bob aliceId "hello too" - get bob ##> ("", aliceId, SENT 6) - 7 <- sendMessage bob aliceId "message 1" + get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False + ackMessage bob aliceId 6 + 7 <- sendMessage bob aliceId "hello too" get bob ##> ("", aliceId, SENT 7) + 8 <- sendMessage bob aliceId "message 1" + get bob ##> ("", aliceId, SENT 8) get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False - ackMessage alice bobId 6 - get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False ackMessage alice bobId 7 + get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False + ackMessage alice bobId 8 suspendConnection alice bobId - 8 <- sendMessage bob aliceId "message 2" - get bob ##> ("", aliceId, MERR 8 (SMP AUTH)) + 9 <- sendMessage bob aliceId "message 2" + get bob ##> ("", aliceId, MERR 9 (SMP AUTH)) deleteConnection alice bobId liftIO $ noMessages alice "nothing else should be delivered to alice" pure () @@ -148,6 +150,30 @@ testAsyncBothOffline = do exchangeGreetings alice' bobId bob' aliceId pure () +testAsyncServerOffline :: ATransport -> IO () +testAsyncServerOffline t = do + alice <- getSMPAgentClient cfg + bob <- getSMPAgentClient cfg {dbFile = testDB2} + -- create connection and shutdown the server + Right (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ -> + runExceptT $ createConnection alice SCMInvitation + -- connection fails + Left (BROKER NETWORK) <- runExceptT $ joinConnection bob cReq "bob's connInfo" + ("", bobId1, DOWN) <- get alice + bobId1 `shouldBe` bobId + -- connection succeeds after server start + Right () <- withSmpServerStoreLogOn t testPort $ \_ -> runExceptT $ do + ("", bobId2, UP) <- get alice + liftIO $ bobId2 `shouldBe` bobId + aliceId <- joinConnection bob cReq "bob's connInfo" + ("", _, CONF confId "bob's connInfo") <- get alice + allowConnection alice bobId confId "alice's connInfo" + get alice ##> ("", bobId, CON) + get bob ##> ("", aliceId, INFO "alice's connInfo") + get bob ##> ("", aliceId, CON) + exchangeGreetings alice bobId bob aliceId + pure () + testAsyncHelloTimeout :: IO () testAsyncHelloTimeout = do alice <- getSMPAgentClient cfg @@ -161,11 +187,11 @@ testAsyncHelloTimeout = do exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO () exchangeGreetings alice bobId bob aliceId = do - 4 <- sendMessage alice bobId "hello" - get alice ##> ("", bobId, SENT 4) + 5 <- sendMessage alice bobId "hello" + get alice ##> ("", bobId, SENT 5) get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False - ackMessage bob aliceId 4 - 5 <- sendMessage bob aliceId "hello too" - get bob ##> ("", aliceId, SENT 5) + ackMessage bob aliceId 5 + 6 <- sendMessage bob aliceId "hello too" + get bob ##> ("", aliceId, SENT 6) get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False - ackMessage alice bobId 5 + ackMessage alice bobId 6 diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 7cfdd989f..28f39379b 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -173,7 +173,9 @@ sndQueue1 = SndQueue { server = SMPServer "smp.simplex.im" "5223" testKeyHash, sndId = "3456", + sndPublicKey = Nothing, sndPrivateKey = testPrivateSignKey, + e2ePubKey = Nothing, e2eDhSecret = testDhSecret, status = New } @@ -303,7 +305,9 @@ testUpgradeRcvConnToDuplex = SndQueue { server = SMPServer "smp.simplex.im" "5223" testKeyHash, sndId = "2345", + sndPublicKey = Nothing, sndPrivateKey = testPrivateSignKey, + e2ePubKey = Nothing, e2eDhSecret = testDhSecret, status = New } @@ -393,7 +397,7 @@ mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash = sndMsgId = externalSndId, broker = (brokerId, ts) }, - msgType = A_MSG_, + msgType = AM_A_MSG_, msgBody = hw, internalHash, externalPrevSndHash = "hash_from_sender" @@ -422,7 +426,7 @@ mkSndMsgData internalId internalSndId internalHash = { internalId, internalSndId, internalTs = ts, - msgType = A_MSG_, + msgType = AM_A_MSG_, msgBody = hw, internalHash, prevMsgHash = internalHash