dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-03-31 01:05:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: MCFile (#580)

Browse Source
This commit is contained in:
JRoberts
2022-04-28 09:40:51 +04:00
committed by GitHub
parent a7554771a0
commit c48a516586
2 changed files with 14 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/Simplex/Chat/Protocol.hs
View File

@@ -148,18 +148,20 @@ cmToQuotedMsg = \case
XMsgNew (MCQuote quotedMsg _) -> Just quotedMsg
_ -> Nothing
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCUnknown_ Text
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCFile_ | MCUnknown_ Text
instance StrEncoding MsgContentTag where
strEncode = \case
MCText_ -> "text"
MCLink_ -> "link"
MCImage_ -> "image"
MCFile_ -> "file"
MCUnknown_ t -> encodeUtf8 t
strDecode = \case
"text" -> Right MCText_
"link" -> Right MCLink_
"image" -> Right MCImage_
"file" -> Right MCFile_
t -> Right . MCUnknown_ $ safeDecodeUtf8 t
strP = strDecode <$?> A.takeTill (== ' ')
@@ -196,6 +198,7 @@ data MsgContent
= MCText Text
| MCLink {text :: Text, preview :: LinkPreview}
| MCImage {text :: Text, image :: ImageData}
| MCFile Text
| MCUnknown {tag :: Text, text :: Text, json :: J.Object}
deriving (Eq, Show)
@@ -204,6 +207,7 @@ msgContentText = \case
MCText t -> t
MCLink {text} -> text
MCImage {text} -> text
MCFile t -> t
MCUnknown {text} -> text
msgContentTag :: MsgContent -> MsgContentTag
@@ -211,6 +215,7 @@ msgContentTag = \case
MCText _ -> MCText_
MCLink {} -> MCLink_
MCImage {} -> MCImage_
MCFile {} -> MCFile_
MCUnknown {tag} -> MCUnknown_ tag
data ExtMsgContent = ExtMsgContent MsgContent (Maybe FileInvitation)
@@ -236,6 +241,7 @@ instance FromJSON MsgContent where
text <- v .: "text"
image <- v .: "image"
pure MCImage {image, text}
MCFile_ -> MCFile <$> v .: "text"
MCUnknown_ tag -> do
text <- fromMaybe unknownMsgType <$> v .:? "text"
pure MCUnknown {tag, text, json = v}
@@ -261,11 +267,13 @@ instance ToJSON MsgContent where
MCText t -> J.object ["type" .= MCText_, "text" .= t]
MCLink {text, preview} -> J.object ["type" .= MCLink_, "text" .= text, "preview" .= preview]
MCImage {text, image} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image]
MCFile t -> J.object ["type" .= MCFile_, "text" .= t]
toEncoding = \case
MCUnknown {json} -> JE.value $ J.Object json
MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t
MCLink {text, preview} -> J.pairs $ "type" .= MCLink_ <> "text" .= text <> "preview" .= preview
MCImage {text, image} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image
MCFile t -> J.pairs $ "type" .= MCFile_ <> "text" .= t
instance ToField MsgContent where
toField = toField . safeDecodeUtf8 . LB.toStrict . J.encode