add APICreateChatItem and files

src/Simplex/Chat.hs

@@ -763,13 +763,7 @@ processChatCommand = \case
             quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership')
             quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
             quoteData _ _ = throwChatError CEInvalidQuote
-    CTLocal -> do
-      nf <- withStore $ \db -> getNoteFolder db user chatId
-      -- TODO: files, voice, etc.
-      ci <- createInternalChatItem_ user (CDLocalSnd nf) (CISndMsgContent mc) Nothing
-      pure $ CRNewChatItem user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci)
-    CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
-    CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
+    _ -> pure $ chatCmdError (Just user) "not supported"
     where
       quoteContent :: forall d. MsgContent -> Maybe (CIFile d) -> MsgContent
       quoteContent qmc ciFile_
@@ -824,6 +818,26 @@ processChatCommand = \case
       unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c)
       unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c)
       unzipMaybe3 _ = (Nothing, Nothing, Nothing)
+  APICreateChatItem folderId (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user -> do
+    forM_ quotedItemId_ $ \_ -> throwError $ ChatError $ CECommandError "not supported"
+    nf <- withStore $ \db -> getNoteFolder db user folderId
+    -- TODO: assertLocalAllowed user MDSnd nf XMsgNew_
+    ci'@ChatItem {meta = CIMeta{itemId, itemTs}} <- createInternalChatItem_ user (CDLocalSnd nf) (CISndMsgContent mc) Nothing
+    ciFile_ <- forM file_ $ localFile user nf itemId itemTs
+    let ci = (ci' :: ChatItem 'CTLocal 'MDSnd) {file = ciFile_}
+    pure . CRNewChatItem user $ AChatItem SCTLocal SMDSnd (LocalChat nf) ci
+    where
+      localFile user nf chatItemId createdAt (CryptoFile file cfArgs) = do
+        fsFilePath <- toFSFilePath file
+        fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs
+        let fileName = takeFileName file
+            fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}
+        chSize <- asks $ fileChunkSize . config
+        withStore $ \db -> do
+          FileTransferMeta {fileId} <- liftIO $ createSndLocalFileTransfer db user nf file fileInvitation chSize
+          liftIO $ updateFileTransferChatItemId db fileId chatItemId createdAt
+          let fileSource = Just $ CF.plain file
+          pure CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndComplete, fileProtocol = FPLocal}
   APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of
     CTDirect -> do
       ct@Contact {contactId} <- withStore $ \db -> getContact db user chatId
@@ -1562,8 +1576,8 @@ processChatCommand = \case
         let chatRef = ChatRef CTGroup gId
         processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc
       CTLocal -> do
-        chatRef <- withStore $ \db -> ChatRef CTLocal <$> getNoteFolderIdByName db user name
-        processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc
+        folderId <- withStore $ \db -> getNoteFolderIdByName db user name
+        processChatCommand . APICreateChatItem folderId $ ComposedMessage Nothing Nothing mc
       _ -> throwChatError $ CECommandError "not supported"
   SendMemberContactMessage gName mName msg -> withUser $ \user -> do
     (gId, mId) <- getGroupAndMemberId user gName mName
@@ -1901,7 +1915,9 @@ processChatCommand = \case
     asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
   SendFile chatName f -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
-    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCFile "")
+    case chatRef of
+      ChatRef CTLocal folderId -> processChatCommand . APICreateChatItem folderId $ ComposedMessage (Just f) Nothing (MCFile "")
+      _ -> processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCFile "")
   SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
     filePath <- toFSFilePath fPath
@@ -1970,11 +1986,14 @@ processChatCommand = \case
                     updateRcvFileAgentId db fileId Nothing
                   getChatItemByFileId db user fileId
                 pure $ CRRcvFileCancelled user ci ftr
+        FTLocal _ -> throwChatError $ CEFileCancel fileId "cannot cancel local files"
   FileStatus fileId -> withUser $ \user -> do
     ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db user fileId
     case file of
       Just CIFile {fileProtocol = FPXFTP} ->
         pure $ CRFileTransferStatusXFTP user ci
+      -- Just CIFile {fileProtocol = FPLocal, fileId,} ->
+      --   pure $ CRLocalFileStatus user fileId ???
       _ -> do
         fileStatus <- withStore $ \db -> getFileTransferProgress db user fileId
         pure $ CRFileTransferStatus user fileStatus
@@ -6058,6 +6077,7 @@ chatCommandP =
       "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
       "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal),
       "/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
+      "/_create $" *> (APICreateChatItem <$> A.decimal <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
       "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
       "/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),
       "/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <* A.space <*> A.decimal <* A.space <*> A.decimal),

src/Simplex/Chat/Controller.hs

@@ -256,6 +256,7 @@ data ChatCommand
   | APIGetChatItems ChatPagination (Maybe String)
   | APIGetChatItemInfo ChatRef ChatItemId
   | APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage}
+  | APICreateChatItem {noteFolderId :: NoteFolderId, composedMessage :: ComposedMessage}
   | APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
   | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
   | APIDeleteMemberChatItem GroupId GroupMemberId ChatItemId
@@ -561,6 +562,7 @@ data ChatResponse
   | CRNoteFolderDeleted {user :: User, noteFolder :: NoteFolder}
   | CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
   | CRFileTransferStatusXFTP User AChatItem
+  -- | CRLocalFileStatus User CIFileInfo
   | CRUserProfile {user :: User, profile :: Profile}
   | CRUserProfileNoChange {user :: User}
   | CRUserPrivacy {user :: User, updatedUser :: User}

src/Simplex/Chat/Help.hs

@@ -106,6 +106,7 @@ filesHelpInfo =
     [ green "File transfer commands:",
       indent <> highlight "/file @<contact> <file_path>       " <> " - send file to contact",
       indent <> highlight "/file #<group> <file_path>         " <> " - send file to group",
+      indent <> highlight "/file $<folder> <file_path>        " <> " - add file to folder",
       indent <> highlight "/image <name> [<file_path>]        " <> " - send file as image to @contact or #group",
       indent <> highlight "/freceive <file_id> [<file_path>]  " <> " - accept to receive file",
       indent <> highlight "/fforward <name> [<file_id>]       " <> " - forward received file to @contact or #group",

src/Simplex/Chat/Messages.hs

@@ -464,7 +464,7 @@ data CIFile (d :: MsgDirection) = CIFile
   }
   deriving (Show)
 
-data FileProtocol = FPSMP | FPXFTP
+data FileProtocol = FPSMP | FPXFTP | FPLocal
   deriving (Eq, Show, Ord)
 
 instance FromField FileProtocol where fromField = fromTextField_ textDecode
@@ -482,10 +482,12 @@ instance TextEncoding FileProtocol where
   textDecode = \case
     "smp" -> Just FPSMP
     "xftp" -> Just FPXFTP
+    "local" -> Just FPLocal
     _ -> Nothing
   textEncode = \case
     FPSMP -> "smp"
     FPXFTP -> "xftp"
+    FPLocal -> "local"
 
 data CIFileStatus (d :: MsgDirection) where
   CIFSSndStored :: CIFileStatus 'MDSnd

src/Simplex/Chat/Migrations/M20231219_note_folders.hs

@@ -31,6 +31,7 @@ m20231219_note_folders =
 
     ALTER TABLE chat_items ADD COLUMN note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE;
     ALTER TABLE chat_item_reactions ADD COLUMN note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE;
+    ALTER TABLE files ADD COLUMN note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE;
 |]
 
 down_m20231219_note_folders :: Query
@@ -40,4 +41,5 @@ DROP INDEX idx_note_folders_user_id_local_display_name;
 DROP TABLE note_folders;
 ALTER TABLE chat_items DROP COLUMN note_folder_id;
 ALTER TABLE chat_item_reactions DROP COLUMN note_folder_id;
+ALTER TABLE files DROP COLUMN note_folder_id;
 |]

src/Simplex/Chat/Store/Files.hs

@@ -18,6 +18,7 @@ module Simplex.Chat.Store.Files
     createSndDirectFTConnection,
     createSndGroupFileTransfer,
     createSndGroupFileTransferConnection,
+    createSndLocalFileTransfer,
     createSndDirectInlineFT,
     createSndGroupInlineFT,
     updateSndDirectFTDelivery,
@@ -210,6 +211,16 @@ createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId)
     "INSERT INTO snd_files (file_id, file_status, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
     (fileId, FSAccepted, connId, groupMemberId, currentTs, currentTs)
 
+createSndLocalFileTransfer :: DB.Connection -> User -> NoteFolder -> FilePath -> FileInvitation -> Integer -> IO FileTransferMeta
+createSndLocalFileTransfer db User {userId} NoteFolder {noteFolderId} filePath FileInvitation {fileName, fileSize, fileInline} chunkSize = do
+  currentTs <- getCurrentTime
+  DB.execute
+    db
+    "INSERT INTO files (user_id, note_folder_id, file_name, file_path, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
+    ((userId, noteFolderId, fileName, filePath, fileSize, chunkSize) :. (fileInline, CIFSSndComplete, FPLocal, currentTs, currentTs))
+  fileId <- insertedRowId db
+  pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
+
 createSndDirectInlineFT :: DB.Connection -> Contact -> FileTransferMeta -> ExceptT StoreError IO SndFileTransfer
 createSndDirectInlineFT _ Contact {localDisplayName, activeConn = Nothing} _ = throwError $ SEContactNotReady localDisplayName
 createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Just Connection {connId, agentConnId}} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = liftIO $ do
@@ -814,12 +825,14 @@ getFileTransferProgress db user fileId = do
       FTSnd _ [] -> pure [Only 0]
       FTSnd _ _ -> DB.query db "SELECT COUNT(*) FROM snd_file_chunks WHERE file_id = ? and chunk_sent = 1 GROUP BY connection_id" (Only fileId)
       FTRcv _ -> DB.query db "SELECT COUNT(*) FROM rcv_file_chunks WHERE file_id = ? AND chunk_stored = 1" (Only fileId)
+      FTLocal _ -> pure [Only 0]
 
 getFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransfer
 getFileTransfer db user@User {userId} fileId =
   fileTransfer =<< liftIO (getFileTransferRow_ db userId fileId)
   where
     fileTransfer :: [(Maybe Int64, Maybe Int64)] -> ExceptT StoreError IO FileTransfer
+    fileTransfer [(Nothing, Nothing)] = FTLocal <$> getLocalFileMeta db user fileId
     fileTransfer [(Nothing, Just _)] = FTRcv <$> getRcvFileTransfer db user fileId
     fileTransfer _ = do
       (ftm, fts) <- getSndFileTransfer db user fileId
@@ -891,6 +904,23 @@ getFileTransferMeta_ db userId fileId =
           xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted, cryptoArgs}) <$> aSndFileId_
        in FileTransferMeta {fileId, xftpSndFile, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
 
+getLocalFileMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO LocalFileMeta
+getLocalFileMeta db User {userId} fileId =
+  ExceptT . firstRow localFileMeta (SEFileNotFound fileId) $
+    DB.query
+      db
+      [sql|
+        SELECT file_name, file_size, file_path, file_crypto_key, file_crypto_nonce
+        FROM files
+        WHERE user_id = ? AND file_id = ?
+      |]
+      (userId, fileId)
+  where
+    localFileMeta :: (FilePath, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce) -> LocalFileMeta
+    localFileMeta (fileName, fileSize, filePath, fileKey, fileNonce) =
+      let fileCryptoArgs = CFArgs <$> fileKey <*> fileNonce
+       in LocalFileMeta {fileId, fileName, fileSize, filePath, fileCryptoArgs}
+
 getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo]
 getContactFileInfo db User {userId} Contact {contactId} =
   map toFileInfo

src/Simplex/Chat/Types.hs

@@ -1144,6 +1144,7 @@ data FileTransfer
         sndFileTransfers :: [SndFileTransfer]
       }
   | FTRcv {rcvFileTransfer :: RcvFileTransfer}
+  | FTLocal {localFileMeta :: LocalFileMeta}
   deriving (Show)
 
 data FileTransferMeta = FileTransferMeta
@@ -1158,6 +1159,15 @@ data FileTransferMeta = FileTransferMeta
   }
   deriving (Eq, Show)
 
+data LocalFileMeta = LocalFileMeta
+  { fileId :: FileTransferId,
+    fileName :: String,
+    filePath :: String,
+    fileSize :: Integer,
+    fileCryptoArgs :: Maybe CryptoFileArgs
+  }
+  deriving (Eq, Show)
+
 data XFTPSndFile = XFTPSndFile
   { agentSndFileId :: AgentSndFileId,
     privateSndFileDescr :: Maybe Text,
@@ -1169,8 +1179,10 @@ data XFTPSndFile = XFTPSndFile
 fileTransferCancelled :: FileTransfer -> Bool
 fileTransferCancelled (FTSnd FileTransferMeta {cancelled} _) = cancelled
 fileTransferCancelled (FTRcv RcvFileTransfer {cancelled}) = cancelled
+fileTransferCancelled FTLocal {} = False
 
 -- For XFTP file transfers FSConnected means "uploaded to XFTP relays"
+-- Local files are always FSComplete
 data FileStatus = FSNew | FSAccepted | FSConnected | FSComplete | FSCancelled deriving (Eq, Ord, Show)
 
 instance FromField FileStatus where fromField = fromTextField_ textDecode
@@ -1644,6 +1656,8 @@ $(JQ.deriveJSON defaultJSON ''XFTPSndFile)
 
 $(JQ.deriveJSON defaultJSON ''FileTransferMeta)
 
+$(JQ.deriveJSON defaultJSON ''LocalFileMeta)
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "FT") ''FileTransfer)
 
 $(JQ.deriveJSON defaultJSON ''UserPwdHash)

src/Simplex/Chat/View.hs

@@ -554,13 +554,13 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
           quote = maybe [] (groupQuote g) quotedItem
       LocalChat nf -> case chatDir of
         CILocalSnd -> case content of
-          CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
+          CISndMsgContent mc -> hideLive meta $ withLocalFile to $ sndMsg to quote mc
           CISndGroupEvent {} -> showSndItemProhibited to
           _ -> showSndItem to
           where
             to = ttyToLocal nf
         CILocalRcv -> case content of
-          CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
+          CIRcvMsgContent mc -> withLocalFile from $ rcvMsg from quote mc
           CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
           CIRcvGroupEvent {} -> showRcvItemProhibited from
           _ -> showRcvItem from
@@ -578,6 +578,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
       Just _ -> item <> styled (colored Yellow) (" [>>]" :: String)
     withSndFile = withFile viewSentFileInvitation
     withRcvFile = withFile viewReceivedFileInvitation
+    withLocalFile = withFile viewLocalFile
     withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file
     sndMsg = msg viewSentMessage
     rcvMsg = msg viewReceivedMessage
@@ -1590,6 +1591,11 @@ receivingFile_' hu testView status (AChatItem _ _ chat ChatItem {file = Just CIF
       _ -> []
 receivingFile_' _ _ status _ = [plain status <> " receiving file"] -- shouldn't happen
 
+viewLocalFile :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
+viewLocalFile to CIFile {fileId, fileSource} ts tz = case fileSource of
+  Just (CryptoFile fPath _) -> sentWithTime_ ts tz [to <> fileTransferStr fileId fPath]
+  _ -> const []
+
 cryptoFileArgsStr :: Bool -> CryptoFileArgs -> ByteString
 cryptoFileArgsStr testView cfArgs@(CFArgs key nonce)
   | testView = LB.toStrict $ J.encode cfArgs
@@ -1642,6 +1648,7 @@ viewFileTransferStatus (FTRcv ft@RcvFileTransfer {fileId, fileInvitation = FileI
       RFSComplete RcvFileInfo {filePath} -> "complete, path: " <> plain filePath
       RFSCancelled (Just RcvFileInfo {filePath}) -> "cancelled, received part path: " <> plain filePath
       RFSCancelled Nothing -> "cancelled"
+viewFileTransferStatus (FTLocal LocalFileMeta {fileId, fileName}, _) = [fileTransferStr fileId fileName]
 
 viewFileTransferStatusXFTP :: AChatItem -> [StyledString]
 viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName, fileSize, fileStatus, fileSource}}) =

tests/ChatTests/Local.hs

@@ -6,17 +6,18 @@ module ChatTests.Local where
 import ChatClient
 import ChatTests.Utils
 import Test.Hspec
+import System.Directory (copyFile)
 
 chatLocalTests :: SpecWith FilePath
 chatLocalTests = do
   fdescribe "note folders" $ do
     it "create folders, add notes, read, search" testNotes
     it "switch users" testUserNotes
+    it "stores files" testFiles
 
 testNotes :: FilePath -> IO ()
 testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
-  alice ##> "/note folder self"
-  alice <## "new note folder created, write to $self to add notes"
+  createFolder alice "self"
 
   alice #> "$self keep in mind"
   alice ##> "/tail"
@@ -31,8 +32,7 @@ testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
 
 testUserNotes :: FilePath -> IO ()
 testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
-  alice ##> "/note folder self"
-  alice <## "new note folder created, write to $self to add notes"
+  createFolder alice "self"
 
   alice #> "$self keep in mind"
   alice ##> "/tail"
@@ -43,9 +43,26 @@ testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
   alice <## "use /p <display name> to change it"
   alice <## "(the updated profile will be sent to all your contacts)"
 
-  alice ##> "/note folder gossip"
-  alice <## "new note folder created, write to $gossip to add notes"
+  createFolder alice "gossip"
   alice ##> "/tail"
 
   alice ##> "/_delete item $1 1 internal"
   alice <## "chat db error: SENoteFolderNotFound {noteFolderId = 1}"
+
+testFiles :: FilePath -> IO ()
+testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
+  createFolder alice "self"
+
+  alice #$> ("/_files_folder ./tests/tmp/app_files", id, "ok")
+  copyFile "./tests/fixtures/test.jpg" "./tests/tmp/app_files/test.jpg"
+  alice ##> "/_create $1 json {\"filePath\": \"test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}"
+  alice <# "$self file 1 (test.jpg)"
+  alice ##> "/tail"
+  alice <# "$self file 1 (test.jpg)"
+  alice ##> "/fs 1"
+  alice <## "file 1 (test.jpg)"
+
+createFolder :: TestCC -> String -> IO ()
+createFolder cc label = do
+  cc ##> ("/note folder " <> label)
+  cc <## ("new note folder created, write to $" <> label <> " to add notes")