blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: types for timed and live messages (#1572)

Browse Source 
* core: types for timed and live messages

* add protocol tests
This commit is contained in:
Evgeny Poberezkin
2022-12-14 12:16:11 +00:00
committed by GitHub
parent 7b8f5be821
commit 677c6aeb2e
3 changed files with 70 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Protocol.hs
+17 -13
View File
@@ -179,7 +179,7 @@ instance StrEncoding AChatMessage where
data ChatMsgEvent (e :: MsgEncoding) where
XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
XMsgUpdate :: SharedMsgId -> MsgContent -> ChatMsgEvent 'Json
XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, live :: Maybe Bool} -> ChatMsgEvent 'Json
XMsgDel :: SharedMsgId -> ChatMsgEvent 'Json
XMsgDeleted :: ChatMsgEvent 'Json
XFile :: FileInvitation -> ChatMsgEvent 'Json -- TODO discontinue
@@ -356,7 +356,7 @@ msgContentTag = \case
MCFile {} -> MCFile_
MCUnknown {tag} -> MCUnknown_ tag
data ExtMsgContent = ExtMsgContent MsgContent (Maybe FileInvitation)
data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInvitation, ttl :: Maybe Int, live :: Maybe Bool}
deriving (Eq, Show)
parseMsgContainer :: J.Object -> JT.Parser MsgContainer
@@ -365,7 +365,10 @@ parseMsgContainer v =
<|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc)
<|> MCSimple <$> mc
where
mc = ExtMsgContent <$> v .: "content" <*> v .:? "file"
mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live"
extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
extMsgContent mc file = ExtMsgContent mc file Nothing Nothing
instance FromJSON MsgContent where
parseJSON (J.Object v) =
@@ -395,13 +398,12 @@ unknownMsgType = "unknown message type"
msgContainerJSON :: MsgContainer -> J.Object
msgContainerJSON = \case
MCQuote qm (ExtMsgContent c file) -> JM.fromList $ withFile ["quote" .= qm, "content" .= c] file
MCForward (ExtMsgContent c file) -> JM.fromList $ withFile ["forward" .= True, "content" .= c] file
MCSimple (ExtMsgContent c file) -> JM.fromList $ withFile ["content" .= c] file
MCQuote qm mc -> o $ ("quote" .= qm) : msgContent mc
MCForward mc -> o $ ("forward" .= True) : msgContent mc
MCSimple mc -> o $ msgContent mc
where
withFile l = \case
Nothing -> l
Just f -> l <> ["file" .= f]
o = JM.fromList
msgContent (ExtMsgContent c file ttl live) = ("file" .=? file) $ ("ttl" .=? ttl) $ ("live" .=? live) ["content" .= c]
instance ToJSON MsgContent where
toJSON = \case
@@ -551,7 +553,7 @@ instance StrEncoding ACMEventTag where
toCMEventTag :: ChatMsgEvent e -> CMEventTag e
toCMEventTag msg = case msg of
XMsgNew _ -> XMsgNew_
XMsgUpdate _ _ -> XMsgUpdate_
XMsgUpdate {} -> XMsgUpdate_
XMsgDel _ -> XMsgDel_
XMsgDeleted -> XMsgDeleted_
XFile _ -> XFile_
@@ -636,7 +638,7 @@ appJsonToCM AppMessageJson {msgId, event, params} = do
msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
msg = \case
XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content"
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "live"
XMsgDel_ -> XMsgDel <$> p "msgId"
XMsgDeleted_ -> pure XMsgDeleted
XFile_ -> XFile <$> p "file"
@@ -670,6 +672,9 @@ appJsonToCM AppMessageJson {msgId, event, params} = do
XOk_ -> pure XOk
XUnknown_ t -> pure $ XUnknown t params
(.=?) :: ToJSON v => JT.Key -> Maybe v -> [(J.Key, J.Value)] -> [(J.Key, J.Value)]
key .=? value = maybe id ((:) . (key .=)) value
chatToAppMessage :: forall e. MsgEncodingI e => ChatMessage e -> AppMessage e
chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
SBinary ->
@@ -680,14 +685,13 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
tag = toCMEventTag chatMsgEvent
o :: [(J.Key, J.Value)] -> J.Object
o = JM.fromList
key .=? value = maybe id ((:) . (key .=)) value
toBody :: ChatMsgEvent 'Binary -> (Maybe SharedMsgId, ByteString)
toBody = \case
BFileChunk (SharedMsgId msgId') chunk -> (Nothing, smpEncode (msgId', IFC chunk))
params :: ChatMsgEvent 'Json -> J.Object
params = \case
XMsgNew container -> msgContainerJSON container
XMsgUpdate msgId' content -> o ["msgId" .= msgId', "content" .= content]
XMsgUpdate msgId' content live -> o $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
XMsgDel msgId' -> o ["msgId" .= msgId']
XMsgDeleted -> JM.empty
XFile fileInv -> o ["file" .= fileInv]