Merge branch 'master' into master-ghc9

src/Simplex/Chat/Protocol.hs

@@ -48,6 +48,17 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
+import Simplex.Messaging.Version hiding (version)
+
+currentChatVersion :: Version
+currentChatVersion = 2
+
+supportedChatVRange :: VersionRange
+supportedChatVRange = mkVersionRange 1 currentChatVersion
+
+-- version range that supports skipping establishing direct connections in a group
+groupNoDirectVRange :: VersionRange
+groupNoDirectVRange = mkVersionRange 2 currentChatVersion
 
 data ConnectionEntity
   = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
@@ -104,7 +115,8 @@ data AppMessage (e :: MsgEncoding) where
 
 -- chat message is sent as JSON with these properties
 data AppMessageJson = AppMessageJson
-  { msgId :: Maybe SharedMsgId,
+  { v :: Maybe ChatVersionRange,
+    msgId :: Maybe SharedMsgId,
     event :: Text,
     params :: J.Object
   }
@@ -163,7 +175,11 @@ instance ToJSON MsgRef where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
-data ChatMessage e = ChatMessage {msgId :: Maybe SharedMsgId, chatMsgEvent :: ChatMsgEvent e}
+data ChatMessage e = ChatMessage
+  { chatVRange :: VersionRange,
+    msgId :: Maybe SharedMsgId,
+    chatMsgEvent :: ChatMsgEvent e
+  }
   deriving (Eq, Show)
 
 data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMessage e)
@@ -726,17 +742,17 @@ appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
 appBinaryToCM AppMessageBinary {msgId, tag, body} = do
   eventTag <- strDecode $ B.singleton tag
   chatMsgEvent <- parseAll (msg eventTag) body
-  pure ChatMessage {msgId, chatMsgEvent}
+  pure ChatMessage {chatVRange = chatInitialVRange, msgId, chatMsgEvent}
   where
     msg :: CMEventTag 'Binary -> A.Parser (ChatMsgEvent 'Binary)
     msg = \case
       BFileChunk_ -> BFileChunk <$> (SharedMsgId <$> smpP) <*> (unIFC <$> smpP)
 
 appJsonToCM :: AppMessageJson -> Either String (ChatMessage 'Json)
-appJsonToCM AppMessageJson {msgId, event, params} = do
+appJsonToCM AppMessageJson {v, msgId, event, params} = do
   eventTag <- strDecode $ encodeUtf8 event
   chatMsgEvent <- msg eventTag
-  pure ChatMessage {msgId, chatMsgEvent}
+  pure ChatMessage {chatVRange = maybe chatInitialVRange fromChatVRange v, msgId, chatMsgEvent}
   where
     p :: FromJSON a => J.Key -> Either String a
     p key = JT.parseEither (.: key) params
@@ -786,11 +802,11 @@ appJsonToCM AppMessageJson {msgId, event, params} = do
 key .=? value = maybe id ((:) . (key .=)) value
 
 chatToAppMessage :: forall e. MsgEncodingI e => ChatMessage e -> AppMessage e
-chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
+chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @e of
   SBinary ->
     let (binaryMsgId, body) = toBody chatMsgEvent
      in AMBinary AppMessageBinary {msgId = binaryMsgId, tag = B.head $ strEncode tag, body}
-  SJson -> AMJson AppMessageJson {msgId, event = textEncode tag, params = params chatMsgEvent}
+  SJson -> AMJson AppMessageJson {v = Just $ ChatVersionRange chatVRange, msgId, event = textEncode tag, params = params chatMsgEvent}
   where
     tag = toCMEventTag chatMsgEvent
     o :: [(J.Key, J.Value)] -> J.Object
@@ -806,7 +822,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
       XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
       XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId']
       XMsgDeleted -> JM.empty
-      XMsgReact msgId' memberId reaction add -> o $ ("memberId" .=? memberId) ["msgId" .= msgId', "reaction" .= reaction, "add" .= add]        
+      XMsgReact msgId' memberId reaction add -> o $ ("memberId" .=? memberId) ["msgId" .= msgId', "reaction" .= reaction, "add" .= add]
       XFile fileInv -> o ["file" .= fileInv]
       XFileAcpt fileName -> o ["fileName" .= fileName]
       XFileAcptInv sharedMsgId fileConnReq fileName -> o $ ("fileConnReq" .=? fileConnReq) ["msgId" .= sharedMsgId, "fileName" .= fileName]