replace FTLocal with createLocalFile

src/Simplex/Chat.hs

@@ -794,22 +794,15 @@ processChatCommand' vr = \case
     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
+    ci'@ChatItem {meta = CIMeta {itemId, itemTs}} <- createInternalChatItem_ user (CDLocalSnd nf) (CISndMsgContent mc) Nothing
+    ciFile_ <- forM file_ $ \cf@CryptoFile {filePath, cryptoArgs} -> do
+      fsFilePath <- toFSFilePath filePath -- XXX: only used for size?..
+      fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cryptoArgs
+      withStore' $ \db -> do
+        fileId <- createLocalFile CIFSSndComplete db user nf itemId itemTs cf fileSize
+        pure CIFile {fileId, fileName = takeFileName filePath, fileSize, fileSource = Just cf, fileStatus = CIFSSndComplete, fileProtocol = FPLocal}
     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
@@ -1959,14 +1952,15 @@ processChatCommand' vr = \case
                     updateRcvFileAgentId db fileId Nothing
                   getChatItemByFileId db vr user fileId
                 pure $ CRRcvFileCancelled user ci ftr
-        FTLocal _ -> throwChatError $ CEFileCancel fileId "cannot cancel local files"
-  FileStatus fileId -> withUser $ \user -> do
+  FileStatus fileId -> withUser $ \user@User {userId} -> do
     ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db vr user fileId
     case file of
+      Just CIFile {fileProtocol = FPLocal} -> do
+        -- XXX: not stricly a file transfer but the file *has* some status
+        fileMeta <- withStore $ \db -> getLocalFileMeta db userId fileId
+        pure $ CRLocalFileStatus user fileMeta
       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

src/Simplex/Chat/Controller.hs

@@ -563,7 +563,7 @@ data ChatResponse
   | CRNoteFolderDeleted {user :: User, noteFolder :: NoteFolder}
   | CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
   | CRFileTransferStatusXFTP User AChatItem
-  -- | CRLocalFileStatus User CIFileInfo
+  | CRLocalFileStatus User LocalFileMeta
   | CRUserProfile {user :: User, profile :: Profile}
   | CRUserProfileNoChange {user :: User}
   | CRUserPrivacy {user :: User, updatedUser :: User}

src/Simplex/Chat/Store/Files.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -18,7 +19,6 @@ module Simplex.Chat.Store.Files
     createSndDirectFTConnection,
     createSndGroupFileTransfer,
     createSndGroupFileTransferConnection,
-    createSndLocalFileTransfer,
     createSndDirectInlineFT,
     createSndGroupInlineFT,
     updateSndDirectFTDelivery,
@@ -75,7 +75,9 @@ module Simplex.Chat.Store.Files
     getSndFileTransfers,
     getContactFileInfo,
     getNoteFolderFileInfo,
+    createLocalFile,
     getLocalCryptoFile,
+    getLocalFileMeta,
     updateDirectCIFileStatus,
   )
 where
@@ -93,6 +95,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
 import Data.Type.Equality
 import Database.SQLite.Simple (Only (..), (:.) (..))
 import Database.SQLite.Simple.QQ (sql)
+import Database.SQLite.Simple.ToField (ToField)
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
@@ -110,6 +113,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
 import Simplex.Messaging.Version (VersionRange)
+import System.FilePath (takeFileName)
 
 getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
 getLiveSndFileTransfers db User {userId} = do
@@ -213,16 +217,6 @@ 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
@@ -847,19 +841,17 @@ 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, FileProtocol)] -> ExceptT StoreError IO FileTransfer
+    fileTransfer [(_, _, FPLocal)] = throwError $ SEBadFileTransfer fileId
     fileTransfer [(Nothing, Just _, _)] = FTRcv <$> getRcvFileTransfer db user fileId
-    fileTransfer [(Just _, Nothing, _)] = do
+    fileTransfer _ = do
       (ftm, fts) <- getSndFileTransfer db user fileId
       pure $ FTSnd {fileTransferMeta = ftm, sndFileTransfers = fts}
-    fileTransfer [(Nothing, Nothing, FPLocal)] = FTLocal <$> getLocalFileMeta db userId fileId
-    fileTransfer _ = throwError $ SEBadFileTransfer fileId
 
 getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64, FileProtocol)]
 getFileTransferRow_ db userId fileId =
@@ -927,6 +919,26 @@ 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_}
 
+createLocalFile :: ToField (CIFileStatus d) => CIFileStatus d -> DB.Connection -> User -> NoteFolder -> ChatItemId -> UTCTime -> CryptoFile -> Integer -> IO Int64
+createLocalFile fileStatus db User {userId} NoteFolder {noteFolderId} chatItemId itemTs CryptoFile {filePath, cryptoArgs} fileSize = do
+  DB.execute
+    db
+    [sql|
+      INSERT INTO files
+        ( user_id, note_folder_id, chat_item_id,
+          file_name, file_path, file_size,
+          file_crypto_key, file_crypto_nonce,
+          chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at
+        )
+      VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+    |]
+    ( (userId, noteFolderId, chatItemId)
+        :. (takeFileName filePath, filePath, fileSize)
+        :. maybe (Nothing, Nothing) (\(CFArgs key nonce) -> (Just key, Just nonce)) cryptoArgs
+        :. (65536 :: Int, Nothing :: Maybe InlineFileMode, fileStatus, FPLocal, itemTs, itemTs)
+    )
+  insertedRowId db
+
 getLocalFileMeta :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalFileMeta
 getLocalFileMeta db userId fileId =
   ExceptT . firstRow localFileMeta (SEFileNotFound fileId) $

src/Simplex/Chat/Types.hs

@@ -1147,7 +1147,6 @@ data FileTransfer
         sndFileTransfers :: [SndFileTransfer]
       }
   | FTRcv {rcvFileTransfer :: RcvFileTransfer}
-  | FTLocal {localFileMeta :: LocalFileMeta}
   deriving (Show)
 
 data FileTransferMeta = FileTransferMeta
@@ -1182,7 +1181,6 @@ 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

src/Simplex/Chat/View.hs

@@ -155,6 +155,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
           | viaGroupLink -> [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
           | otherwise -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
         Nothing -> []
+  CRLocalFileStatus u lfm -> ttyUser u $ viewLocalFileStatus lfm
   CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
   CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci
   CRUserProfile u p -> ttyUser u $ viewUserProfile p
@@ -1598,6 +1599,9 @@ viewLocalFile to CIFile {fileId, fileSource} ts tz = case fileSource of
   Just (CryptoFile fPath _) -> sentWithTime_ ts tz [to <> fileTransferStr fileId fPath]
   _ -> const []
 
+viewLocalFileStatus :: LocalFileMeta -> [StyledString]
+viewLocalFileStatus LocalFileMeta {fileId, filePath} = ["local " <> fileTransferStr fileId filePath]
+
 cryptoFileArgsStr :: Bool -> CryptoFileArgs -> ByteString
 cryptoFileArgsStr testView cfArgs@(CFArgs key nonce)
   | testView = LB.toStrict $ J.encode cfArgs
@@ -1650,7 +1654,6 @@ 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

@@ -60,7 +60,7 @@ testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
   alice ##> "/tail"
   alice <# "$self file 1 (test.jpg)"
   alice ##> "/fs 1"
-  alice <## "file 1 (test.jpg)"
+  alice <## "local file 1 (test.jpg)"
 
 createFolder :: TestCC -> String -> IO ()
 createFolder cc label = do