core: images api (#506)

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

src/Simplex/Chat/Controller.hs

@@ -94,8 +94,8 @@ data ChatCommand
   | APIGetChats
   | APIGetChat ChatType Int64 ChatPagination
   | APIGetChatItems Int
-  | APISendMessage ChatType Int64 MsgContent
-  | APISendMessageQuote ChatType Int64 ChatItemId MsgContent
+  | APISendMessage ChatType Int64 (Maybe FilePath) MsgContent
+  | APISendMessageQuote ChatType Int64 ChatItemId (Maybe FilePath) MsgContent
   | APIUpdateChatItem ChatType Int64 ChatItemId MsgContent
   | APIDeleteChatItem ChatType Int64 ChatItemId CIDeleteMode
   | APIChatRead ChatType Int64 (ChatItemId, ChatItemId)

src/Simplex/Chat/Messages.hs

@@ -79,7 +79,8 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
     meta :: CIMeta d,
     content :: CIContent d,
     formattedText :: Maybe MarkdownList,
-    quotedItem :: Maybe (CIQuote c)
+    quotedItem :: Maybe (CIQuote c),
+    file :: Maybe CIFile
   }
   deriving (Show, Generic)
 
@@ -265,6 +266,16 @@ quoteMsgDirection = \case
   CIQGroupSnd -> MDSnd
   CIQGroupRcv _ -> MDRcv
 
+data CIFile = CIFile
+  { file :: FilePath, -- local file path
+    loaded :: Bool
+  }
+  deriving (Show, Generic)
+
+instance ToJSON CIFile where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
 data CIStatus (d :: MsgDirection) where
   CISSndNew :: CIStatus 'MDSnd
   CISSndSent :: CIStatus 'MDSnd

src/Simplex/Chat/Protocol.hs

@@ -148,16 +148,18 @@ cmToQuotedMsg = \case
   XMsgNew (MCQuote quotedMsg _) -> Just quotedMsg
   _ -> Nothing
 
-data MsgContentTag = MCText_ | MCLink_ | MCUnknown_ Text
+data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCUnknown_ Text
 
 instance StrEncoding MsgContentTag where
   strEncode = \case
     MCText_ -> "text"
     MCLink_ -> "link"
+    MCImage_ -> "image"
     MCUnknown_ t -> encodeUtf8 t
   strDecode = \case
     "text" -> Right MCText_
     "link" -> Right MCLink_
+    "image" -> Right MCImage_
     t -> Right . MCUnknown_ $ safeDecodeUtf8 t
   strP = strDecode <$?> A.takeTill (== ' ')
 
@@ -169,16 +171,16 @@ instance ToJSON MsgContentTag where
   toEncoding = strToJEncoding
 
 data MsgContainer
-  = MCSimple MsgContent
-  | MCQuote QuotedMsg MsgContent
-  | MCForward MsgContent
+  = MCSimple ExtMsgContent
+  | MCQuote QuotedMsg ExtMsgContent
+  | MCForward ExtMsgContent
   deriving (Eq, Show)
 
 mcContent :: MsgContainer -> MsgContent
 mcContent = \case
-  MCSimple c -> c
-  MCQuote _ c -> c
-  MCForward c -> c
+  MCSimple (ExtMsgContent c _) -> c
+  MCQuote _ (ExtMsgContent c _) -> c
+  MCForward (ExtMsgContent c _) -> c
 
 data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData}
   deriving (Eq, Show, Generic)
@@ -193,6 +195,7 @@ instance ToJSON LinkPreview where
 data MsgContent
   = MCText Text
   | MCLink {text :: Text, preview :: LinkPreview}
+  | MCImage {text :: Text, image :: ImageData}
   | MCUnknown {tag :: Text, text :: Text, json :: J.Object}
   deriving (Eq, Show)
 
@@ -200,21 +203,26 @@ msgContentText :: MsgContent -> Text
 msgContentText = \case
   MCText t -> t
   MCLink {text} -> text
+  MCImage {text} -> text
   MCUnknown {text} -> text
 
 msgContentTag :: MsgContent -> MsgContentTag
 msgContentTag = \case
   MCText _ -> MCText_
   MCLink {} -> MCLink_
+  MCImage {} -> MCImage_
   MCUnknown {tag} -> MCUnknown_ tag
 
+data ExtMsgContent = ExtMsgContent MsgContent (Maybe FileInvitation)
+  deriving (Eq, Show)
+
 parseMsgContainer :: J.Object -> JT.Parser MsgContainer
 parseMsgContainer v =
   MCQuote <$> v .: "quote" <*> mc
     <|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc)
     <|> MCSimple <$> mc
   where
-    mc = v .: "content"
+    mc = ExtMsgContent <$> v .: "content" <*> v .:? "file"
 
 instance FromJSON MsgContent where
   parseJSON (J.Object v) =
@@ -224,6 +232,10 @@ instance FromJSON MsgContent where
         text <- v .: "text"
         preview <- v .: "preview"
         pure MCLink {text, preview}
+      MCImage_ -> do
+        text <- v .: "text"
+        image <- v .: "image"
+        pure MCImage {image, text}
       MCUnknown_ tag -> do
         text <- fromMaybe unknownMsgType <$> v .:? "text"
         pure MCUnknown {tag, text, json = v}
@@ -235,19 +247,25 @@ unknownMsgType = "unknown message type"
 
 msgContainerJSON :: MsgContainer -> J.Object
 msgContainerJSON = \case
-  MCQuote qm c -> JM.fromList ["quote" .= qm, "content" .= c]
-  MCForward c -> JM.fromList ["forward" .= True, "content" .= c]
-  MCSimple c -> JM.fromList ["content" .= c]
+  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
+  where
+    withFile l = \case
+      Nothing -> l
+      Just f -> l <> ["file" .= fileInvitationJSON f]
 
 instance ToJSON MsgContent where
   toJSON = \case
     MCUnknown {json} -> J.Object json
     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]
   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
 
 instance ToField MsgContent where
   toField = toField . safeDecodeUtf8 . LB.toStrict . J.encode

src/Simplex/Chat/Store.hs

@@ -3391,7 +3391,7 @@ toDirectChatItem tz currentTs ((itemId, itemTs, itemContent, itemText, itemStatu
   where
     cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> CChatItem 'CTDirect
     cItem d chatDir ciStatus content =
-      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow}
+      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file = Nothing}
     badItem = Left $ SEBadChatItem itemId
     ciMeta :: CIContent d -> CIStatus d -> CIMeta d
     ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt
@@ -3424,7 +3424,7 @@ toGroupChatItem tz currentTs userContactId ((itemId, itemTs, itemContent, itemTe
   where
     cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe GroupMember -> CChatItem 'CTGroup
     cItem d chatDir ciStatus content quotedMember_ =
-      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_}
+      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file = Nothing}
     badItem = Left $ SEBadChatItem itemId
     ciMeta :: CIContent d -> CIStatus d -> CIMeta d
     ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt