From c179073260daea6ad2ff65e8a18d17a87110b341 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 16 Feb 2024 13:28:50 +0000 Subject: [PATCH] remove support for old versions (#990) * remove support for old versions (WIP) * fix * updates * use version var --- src/Simplex/Messaging/Agent.hs | 121 +++++++------------- src/Simplex/Messaging/Agent/Client.hs | 16 ++- src/Simplex/Messaging/Agent/Protocol.hs | 53 ++++++--- src/Simplex/Messaging/Agent/Store.hs | 11 +- src/Simplex/Messaging/Agent/Store/SQLite.hs | 26 ++--- src/Simplex/Messaging/Crypto/Ratchet.hs | 32 +++--- src/Simplex/Messaging/Protocol.hs | 56 +++------ src/Simplex/Messaging/Server.hs | 35 ++---- src/Simplex/Messaging/Server/MsgStore.hs | 11 +- tests/AgentTests.hs | 4 +- tests/AgentTests/ConnectionRequestTests.hs | 35 +++--- tests/AgentTests/FunctionalAPITests.hs | 53 ++------- tests/AgentTests/SQLiteTests.hs | 2 +- tests/XFTPAgent.hs | 1 - 14 files changed, 180 insertions(+), 276 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 587a206fd..249a97ae0 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -543,8 +543,7 @@ newConnNoQueues :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> SC newConnNoQueues c userId connId enableNtfs cMode = do g <- asks random connAgentVersion <- asks $ maxVersion . smpAgentVRange . config - -- connection mode is determined by the accepting agent - let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, duplexHandshake = Nothing, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk} + let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk} withStore c $ \db -> createNewConn db g cData cMode joinConnAsync :: AgentMonad m => AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> m ConnId @@ -554,8 +553,7 @@ joinConnAsync c userId corrId enableNtfs cReqUri@(CRInvitationUri ConnReqUriData case crAgentVRange `compatibleVersion` aVRange of Just (Compatible connAgentVersion) -> do g <- asks random - let duplexHS = connAgentVersion /= 1 - cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, duplexHandshake = Just duplexHS, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk} + let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk} connId <- withStore c $ \db -> createNewConn db g cData SCMInvitation enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn $ JOIN enableNtfs (ACR sConnectionMode cReqUri) subMode cInfo pure connId @@ -680,26 +678,22 @@ startJoinInvitation userId connId enableNtfs (CRInvitationUri ConnReqUriData {cr (_, rcDHRs) <- atomically $ C.generateKeyPair g let rc = CR.initSndRatchet e2eEncryptVRange rcDHRr rcDHRs $ CR.x3dhSnd pk1 pk2 e2eRcvParams q <- newSndQueue userId "" qInfo - let duplexHS = connAgentVersion /= 1 - cData = ConnData {userId, connId, connAgentVersion, enableNtfs, duplexHandshake = Just duplexHS, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk} + let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk} pure (aVersion, cData, q, rc, e2eSndParams) _ -> throwError $ AGENT A_VERSION joinConnSrv :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> m ConnId joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do - (aVersion, cData@ConnData {connAgentVersion}, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv + (aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv g <- asks random (connId', sq) <- withStore c $ \db -> runExceptT $ do r@(connId', _) <- ExceptT $ createSndConn db g cData q liftIO $ createRatchet db connId' rc pure r let cData' = (cData :: ConnData) {connId = connId'} - duplexHS = connAgentVersion /= 1 tryError (confirmQueue aVersion c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case - Right _ -> do - unless duplexHS . void $ enqueueMessage c cData' sq SMP.noMsgFlags HELLO - pure connId' + Right _ -> pure connId' Left e -> do -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md withStore' c (`deleteConn` connId') @@ -718,11 +712,11 @@ joinConnSrv c userId connId enableNtfs (CRContactUri ConnReqUriData {crAgentVRan joinConnSrvAsync :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> m () joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo subMode srv = do - (aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv + (_aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv q' <- withStore c $ \db -> runExceptT $ do liftIO $ createRatchet db connId rc ExceptT $ updateNewConnSnd db connId q - confirmQueueAsync aVersion c cData q' srv cInfo (Just e2eSndParams) subMode + confirmQueueAsync c cData q' srv cInfo (Just e2eSndParams) subMode joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _srv = do throwError $ CMD PROHIBITED @@ -989,8 +983,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do _ -> throwError $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd) ICDuplexSecure _rId senderKey -> withServer' . tryWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do secure rq senderKey - when (duplexHandshake cData == Just True) . void $ - enqueueMessage c cData sq SMP.MsgFlags {notification = True} HELLO + void $ enqueueMessage c cData sq SMP.MsgFlags {notification = True} HELLO -- ICDeleteConn is no longer used, but it can be present in old client databases ICDeleteConn -> withStore' c (`deleteCommand` cmdId) ICDeleteRcvQueue rId -> withServer $ \srv -> tryWithLock "ICDeleteRcvQueue" $ do @@ -1148,7 +1141,7 @@ submitPendingMsg c cData sq = do void $ getDeliveryWorker True c cData sq runSmpQueueMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> (Worker, TMVar ()) -> m () -runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, duplexHandshake} sq (Worker {doWork}, qLock) = do +runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork}, qLock) = do AgentConfig {messageRetryInterval = ri, messageTimeout, helloTimeout, quotaExceededTimeout} <- asks config forever $ do atomically $ endAgentOperation c AOSndNetwork @@ -1180,21 +1173,13 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, dupl AM_CONN_INFO -> connError msgId NOT_AVAILABLE AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE AM_RATCHET_INFO -> connError msgId NOT_AVAILABLE - AM_HELLO_ - -- in duplexHandshake mode (v2) HELLO is only sent once, without retrying, - -- because the queue must be secured by the time the confirmation or the first HELLO is received - | duplexHandshake == Just True -> connErr - -- otherwise branch is not used in clients with v2+ of agent protocol (since June 2022) - -- TODO remove in v6 - | otherwise -> do - expireTs <- addUTCTime (-helloTimeout) <$> liftIO getCurrentTime - if internalTs < expireTs then connErr else retrySndMsg RIFast - where - connErr = case rq_ of - -- party initiating connection - Just _ -> connError msgId NOT_AVAILABLE - -- party joining connection - _ -> connError msgId NOT_ACCEPTED + -- in duplexHandshake mode (v2) HELLO is only sent once, without retrying, + -- because the queue must be secured by the time the confirmation or the first HELLO is received + AM_HELLO_ -> case rq_ of + -- party initiating connection + Just _ -> connError msgId NOT_AVAILABLE + -- party joining connection + _ -> connError msgId NOT_ACCEPTED AM_REPLY_ -> notifyDel msgId err AM_A_MSG_ -> notifyDel msgId err AM_A_RCVD_ -> notifyDel msgId err @@ -1236,14 +1221,8 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, dupl -- because it can be sent before HELLO is received -- With `status == Active` condition, CON is sent here only by the accepting party, that previously received HELLO when (status == Active) $ notify CON - -- Party joining connection sends REPLY after HELLO in v1, - -- it is an error to send REPLY in duplexHandshake mode (v2), - -- and this branch should never be reached as receive is created before the confirmation, - -- so the condition is not necessary here, strictly speaking. - _ -> unless (duplexHandshake == Just True) $ do - srv <- getSMPServer c userId - qInfo <- createReplyQueue c cData sq SMSubscribe srv - void . enqueueMessage c cData sq SMP.noMsgFlags $ REPLY [qInfo] + -- this branch should never be reached as receive queue is created before the confirmation, + _ -> logError "HELLO sent without receive queue" AM_A_MSG_ -> notify $ SENT mId AM_A_RCVD_ -> pure () AM_QCONT_ -> pure () @@ -1286,7 +1265,6 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, dupl withStore' c $ \db -> do setSndQueueStatus db sq Confirmed when (isJust rq_) $ removeConfirmations db connId - unless (duplexHandshake == Just True) . void $ enqueueMessage c cData sq SMP.noMsgFlags HELLO where notifyDelMsgs :: InternalId -> AgentErrorType -> UTCTime -> m () notifyDelMsgs msgId err expireTs = do @@ -1333,12 +1311,12 @@ ackMessage' c connId msgId rcptInfo_ = withConnLock c connId "ackMessage" $ do del :: m () del = withStoreCtx' "ackMessage': deleteMsg" c $ \db -> deleteMsg db connId $ InternalId msgId sendRcpt :: Connection 'CDuplex -> m () - sendRcpt (DuplexConnection cData _ sqs) = do + sendRcpt (DuplexConnection cData@ConnData {connAgentVersion} _ sqs) = do msg@RcvMsg {msgType, msgReceipt} <- withStoreCtx "ackMessage': getRcvMsg" c $ \db -> getRcvMsg db connId $ InternalId msgId case rcptInfo_ of Just rcptInfo -> do unless (msgType == AM_A_MSG_) $ throwError (CMD PROHIBITED) - when (messageRcptsSupported cData) $ do + when (connAgentVersion >= deliveryRcptsSMPAgentVersion) $ do let RcvMsg {msgMeta = MsgMeta {sndMsgId}, internalHash} = msg rcpt = A_RCVD [AMessageReceipt {agentMsgId = sndMsgId, msgHash = internalHash, rcptInfo}] void $ enqueueMessages c cData sqs SMP.MsgFlags {notification = False} rcpt @@ -1567,13 +1545,13 @@ connectionStats = \case NewConnection cData -> stats cData where - stats cData@ConnData {connAgentVersion, ratchetSyncState} = + stats ConnData {connAgentVersion, ratchetSyncState} = ConnectionStats { connAgentVersion, rcvQueuesInfo = [], sndQueuesInfo = [], ratchetSyncState, - ratchetSyncSupported = ratchetSyncSupported' cData + ratchetSyncSupported = connAgentVersion >= ratchetSyncSMPAgentVersion } -- | Change servers to be used for creating new queues, in Reader monad @@ -1903,7 +1881,7 @@ cleanupManager c@AgentClient {subQ} = do -- | make sure to ACK or throw in each message processing branch -- it cannot be finally, unfortunately, as sometimes it needs to be ACK+DEL processSMPTransmission :: forall m. AgentMonad m => AgentClient -> ServerTransmission BrokerMsg -> m () -processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, sessId, rId, cmd) = do +processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v, sessId, rId, cmd) = do (rq, SomeConn _ conn) <- withStore c (\db -> getRcvConn db srv rId) processSMP rq conn $ toConnData conn where @@ -1911,11 +1889,11 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s processSMP rq@RcvQueue {e2ePrivKey, e2eDhSecret, status} conn - cData@ConnData {userId, connId, duplexHandshake, connAgentVersion, ratchetSyncState = rss} = + cData@ConnData {userId, connId, connAgentVersion, ratchetSyncState = rss} = withConnLock c connId "processSMP" $ case cmd of SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId} -> handleNotifyAck $ do - msg' <- decryptSMPMessage v rq msg + msg' <- decryptSMPMessage rq msg handleNotifyAck $ case msg' of SMP.ClientRcvMsgBody {msgTs = srvTs, msgFlags, msgBody} -> processClientMsg srvTs msgFlags msgBody SMP.ClientRcvMsgQuota {} -> queueDrained >> ack @@ -1967,7 +1945,6 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s conn'' <- resetRatchetSync case aMessage of HELLO -> helloMsg srvMsgId conn'' >> ackDel msgId - REPLY cReq -> replyMsg srvMsgId conn'' cReq >> ackDel msgId -- note that there is no ACK sent for A_MSG, it is sent with agent's user ACK command A_MSG body -> do logServer "<--" c srv rId $ "MSG :" <> logSecret srvMsgId @@ -2126,16 +2103,14 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s case (agentMsgBody_, skipped) of (Right agentMsgBody, CR.SMDNoChange) -> parseMessage agentMsgBody >>= \case - AgentConnInfo connInfo -> - processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = [], smpClientVersion} False AgentConnInfoReply smpQueues connInfo -> - processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion} True - _ -> prohibited + processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion} + _ -> prohibited -- including AgentConnInfo, that is prohibited here in v2 where - processConf connInfo senderConf duplexHS = do + processConf connInfo senderConf = do let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} confId <- withStore c $ \db -> do - setHandshakeVersion db connId agentVersion duplexHS + setConnectionVersion db connId agentVersion createConfirmation db g newConfirmation let srvs = map qServer $ smpReplyQueues senderConf notify $ CONF confId srvs connInfo @@ -2163,11 +2138,9 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s DuplexConnection _ _ (sq@SndQueue {status = sndStatus} :| _) -- `sndStatus == Active` when HELLO was previously sent, and this is the reply HELLO -- this branch is executed by the accepting party in duplexHandshake mode (v2) - -- and by the initiating party in v1 - -- Also see comment where HELLO is sent. + -- (was executed by initiating party in v1 that is no longer supported) | sndStatus == Active -> notify CON - | duplexHandshake == Just True -> enqueueDuplexHello sq - | otherwise -> pure () + | otherwise -> enqueueDuplexHello sq _ -> pure () where enqueueDuplexHello :: SndQueue -> m () @@ -2175,18 +2148,6 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s let cData' = toConnData conn' void $ enqueueMessage c cData' sq SMP.MsgFlags {notification = True} HELLO - replyMsg :: SMP.MsgId -> Connection c -> NonEmpty SMPQueueInfo -> m () - replyMsg srvMsgId conn' smpQueues = do - logServer "<--" c srv rId $ "MSG :" <> logSecret srvMsgId - case duplexHandshake of - Just True -> prohibited - _ -> case conn' of - RcvConnection {} -> do - AcceptedConfirmation {ownConnInfo} <- withStore c (`getAcceptedConfirmation` connId) - let cData' = toConnData conn' - connectReplyQueues c cData' ownConnInfo smpQueues `catchAgentError` (notify . ERR) - _ -> prohibited - continueSending :: SMP.MsgId -> (SMPServer, SMP.SenderId) -> Connection 'CDuplex -> m () continueSending srvMsgId addr (DuplexConnection _ _ sqs) = case findQ addr sqs of @@ -2416,14 +2377,14 @@ connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo (qInfo :| _) = sq' <- withStore c $ \db -> upgradeRcvConnToDuplex db connId sq enqueueConfirmation c cData sq' ownConnInfo Nothing -confirmQueueAsync :: forall m. AgentMonad m => Compatible Version -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> SubscriptionMode -> m () -confirmQueueAsync v c cData sq srv connInfo e2eEncryption_ subMode = do - storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation v c cData sq srv connInfo subMode +confirmQueueAsync :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> SubscriptionMode -> m () +confirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do + storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode submitPendingMsg c cData sq confirmQueue :: forall m. AgentMonad m => Compatible Version -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> SubscriptionMode -> m () -confirmQueue v@(Compatible agentVersion) c cData@ConnData {connId} sq srv connInfo e2eEncryption_ subMode = do - msg <- mkConfirmation =<< mkAgentConfirmation v c cData sq srv connInfo subMode +confirmQueue (Compatible agentVersion) c cData@ConnData {connId} sq srv connInfo e2eEncryption_ subMode = do + msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode sendConfirmation c sq msg withStore' c $ \db -> setSndQueueStatus db sq Confirmed where @@ -2433,12 +2394,10 @@ confirmQueue v@(Compatible agentVersion) c cData@ConnData {connId} sq srv connIn encConnInfo <- agentRatchetEncrypt db connId (smpEncode aMessage) e2eEncConnInfoLength pure . smpEncode $ AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} -mkAgentConfirmation :: AgentMonad m => Compatible Version -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> m AgentMessage -mkAgentConfirmation (Compatible agentVersion) c cData sq srv connInfo subMode - | agentVersion == 1 = pure $ AgentConnInfo connInfo - | otherwise = do - qInfo <- createReplyQueue c cData sq subMode srv - pure $ AgentConnInfoReply (qInfo :| []) connInfo +mkAgentConfirmation :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> m AgentMessage +mkAgentConfirmation c cData sq srv connInfo subMode = do + qInfo <- createReplyQueue c cData sq subMode srv + pure $ AgentConnInfoReply (qInfo :| []) connInfo enqueueConfirmation :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m () enqueueConfirmation c cData sq connInfo e2eEncryption_ = do diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index ad28e79de..c6765a3e7 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -213,7 +213,6 @@ import Simplex.Messaging.Protocol import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM -import Simplex.Messaging.Transport (THandleParams (..)) import Simplex.Messaging.Transport.Client (TransportHost) import Simplex.Messaging.Util import Simplex.Messaging.Version @@ -1118,11 +1117,11 @@ sendInvitation c userId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, getQueueMessage :: AgentMonad m => AgentClient -> RcvQueue -> m (Maybe SMPMsgMeta) getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do atomically createTakeGetLock - (v, msg_) <- withSMPClient c rq "GET" $ \smp -> - (thVersion $ thParams smp,) <$> getSMPMessage smp rcvPrivateKey rcvId - mapM (decryptMeta v) msg_ + msg_ <- withSMPClient c rq "GET" $ \smp -> + getSMPMessage smp rcvPrivateKey rcvId + mapM decryptMeta msg_ where - decryptMeta v msg@SMP.RcvMessage {msgId} = SMP.rcvMessageMeta msgId <$> decryptSMPMessage v rq msg + decryptMeta msg@SMP.RcvMessage {msgId} = SMP.rcvMessageMeta msgId <$> decryptSMPMessage rq msg createTakeGetLock = TM.alterF takeLock (server, rcvId) $ getMsgLocks c where takeLock l_ = do @@ -1130,10 +1129,9 @@ getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do takeTMVar l pure $ Just l -decryptSMPMessage :: AgentMonad m => Version -> RcvQueue -> SMP.RcvMessage -> m SMP.ClientRcvMsgBody -decryptSMPMessage v rq SMP.RcvMessage {msgId, msgTs, msgFlags, msgBody = SMP.EncRcvMsgBody body} - | v == 1 || v == 2 = SMP.ClientRcvMsgBody msgTs msgFlags <$> decrypt body - | otherwise = liftEither . parse SMP.clientRcvMsgBodyP (AGENT A_MESSAGE) =<< decrypt body +decryptSMPMessage :: AgentMonad m => RcvQueue -> SMP.RcvMessage -> m SMP.ClientRcvMsgBody +decryptSMPMessage rq SMP.RcvMessage {msgId, msgBody = SMP.EncRcvMsgBody body} = + liftEither . parse SMP.clientRcvMsgBodyP (AGENT A_MESSAGE) =<< decrypt body where decrypt = agentCbDecrypt (rcvDhSecret rq) (C.cbNonce msgId) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index a56908b38..6129b8503 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -33,6 +33,8 @@ -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md module Simplex.Messaging.Agent.Protocol ( -- * Protocol parameters + ratchetSyncSMPAgentVersion, + deliveryRcptsSMPAgentVersion, supportedSMPAgentVRange, e2eEncConnInfoLength, e2eEncUserMsgLength, @@ -164,7 +166,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L import Data.Map (Map) import qualified Data.Map as M -import Data.Maybe (isJust) +import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) @@ -203,6 +205,7 @@ import Simplex.Messaging.Protocol legacyStrEncodeServer, noAuthSrv, sameSrvAddr, + srvHostnamesSMPClientVersion, pattern ProtoServerWithAuth, pattern SMPServer, ) @@ -216,11 +219,26 @@ import Simplex.RemoteControl.Types import Text.Read import UnliftIO.Exception (Exception) +-- SMP agent protocol version history: +-- 1 - binary protocol encoding (1/1/2022) +-- 2 - "duplex" (more efficient) connection handshake (6/9/2022) +-- 3 - support ratchet renegotiation (6/30/2023) +-- 4 - delivery receipts (7/13/2023) + +duplexHandshakeSMPAgentVersion :: Version +duplexHandshakeSMPAgentVersion = 2 + +ratchetSyncSMPAgentVersion :: Version +ratchetSyncSMPAgentVersion = 3 + +deliveryRcptsSMPAgentVersion :: Version +deliveryRcptsSMPAgentVersion = 4 + currentSMPAgentVersion :: Version currentSMPAgentVersion = 4 supportedSMPAgentVRange :: VersionRange -supportedSMPAgentVRange = mkVersionRange 1 currentSMPAgentVersion +supportedSMPAgentVRange = mkVersionRange duplexHandshakeSMPAgentVersion currentSMPAgentVersion -- it is shorter to allow all handshake headers, -- including E2E (double-ratchet) parameters and @@ -843,9 +861,10 @@ instance Encoding AgentMsgEnvelope where -- or in case of AgentInvitation - in plain text body) -- AgentRatchetInfo is not encrypted with double ratchet, but with per-queue E2E encryption data AgentMessage - = AgentConnInfo ConnInfo - | -- AgentConnInfoReply is only used in duplexHandshake mode (v2), allowing to include reply queue(s) in the initial confirmation. - -- It makes REPLY message unnecessary. + = -- used by the initiating party when confirming reply queue + AgentConnInfo ConnInfo + | -- AgentConnInfoReply is used by accepting party in duplexHandshake mode (v2), allowing to include reply queue(s) in the initial confirmation. + -- It made removed REPLY message unnecessary. AgentConnInfoReply (NonEmpty SMPQueueInfo) ConnInfo | AgentRatchetInfo ByteString | AgentMessage APrivHeader AMessage @@ -927,8 +946,6 @@ agentMessageType = \case -- until the queue is secured - the OK response from the server instead of initial AUTH errors confirms it. -- - in v2 duplexHandshake it is sent only once, when it is known that the queue was secured. HELLO -> AM_HELLO_ - -- REPLY is only used in v1 - REPLY _ -> AM_REPLY_ A_MSG _ -> AM_A_MSG_ A_RCVD {} -> AM_A_RCVD_ QCONT _ -> AM_QCONT_ @@ -953,7 +970,6 @@ instance Encoding APrivHeader where data AMsgType = HELLO_ - | REPLY_ | A_MSG_ | A_RCVD_ | QCONT_ @@ -967,7 +983,6 @@ data AMsgType instance Encoding AMsgType where smpEncode = \case HELLO_ -> "H" - REPLY_ -> "R" A_MSG_ -> "M" A_RCVD_ -> "V" QCONT_ -> "QC" @@ -979,7 +994,6 @@ instance Encoding AMsgType where smpP = A.anyChar >>= \case 'H' -> pure HELLO_ - 'R' -> pure REPLY_ 'M' -> pure A_MSG_ 'V' -> pure A_RCVD_ 'Q' -> @@ -999,8 +1013,6 @@ instance Encoding AMsgType where data AMessage = -- | the first message in the queue to validate it is secured HELLO - | -- | reply queues information - REPLY (NonEmpty SMPQueueInfo) | -- | agent envelope for the client message A_MSG MsgBody | -- | agent envelope for delivery receipt @@ -1062,7 +1074,6 @@ type SndQAddr = (SMPServer, SMP.SenderId) instance Encoding AMessage where smpEncode = \case HELLO -> smpEncode HELLO_ - REPLY smpQueues -> smpEncode (REPLY_, smpQueues) A_MSG body -> smpEncode (A_MSG_, Tail body) A_RCVD mrs -> smpEncode (A_RCVD_, mrs) QCONT addr -> smpEncode (QCONT_, addr) @@ -1075,7 +1086,6 @@ instance Encoding AMessage where smpP >>= \case HELLO_ -> pure HELLO - REPLY_ -> REPLY <$> smpP A_MSG_ -> A_MSG . unTail <$> smpP A_RCVD_ -> A_RCVD <$> smpP QCONT_ -> QCONT <$> smpP @@ -1126,17 +1136,22 @@ instance StrEncoding AConnectionRequestUri where _crScheme :: ServiceScheme <- strP crMode <- A.char '/' *> crModeP <* optional (A.char '/') <* "#/?" query <- strP - crAgentVRange <- queryParam "v" query + aVRange <- queryParam "v" query crSmpQueues <- queryParam "smp" query let crClientData = safeDecodeUtf8 <$> queryParamStr "data" query - let crData = ConnReqUriData {crScheme = SSSimplex, crAgentVRange, crSmpQueues, crClientData} + let crData = ConnReqUriData {crScheme = SSSimplex, crAgentVRange = aVRange, crSmpQueues, crClientData} case crMode of CMInvitation -> do crE2eParams <- queryParam "e2e" query pure . ACR SCMInvitation $ CRInvitationUri crData crE2eParams - CMContact -> pure . ACR SCMContact $ CRContactUri crData + -- contact links are adjusted to the minimum version supported by the agent + -- to preserve compatibility with the old links published online + CMContact -> pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange} where crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact + adjustAgentVRange vr = + let v = max duplexHandshakeSMPAgentVersion $ minVersion vr + in fromMaybe vr $ safeVersionRange v (max v $ maxVersion vr) instance ConnectionModeI m => FromJSON (ConnectionRequestUri m) where parseJSON = strParseJSON "ConnectionRequestUri" @@ -1277,7 +1292,7 @@ sameQAddress (srv, qId) (srv', qId') = sameSrvAddr srv srv' && qId == qId' instance StrEncoding SMPQueueUri where strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey}) - | minVersion vr > 1 = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams + | minVersion vr >= srvHostnamesSMPClientVersion = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams | otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam) where query = strEncode . QSP QEscape @@ -1289,7 +1304,7 @@ instance StrEncoding SMPQueueUri where senderId <- strP <* optional (A.char '/') <* A.char '#' (vr, hs, dhPublicKey) <- unversioned <|> versioned let srv' = srv {host = h :| host <> hs} - smpServer = if maxVersion vr == 1 then updateSMPServerHosts srv' else srv' + smpServer = if maxVersion vr < srvHostnamesSMPClientVersion then updateSMPServerHosts srv' else srv' pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey} where unversioned = (versionToRange 1,[],) <$> strP <* A.endOfInput diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index db1d37c06..8f67c74c2 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -317,7 +317,6 @@ data ConnData = ConnData userId :: UserId, connAgentVersion :: Version, enableNtfs :: Bool, - duplexHandshake :: Maybe Bool, -- added in agent protocol v2 lastExternalSndId :: PrevExternalSndId, deleted :: Bool, ratchetSyncState :: RatchetSyncState @@ -326,14 +325,8 @@ data ConnData = ConnData -- this function should be mirrored in the clients ratchetSyncAllowed :: ConnData -> Bool -ratchetSyncAllowed cData@ConnData {ratchetSyncState} = - ratchetSyncSupported' cData && (ratchetSyncState `elem` ([RSAllowed, RSRequired] :: [RatchetSyncState])) - -ratchetSyncSupported' :: ConnData -> Bool -ratchetSyncSupported' ConnData {connAgentVersion} = connAgentVersion >= 3 - -messageRcptsSupported :: ConnData -> Bool -messageRcptsSupported ConnData {connAgentVersion} = connAgentVersion >= 4 +ratchetSyncAllowed ConnData {ratchetSyncState, connAgentVersion} = + connAgentVersion >= ratchetSyncSMPAgentVersion && (ratchetSyncState `elem` ([RSAllowed, RSRequired] :: [RatchetSyncState])) -- this function should be mirrored in the clients ratchetSyncSendProhibited :: ConnData -> Bool diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 38319d31c..d007ff0ee 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -92,8 +92,8 @@ module Simplex.Messaging.Agent.Store.SQLite acceptConfirmation, getAcceptedConfirmation, removeConfirmations, - setHandshakeVersion, -- Invitations - sent via Contact connections + setConnectionVersion, createInvitation, getInvitation, acceptInvitation, @@ -543,11 +543,11 @@ createConn_ gVar cData create = checkConstraint SEConnDuplicate $ case cData of ConnData {connId} -> Right . (connId,) <$> create connId createNewConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> SConnectionMode c -> IO (Either StoreError ConnId) -createNewConn db gVar cData@ConnData {userId, connAgentVersion, enableNtfs, duplexHandshake} cMode = do +createNewConn db gVar cData@ConnData {userId, connAgentVersion, enableNtfs} cMode = do fst <$$> createConn_ gVar cData create where create connId = - DB.execute db "INSERT INTO connections (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake) VALUES (?,?,?,?,?,?)" (userId, connId, cMode, connAgentVersion, enableNtfs, duplexHandshake) + DB.execute db "INSERT INTO connections (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake) VALUES (?,?,?,?,?,?)" (userId, connId, cMode, connAgentVersion, enableNtfs, True) updateNewConnRcv :: DB.Connection -> ConnId -> NewRcvQueue -> IO (Either StoreError RcvQueue) updateNewConnRcv db connId rq = @@ -570,19 +570,19 @@ updateNewConnSnd db connId sq = updateConn = Right <$> addConnSndQueue_ db connId sq createRcvConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> NewRcvQueue -> SConnectionMode c -> IO (Either StoreError (ConnId, RcvQueue)) -createRcvConn db gVar cData@ConnData {userId, connAgentVersion, enableNtfs, duplexHandshake} q@RcvQueue {server} cMode = +createRcvConn db gVar cData@ConnData {userId, connAgentVersion, enableNtfs} q@RcvQueue {server} cMode = createConn_ gVar cData $ \connId -> do serverKeyHash_ <- createServer_ db server - DB.execute db "INSERT INTO connections (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake) VALUES (?,?,?,?,?,?)" (userId, connId, cMode, connAgentVersion, enableNtfs, duplexHandshake) + DB.execute db "INSERT INTO connections (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake) VALUES (?,?,?,?,?,?)" (userId, connId, cMode, connAgentVersion, enableNtfs, True) insertRcvQueue_ db connId q serverKeyHash_ createSndConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> NewSndQueue -> IO (Either StoreError (ConnId, SndQueue)) -createSndConn db gVar cData@ConnData {userId, connAgentVersion, enableNtfs, duplexHandshake} q@SndQueue {server} = +createSndConn db gVar cData@ConnData {userId, connAgentVersion, enableNtfs} q@SndQueue {server} = -- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_ ifM (liftIO $ checkConfirmedSndQueueExists_ db q) (pure $ Left SESndQueueExists) $ createConn_ gVar cData $ \connId -> do serverKeyHash_ <- createServer_ db server - DB.execute db "INSERT INTO connections (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake) VALUES (?,?,?,?,?,?)" (userId, connId, SCMInvitation, connAgentVersion, enableNtfs, duplexHandshake) + DB.execute db "INSERT INTO connections (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake) VALUES (?,?,?,?,?,?)" (userId, connId, SCMInvitation, connAgentVersion, enableNtfs, True) insertSndQueue_ db connId q serverKeyHash_ checkConfirmedSndQueueExists_ :: DB.Connection -> NewSndQueue -> IO Bool @@ -869,9 +869,9 @@ removeConfirmations db connId = |] [":conn_id" := connId] -setHandshakeVersion :: DB.Connection -> ConnId -> Version -> Bool -> IO () -setHandshakeVersion db connId aVersion duplexHS = - DB.execute db "UPDATE connections SET smp_agent_version = ?, duplex_handshake = ? WHERE conn_id = ?" (aVersion, duplexHS, connId) +setConnectionVersion :: DB.Connection -> ConnId -> Version -> IO () +setConnectionVersion db connId aVersion = + DB.execute db "UPDATE connections SET smp_agent_version = ? WHERE conn_id = ?" (aVersion, connId) createInvitation :: DB.Connection -> TVar ChaChaDRG -> NewInvitation -> IO (Either StoreError InvitationId) createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInfo} = @@ -1920,15 +1920,15 @@ getConnData db connId' = db [sql| SELECT - user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, duplex_handshake, + user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, last_external_snd_msg_id, deleted, ratchet_sync_state FROM connections WHERE conn_id = ? |] (Only connId') where - cData (userId, connId, cMode, connAgentVersion, enableNtfs_, duplexHandshake, lastExternalSndId, deleted, ratchetSyncState) = - (ConnData {userId, connId, connAgentVersion, enableNtfs = fromMaybe True enableNtfs_, duplexHandshake, lastExternalSndId, deleted, ratchetSyncState}, cMode) + cData (userId, connId, cMode, connAgentVersion, enableNtfs_, lastExternalSndId, deleted, ratchetSyncState) = + (ConnData {userId, connId, connAgentVersion, enableNtfs = fromMaybe True enableNtfs_, lastExternalSndId, deleted, ratchetSyncState}, cMode) setConnDeleted :: DB.Connection -> ConnId -> IO () setConnDeleted db connId = DB.execute db "UPDATE connections SET deleted = ? WHERE conn_id = ?" (True, connId) diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs index 4b74bfe7b..0afa06db3 100644 --- a/src/Simplex/Messaging/Crypto/Ratchet.hs +++ b/src/Simplex/Messaging/Crypto/Ratchet.hs @@ -42,11 +42,18 @@ import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE' import Simplex.Messaging.Version import UnliftIO.STM +-- e2e encryption headers version history: +-- 1 - binary protocol encoding (1/1/2022) +-- 2 - use KDF in x3dh (10/20/2022) + +kdfX3DHE2EEncryptVersion :: Version +kdfX3DHE2EEncryptVersion = 2 + currentE2EEncryptVersion :: Version currentE2EEncryptVersion = 2 supportedE2EEncryptVRange :: VersionRange -supportedE2EEncryptVRange = mkVersionRange 1 currentE2EEncryptVersion +supportedE2EEncryptVRange = mkVersionRange kdfX3DHE2EEncryptVersion currentE2EEncryptVersion data E2ERatchetParams (a :: Algorithm) = E2ERatchetParams Version (PublicKey a) (PublicKey a) @@ -97,27 +104,22 @@ data RatchetInitParams = RatchetInitParams deriving (Eq, Show) x3dhSnd :: DhAlgorithm a => PrivateKey a -> PrivateKey a -> E2ERatchetParams a -> RatchetInitParams -x3dhSnd spk1 spk2 (E2ERatchetParams v rk1 rk2) = - x3dh v (publicKey spk1, rk1) (dh' rk1 spk2) (dh' rk2 spk1) (dh' rk2 spk2) +x3dhSnd spk1 spk2 (E2ERatchetParams _ rk1 rk2) = + x3dh (publicKey spk1, rk1) (dh' rk1 spk2) (dh' rk2 spk1) (dh' rk2 spk2) x3dhRcv :: DhAlgorithm a => PrivateKey a -> PrivateKey a -> E2ERatchetParams a -> RatchetInitParams -x3dhRcv rpk1 rpk2 (E2ERatchetParams v sk1 sk2) = - x3dh v (sk1, publicKey rpk1) (dh' sk2 rpk1) (dh' sk1 rpk2) (dh' sk2 rpk2) +x3dhRcv rpk1 rpk2 (E2ERatchetParams _ sk1 sk2) = + x3dh (sk1, publicKey rpk1) (dh' sk2 rpk1) (dh' sk1 rpk2) (dh' sk2 rpk2) -x3dh :: DhAlgorithm a => Version -> (PublicKey a, PublicKey a) -> DhSecret a -> DhSecret a -> DhSecret a -> RatchetInitParams -x3dh v (sk1, rk1) dh1 dh2 dh3 = +x3dh :: DhAlgorithm a => (PublicKey a, PublicKey a) -> DhSecret a -> DhSecret a -> DhSecret a -> RatchetInitParams +x3dh (sk1, rk1) dh1 dh2 dh3 = RatchetInitParams {assocData, ratchetKey = RatchetKey sk, sndHK = Key hk, rcvNextHK = Key nhk} where assocData = Str $ pubKeyBytes sk1 <> pubKeyBytes rk1 dhs = dhBytes' dh1 <> dhBytes' dh2 <> dhBytes' dh3 - (hk, nhk, sk) - -- for backwards compatibility with clients using agent version before 3.4.0 - | v == 1 = - let (hk', rest) = B.splitAt 32 dhs - in uncurry (hk',,) $ B.splitAt 32 rest - | otherwise = - let salt = B.replicate 64 '\0' - in hkdf3 salt dhs "SimpleXX3DH" + (hk, nhk, sk) = + let salt = B.replicate 64 '\0' + in hkdf3 salt dhs "SimpleXX3DH" type RatchetX448 = Ratchet 'X448 diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 78a8d757f..dfac5d570 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -135,6 +135,7 @@ module Simplex.Messaging.Protocol legacyEncodeServer, legacyServerP, legacyStrEncodeServer, + srvHostnamesSMPClientVersion, sameSrvAddr, sameSrvAddr', noAuthSrv, @@ -189,6 +190,13 @@ import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..)) import Simplex.Messaging.Util (bshow, eitherToMaybe, (<$?>)) import Simplex.Messaging.Version +-- SMP client protocol version history: +-- 1 - binary protocol encoding (1/1/2022) +-- 2 - multiple server hostnames and versioned queue addresses (8/12/2022) + +srvHostnamesSMPClientVersion :: Version +srvHostnamesSMPClientVersion = 2 + currentSMPClientVersion :: Version currentSMPClientVersion = 2 @@ -370,8 +378,6 @@ data BrokerMsg where data RcvMessage = RcvMessage { msgId :: MsgId, - msgTs :: SystemTime, - msgFlags :: MsgFlags, msgBody :: EncRcvMsgBody -- e2e encrypted, with extra encryption for recipient } deriving (Eq, Show) @@ -399,21 +405,6 @@ messageTs = \case Message {msgTs} -> msgTs MessageQuota {msgTs} -> msgTs -instance StrEncoding RcvMessage where - strEncode RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} = - B.unwords - [ strEncode msgId, - strEncode msgTs, - "flags=" <> strEncode msgFlags, - strEncode body - ] - strP = do - msgId <- strP_ - msgTs <- strP_ - msgFlags <- ("flags=" *> strP_) <|> pure noMsgFlags - msgBody <- EncRcvMsgBody <$> strP - pure RcvMessage {msgId, msgTs, msgFlags, msgBody} - newtype EncRcvMsgBody = EncRcvMsgBody ByteString deriving (Eq, Show) @@ -1113,14 +1104,10 @@ instance PartyI p => ProtocolEncoding ErrorType (Command p) where NKEY k dhKey -> e (NKEY_, ' ', k, dhKey) NDEL -> e NDEL_ GET -> e GET_ - ACK msgId - | v == 1 -> e ACK_ - | otherwise -> e (ACK_, ' ', msgId) + ACK msgId -> e (ACK_, ' ', msgId) OFF -> e OFF_ DEL -> e DEL_ - SEND flags msg - | v == 1 -> e (SEND_, ' ', Tail msg) - | otherwise -> e (SEND_, ' ', flags, ' ', Tail msg) + SEND flags msg -> e (SEND_, ' ', flags, ' ', Tail msg) PING -> e PING_ NSUB -> e NSUB_ where @@ -1170,16 +1157,12 @@ instance ProtocolEncoding ErrorType Cmd where NKEY_ -> NKEY <$> _smpP <*> smpP NDEL_ -> pure NDEL GET_ -> pure GET - ACK_ - | v == 1 -> pure $ ACK "" - | otherwise -> ACK <$> _smpP + ACK_ -> ACK <$> _smpP OFF_ -> pure OFF DEL_ -> pure DEL CT SSender tag -> Cmd SSender <$> case tag of - SEND_ - | v == 1 -> SEND noMsgFlags <$> (unTail <$> _smpP) - | otherwise -> SEND <$> _smpP <*> (unTail <$> _smpP) + SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP) PING_ -> pure PING CT SNotifier NSUB_ -> pure $ Cmd SNotifier NSUB @@ -1190,12 +1173,10 @@ instance ProtocolEncoding ErrorType Cmd where instance ProtocolEncoding ErrorType BrokerMsg where type Tag BrokerMsg = BrokerMsgTag - encodeProtocol v = \case + encodeProtocol _v = \case IDS (QIK rcvId sndId srvDh) -> e (IDS_, ' ', rcvId, sndId, srvDh) - MSG RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} - | v == 1 -> e (MSG_, ' ', msgId, msgTs, Tail body) - | v == 2 -> e (MSG_, ' ', msgId, msgTs, msgFlags, ' ', Tail body) - | otherwise -> e (MSG_, ' ', msgId, Tail body) + MSG RcvMessage {msgId, msgBody = EncRcvMsgBody body} -> + e (MSG_, ' ', msgId, Tail body) NID nId srvNtfDh -> e (NID_, ' ', nId, srvNtfDh) NMSG nmsgNonce encNMsgMeta -> e (NMSG_, ' ', nmsgNonce, encNMsgMeta) END -> e END_ @@ -1206,13 +1187,10 @@ instance ProtocolEncoding ErrorType BrokerMsg where e :: Encoding a => a -> ByteString e = smpEncode - protocolP v = \case + protocolP _v = \case MSG_ -> do msgId <- _smpP - MSG <$> case v of - 1 -> RcvMessage msgId <$> smpP <*> pure noMsgFlags <*> bodyP - 2 -> RcvMessage msgId <$> smpP <*> smpP <*> (A.space *> bodyP) - _ -> RcvMessage msgId (MkSystemTime 0 0) noMsgFlags <$> bodyP + MSG . RcvMessage msgId <$> bodyP where bodyP = EncRcvMsgBody . unTail <$> smpP IDS_ -> IDS <$> (QIK <$> _smpP <*> smpP <*> smpP) diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 83fe32d40..a85ce6cb8 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -542,7 +542,7 @@ dummyKeyX25519 :: C.PublicKey 'C.X25519 dummyKeyX25519 = "MCowBQYDK2VuAyEA4JGSMYht18H4mas/jHeBwfcM7jLwNYJNOAhi2/g4RXg=" client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m () -client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Server {subscribedQ, ntfSubscribedQ, notifiers} = do +client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Server {subscribedQ, ntfSubscribedQ, notifiers} = do labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands" forever $ atomically (readTBQueue rcvQ) @@ -856,17 +856,12 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sess time name = timed name queueId encryptMsg :: QueueRec -> Message -> RcvMessage - encryptMsg qr msg = case msg of - Message {msgFlags, msgBody} - | thVersion == 1 || thVersion == 2 -> encrypt msgFlags msgBody - | otherwise -> encrypt msgFlags $ encodeRcvMsgBody RcvMsgBody {msgTs = msgTs', msgFlags, msgBody} - MessageQuota {} -> - encrypt noMsgFlags $ encodeRcvMsgBody (RcvMsgQuota msgTs') + encryptMsg qr msg = encrypt . encodeRcvMsgBody $ case msg of + Message {msgFlags, msgBody} -> RcvMsgBody {msgTs = msgTs', msgFlags, msgBody} + MessageQuota {} -> RcvMsgQuota msgTs' where - encrypt :: KnownNat i => MsgFlags -> C.MaxLenBS i -> RcvMessage - encrypt msgFlags body = - let encBody = EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) (C.cbNonce msgId') body - in RcvMessage msgId' msgTs' msgFlags encBody + encrypt :: KnownNat i => C.MaxLenBS i -> RcvMessage + encrypt body = RcvMessage msgId' . EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) (C.cbNonce msgId') body msgId' = messageId msg msgTs' = messageTs msg @@ -942,11 +937,10 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= \case where restoreMessages f = do logInfo $ "restoring messages from file " <> T.pack f - st <- asks queueStore ms <- asks msgStore quota <- asks $ msgQueueQuota . config old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch) - runExceptT (liftIO (B.readFile f) >>= foldM (\expired -> restoreMsg expired st ms quota old_) 0 . B.lines) >>= \case + runExceptT (liftIO (B.readFile f) >>= foldM (\expired -> restoreMsg expired ms quota old_) 0 . B.lines) >>= \case Left e -> do logError . T.pack $ "error restoring messages: " <> e liftIO exitFailure @@ -955,14 +949,9 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= \case logInfo "messages restored" pure expired where - restoreMsg !expired st ms quota old_ s = do - r <- liftEither . first (msgErr "parsing") $ strDecode s - case r of - MLRv3 rId msg -> addToMsgQueue rId msg - MLRv1 rId encMsg -> do - qr <- liftEitherError (msgErr "queue unknown") . atomically $ getQueue st SRecipient rId - msg' <- updateMsgV1toV3 qr encMsg - addToMsgQueue rId msg' + restoreMsg !expired ms quota old_ s = do + MLRv3 rId msg <- liftEither . first (msgErr "parsing") $ strDecode s + addToMsgQueue rId msg where addToMsgQueue rId msg = do (isExpired, logFull) <- atomically $ do @@ -974,10 +963,6 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= \case MessageQuota {} -> writeMsg q msg $> (False, False) when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg) pure $ if isExpired then expired + 1 else expired - updateMsgV1toV3 QueueRec {rcvDhSecret} RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} = do - let nonce = C.cbNonce msgId - msgBody <- liftEither . first (msgErr "v1 message decryption") $ C.maxLenBS =<< C.cbDecrypt rcvDhSecret nonce body - pure Message {msgId, msgTs, msgFlags, msgBody} msgErr :: Show e => String -> e -> String msgErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s) diff --git a/src/Simplex/Messaging/Server/MsgStore.hs b/src/Simplex/Messaging/Server/MsgStore.hs index 55a9c5499..7bc1417c0 100644 --- a/src/Simplex/Messaging/Server/MsgStore.hs +++ b/src/Simplex/Messaging/Server/MsgStore.hs @@ -3,14 +3,11 @@ module Simplex.Messaging.Server.MsgStore where -import Control.Applicative ((<|>)) import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Protocol (Message (..), RcvMessage (..), RecipientId) +import Simplex.Messaging.Protocol (Message (..), RecipientId) -data MsgLogRecord = MLRv3 RecipientId Message | MLRv1 RecipientId RcvMessage +data MsgLogRecord = MLRv3 RecipientId Message instance StrEncoding MsgLogRecord where - strEncode = \case - MLRv3 rId msg -> strEncode (Str "v3", rId, msg) - MLRv1 rId msg -> strEncode (rId, msg) - strP = "v3 " *> (MLRv3 <$> strP_ <*> strP) <|> MLRv1 <$> strP_ <*> strP + strEncode (MLRv3 rId msg) = strEncode (Str "v3", rId, msg) + strP = "v3 " *> (MLRv3 <$> strP_ <*> strP) diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 589683a78..f0078ae24 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -546,8 +546,8 @@ syntaxTests t = do <> urlEncode True "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=" <> "%40localhost%3A5001%2F3456-w%3D%3D%23" <> urlEncode True sampleDhKey - <> "&v=1" - <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + <> "&v=2" + <> "&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" <> " subscribe " <> "14\nbob's connInfo" ) diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index e6668a1dd..83548182a 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -53,7 +53,7 @@ connReqData :: ConnReqUriData connReqData = ConnReqUriData { crScheme = SSSimplex, - crAgentVRange = mkVersionRange 1 1, + crAgentVRange = mkVersionRange 2 2, crSmpQueues = [queueV1], crClientData = Nothing } @@ -72,6 +72,9 @@ connectionRequest = ACR SCMInvitation $ CRInvitationUri connReqData testE2ERatchetParams +contactAddress :: AConnectionRequestUri +contactAddress = ACR SCMContact $ CRContactUri connReqData + connectionRequestCurrentRange :: AConnectionRequestUri connectionRequestCurrentRange = ACR SCMInvitation $ @@ -112,45 +115,51 @@ connectionRequestTests = `shouldBe` Right queueV1 it "should serialize connection requests" $ do strEncode connectionRequest - `shouldBe` "simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" + `shouldBe` "simplex:/invitation#/?v=2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> urlEncode True testDhKeyStrUri <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" strEncode connectionRequestCurrentRange - `shouldBe` "simplex:/invitation#/?v=1-4&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" + `shouldBe` "simplex:/invitation#/?v=2-4&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> urlEncode True testDhKeyStrUri <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> urlEncode True testDhKeyStrUri - <> "&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + <> "&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" strEncode connectionRequestClientDataEmpty - `shouldBe` "simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" + `shouldBe` "simplex:/invitation#/?v=2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> urlEncode True testDhKeyStrUri <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" <> "&data=%7B%7D" strEncode connectionRequestClientData - `shouldBe` "simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" + `shouldBe` "simplex:/invitation#/?v=2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> urlEncode True testDhKeyStrUri <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" <> "&data=%7B%22type%22%3A%22group_link%22%2C%20%22group_link_id%22%3A%22abc%22%7D" it "should parse connection requests" $ do + strDecode + ( "https://simplex.chat/contact#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23" + <> testDhKeyStrUri + <> "&v=1" -- adjusted to v2 + ) + `shouldBe` Right contactAddress strDecode ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23" <> testDhKeyStrUri <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" - <> "&v=1" + <> "&v=2" ) `shouldBe` Right connectionRequest strDecode ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> testDhKeyStrUri <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" - <> "&v=1" + <> "&v=2" ) `shouldBe` Right connectionRequest strDecode ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> testDhKeyStrUri <> "&e2e=v%3D1-1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" - <> "&v=1-1" + <> "&v=2-2" ) `shouldBe` Right connectionRequest strDecode @@ -158,9 +167,9 @@ connectionRequestTests = <> testDhKeyStrUri <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> testDhKeyStrUri - <> "&e2e=extra_key%3Dnew%26v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + <> "&e2e=extra_key%3Dnew%26v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" <> "&some_new_param=abc" - <> "&v=1-4" + <> "&v=2-4" ) `shouldBe` Right connectionRequestCurrentRange strDecode @@ -168,7 +177,7 @@ connectionRequestTests = <> testDhKeyStrUri <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" <> "&data=%7B%7D" - <> "&v=1-1" + <> "&v=2-2" ) `shouldBe` Right connectionRequestClientDataEmpty strDecode @@ -176,6 +185,6 @@ connectionRequestTests = <> testDhKeyStrUri <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" <> "&data=%7B%22type%22%3A%22group_link%22%2C%20%22group_link_id%22%3A%22abc%22%7D" - <> "&v=1-1" + <> "&v=2" ) `shouldBe` Right connectionRequestClientData diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index b3c710bd7..758ba9b06 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -34,7 +34,7 @@ module AgentTests.FunctionalAPITests ) where -import AgentTests.ConnectionRequestTests (connReqData, queueAddr, testE2ERatchetParams) +import AgentTests.ConnectionRequestTests (connReqData, queueAddr, testE2ERatchetParams12) import Control.Concurrent (killThread, threadDelay) import Control.Monad import Control.Monad.Except @@ -129,9 +129,6 @@ pattern Rcvd agentMsgId <- RCVD MsgMeta {integrity = MsgOk} [MsgReceipt {agentMs smpCfgVPrev :: ProtocolClientConfig smpCfgVPrev = (smpCfg agentCfg) {serverVRange = prevRange $ serverVRange $ smpCfg agentCfg} -smpCfgV4 :: ProtocolClientConfig -smpCfgV4 = (smpCfg agentCfg) {serverVRange = mkVersionRange 4 4} - smpCfgV7 :: ProtocolClientConfig smpCfgV7 = (smpCfg agentCfg) {serverVRange = mkVersionRange 4 authCmdsSMPVersion} @@ -155,26 +152,11 @@ agentCfgV7 = ntfCfg = ntfCfgV2 } -agentCfgV1 :: AgentConfig -agentCfgV1 = - agentCfg - { smpAgentVRange = v1Range, - smpClientVRange = v1Range, - e2eEncryptVRange = v1Range, - smpCfg = smpCfgV4 - } - agentCfgRatchetVPrev :: AgentConfig agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg} -agentCfgRatchetV1 :: AgentConfig -agentCfgRatchetV1 = agentCfg {e2eEncryptVRange = v1Range} - prevRange :: VersionRange -> VersionRange -prevRange vr = vr {maxVersion = maxVersion vr - 1} - -v1Range :: VersionRange -v1Range = mkVersionRange 1 1 +prevRange vr = vr {maxVersion = max (minVersion vr) (maxVersion vr - 1)} runRight_ :: (Eq e, Show e, HasCallStack) => ExceptT e IO () -> Expectation runRight_ action = runExceptT action `shouldReturn` Right () @@ -223,8 +205,6 @@ functionalAPITests t = do 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 it "should restore confirmation after client restart" $ testAllowConnectionClientRestart t describe "Message delivery" $ do @@ -388,19 +368,17 @@ testMatrix2 t runTest = do it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 runTest it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 runTest it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 runTest - it "v1" $ withSmpServer t $ runTestCfg2 agentCfgV1 agentCfgV1 4 runTest - it "v1 to current" $ withSmpServer t $ runTestCfg2 agentCfgV1 agentCfg 4 runTest - it "current to v1" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgV1 4 runTest testRatchetMatrix2 :: ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testRatchetMatrix2 t runTest = do it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 runTest - it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 3 runTest - it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 3 runTest - it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 3 runTest - it "ratchet v1" $ withSmpServer t $ runTestCfg2 agentCfgRatchetV1 agentCfgRatchetV1 3 runTest - it "ratchets v1 to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetV1 agentCfg 3 runTest - it "ratchets current to v1" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetV1 3 runTest + pendingV "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 3 runTest + pendingV "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 3 runTest + pendingV "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 3 runTest + where + pendingV = + let vr = e2eEncryptVRange agentCfg + in if minVersion vr == maxVersion vr then xit else it testServerMatrix2 :: ATransport -> (InitialAgentServers -> IO ()) -> Spec testServerMatrix2 t runTest = do @@ -423,7 +401,7 @@ withAgentClients2 :: (AgentClient -> AgentClient -> IO ()) -> IO () withAgentClients2 = withAgentClientsCfg2 agentCfg agentCfg runAgentClientTest :: HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO () -runAgentClientTest alice bob baseId = +runAgentClientTest alice@AgentClient {} bob baseId = runRight_ $ do (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe @@ -600,15 +578,6 @@ testAsyncServerOffline t = withAgentClients2 $ \alice bob -> do get bob ##> ("", aliceId, CON) exchangeGreetings alice bobId bob aliceId -testAsyncHelloTimeout :: HasCallStack => IO () -testAsyncHelloTimeout = do - -- this test would only work if any of the agent is v1, there is no HELLO timeout in v2 - withAgentClientsCfg2 agentCfgV1 agentCfg {helloTimeout = 1} $ \alice bob -> runRight_ $ do - (_, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe - disconnectAgentClient alice - aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe - get bob ##> ("", aliceId, ERR $ CONN NOT_ACCEPTED) - testAllowConnectionClientRestart :: HasCallStack => ATransport -> IO () testAllowConnectionClientRestart t = do let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]} @@ -2278,7 +2247,7 @@ testServerMultipleIdentities = } ] } - testE2ERatchetParams + testE2ERatchetParams12 exchangeGreetings :: HasCallStack => AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO () exchangeGreetings = exchangeGreetingsMsgId 4 diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 1421209b8..5799a0492 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -172,7 +172,7 @@ testForeignKeysEnabled = `shouldThrow` (\e -> SQL.sqlError e == SQL.ErrorConstraint) cData1 :: ConnData -cData1 = ConnData {userId = 1, connId = "conn1", connAgentVersion = 1, enableNtfs = True, duplexHandshake = Nothing, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk} +cData1 = ConnData {userId = 1, connId = "conn1", connAgentVersion = 1, enableNtfs = True, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk} testPrivateAuthKey :: C.APrivateAuthKey testPrivateAuthKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe" diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs index 6ac64a4c1..46d3d4dd8 100644 --- a/tests/XFTPAgent.hs +++ b/tests/XFTPAgent.hs @@ -209,7 +209,6 @@ testXFTPAgentSendReceiveNoRedirect = withXFTPServer $ do sfGet sndr >>= \case (_, _, SFDONE _snd (vfd : _)) -> pure vfd r -> error $ "Expected SFDONE, got " <> show r - B.putStrLn $ strEncode vfdDirect let uri = strEncode $ fileDescriptionURI vfdDirect B.length uri `shouldSatisfy` (< qrSizeLimit) case strDecode uri of