diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 5c455ba9a..b27aeab14 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -534,34 +534,18 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do sendConMsg toConn reConn = atomically $ writeTBQueue subQ ("", toConn, ICON reConn) agentClientMsg :: PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m () - agentClientMsg receivedPrevMsgHash senderMeta brokerMeta msgBody msgHash = do + agentClientMsg externalPrevSndHash sender broker msgBody internalHash = do logServer "<--" c srv rId "MSG " case status of Active -> do internalTs <- liftIO getCurrentTime (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore (`updateRcvIds` connId) - let msgIntegrity = checkMsgIntegrity prevExtSndId (fst senderMeta) prevRcvMsgHash receivedPrevMsgHash - withStore $ \st -> - createRcvMsg st connId $ - RcvMsgData - { internalId, - internalRcvId, - internalTs, - senderMeta, - brokerMeta, - msgBody, - internalHash = msgHash, - externalPrevSndHash = receivedPrevMsgHash, - msgIntegrity - } - notify - MSG - { recipientMeta = (unId internalId, internalTs), - senderMeta, - brokerMeta, - msgBody, - msgIntegrity - } + let integrity = checkMsgIntegrity prevExtSndId (fst sender) prevRcvMsgHash externalPrevSndHash + recipient = (unId internalId, internalTs) + msgMeta = MsgMeta {integrity, recipient, sender, broker} + rcvMsg = RcvMsgData {msgMeta, msgBody, internalRcvId, internalHash, externalPrevSndHash} + withStore $ \st -> createRcvMsg st connId rcvMsg + notify $ MSG msgMeta msgBody _ -> prohibited checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index ab57e3d5e..0b81b6f9b 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -32,6 +32,7 @@ module Simplex.Messaging.Agent.Protocol ACommand (..), AParty (..), SAParty (..), + MsgMeta (..), SMPMessage (..), AMessage (..), SMPServer (..), @@ -166,14 +167,7 @@ data ACommand (p :: AParty) where -- STAT :: QueueDirection -> Maybe QueueStatus -> Maybe SubMode -> ACommand Agent SEND :: MsgBody -> ACommand Client SENT :: AgentMsgId -> ACommand Agent - MSG :: - { recipientMeta :: (AgentMsgId, UTCTime), - brokerMeta :: (MsgId, UTCTime), - senderMeta :: (AgentMsgId, UTCTime), - msgIntegrity :: MsgIntegrity, - msgBody :: MsgBody - } -> - ACommand Agent + MSG :: MsgMeta -> MsgBody -> ACommand Agent -- ACK :: AgentMsgId -> ACommand Client -- RCVD :: AgentMsgId -> ACommand Agent OFF :: ACommand Client @@ -185,6 +179,15 @@ deriving instance Eq (ACommand p) deriving instance Show (ACommand p) +-- | Agent message metadata sent to the client +data MsgMeta = MsgMeta + { integrity :: MsgIntegrity, + recipient :: (AgentMsgId, UTCTime), + broker :: (MsgId, UTCTime), + sender :: (AgentMsgId, UTCTime) + } + deriving (Eq, Show) + -- | SMP message formats. data SMPMessage = -- | SMP confirmation @@ -496,16 +499,16 @@ commandP = sendCmd = ACmd SClient . SEND <$> A.takeByteString sentResp = ACmd SAgent . SENT <$> A.decimal iconMsg = ACmd SAgent . ICON <$> A.takeTill wordEnd - message = do - msgIntegrity <- msgIntegrityP <* A.space - recipientMeta <- "R=" *> partyMeta A.decimal - brokerMeta <- "B=" *> partyMeta base64P - senderMeta <- "S=" *> partyMeta A.decimal - msgBody <- A.takeByteString - return $ ACmd SAgent MSG {recipientMeta, brokerMeta, senderMeta, msgIntegrity, msgBody} + message = ACmd SAgent <$> (MSG <$> msgMetaP <* A.space <*> A.takeByteString) + msgMetaP = do + integrity <- msgIntegrityP + recipient <- " R=" *> partyMeta A.decimal + broker <- " B=" *> partyMeta base64P + sender <- " S=" *> partyMeta A.decimal + pure MsgMeta {integrity, recipient, broker, sender} introP f = f <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString replyMode = ReplyMode <$> (" NO_REPLY" $> Off <|> pure On) - partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P <* A.space + partyMeta idParser = (,) <$> idParser <* "," <*> tsISO8601P agentError = ACmd SAgent . ERR <$> agentErrorTypeP -- | Message integrity validation result parser. @@ -534,15 +537,8 @@ serializeCommand = \case END -> "END" SEND msgBody -> "SEND " <> serializeMsg msgBody SENT mId -> "SENT " <> bshow mId - MSG {recipientMeta = (rmId, rTs), brokerMeta = (bmId, bTs), senderMeta = (smId, sTs), msgIntegrity, msgBody} -> - B.unwords - [ "MSG", - serializeMsgIntegrity msgIntegrity, - "R=" <> bshow rmId <> "," <> showTs rTs, - "B=" <> encode bmId <> "," <> showTs bTs, - "S=" <> bshow smId <> "," <> showTs sTs, - serializeMsg msgBody - ] + MSG msgMeta msgBody -> + "MSG " <> serializeMsgMeta msgMeta <> " " <> serializeMsg msgBody OFF -> "OFF" DEL -> "DEL" CON -> "CON" @@ -556,6 +552,14 @@ serializeCommand = \case ReplyMode On -> "" showTs :: UTCTime -> ByteString showTs = B.pack . formatISO8601Millis + serializeMsgMeta :: MsgMeta -> ByteString + serializeMsgMeta MsgMeta {integrity, recipient = (rmId, rTs), broker = (bmId, bTs), sender = (smId, sTs)} = + B.unwords + [ serializeMsgIntegrity integrity, + "R=" <> bshow rmId <> "," <> showTs rTs, + "B=" <> encode bmId <> "," <> showTs bTs, + "S=" <> bshow smId <> "," <> showTs sTs + ] -- | Serialize message integrity validation result. serializeMsgIntegrity :: MsgIntegrity -> ByteString @@ -636,7 +640,7 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody cmdWithMsgBody :: ACommand p -> m (Either AgentErrorType (ACommand p)) cmdWithMsgBody = \case SEND body -> SEND <$$> getMsgBody body - MSG agentMsgId srvTS agentTS integrity body -> MSG agentMsgId srvTS agentTS integrity <$$> getMsgBody body + MSG msgMeta body -> MSG msgMeta <$$> getMsgBody body INTRO introId cInfo -> INTRO introId <$$> getMsgBody cInfo REQ introId cInfo -> REQ introId <$$> getMsgBody cInfo ACPT introId cInfo -> ACPT introId <$$> getMsgBody cInfo diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 7b4b03cbc..cad975570 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -170,15 +170,11 @@ type PrevSndMsgHash = MsgHash -- * Message data containers - used on Msg creation to reduce number of parameters data RcvMsgData = RcvMsgData - { internalId :: InternalId, - internalRcvId :: InternalRcvId, - internalTs :: InternalTs, - senderMeta :: (ExternalSndId, ExternalSndTs), - brokerMeta :: (BrokerId, BrokerTs), + { msgMeta :: MsgMeta, msgBody :: MsgBody, + internalRcvId :: InternalRcvId, internalHash :: MsgHash, - externalPrevSndHash :: MsgHash, - msgIntegrity :: MsgIntegrity + externalPrevSndHash :: MsgHash } data SndMsgData = SndMsgData diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index ce46d964c..3d3ec8d67 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -746,7 +746,8 @@ updateLastIdsRcv_ dbConn connId newInternalId newInternalRcvId = -- * createRcvMsg helpers insertRcvMsgBase_ :: DB.Connection -> ConnId -> RcvMsgData -> IO () -insertRcvMsgBase_ dbConn connId RcvMsgData {..} = do +insertRcvMsgBase_ dbConn connId RcvMsgData {msgMeta, msgBody, internalRcvId} = do + let MsgMeta {recipient = (internalId, internalTs)} = msgMeta DB.executeNamed dbConn [sql| @@ -763,7 +764,8 @@ insertRcvMsgBase_ dbConn connId RcvMsgData {..} = do ] insertRcvMsgDetails_ :: DB.Connection -> ConnId -> RcvMsgData -> IO () -insertRcvMsgDetails_ dbConn connId RcvMsgData {..} = +insertRcvMsgDetails_ dbConn connId RcvMsgData {msgMeta, internalRcvId, internalHash, externalPrevSndHash} = do + let MsgMeta {integrity, recipient, sender, broker} = msgMeta DB.executeNamed dbConn [sql| @@ -778,19 +780,19 @@ insertRcvMsgDetails_ dbConn connId RcvMsgData {..} = |] [ ":conn_alias" := connId, ":internal_rcv_id" := internalRcvId, - ":internal_id" := internalId, - ":external_snd_id" := fst senderMeta, - ":external_snd_ts" := snd senderMeta, - ":broker_id" := fst brokerMeta, - ":broker_ts" := snd brokerMeta, + ":internal_id" := fst recipient, + ":external_snd_id" := fst sender, + ":external_snd_ts" := snd sender, + ":broker_id" := fst broker, + ":broker_ts" := snd broker, ":rcv_status" := Received, ":internal_hash" := internalHash, ":external_prev_snd_hash" := externalPrevSndHash, - ":integrity" := msgIntegrity + ":integrity" := integrity ] updateHashRcv_ :: DB.Connection -> ConnId -> RcvMsgData -> IO () -updateHashRcv_ dbConn connId RcvMsgData {..} = +updateHashRcv_ dbConn connId RcvMsgData {msgMeta, internalHash, internalRcvId} = DB.executeNamed dbConn -- last_internal_rcv_msg_id equality check prevents race condition in case next id was reserved @@ -801,7 +803,7 @@ updateHashRcv_ dbConn connId RcvMsgData {..} = WHERE conn_alias = :conn_alias AND last_internal_rcv_msg_id = :last_internal_rcv_msg_id; |] - [ ":last_external_snd_msg_id" := fst senderMeta, + [ ":last_external_snd_msg_id" := fst (sender msgMeta), ":last_rcv_msg_hash" := internalHash, ":conn_alias" := connId, ":last_internal_rcv_msg_id" := internalRcvId diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 34993c8e8..576c2ea63 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -101,7 +101,7 @@ h #:# err = tryGet `shouldReturn` () _ -> return () pattern Msg :: MsgBody -> ACommand 'Agent -pattern Msg msgBody <- MSG {msgBody, msgIntegrity = MsgOk} +pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody testDuplexConnection :: Transport c => TProxy c -> c -> c -> IO () testDuplexConnection _ alice bob = do diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 1a00df797..6dd69da19 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -402,21 +402,24 @@ ts = UTCTime (fromGregorian 2021 02 24) (secondsToDiffTime 0) mkRcvMsgData :: InternalId -> InternalRcvId -> ExternalSndId -> BrokerId -> MsgHash -> RcvMsgData mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash = RcvMsgData - { internalId, - internalRcvId, - internalTs = ts, - senderMeta = (externalSndId, ts), - brokerMeta = (brokerId, ts), + { internalRcvId, + msgMeta = + MsgMeta + { integrity = MsgOk, + recipient = (unId internalId, ts), + sender = (externalSndId, ts), + broker = (brokerId, ts) + }, msgBody = hw, internalHash, - externalPrevSndHash = "hash_from_sender", - msgIntegrity = MsgOk + externalPrevSndHash = "hash_from_sender" } testCreateRcvMsg' :: SQLiteStore -> PrevExternalSndId -> PrevRcvMsgHash -> ConnId -> RcvMsgData -> Expectation testCreateRcvMsg' st expectedPrevSndId expectedPrevHash connId rcvMsgData@RcvMsgData {..} = do + let MsgMeta {recipient = (internalId, _)} = msgMeta updateRcvIds st connId - `returnsResult` (internalId, internalRcvId, expectedPrevSndId, expectedPrevHash) + `returnsResult` (InternalId internalId, internalRcvId, expectedPrevSndId, expectedPrevHash) createRcvMsg st connId rcvMsgData `returnsResult` ()