raw chat message parsing test

apps/simplex-chat/Simplex/Chat/Controller.hs

@@ -11,10 +11,10 @@ import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Numeric.Natural
 import Simplex.Chat.Protocol
+import Simplex.Chat.Types
 import Simplex.Messaging.Agent (AgentClient)
 import Simplex.Messaging.Agent.Protocol (AgentErrorType)
 import Simplex.Notification
-import Simplex.Store.Types
 import Simplex.Terminal
 import Types
 import UnliftIO.STM

apps/simplex-chat/Simplex/Chat/Protocol.hs → src/Simplex/Chat/Protocol.hs

@@ -13,9 +13,9 @@ import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text (Text)
+import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Parsers (base64P)
-import Simplex.Store.Types
 
 type ChatTransmission = (MsgMeta, ChatMessage)
 
@@ -37,38 +37,43 @@ data RawChatMessage
         continuationId :: Int,
         continuationData :: ByteString
       }
+  deriving (Eq, Show)
 
 data ChatMsgEvent
   = SimplexChatMsgEvent (NonEmpty ByteString)
   | ChatMsgEvent NameSpace (NonEmpty ByteString)
+  deriving (Eq, Show)
 
 data MsgBodyContent = MsgBodyContent
   { contentType :: ContentType,
-    contentSize :: Int,
     contentHash :: Maybe ByteString,
     contentData :: MsgBodyPartData
   }
+  deriving (Eq, Show)
 
 data ContentType
   = ContentType NameSpace ByteString -- unknown namespace
   | MimeContentType ByteString -- i. namespace for MIME content type
   | ChannelContentType ByteString -- c. namespace for SimpleX channel content type
   | SimplexContentType ByteString -- x. namespace
   | SimplexDAG -- x.dag content type
+  deriving (Eq, Show)
 
 type NameSpace = ByteString
 
 data MsgBodyPartData
   = -- | fully loaded
     MBFull MsgData
   | -- | partially loaded
-    MBPartial MsgData
+    MBPartial Int MsgData
   | -- | not loaded yet
-    MBEmpty
+    MBEmpty Int
+  deriving (Eq, Show)
 
 data MsgData
   = MsgData ByteString
-  | MsgDataRec {recId :: Int64, recSize :: Int}
+  | MsgDataRec {dataId :: Int64, dataSize :: Int}
+  deriving (Eq, Show)
 
 rawChatMessageP :: Parser RawChatMessage
 rawChatMessageP = A.char '#' *> chatMsgContP <|> chatMsgP
@@ -83,7 +88,7 @@ rawChatMessageP = A.char '#' *> chatMsgContP <|> chatMsgP
     chatMsgP = do
       chatMsgId <- optional A.decimal <* A.space
       chatMsgEvent <- chatMsgEventP <* A.space
-      chatMsgParams <- A.takeTill (A.inClass ", ") `A.sepBy'` A.char ',' <* A.space
+      chatMsgParams <- A.takeWhile1 (not . A.inClass ", ") `A.sepBy'` A.char ',' <* A.space
       chatMsgBody <- msgBodyContent =<< contentInfo `A.sepBy'` A.char ',' <* A.space
       pure RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody}
     chatMsgEventP :: Parser ChatMsgEvent
@@ -104,7 +109,7 @@ rawChatMessageP = A.char '#' *> chatMsgContP <|> chatMsgP
       contentType <- contentTypeP
       contentSize <- A.char ':' *> A.decimal
       contentHash <- optional (A.char ':' *> base64P)
-      pure MsgBodyContent {contentType, contentSize, contentHash, contentData = MBEmpty}
+      pure MsgBodyContent {contentType, contentHash, contentData = MBEmpty contentSize}
     contentTypeP :: Parser ContentType
     contentTypeP = do
       identifier <* A.char '.' >>= \case
@@ -119,9 +124,9 @@ rawChatMessageP = A.char '#' *> chatMsgContP <|> chatMsgP
           s -> SimplexContentType s
     msgBodyContent :: [MsgBodyContent] -> Parser [MsgBodyContent]
     msgBodyContent [] = pure []
-    msgBodyContent (p : ps) = do
-      let size = contentSize p
+    msgBodyContent (p@MsgBodyContent {contentData = MBEmpty size} : ps) = do
       s <- A.take size <* A.space <|> A.takeByteString
       if B.length s == size
-        then (p {contentData = MBFull (MsgData s)} :) <$> msgBodyContent ps
-        else pure $ p {contentData = if B.null s then MBEmpty else MBPartial (MsgData s)} : ps
+        then (p {contentData = MBFull $ MsgData s} :) <$> msgBodyContent ps
+        else pure $ (if B.null s then p else p {contentData = MBPartial size $ MsgData s}) : ps
+    msgBodyContent _ = fail "expected contentData = MBEmpty"

apps/simplex-chat/Simplex/Store/Types.hs → src/Simplex/Chat/Types.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 
-module Simplex.Store.Types where
+module Simplex.Chat.Types where
 
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)

tests/ProtocolTests.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module ProtocolTests where
+
+import Data.ByteString.Char8 (ByteString)
+import Simplex.Chat.Protocol
+import Simplex.Messaging.Parsers (parseAll)
+import Test.Hspec
+
+protocolTests :: Spec
+protocolTests = do
+  parseChatMessageTest
+
+(#==) :: ByteString -> RawChatMessage -> Expectation
+s #== msg = parseAll rawChatMessageP s `shouldBe` Right msg
+
+parseChatMessageTest :: Spec
+parseChatMessageTest = describe "Raw chat message format" $ do
+  it "should parse raw chat messages" $ do
+    "5 x.grp.mem.leave   " #== RawChatMessage (Just 5) (SimplexChatMsgEvent ["grp", "mem", "leave"]) [] []
+    "6 x.msg.del 3  " #== RawChatMessage (Just 6) (SimplexChatMsgEvent ["msg", "del"]) ["3"] []
+    "7 x.msg.new c.text c.text:11 hello there "
+      #== RawChatMessage
+        (Just 7)
+        (SimplexChatMsgEvent ["msg", "new"])
+        ["c.text"]
+        [MsgBodyContent (ChannelContentType "text") Nothing $ MBFull (MsgData "hello there")]
+    "8 x.msg.new c.image x.dag:16,c.text:7,i.image/jpg:64:MDEyMzQ1Njc=,i.image/png:4000:MDEyMzQ1Njc= 0123456789012345 picture abcdef"
+      #== RawChatMessage
+        (Just 8)
+        (SimplexChatMsgEvent ["msg", "new"])
+        ["c.image"]
+        [ MsgBodyContent SimplexDAG Nothing $ MBFull (MsgData "0123456789012345"),
+          MsgBodyContent (ChannelContentType "text") Nothing $ MBFull (MsgData "picture"),
+          MsgBodyContent (MimeContentType "image/jpg") (Just "01234567") $ MBPartial 64 (MsgData "abcdef"),
+          MsgBodyContent (MimeContentType "image/png") (Just "01234567") $ MBEmpty 4000
+        ]
+    "#8.1 abcdef" #== RawChatMsgContinuation 8 1 "abcdef"

tests/Test.hs

@@ -1,7 +1,9 @@
 import MarkdownTests
+import ProtocolTests
 import Test.Hspec
 
 main :: IO ()
 main = do
   hspec $ do
     describe "SimpleX chat markdown" markdownTests
+    describe "SimpleX chat protocol" protocolTests