update chat protocol to use JSON encoding for chat messages (#182)

* started chat protocol

* text message example

* events json

* same style comments

* jsonc

* num for rendering

* try to fix comment rendering

* revert num

* chat protocol: make msg params closer to types

* AppMessage type

* combine new and old simplexmq dependencies

* json parsers

* version-compatible types for connection requests

* more parsers

* remove import

* decode/encode from/to AppMessage

* make group invitation a property in params

* switch chat to the new agent

* remove "compatibility" attempt

* new JSON encoding for chat messages

* simplexmq from github

* update MsgContent name

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>

src/Simplex/Chat/Controller.hs

@@ -78,9 +78,10 @@ data ChatErrorType
   | CEFileSend Int64 AgentErrorType
   | CEFileRcvChunk String
   | CEFileInternal String
+  | CEAgentVersion
   deriving (Show, Exception)
 
-type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
+type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m, MonadFail m)
 
 setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
 setActive to = asks (activeTo . chatTerminal) >>= atomically . (`writeTVar` to)

src/Simplex/Chat/Options.hs

@@ -7,7 +7,8 @@ import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Options.Applicative
-import Simplex.Messaging.Agent.Protocol (SMPServer (..), smpServerP)
+import Simplex.Messaging.Agent.Protocol (SMPServer (..))
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import System.FilePath (combine)
 
@@ -37,8 +38,8 @@ chatOpts appDir =
             )
           <> value
             ( L.fromList
-                [ "smp2.simplex.im#z5W2QLQ1Br3Yd6CoWg7bIq1bHdwK7Y8bEiEXBs/WfAg=", -- London, UK
-                  "smp3.simplex.im#nxc7HnrnM8dOKgkMp008ub/9o9LXJlxlMrMpR+mfMQw=" -- Fremont, CA
+                [ "smp://z5W2QLQ1Br3Yd6CoWg7bIq1bHdwK7Y8bEiEXBs_WfAg=@smp2.simplex.im", -- London, UK
+                  "smp://nxc7HnrnM8dOKgkMp008ub_9o9LXJlxlMrMpR-mfMQw=@smp3.simplex.im" -- Fremont, CA
                 ]
             )
       )
@@ -48,7 +49,7 @@ chatOpts appDir =
 parseSMPServer :: ReadM (NonEmpty SMPServer)
 parseSMPServer = eitherReader $ parseAll servers . B.pack
   where
-    servers = L.fromList <$> smpServerP `A.sepBy1` A.char ','
+    servers = L.fromList <$> strP `A.sepBy1` A.char ','
 
 getChatOpts :: FilePath -> IO ChatOpts
 getChatOpts appDir = execParser opts

src/Simplex/Chat/Protocol.hs

@@ -1,35 +1,32 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TupleSections #-}
 
 module Simplex.Chat.Protocol where
 
-import Control.Applicative (optional)
-import Control.Monad ((<=<), (>=>))
-import Data.Aeson (FromJSON, ToJSON)
+import Control.Monad ((<=<))
+import Data.Aeson (FromJSON, ToJSON, (.:), (.=))
 import qualified Data.Aeson as J
-import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import qualified Data.ByteString.Base64 as B64
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Int (Int64)
-import Data.List (find, findIndex)
+import qualified Data.HashMap.Strict as H
 import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import GHC.Generics
 import Simplex.Chat.Types
-import Simplex.Chat.Util (safeDecodeUtf8)
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util (bshow)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Util ((<$?>))
 
 data ChatDirection (p :: AParty) where
   ReceivedDirectMessage :: Connection -> Maybe Contact -> ChatDirection 'Agent
@@ -52,6 +49,23 @@ fromConnection = \case
   RcvFileConnection conn _ -> conn
   UserContactConnection conn _ -> conn
 
+-- chat message is sent as JSON with these properties
+data AppMessage = AppMessage
+  { event :: Text,
+    params :: J.Object
+  }
+  deriving (Generic, FromJSON)
+
+instance ToJSON AppMessage where toEncoding = J.genericToEncoding J.defaultOptions
+
+newtype ChatMessage = ChatMessage {chatMsgEvent :: ChatMsgEvent}
+  deriving (Eq, Show)
+
+instance StrEncoding ChatMessage where
+  strEncode = LB.toStrict . J.encode . chatToAppMessage
+  strDecode = appToChatMessage <=< J.eitherDecodeStrict'
+  strP = strDecode <$?> A.takeByteString
+
 data ChatMsgEvent
   = XMsgNew MsgContent
   | XFile FileInvitation
@@ -70,372 +84,215 @@ data ChatMsgEvent
   | XGrpMemDel MemberId
   | XGrpLeave
   | XGrpDel
-  | XInfoProbe ByteString
-  | XInfoProbeCheck ByteString
-  | XInfoProbeOk ByteString
+  | XInfoProbe Probe
+  | XInfoProbeCheck ProbeHash
+  | XInfoProbeOk Probe
   | XOk
   deriving (Eq, Show)
 
-data MessageType = MTText | MTImage deriving (Eq, Show)
+data MsgContentType = MCText_ | MCUnknown_
 
-data MsgContent = MsgContent
-  { messageType :: MessageType,
-    files :: [(ContentType, Int)],
-    content :: [MsgContentBody]
-  }
+instance StrEncoding MsgContentType where
+  strEncode = \case
+    MCText_ -> "text"
+    MCUnknown_ -> "text"
+  strDecode = \case
+    "text" -> Right MCText_
+    _ -> Right MCUnknown_
+  strP = strDecode <$?> A.takeTill (== ' ')
+
+instance FromJSON MsgContentType where
+  parseJSON = strParseJSON "MsgContentType"
+
+instance ToJSON MsgContentType where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+data MsgContent = MCText Text | MCUnknown
   deriving (Eq, Show)
 
-toMsgType :: ByteString -> Either String MessageType
-toMsgType = \case
-  "c.text" -> Right MTText
-  "c.image" -> Right MTImage
-  t -> Left $ "invalid message type " <> B.unpack t
+toMsgContentType :: MsgContent -> MsgContentType
+toMsgContentType = \case
+  MCText _ -> MCText_
+  MCUnknown -> MCUnknown_
 
-rawMsgType :: MessageType -> ByteString
-rawMsgType = \case
-  MTText -> "c.text"
-  MTImage -> "c.image"
+instance FromJSON MsgContent where
+  parseJSON (J.Object v) = do
+    v .: "type" >>= \case
+      MCText_ -> MCText <$> v .: "text"
+      MCUnknown_ -> pure MCUnknown
+  parseJSON invalid =
+    JT.prependFailure "bad MsgContent, " (JT.typeMismatch "Object" invalid)
 
-data ChatMessage = ChatMessage
-  { chatMsgId :: Maybe Int64,
-    chatMsgEvent :: ChatMsgEvent,
-    chatDAG :: Maybe ByteString
-  }
-  deriving (Eq, Show)
+unknownMsgType :: Text
+unknownMsgType = "unknown message type"
 
-toChatEventType :: ChatMsgEvent -> Text
-toChatEventType = \case
-  XMsgNew _ -> "x.msg.new"
-  XFile _ -> "x.file"
-  XFileAcpt _ -> "x.file.acpt"
-  XInfo _ -> "x.info"
-  XContact _ _ -> "x.con"
-  XGrpInv _ -> "x.grp.inv"
-  XGrpAcpt _ -> "x.grp.acpt"
-  XGrpMemNew _ -> "x.grp.mem.new"
-  XGrpMemIntro _ -> "x.grp.mem.intro"
-  XGrpMemInv _ _ -> "x.grp.mem.inv"
-  XGrpMemFwd _ _ -> "x.grp.mem.fwd"
-  XGrpMemInfo _ _ -> "x.grp.mem.info"
-  XGrpMemCon _ -> "x.grp.mem.con"
-  XGrpMemConAll _ -> "x.grp.mem.con.all"
-  XGrpMemDel _ -> "x.grp.mem.del"
-  XGrpLeave -> "x.grp.leave"
-  XGrpDel -> "x.grp.del"
-  XInfoProbe _ -> "x.info.probe"
-  XInfoProbeCheck _ -> "x.info.probe.check"
-  XInfoProbeOk _ -> "x.info.probe.ok"
-  XOk -> "x.ok"
+instance ToJSON MsgContent where
+  toJSON mc =
+    J.object $
+      ("type" .= toMsgContentType mc) : case mc of
+        MCText t -> ["text" .= t]
+        MCUnknown -> ["text" .= unknownMsgType]
+  toEncoding mc =
+    J.pairs $
+      ("type" .= toMsgContentType mc) <> case mc of
+        MCText t -> "text" .= t
+        MCUnknown -> "text" .= unknownMsgType
 
-toChatMessage :: RawChatMessage -> Either String ChatMessage
-toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody} = do
-  (chatDAG, body) <- getDAG <$> mapM toMsgBodyContent chatMsgBody
-  let chatMsg msg = pure ChatMessage {chatMsgId, chatMsgEvent = msg, chatDAG}
-  case (chatMsgEvent, chatMsgParams) of
-    ("x.msg.new", mt : rawFiles) -> do
-      t <- toMsgType mt
-      files <- toFiles rawFiles
-      chatMsg . XMsgNew $ MsgContent {messageType = t, files, content = body}
-    ("x.file", [name, size, cReq]) -> do
-      let fileName = T.unpack $ safeDecodeUtf8 name
-      fileSize <- parseAll A.decimal size
-      fileConnReq <- parseAll connReqP' cReq
-      chatMsg . XFile $ FileInvitation {fileName, fileSize, fileConnReq}
-    ("x.file.acpt", [name]) ->
-      chatMsg . XFileAcpt . T.unpack $ safeDecodeUtf8 name
-    ("x.info", []) -> do
-      profile <- getJSON body
-      chatMsg $ XInfo profile
-    ("x.con", []) -> do
-      profile <- getJSON body
-      chatMsg $ XContact profile Nothing
-    ("x.con", mt : rawFiles) -> do
-      (profile, body') <- extractJSON body
-      t <- toMsgType mt
-      files <- toFiles rawFiles
-      chatMsg . XContact profile $ Just MsgContent {messageType = t, files, content = body'}
-    ("x.grp.inv", [fromMemId, fromRole, memId, role, cReq]) -> do
-      fromMem <- (,) <$> B64.decode fromMemId <*> toMemberRole fromRole
-      invitedMem <- (,) <$> B64.decode memId <*> toMemberRole role
-      groupConnReq <- parseAll connReqP' cReq
-      profile <- getJSON body
-      chatMsg . XGrpInv $ GroupInvitation fromMem invitedMem groupConnReq profile
-    ("x.grp.acpt", [memId]) ->
-      chatMsg . XGrpAcpt =<< B64.decode memId
-    ("x.grp.mem.new", [memId, role]) -> do
-      chatMsg . XGrpMemNew =<< toMemberInfo memId role body
-    ("x.grp.mem.intro", [memId, role]) ->
-      chatMsg . XGrpMemIntro =<< toMemberInfo memId role body
-    ("x.grp.mem.inv", [memId, groupConnReq, directConnReq]) ->
-      chatMsg =<< (XGrpMemInv <$> B64.decode memId <*> toIntroInv groupConnReq directConnReq)
-    ("x.grp.mem.fwd", [memId, role, groupConnReq, directConnReq]) -> do
-      chatMsg =<< (XGrpMemFwd <$> toMemberInfo memId role body <*> toIntroInv groupConnReq directConnReq)
-    ("x.grp.mem.info", [memId]) ->
-      chatMsg =<< (XGrpMemInfo <$> B64.decode memId <*> getJSON body)
-    ("x.grp.mem.con", [memId]) ->
-      chatMsg . XGrpMemCon =<< B64.decode memId
-    ("x.grp.mem.con.all", [memId]) ->
-      chatMsg . XGrpMemConAll =<< B64.decode memId
-    ("x.grp.mem.del", [memId]) ->
-      chatMsg . XGrpMemDel =<< B64.decode memId
-    ("x.grp.leave", []) ->
-      chatMsg XGrpLeave
-    ("x.grp.del", []) ->
-      chatMsg XGrpDel
-    ("x.info.probe", [probe]) -> do
-      chatMsg . XInfoProbe =<< B64.decode probe
-    ("x.info.probe.check", [probeHash]) -> do
-      chatMsg . XInfoProbeCheck =<< B64.decode probeHash
-    ("x.info.probe.ok", [probe]) -> do
-      chatMsg . XInfoProbeOk =<< B64.decode probe
-    ("x.ok", []) ->
-      chatMsg XOk
-    _ -> Left $ "bad syntax or unsupported event " <> B.unpack chatMsgEvent
+data CMEventTag
+  = XMsgNew_
+  | XFile_
+  | XFileAcpt_
+  | XInfo_
+  | XContact_
+  | XGrpInv_
+  | XGrpAcpt_
+  | XGrpMemNew_
+  | XGrpMemIntro_
+  | XGrpMemInv_
+  | XGrpMemFwd_
+  | XGrpMemInfo_
+  | XGrpMemCon_
+  | XGrpMemConAll_
+  | XGrpMemDel_
+  | XGrpLeave_
+  | XGrpDel_
+  | XInfoProbe_
+  | XInfoProbeCheck_
+  | XInfoProbeOk_
+  | XOk_
+
+instance StrEncoding CMEventTag where
+  strEncode = \case
+    XMsgNew_ -> "x.msg.new"
+    XFile_ -> "x.file"
+    XFileAcpt_ -> "x.file.acpt"
+    XInfo_ -> "x.info"
+    XContact_ -> "x.contact"
+    XGrpInv_ -> "x.grp.inv"
+    XGrpAcpt_ -> "x.grp.acpt"
+    XGrpMemNew_ -> "x.grp.mem.new"
+    XGrpMemIntro_ -> "x.grp.mem.intro"
+    XGrpMemInv_ -> "x.grp.mem.inv"
+    XGrpMemFwd_ -> "x.grp.mem.fwd"
+    XGrpMemInfo_ -> "x.grp.mem.info"
+    XGrpMemCon_ -> "x.grp.mem.con"
+    XGrpMemConAll_ -> "x.grp.mem.con.all"
+    XGrpMemDel_ -> "x.grp.mem.del"
+    XGrpLeave_ -> "x.grp.leave"
+    XGrpDel_ -> "x.grp.del"
+    XInfoProbe_ -> "x.info.probe"
+    XInfoProbeCheck_ -> "x.info.probe.check"
+    XInfoProbeOk_ -> "x.info.probe.ok"
+    XOk_ -> "x.ok"
+  strDecode = \case
+    "x.msg.new" -> Right XMsgNew_
+    "x.file" -> Right XFile_
+    "x.file.acpt" -> Right XFileAcpt_
+    "x.info" -> Right XInfo_
+    "x.contact" -> Right XContact_
+    "x.grp.inv" -> Right XGrpInv_
+    "x.grp.acpt" -> Right XGrpAcpt_
+    "x.grp.mem.new" -> Right XGrpMemNew_
+    "x.grp.mem.intro" -> Right XGrpMemIntro_
+    "x.grp.mem.inv" -> Right XGrpMemInv_
+    "x.grp.mem.fwd" -> Right XGrpMemFwd_
+    "x.grp.mem.info" -> Right XGrpMemInfo_
+    "x.grp.mem.con" -> Right XGrpMemCon_
+    "x.grp.mem.con.all" -> Right XGrpMemConAll_
+    "x.grp.mem.del" -> Right XGrpMemDel_
+    "x.grp.leave" -> Right XGrpLeave_
+    "x.grp.del" -> Right XGrpDel_
+    "x.info.probe" -> Right XInfoProbe_
+    "x.info.probe.check" -> Right XInfoProbeCheck_
+    "x.info.probe.ok" -> Right XInfoProbeOk_
+    "x.ok" -> Right XOk_
+    _ -> Left "bad CMEventTag"
+  strP = strDecode <$?> A.takeTill (== ' ')
+
+toCMEventTag :: ChatMsgEvent -> CMEventTag
+toCMEventTag = \case
+  XMsgNew _ -> XMsgNew_
+  XFile _ -> XFile_
+  XFileAcpt _ -> XFileAcpt_
+  XInfo _ -> XInfo_
+  XContact _ _ -> XContact_
+  XGrpInv _ -> XGrpInv_
+  XGrpAcpt _ -> XGrpAcpt_
+  XGrpMemNew _ -> XGrpMemNew_
+  XGrpMemIntro _ -> XGrpMemIntro_
+  XGrpMemInv _ _ -> XGrpMemInv_
+  XGrpMemFwd _ _ -> XGrpMemFwd_
+  XGrpMemInfo _ _ -> XGrpMemInfo_
+  XGrpMemCon _ -> XGrpMemCon_
+  XGrpMemConAll _ -> XGrpMemConAll_
+  XGrpMemDel _ -> XGrpMemDel_
+  XGrpLeave -> XGrpLeave_
+  XGrpDel -> XGrpDel_
+  XInfoProbe _ -> XInfoProbe_
+  XInfoProbeCheck _ -> XInfoProbeCheck_
+  XInfoProbeOk _ -> XInfoProbeOk_
+  XOk -> XOk_
+
+toChatEventTag :: ChatMsgEvent -> Text
+toChatEventTag = decodeLatin1 . strEncode . toCMEventTag
+
+appToChatMessage :: AppMessage -> Either String ChatMessage
+appToChatMessage AppMessage {event, params} = do
+  eventTag <- strDecode $ encodeUtf8 event
+  chatMsgEvent <- msg eventTag
+  pure ChatMessage {chatMsgEvent}
   where
-    getDAG :: [MsgContentBody] -> (Maybe ByteString, [MsgContentBody])
-    getDAG body = case break (isContentType SimplexDAG) body of
-      (b, MsgContentBody SimplexDAG dag : a) -> (Just dag, b <> a)
-      _ -> (Nothing, body)
-    toMemberInfo :: ByteString -> ByteString -> [MsgContentBody] -> Either String MemberInfo
-    toMemberInfo memId role body = MemberInfo <$> B64.decode memId <*> toMemberRole role <*> getJSON body
-    toIntroInv :: ByteString -> ByteString -> Either String IntroInvitation
-    toIntroInv groupConnReq directConnReq = IntroInvitation <$> parseAll connReqP' groupConnReq <*> parseAll connReqP' directConnReq
-    toContentInfo :: (RawContentType, Int) -> Either String (ContentType, Int)
-    toContentInfo (rawType, size) = (,size) <$> toContentType rawType
-    toFiles :: [ByteString] -> Either String [(ContentType, Int)]
-    toFiles = mapM $ toContentInfo <=< parseAll contentInfoP
-    getJSON :: FromJSON a => [MsgContentBody] -> Either String a
-    getJSON = J.eitherDecodeStrict' <=< getSimplexContentType XCJson
-    extractJSON :: FromJSON a => [MsgContentBody] -> Either String (a, [MsgContentBody])
-    extractJSON =
-      extractSimplexContentType XCJson >=> \(a, bs) -> do
-        j <- J.eitherDecodeStrict' a
-        pure (j, bs)
+    p :: FromJSON a => Text -> Either String a
+    p key = JT.parseEither (.: key) params
+    msg = \case
+      XMsgNew_ -> XMsgNew <$> p "content"
+      XFile_ -> XFile <$> p "file"
+      XFileAcpt_ -> XFileAcpt <$> p "fileName"
+      XInfo_ -> XInfo <$> p "profile"
+      XContact_ -> XContact <$> p "profile" <*> p "content"
+      XGrpInv_ -> XGrpInv <$> p "groupInvitation"
+      XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
+      XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
+      XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo"
+      XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
+      XGrpMemFwd_ -> XGrpMemFwd <$> p "memberInfo" <*> p "memberIntro"
+      XGrpMemInfo_ -> XGrpMemInfo <$> p "memberId" <*> p "profile"
+      XGrpMemCon_ -> XGrpMemCon <$> p "memberId"
+      XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId"
+      XGrpMemDel_ -> XGrpMemDel <$> p "memberId"
+      XGrpLeave_ -> pure XGrpLeave
+      XGrpDel_ -> pure XGrpDel
+      XInfoProbe_ -> XInfoProbe <$> p "probe"
+      XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
+      XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
+      XOk_ -> pure XOk
 
-isContentType :: ContentType -> MsgContentBody -> Bool
-isContentType t MsgContentBody {contentType = t'} = t == t'
-
-isSimplexContentType :: XContentType -> MsgContentBody -> Bool
-isSimplexContentType = isContentType . SimplexContentType
-
-getContentType :: ContentType -> [MsgContentBody] -> Either String ByteString
-getContentType t body = case find (isContentType t) body of
-  Just MsgContentBody {contentData} -> Right contentData
-  Nothing -> Left "no required content type"
-
-extractContentType :: ContentType -> [MsgContentBody] -> Either String (ByteString, [MsgContentBody])
-extractContentType t body = case findIndex (isContentType t) body of
-  Just i -> case splitAt i body of
-    (b, el : a) -> Right (contentData (el :: MsgContentBody), b ++ a)
-    (_, []) -> Left "no required content type" -- this can only happen if findIndex returns incorrect result
-  Nothing -> Left "no required content type"
-
-getSimplexContentType :: XContentType -> [MsgContentBody] -> Either String ByteString
-getSimplexContentType = getContentType . SimplexContentType
-
-extractSimplexContentType :: XContentType -> [MsgContentBody] -> Either String (ByteString, [MsgContentBody])
-extractSimplexContentType = extractContentType . SimplexContentType
-
-rawChatMessage :: ChatMessage -> RawChatMessage
-rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
-  case chatMsgEvent of
-    XMsgNew MsgContent {messageType = t, files, content} ->
-      rawMsg (rawMsgType t : toRawFiles files) content
-    XFile FileInvitation {fileName, fileSize, fileConnReq} ->
-      rawMsg [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeConnReq' fileConnReq] []
-    XFileAcpt fileName ->
-      rawMsg [encodeUtf8 $ T.pack fileName] []
-    XInfo profile ->
-      rawMsg [] [jsonBody profile]
-    XContact profile Nothing ->
-      rawMsg [] [jsonBody profile]
-    XContact profile (Just MsgContent {messageType = t, files, content}) ->
-      rawMsg (rawMsgType t : toRawFiles files) (jsonBody profile : content)
-    XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) cReq groupProfile) ->
-      let params =
-            [ B64.encode fromMemId,
-              serializeMemberRole fromRole,
-              B64.encode memId,
-              serializeMemberRole role,
-              serializeConnReq' cReq
-            ]
-       in rawMsg params [jsonBody groupProfile]
-    XGrpAcpt memId ->
-      rawMsg [B64.encode memId] []
-    XGrpMemNew (MemberInfo memId role profile) ->
-      let params = [B64.encode memId, serializeMemberRole role]
-       in rawMsg params [jsonBody profile]
-    XGrpMemIntro (MemberInfo memId role profile) ->
-      rawMsg [B64.encode memId, serializeMemberRole role] [jsonBody profile]
-    XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq} ->
-      let params = [B64.encode memId, serializeConnReq' groupConnReq, serializeConnReq' directConnReq]
-       in rawMsg params []
-    XGrpMemFwd (MemberInfo memId role profile) IntroInvitation {groupConnReq, directConnReq} ->
-      let params =
-            [ B64.encode memId,
-              serializeMemberRole role,
-              serializeConnReq' groupConnReq,
-              serializeConnReq' directConnReq
-            ]
-       in rawMsg params [jsonBody profile]
-    XGrpMemInfo memId profile ->
-      rawMsg [B64.encode memId] [jsonBody profile]
-    XGrpMemCon memId ->
-      rawMsg [B64.encode memId] []
-    XGrpMemConAll memId ->
-      rawMsg [B64.encode memId] []
-    XGrpMemDel memId ->
-      rawMsg [B64.encode memId] []
-    XGrpLeave ->
-      rawMsg [] []
-    XGrpDel ->
-      rawMsg [] []
-    XInfoProbe probe ->
-      rawMsg [B64.encode probe] []
-    XInfoProbeCheck probeHash ->
-      rawMsg [B64.encode probeHash] []
-    XInfoProbeOk probe ->
-      rawMsg [B64.encode probe] []
-    XOk ->
-      rawMsg [] []
+chatToAppMessage :: ChatMessage -> AppMessage
+chatToAppMessage ChatMessage {chatMsgEvent} = AppMessage {event, params}
   where
-    rawMsg :: [ByteString] -> [MsgContentBody] -> RawChatMessage
-    rawMsg chatMsgParams body = do
-      let event = encodeUtf8 $ toChatEventType chatMsgEvent
-      RawChatMessage {chatMsgId, chatMsgEvent = event, chatMsgParams, chatMsgBody = rawWithDAG body}
-    rawContentInfo :: (ContentType, Int) -> (RawContentType, Int)
-    rawContentInfo (t, size) = (rawContentType t, size)
-    jsonBody :: ToJSON a => a -> MsgContentBody
-    jsonBody x =
-      let json = LB.toStrict $ J.encode x
-       in MsgContentBody {contentType = SimplexContentType XCJson, contentData = json}
-    rawWithDAG :: [MsgContentBody] -> [RawMsgBodyContent]
-    rawWithDAG body = map rawMsgBodyContent $ case chatDAG of
-      Nothing -> body
-      Just dag -> MsgContentBody {contentType = SimplexDAG, contentData = dag} : body
-    toRawFiles :: [(ContentType, Int)] -> [ByteString]
-    toRawFiles = map $ serializeContentInfo . rawContentInfo
-
-toMsgBodyContent :: RawMsgBodyContent -> Either String MsgContentBody
-toMsgBodyContent RawMsgBodyContent {contentType, contentData} = do
-  cType <- toContentType contentType
-  pure MsgContentBody {contentType = cType, contentData}
-
-rawMsgBodyContent :: MsgContentBody -> RawMsgBodyContent
-rawMsgBodyContent MsgContentBody {contentType = t, contentData} =
-  RawMsgBodyContent {contentType = rawContentType t, contentData}
-
-data MsgContentBody = MsgContentBody
-  { contentType :: ContentType,
-    contentData :: ByteString
-  }
-  deriving (Eq, Show)
-
-data ContentType
-  = SimplexContentType XContentType
-  | MimeContentType MContentType
-  | SimplexDAG
-  deriving (Eq, Show)
-
-data XContentType = XCText | XCImage | XCJson deriving (Eq, Show)
-
-data MContentType = MCImageJPG | MCImagePNG deriving (Eq, Show)
-
-toContentType :: RawContentType -> Either String ContentType
-toContentType (RawContentType ns cType) = case ns of
-  "x" -> case cType of
-    "text" -> Right $ SimplexContentType XCText
-    "image" -> Right $ SimplexContentType XCImage
-    "json" -> Right $ SimplexContentType XCJson
-    "dag" -> Right SimplexDAG
-    _ -> err
-  "m" -> case cType of
-    "image/jpg" -> Right $ MimeContentType MCImageJPG
-    "image/png" -> Right $ MimeContentType MCImagePNG
-    _ -> err
-  _ -> err
-  where
-    err = Left . B.unpack $ "invalid content type " <> ns <> "." <> cType
-
-rawContentType :: ContentType -> RawContentType
-rawContentType t = case t of
-  SimplexContentType t' -> RawContentType "x" $ case t' of
-    XCText -> "text"
-    XCImage -> "image"
-    XCJson -> "json"
-  MimeContentType t' -> RawContentType "m" $ case t' of
-    MCImageJPG -> "image/jpg"
-    MCImagePNG -> "image/png"
-  SimplexDAG -> RawContentType "x" "dag"
-
-newtype ContentMsg = NewContentMsg ContentData
-
-newtype ContentData = ContentText Text
-
-data RawChatMessage = RawChatMessage
-  { chatMsgId :: Maybe Int64,
-    chatMsgEvent :: ByteString,
-    chatMsgParams :: [ByteString],
-    chatMsgBody :: [RawMsgBodyContent]
-  }
-  deriving (Eq, Show)
-
-data RawMsgBodyContent = RawMsgBodyContent
-  { contentType :: RawContentType,
-    contentData :: ByteString
-  }
-  deriving (Eq, Show)
-
-data RawContentType = RawContentType NameSpace ByteString
-  deriving (Eq, Show)
-
-type NameSpace = ByteString
-
-newtype MsgData = MsgData ByteString
-  deriving (Eq, Show)
-
-class DataLength a where
-  dataLength :: a -> Int
-
-rawChatMessageP :: Parser RawChatMessage
-rawChatMessageP = do
-  chatMsgId <- optional A.decimal <* A.space
-  chatMsgEvent <- B.intercalate "." <$> identifierP `A.sepBy1'` A.char '.' <* A.space
-  chatMsgParams <- A.takeWhile1 (not . A.inClass ", ") `A.sepBy'` A.char ',' <* A.space
-  chatMsgBody <- msgBodyContent =<< contentInfoP `A.sepBy'` A.char ',' <* A.space
-  pure RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody}
-  where
-    msgBodyContent :: [(RawContentType, Int)] -> Parser [RawMsgBodyContent]
-    msgBodyContent [] = pure []
-    msgBodyContent ((contentType, size) : ps) = do
-      contentData <- A.take size <* A.space
-      ((RawMsgBodyContent {contentType, contentData}) :) <$> msgBodyContent ps
-
-contentInfoP :: Parser (RawContentType, Int)
-contentInfoP = do
-  contentType <- RawContentType <$> identifierP <* A.char '.' <*> A.takeTill (A.inClass ":, ")
-  size <- A.char ':' *> A.decimal
-  pure (contentType, size)
-
-identifierP :: Parser ByteString
-identifierP = B.cons <$> A.letter_ascii <*> A.takeWhile (\c -> A.isAlpha_ascii c || A.isDigit c)
-
-serializeRawChatMessage :: RawChatMessage -> ByteString
-serializeRawChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody} =
-  B.unwords
-    [ maybe "" bshow chatMsgId,
-      chatMsgEvent,
-      B.intercalate "," chatMsgParams,
-      B.unwords $ map serializeBodyContentInfo chatMsgBody,
-      B.unwords $ map msgContentData chatMsgBody
-    ]
-
-serializeBodyContentInfo :: RawMsgBodyContent -> ByteString
-serializeBodyContentInfo RawMsgBodyContent {contentType = t, contentData} =
-  serializeContentInfo (t, B.length contentData)
-
-serializeContentInfo :: (RawContentType, Int) -> ByteString
-serializeContentInfo (RawContentType ns cType, size) = ns <> "." <> cType <> ":" <> bshow size
-
-msgContentData :: RawMsgBodyContent -> ByteString
-msgContentData RawMsgBodyContent {contentData} = contentData <> " "
+    event = toChatEventTag chatMsgEvent
+    o :: [(Text, J.Value)] -> J.Object
+    o = H.fromList
+    params = case chatMsgEvent of
+      XMsgNew content -> o ["content" .= content]
+      XFile fileInv -> o ["file" .= fileInv]
+      XFileAcpt fileName -> o ["fileName" .= fileName]
+      XInfo profile -> o ["profile" .= profile]
+      XContact profile content -> o ["profile" .= profile, "content" .= content]
+      XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
+      XGrpAcpt memId -> o ["memberId" .= memId]
+      XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
+      XGrpMemIntro memInfo -> o ["memberInfo" .= memInfo]
+      XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]
+      XGrpMemFwd memInfo memIntro -> o ["memberInfo" .= memInfo, "memberIntro" .= memIntro]
+      XGrpMemInfo memId profile -> o ["memberId" .= memId, "profile" .= profile]
+      XGrpMemCon memId -> o ["memberId" .= memId]
+      XGrpMemConAll memId -> o ["memberId" .= memId]
+      XGrpMemDel memId -> o ["memberId" .= memId]
+      XGrpLeave -> H.empty
+      XGrpDel -> H.empty
+      XInfoProbe probe -> o ["probe" .= probe]
+      XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
+      XInfoProbeOk probe -> o ["probe" .= probe]
+      XOk -> H.empty

src/Simplex/Chat/Store.hs

@@ -667,20 +667,20 @@ getMatchingContacts st userId Contact {contactId, profile = Profile {displayName
           ]
     rights <$> mapM (runExceptT . getContact_ db userId) contactNames
 
-createSentProbe :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> UserId -> Contact -> m (ByteString, Int64)
+createSentProbe :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> UserId -> Contact -> m (Probe, Int64)
 createSentProbe st gVar userId _to@Contact {contactId} =
   liftIOEither . withTransaction st $ \db ->
     createWithRandomBytes 32 gVar $ \probe -> do
       DB.execute db "INSERT INTO sent_probes (contact_id, probe, user_id) VALUES (?,?,?)" (contactId, probe, userId)
-      (probe,) <$> insertedRowId db
+      (Probe probe,) <$> insertedRowId db
 
 createSentProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> Contact -> m ()
 createSentProbeHash st userId probeId _to@Contact {contactId} =
   liftIO . withTransaction st $ \db ->
     DB.execute db "INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, user_id) VALUES (?,?,?)" (probeId, contactId, userId)
 
-matchReceivedProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe Contact)
-matchReceivedProbe st userId _from@Contact {contactId} probe =
+matchReceivedProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Probe -> m (Maybe Contact)
+matchReceivedProbe st userId _from@Contact {contactId} (Probe probe) =
   liftIO . withTransaction st $ \db -> do
     let probeHash = C.sha256Hash probe
     contactNames <-
@@ -701,8 +701,8 @@ matchReceivedProbe st userId _from@Contact {contactId} probe =
         either (const Nothing) Just
           <$> runExceptT (getContact_ db userId cName)
 
-matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe (Contact, ByteString))
-matchReceivedProbeHash st userId _from@Contact {contactId} probeHash =
+matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ProbeHash -> m (Maybe (Contact, Probe))
+matchReceivedProbeHash st userId _from@Contact {contactId} (ProbeHash probeHash) =
   liftIO . withTransaction st $ \db -> do
     namesAndProbes <-
       DB.query
@@ -718,11 +718,11 @@ matchReceivedProbeHash st userId _from@Contact {contactId} probeHash =
     case namesAndProbes of
       [] -> pure Nothing
       (cName, probe) : _ ->
-        either (const Nothing) (Just . (,probe))
+        either (const Nothing) (Just . (,Probe probe))
           <$> runExceptT (getContact_ db userId cName)
 
-matchSentProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe Contact)
-matchSentProbe st userId _from@Contact {contactId} probe =
+matchSentProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Probe -> m (Maybe Contact)
+matchSentProbe st userId _from@Contact {contactId} (Probe probe) =
   liftIO . withTransaction st $ \db -> do
     contactNames <-
       map fromOnly
@@ -889,7 +889,7 @@ createNewGroup st gVar user groupProfile =
     DB.execute db "INSERT INTO groups (local_display_name, user_id, group_profile_id) VALUES (?, ?, ?)" (displayName, uId, profileId)
     groupId <- insertedRowId db
     memberId <- randomBytes gVar 12
-    membership <- createContactMember_ db user groupId user (memberId, GROwner) GCUserMember GSMemCreator IBUser
+    membership <- createContactMember_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser
     pure $ Right Group {groupId, localDisplayName = displayName, groupProfile, members = [], membership}
 
 -- | creates a new group record for the group the current user was invited to, or returns an existing one
@@ -1022,7 +1022,7 @@ getGroupInvitation st user localDisplayName =
     findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId)
     findFromContact _ = const Nothing
 
-type GroupMemberRow = (Int64, Int64, ByteString, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text)
+type GroupMemberRow = (Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text)
 
 toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
 toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, localDisplayName, memberContactId, displayName, fullName) =
@@ -1035,7 +1035,7 @@ createContactMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User ->
 createContactMember st gVar user groupId contact memberRole agentConnId connRequest =
   liftIOEither . withTransaction st $ \db ->
     createWithRandomId gVar $ \memId -> do
-      member@GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest)
+      member@GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact (MemberIdRole (MemberId memId) memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest)
       void $ createMemberConnection_ db (userId user) groupMemberId agentConnId Nothing 0
       pure member
 
@@ -1269,12 +1269,12 @@ createIntroToMemberContact st userId GroupMember {memberContactId = viaContactId
 createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe Int64 -> Int -> IO Connection
 createMemberConnection_ db userId groupMemberId = createConnection_ db userId ConnMember (Just groupMemberId)
 
-createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
-createContactMember_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy =
-  createContactMemberInv_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy Nothing
+createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
+createContactMember_ db user groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy =
+  createContactMemberInv_ db user groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy Nothing
 
-createContactMemberInv_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember
-createContactMemberInv_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy connRequest = do
+createContactMemberInv_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember
+createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy connRequest = do
   insertMember_
   groupMemberId <- insertedRowId db
   let memberProfile = profile' userOrContact

src/Simplex/Chat/Types.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
@@ -11,8 +12,10 @@
 
 module Simplex.Chat.Types where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, (.:), (.=))
 import qualified Data.Aeson as J
+import qualified Data.Aeson.Types as JT
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -29,9 +32,11 @@ import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics
-import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, ConnectionMode (..), ConnectionRequest, InvitationId, MsgMeta (..), serializeMsgIntegrity)
+import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, MsgMeta (..), serializeMsgIntegrity)
 import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (MsgBody)
+import Simplex.Messaging.Util ((<$?>))
 
 class IsContact a where
   contactId' :: a -> Int64
@@ -106,41 +111,56 @@ data Profile = Profile
   { displayName :: ContactName,
     fullName :: Text
   }
-  deriving (Generic, Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON Profile where toEncoding = J.genericToEncoding J.defaultOptions
 
-instance FromJSON Profile
-
 data GroupProfile = GroupProfile
   { displayName :: GroupName,
     fullName :: Text
   }
-  deriving (Generic, Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
 
 instance ToJSON GroupProfile where toEncoding = J.genericToEncoding J.defaultOptions
 
-instance FromJSON GroupProfile
-
 data GroupInvitation = GroupInvitation
-  { fromMember :: (MemberId, GroupMemberRole),
-    invitedMember :: (MemberId, GroupMemberRole),
+  { fromMember :: MemberIdRole,
+    invitedMember :: MemberIdRole,
     connRequest :: ConnReqInvitation,
     groupProfile :: GroupProfile
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON GroupInvitation where toEncoding = J.genericToEncoding J.defaultOptions
+
+data MemberIdRole = MemberIdRole
+  { memberId :: MemberId,
+    memberRole :: GroupMemberRole
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON MemberIdRole where toEncoding = J.genericToEncoding J.defaultOptions
 
 data IntroInvitation = IntroInvitation
   { groupConnReq :: ConnReqInvitation,
     directConnReq :: ConnReqInvitation
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
 
-data MemberInfo = MemberInfo MemberId GroupMemberRole Profile
-  deriving (Eq, Show)
+instance ToJSON IntroInvitation where toEncoding = J.genericToEncoding J.defaultOptions
+
+data MemberInfo = MemberInfo
+  { memberId :: MemberId,
+    memberRole :: GroupMemberRole,
+    profile :: Profile
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON MemberInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
 memberInfo :: GroupMember -> MemberInfo
-memberInfo m = MemberInfo (memberId m) (memberRole m) (memberProfile m)
+memberInfo GroupMember {memberId, memberRole, memberProfile} =
+  MemberInfo memberId memberRole memberProfile
 
 data ReceivedGroupInvitation = ReceivedGroupInvitation
   { fromMember :: GroupMember,
@@ -183,7 +203,24 @@ data NewGroupMember = NewGroupMember
     memContactId :: Maybe Int64
   }
 
-type MemberId = ByteString
+newtype MemberId = MemberId {unMemberId :: ByteString}
+  deriving (Eq, Show)
+
+instance FromField MemberId where fromField f = MemberId <$> fromField f
+
+instance ToField MemberId where toField (MemberId m) = toField m
+
+instance StrEncoding MemberId where
+  strEncode (MemberId m) = strEncode m
+  strDecode s = MemberId <$> strDecode s
+  strP = MemberId <$> strP
+
+instance FromJSON MemberId where
+  parseJSON = strParseJSON "MemberId"
+
+instance ToJSON MemberId where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
 
 data InvitedBy = IBContact Int64 | IBUser | IBUnknown
   deriving (Eq, Show)
@@ -203,22 +240,28 @@ fromInvitedBy userCtId = \case
 data GroupMemberRole = GRMember | GRAdmin | GROwner
   deriving (Eq, Show, Ord)
 
-instance FromField GroupMemberRole where fromField = fromBlobField_ toMemberRole
+instance FromField GroupMemberRole where fromField = fromBlobField_ strDecode
 
-instance ToField GroupMemberRole where toField = toField . serializeMemberRole
+instance ToField GroupMemberRole where toField = toField . strEncode
 
-toMemberRole :: ByteString -> Either String GroupMemberRole
-toMemberRole = \case
-  "owner" -> Right GROwner
-  "admin" -> Right GRAdmin
-  "member" -> Right GRMember
-  r -> Left $ "invalid group member role " <> B.unpack r
+instance StrEncoding GroupMemberRole where
+  strEncode = \case
+    GROwner -> "owner"
+    GRAdmin -> "admin"
+    GRMember -> "member"
+  strDecode = \case
+    "owner" -> Right GROwner
+    "admin" -> Right GRAdmin
+    "member" -> Right GRMember
+    r -> Left $ "bad GroupMemberRole " <> B.unpack r
+  strP = strDecode <$?> A.takeByteString
 
-serializeMemberRole :: GroupMemberRole -> ByteString
-serializeMemberRole = \case
-  GROwner -> "owner"
-  GRAdmin -> "admin"
-  GRMember -> "member"
+instance FromJSON GroupMemberRole where
+  parseJSON = strParseJSON "GroupMemberRole"
+
+instance ToJSON GroupMemberRole where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
 
 fromBlobField_ :: Typeable k => (ByteString -> Either String k) -> FieldParser k
 fromBlobField_ p = \case
@@ -228,6 +271,36 @@ fromBlobField_ p = \case
       Left e -> returnError ConversionFailed f ("could not parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
 
+newtype Probe = Probe {unProbe :: ByteString}
+  deriving (Eq, Show)
+
+instance StrEncoding Probe where
+  strEncode (Probe p) = strEncode p
+  strDecode s = Probe <$> strDecode s
+  strP = Probe <$> strP
+
+instance FromJSON Probe where
+  parseJSON = strParseJSON "Probe"
+
+instance ToJSON Probe where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+newtype ProbeHash = ProbeHash {unProbeHash :: ByteString}
+  deriving (Eq, Show)
+
+instance StrEncoding ProbeHash where
+  strEncode (ProbeHash p) = strEncode p
+  strDecode s = ProbeHash <$> strDecode s
+  strP = ProbeHash <$> strP
+
+instance FromJSON ProbeHash where
+  parseJSON = strParseJSON "ProbeHash"
+
+instance ToJSON ProbeHash where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
 data GroupMemberCategory
   = GCUserMember
   | GCInviteeMember -- member invited by the user
@@ -350,7 +423,24 @@ data FileInvitation = FileInvitation
     fileSize :: Integer,
     fileConnReq :: ConnReqInvitation
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+
+instance FromJSON FileInvitation where
+  parseJSON (J.Object v) = FileInvitation <$> v .: "fileName" <*> v .: "fileSize" <*> v .: "fileConnReq"
+  parseJSON invalid = JT.prependFailure "bad FileInvitation, " (JT.typeMismatch "Object" invalid)
+
+instance ToJSON FileInvitation where
+  toJSON (FileInvitation fileName fileSize fileConnReq) =
+    J.object
+      [ "fileName" .= fileName,
+        "fileSize" .= fileSize,
+        "fileConnReq" .= fileConnReq
+      ]
+  toEncoding (FileInvitation fileName fileSize fileConnReq) =
+    J.pairs $
+      "fileName" .= fileName
+        <> "fileSize" .= fileSize
+        <> "fileConnReq" .= fileConnReq
 
 data RcvFileTransfer = RcvFileTransfer
   { fileId :: Int64,
@@ -404,9 +494,9 @@ serializeFileStatus = \case
 data RcvChunkStatus = RcvChunkOk | RcvChunkFinal | RcvChunkDuplicate | RcvChunkError
   deriving (Eq, Show)
 
-type ConnReqInvitation = ConnectionRequest 'CMInvitation
+type ConnReqInvitation = ConnectionRequestUri 'CMInvitation
 
-type ConnReqContact = ConnectionRequest 'CMContact
+type ConnReqContact = ConnectionRequestUri 'CMContact
 
 data Connection = Connection
   { connId :: Int64,
@@ -592,7 +682,7 @@ data RcvMsgDelivery = RcvMsgDelivery
     agentMsgMeta :: MsgMeta
   }
 
-data MsgMetaJ = MsgMetaJ
+data MsgMetaJSON = MsgMetaJSON
   { integrity :: Text,
     rcvId :: Int64,
     rcvTs :: UTCTime,
@@ -600,15 +690,13 @@ data MsgMetaJ = MsgMetaJ
     serverTs :: UTCTime,
     sndId :: Int64
   }
-  deriving (Generic, Eq, Show)
+  deriving (Eq, Show, FromJSON, Generic)
 
-instance ToJSON MsgMetaJ where toEncoding = J.genericToEncoding J.defaultOptions
+instance ToJSON MsgMetaJSON where toEncoding = J.genericToEncoding J.defaultOptions
 
-instance FromJSON MsgMetaJ
-
-msgMetaToJson :: MsgMeta -> MsgMetaJ
-msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sender = (sndId, _)} =
-  MsgMetaJ
+msgMetaToJson :: MsgMeta -> MsgMetaJSON
+msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sndMsgId = sndId} =
+  MsgMetaJSON
     { integrity = (decodeLatin1 . serializeMsgIntegrity) integrity,
       rcvId,
       rcvTs,

src/Simplex/Chat/View.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
@@ -102,6 +103,7 @@ import Simplex.Chat.Terminal (printToTerminal)
 import Simplex.Chat.Types
 import Simplex.Chat.Util (safeDecodeUtf8)
 import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Encoding.String
 import qualified Simplex.Messaging.Protocol as SMP
 import System.Console.ANSI.Types
 
@@ -328,7 +330,7 @@ connReqInvitation_ :: ConnReqInvitation -> [StyledString]
 connReqInvitation_ cReq =
   [ "pass this invitation link to your contact (via another channel): ",
     "",
-    (plain . serializeConnReq') cReq,
+    (plain . strEncode) cReq,
     "",
     "and ask them to connect: " <> highlight' "/c <invitation_link_above>"
   ]
@@ -380,7 +382,7 @@ connReqContact_ :: StyledString -> ConnReqContact -> [StyledString]
 connReqContact_ intro cReq =
   [ intro,
     "",
-    (plain . serializeConnReq') cReq,
+    (plain . strEncode) cReq,
     "",
     "Anybody can send you contact requests with: " <> highlight' "/c <contact_link_above>",
     "to show it again: " <> highlight' "/sa",
@@ -444,7 +446,7 @@ cannotResendInvitation g c =
 
 receivedGroupInvitation :: Group -> ContactName -> GroupMemberRole -> [StyledString]
 receivedGroupInvitation g@Group {localDisplayName} c role =
-  [ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (serializeMemberRole role),
+  [ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (strEncode role),
     "use " <> highlight ("/j " <> localDisplayName) <> " to accept"
   ]
 
@@ -492,7 +494,7 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov
   where
     removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
     groupMember m = ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
-    role = plain . serializeMemberRole . memberRole
+    role m = plain . strEncode $ memberRole (m :: GroupMember)
     category m = case memberCategory m of
       GCUserMember -> "you, "
       GCInviteeMember -> "invited, "
@@ -753,6 +755,7 @@ chatError = \case
     CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e]
     CEFileRcvChunk e -> ["error receiving file: " <> plain e]
     CEFileInternal e -> ["file error: " <> plain e]
+    CEAgentVersion -> ["unsupported agent version"]
   -- e -> ["chat error: " <> sShow e]
   ChatErrorStore err -> case err of
     SEDuplicateName -> ["this display name is already used by user, contact or group"]

src/Simplex/Chat/protocol.md

@@ -22,9 +22,6 @@ The syntax of the message inside agent MSG:
 ```abnf
 agentMessageBody = [chatMsgId] SP msgEvent SP [parameters] SP [contentParts [SP msgBodyParts]]
 chatMsgId = 1*DIGIT ; used to refer to previous message;
-                    ; in the group should only be used in messages sent to all members,
-                    ; which is the main reason not to use external agent ID -
-                    ; some messages are sent only to one member
 msgEvent = protocolNamespace 1*("." msgTypeName)
 protocolNamespace = 1*ALPHA ; "x" for all events defined in the protocol
 msgTypeName = 1*ALPHA
@@ -68,6 +65,219 @@ refMsgHash = 16*16(OCTET) ; SHA256 of agent message body
 ' x.file name,size x.text:NNN <invitation> '
 ```
 
+Chat message JTD:
+
+```jsonc
+{
+  "properties": {
+    "msgId": {"type": "string"},
+    "minVersion": {"type": "uint16"}, // Word16
+    "maxVersion": {"type": "uint16"}, // Word16
+    "event": {"type": "string"}, // Text e.g. s.ok
+    "params": {"values": {}}, // Map Text Value
+  },
+  "optionalProperties": {
+    "dag": {"type": "string"}
+  }
+}
+```
+
+Events:
+
+```jsonc
+"event": "x.msg.new" // XMsgNew
+"params":            // MsgContent
+{
+  "content": {
+    "msgType": "text",
+    // field "files" can be represented in content as contentType "file" with length prepended or as complex contentData
+    "text": "<msg text>"
+  }
+  // "content": [
+    // free form contentType for extensibility and/or complex content types? e.g. MIME
+    // could it be useful if contentData was free form as well? currently it is ByteString
+  //  {"contentType": <content type>, "contentData": "<content data>"},
+  //  ...
+  //  {"contentType": <content type N>, "contentData": "<content data N>"}
+  // ]
+}
+
+"event": "x.file" // XFile; TODO rename into x.file.inv?
+"params":         // FileInvitation
+{
+  "file": {
+    "fileName": "<file name>",
+    "fileSize": <file size>, // integer
+    "fileConnReq": "<file conn req>"
+  }
+}
+
+"event": "x.file.acpt" // XFileAcpt
+"params":              // String
+{
+  "fileName": "<file name>"
+}
+
+"event": "x.info" // XInfo
+"params":         // Profile
+{
+  "profile": {
+    "displayName": "<display name>",
+    "fullName": "<full name>"
+  }
+}
+
+"event": "x.contact" // XContact
+"params":        // Profile (Maybe MsgContent)
+{
+  "profile": {
+    "displayName": "<display name>",
+    "fullName": "<full name>"
+  },
+  "content": {
+    "msgType": "text",
+    "text": "<msg text>"
+  } // optional
+}
+
+"event": "x.grp.inv" // XGrpInv
+"params":            // GroupInvitation
+{
+  "groupInvitation": {
+    "fromMember": {
+      "memberId": "<from_member ID>",
+      "memberRole": "<from_member role>"
+    },
+    "invitedMember": {
+      "memberId": "<invited_member ID>",
+      "memberRole": "<invited_member role>"
+    },
+    "connRequest": "<conn request>",
+    "groupProfile": {
+      "displayName": "<display name>",
+      "fullName": "<full name>"
+    }
+  }
+}
+
+"event": "x.grp.acpt" // XGrpAcpt
+"params":             // MemberId
+{
+  "memberId": "<member ID>"
+}
+
+"event": "x.grp.mem.new" // XGrpMemNew
+"params":                // MemberInfo
+{
+  "memberInfo": {
+    "memberId": "<member ID>",
+    "memberRole": "<member role>",
+    "profile": {
+      "displayName": "<display name>",
+      "fullName": "<full name>"
+    }
+  }
+}
+
+"event": "x.grp.mem.intro" // XGrpMemIntro
+"params":                  // MemberInfo
+{
+  "memberInfo": {
+    "memberId": "<member ID>",
+    "memberRole": "<member role>",
+    "profile": {
+      "displayName": "<display name>",
+      "fullName": "<full name>"
+    }
+  }
+}
+
+"event": "x.grp.mem.inv" // XGrpMemInv
+"params":                // MemberId IntroInvitation
+{
+  "memberId": "<member ID>",
+  "memberIntro": {
+    "groupConnReq": "<group conn req>",
+    "directConnReq": "<direct conn req>"
+  }
+}
+
+"event": "x.grp.mem.fwd" // XGrpMemFwd
+"params":                // MemberInfo IntroInvitation
+{
+  "memberInfo": {
+    "memberId": "<member ID>",
+    "memberRole": "<member role>",
+    "profile": {
+      "displayName": "<display name>",
+      "fullName": "<full name>"
+    },
+  },
+  "memberIntro": {
+    "groupConnReq": "<group conn req>",
+    "directConnReq": "<direct conn req>"
+  }
+}
+
+"event": "x.grp.mem.info" // XGrpMemInfo
+"params":                 // MemberId Profile
+{
+  "memberId": "<member ID>",
+  "profile": {
+    "displayName": "<display name>",
+    "fullName": "<full name>"
+  }
+}
+
+"event": "x.grp.mem.con" // XGrpMemCon
+"params":                // MemberId
+{
+  "memberId": "<member ID>"
+}
+
+"event": "x.grp.mem.con.all" // XGrpMemConAll
+"params":                    // MemberId
+{
+  "memberId": "<member ID>"
+}
+
+"event": "x.grp.mem.del" // XGrpMemDel
+"params":                // MemberId
+{
+  "memberId": "<member ID>"
+}
+
+"event": "x.grp.leave" // XGrpLeave
+"params":
+{}
+
+"event": "x.grp.del" // XGrpDel
+"params":
+{}
+
+"event": "x.info.probe" // XInfoProbe
+"params":               // ByteString
+{
+  "probe": "<probe>"
+}
+
+"event": "x.info.probe.check" // XInfoProbeCheck
+"params":                     // ByteString
+{
+  "probeHash": "<probe hash>"
+}
+
+"event": "x.info.probe.ok" // XInfoProbeOk
+"params":                  // ByteString
+{
+  "probe": "<probe>"
+}
+
+"event": "x.ok" // XOk
+"params":
+{}
+```
+
 ### Group protocol
 
 #### Add group member