From 18f7ecb7e183c0df177e5fbe0d23b1345422c0fb Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 7 Dec 2023 20:38:58 +0400 Subject: [PATCH] encoding, remove instances --- src/Simplex/Chat.hs | 20 ++++++++++---------- src/Simplex/Chat/Protocol.hs | 17 ++++------------- src/Simplex/Chat/Store/Shared.hs | 2 +- tests/ProtocolTests.hs | 13 ++++++++----- 4 files changed, 23 insertions(+), 29 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index f8a052337b..727aacf893 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3624,9 +3624,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do cmdId <- createAckCmd conn let aChatMsgs = parseChatMessages msgBody withAckMessage agentConnId cmdId msgMeta $ do - -- TODO [batch send] workaround for UNIQUE(connection_id, agent_msg_id) in msg_deliveries - -- - recreate table without UNIQUE constraint? - -- - many-to-many table? forM_ aChatMsgs $ \case Right (ACMsg _ chatMsg) -> processEvent cmdId chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e @@ -5232,7 +5229,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XGrpInfo p' -> xGrpInfo gInfo author p' rcvMsg msgTs _ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event) - -- TODO [batch send] update status of all messages in batch (getChatItemIdByAgentMsgId to return [ChatItemId]) directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m () directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta @@ -5240,7 +5236,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus updateDirectItemStatus ct conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete - -- TODO [batch send] same as for directMsgReceived + -- TODO [batch send] update status of all messages in batch + -- - this is for when we implement identifying inactive connections + -- - regular messages sent in batch would all be marked as delivered by a single receipt + -- - repeat for directMsgReceived if same logic is applied to direct messages + -- - getChatItemIdByAgentMsgId to return [ChatItemId] groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m () groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta @@ -5520,7 +5520,7 @@ createSndMessage chatMsgEvent connOrGroupId = do gVar <- asks idsDrg ChatConfig {chatVRange} <- asks config withStore $ \db -> createNewSndMessage db gVar connOrGroupId $ \sharedMsgId -> - let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} + let msgBody = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} in NewMessage {chatMsgEvent, msgBody} sendBatchedDirectMessages :: (MsgEncodingI e, ChatMonad m) => Connection -> [ChatMsgEvent e] -> ConnOrGroupId -> m (SndMessage, Int64) @@ -5543,13 +5543,13 @@ createBatchedSndMessage events connOrGroupId = do -- - * return list of SndMessages? it's not necessary for current use cases withStore $ \db -> createNewSndMessage db gVar connOrGroupId $ \sharedMsgId -> let chatMsgEvent = XOk -- dummy - msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} + msgBody = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} in NewMessage {chatMsgEvent, msgBody} directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString directMessage chatMsgEvent = do ChatConfig {chatVRange} <- asks config - pure $ strEncode ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} + pure $ encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m Int64 deliverMessage conn cmEventTag msgBody msgId = do @@ -5634,9 +5634,9 @@ sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn _ -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName _ -> pure () +-- TODO [batch send] refactor direct message processing same as groups (e.g. checkIntegrity before processing) saveDirectRcvMSG :: ChatMonad m => Connection -> MsgMeta -> CommandId -> MsgBody -> m (Connection, RcvMessage) -saveDirectRcvMSG conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody = do - -- TODO [batch send] refactor direct message processing same as groups +saveDirectRcvMSG conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody = case parseChatMessages msgBody of [Right (ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent})] -> do conn' <- updatePeerChatVRange conn chatVRange diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index ab941365ce..0d927878ea 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -471,19 +471,10 @@ data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInv $(JQ.deriveJSON defaultJSON ''QuotedMsg) --- TODO [batch send] remove ChatMessage, AChatMessage StrEncoding instances, use specialized function strEncode -instance MsgEncodingI e => StrEncoding (ChatMessage e) where - strEncode msg = case chatToAppMessage msg of - AMJson m -> LB.toStrict $ J.encode m - AMBinary m -> strEncode m - strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP - -instance StrEncoding AChatMessage where - strEncode (ACMsg _ m) = strEncode m - strP = - A.peekChar' >>= \case - '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString) - _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP) +encodeChatMessage :: MsgEncodingI e => ChatMessage e -> ByteString +encodeChatMessage msg = case chatToAppMessage msg of + AMJson m -> LB.toStrict $ J.encode m + AMBinary m -> strEncode m parseChatMessages :: ByteString -> [Either String AChatMessage] parseChatMessages "" = [Left "empty string"] diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index b8f84323dc..79fda1a50e 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -32,7 +32,7 @@ import Simplex.Chat.Protocol import Simplex.Chat.Remote.Types import Simplex.Chat.Types import Simplex.Chat.Types.Preferences -import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId) +import Simplex.Messaging.Agent.Protocol (ConnId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 28de26e38b..db8028f667 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -14,8 +14,6 @@ import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet -import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (parseAll) import Simplex.Messaging.Protocol (supportedSMPClientVRange) import Simplex.Messaging.Version import Test.Hspec @@ -62,12 +60,17 @@ quotedMsg = (==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation s ==## msg = do - strDecode s `shouldBe` Right msg - parseAll strP s `shouldBe` Right msg + case parseChatMessages s of + [acMsg] -> case acMsg of + Right (ACMsg _ msg') -> case checkEncoding msg' of + Right msg'' -> msg'' `shouldBe` msg + Left e -> expectationFailure $ "checkEncoding error: " <> show e + Left e -> expectationFailure $ "parse error: " <> show e + _ -> expectationFailure "exactly one message expected" (##==) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation s ##== msg = - J.eitherDecodeStrict' (strEncode msg) + J.eitherDecodeStrict' (encodeChatMessage msg) `shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value) (##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation