diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 54f7e156d0..b30ec9da7a 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -30,7 +30,7 @@ import Data.Char (isSpace) import Data.Fixed (div') import Data.Functor (($>)) import Data.Int (Int64) -import Data.List (find) +import Data.List (find, isSuffixOf) import Data.List.NonEmpty (NonEmpty, nonEmpty) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) @@ -105,6 +105,12 @@ _defaultSMPServers = _defaultNtfServers :: [NtfServer] _defaultNtfServers = ["smp://ZH1Dkt2_EQRbxUUyjLlcUjg1KAhBrqfvE0xfn7Ki0Zg=@ntf1.simplex.im"] +maxImageSize :: Integer +maxImageSize = 236700 + +fixedImagePreview :: ImageData +fixedImagePreview = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAAXNSR0IArs4c6QAAAKVJREFUeF7t1kENACEUQ0FQhnVQ9lfGO+xggITQdvbMzArPey+8fa3tAfwAEdABZQspQStgBssEcgAIkSAJkiAJljtEgiRIgmUCSZAESZAESZAEyx0iQRIkwTKBJEiCv5fgvTd1wDmn7QAP4AeIgA4oW0gJWgEzWCZwbQ7gAA7ggLKFOIADOKBMIAeAEAmSIAmSYLlDJEiCJFgmkARJkARJ8N8S/ADTZUewBvnTOQAAAABJRU5ErkJggg==" + logCfg :: LogConfig logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} @@ -688,6 +694,15 @@ processChatCommand = \case SendFile chatName f -> withUser $ \user -> do chatRef <- getChatRef user chatName processChatCommand . APISendMessage chatRef $ ComposedMessage (Just f) Nothing (MCFile "") + SendImage chatName f -> withUser $ \user -> do + chatRef <- getChatRef user chatName + filePath <- toFSFilePath f + unless (".jpg" `isSuffixOf` f || ".jpeg" `isSuffixOf` f) $ throwChatError CEFileImageType {filePath} + fileSize <- getFileSize filePath + unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath} + processChatCommand . APISendMessage chatRef $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview) + ForwardFile chatName fileId -> forwardFile chatName fileId SendFile + ForwardImage chatName fileId -> forwardFile chatName fileId SendImage ReceiveFile fileId filePath_ -> withUser $ \user -> withChatLock . procCmd $ do ft <- withStore $ \st -> getRcvFileTransfer st user fileId @@ -829,6 +844,14 @@ processChatCommand = \case _ -> TM.delete ctId calls pure CRCmdOk | otherwise -> throwChatError $ CECallContact contactId + forwardFile :: ChatName -> FileTransferId -> (ChatName -> FilePath -> ChatCommand) -> m ChatResponse + forwardFile chatName fileId sendCommand = withUser $ \user -> do + withStore (\st -> getFileTransfer st user fileId) >>= \case + FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}} -> forward filePath + FTSnd {fileTransferMeta = FileTransferMeta {filePath}} -> forward filePath + _ -> throwChatError CEFileNotReceived {fileId} + where + forward = processChatCommand . sendCommand chatName updateCallItemStatus :: ChatMonad m => UserId -> Contact -> Call -> WebRTCCallStatus -> Maybe MessageId -> m () updateCallItemStatus userId ct Call {chatItemId} receivedStatus msgId_ = do @@ -2237,6 +2260,9 @@ chatCommandP = <|> "/feed " *> (SendMessageBroadcast <$> A.takeByteString) <|> ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP) <|> ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath) + <|> ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath) + <|> ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal) + <|> ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal) <|> ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (A.space *> filePath)) <|> ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal) <|> ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 88313fa84e..331bb61e4e 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -160,6 +160,9 @@ data ChatCommand | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString} | LastMessages (Maybe ChatName) Int | SendFile ChatName FilePath + | SendImage ChatName FilePath + | ForwardFile ChatName FileTransferId + | ForwardImage ChatName FileTransferId | ReceiveFile FileTransferId (Maybe FilePath) | CancelFile FileTransferId | FileStatus FileTransferId @@ -349,6 +352,9 @@ data ChatErrorType | CEFileSend {fileId :: FileTransferId, agentError :: AgentErrorType} | CEFileRcvChunk {message :: String} | CEFileInternal {message :: String} + | CEFileImageType {filePath :: FilePath} + | CEFileImageSize {filePath :: FilePath} + | CEFileNotReceived {fileId :: FileTransferId} | CEInvalidQuote | CEInvalidChatItemUpdate | CEInvalidChatItemDelete diff --git a/src/Simplex/Chat/Help.hs b/src/Simplex/Chat/Help.hs index 6b63cfb940..61f98feddf 100644 --- a/src/Simplex/Chat/Help.hs +++ b/src/Simplex/Chat/Help.hs @@ -102,11 +102,13 @@ filesHelpInfo = [ green "File transfer commands:", indent <> highlight "/file @ " <> " - send file to contact", indent <> highlight "/file # " <> " - send file to group", + indent <> highlight "/image [] " <> " - send file as image to @contact or #group", indent <> highlight "/freceive []" <> " - accept to receive file", + indent <> highlight "/fforward [] " <> " - forward received file to @contact or #group", indent <> highlight "/fcancel " <> " - cancel sending / receiving file", indent <> highlight "/fstatus " <> " - show file transfer status", "", - "The commands may be abbreviated: " <> listHighlight ["/f", "/fr", "/fc", "/fs"] + "The commands may be abbreviated: " <> listHighlight ["/f", "/img", "/fr", "/ff", "/fc", "/fs"] ] groupsHelpInfo :: [StyledString] diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 258eb0dadc..4679fca8bb 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -27,6 +27,7 @@ import Data.Time.LocalTime (ZonedTime (..), localDay, localTimeOfDay, timeOfDayT import GHC.Generics (Generic) import qualified Network.HTTP.Types as Q import Numeric (showFFloat) +import Simplex.Chat (maxImageSize) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Help @@ -739,6 +740,9 @@ viewChatError = \case CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e] CEFileRcvChunk e -> ["error receiving file: " <> plain e] CEFileInternal e -> ["file error: " <> plain e] + CEFileImageType _ -> ["max image size: " <> sShow maxImageSize <> " bytes, resize it or send as a file using " <> highlight' "/f"] + CEFileImageSize _ -> ["image type must be JPG, send as a file using " <> highlight' "/f"] + CEFileNotReceived fileId -> ["file " <> sShow fileId <> " not received"] CEInvalidQuote -> ["cannot reply to this message"] CEInvalidChatItemUpdate -> ["cannot update this item"] CEInvalidChatItemDelete -> ["cannot delete this item"]