core: update sent file status for direct chats when sending complete (#603)

* core: update sent file status for direct chats when sending complete

* update snd file status when started and completed

src/Simplex/Chat.hs

@@ -727,15 +727,20 @@ processChatCommand = \case
           removeFile fsFilePath `E.catch` \(_ :: E.SomeException) ->
             removePathForcibly fsFilePath `E.catch` \(_ :: E.SomeException) -> pure ()
     cancelFiles :: User -> [(Int64, ACIFileStatus)] -> m ()
-    cancelFiles user@User {userId} files =
-      forM_ files $ \(fileId, status) -> do
-        case status of
+    cancelFiles user@User {userId} files = mapM_ maybeCancelFile files
+      where
+        maybeCancelFile :: (Int64, ACIFileStatus) -> m ()
+        maybeCancelFile (fileId, status) = case status of
           AFS _ CIFSSndStored -> cancelById fileId
+          AFS _ CIFSSndTransfer -> cancelById fileId
+          AFS _ CIFSSndCancelled -> pure ()
+          AFS _ CIFSSndComplete -> pure ()
           AFS _ CIFSRcvInvitation -> cancelById fileId
           AFS _ CIFSRcvAccepted -> cancelById fileId
           AFS _ CIFSRcvTransfer -> cancelById fileId
-          _ -> pure ()
-      where
+          AFS _ CIFSRcvCancelled -> pure ()
+          AFS _ CIFSRcvComplete -> pure ()
+        cancelById :: Int64 -> m ()
         cancelById fileId = do
           ft <- withStore (\st -> getFileTransfer st userId fileId)
           void $ cancelFile user fileId ft
@@ -1233,7 +1238,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
         CON -> do
           ci <- withStore $ \st -> do
             updateSndFileStatus st ft FSConnected
-            getChatItemByFileId st user fileId
+            updateDirectCIFileStatus st user fileId CIFSSndTransfer
           toView $ CRSndFileStart ci ft
           sendFileChunk user ft
         SENT msgId -> do
@@ -1774,7 +1779,7 @@ sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentCo
         ci <- withStore $ \st -> do
           updateSndFileStatus st ft FSComplete
           deleteSndFileChunks st ft
-          getChatItemByFileId st user fileId
+          updateDirectCIFileStatus st user fileId CIFSSndComplete
         toView $ CRSndFileComplete ci ft
         closeFileHandle fileId sndFiles
         withAgent (`deleteConnection` acId)

src/Simplex/Chat/Messages.hs

@@ -210,6 +210,11 @@ aChatItems (AChat ct Chat {chatInfo, chatItems}) = map aChatItem chatItems
   where
     aChatItem (CChatItem md ci) = AChatItem ct md chatInfo ci
 
+updateFileStatus :: forall c d. ChatItem c d -> CIFileStatus d -> ChatItem c d
+updateFileStatus ci@ChatItem {file} status = case file of
+  Just f -> ci {file = Just (f :: CIFile d) {fileStatus = status}}
+  Nothing -> ci
+
 instance MsgDirectionI d => ToJSON (JSONAnyChatItem c d) where
   toJSON = J.genericToJSON J.defaultOptions
   toEncoding = J.genericToEncoding J.defaultOptions
@@ -295,7 +300,9 @@ instance MsgDirectionI d => ToJSON (CIFile d) where
 
 data CIFileStatus (d :: MsgDirection) where
   CIFSSndStored :: CIFileStatus 'MDSnd
+  CIFSSndTransfer :: CIFileStatus 'MDSnd
   CIFSSndCancelled :: CIFileStatus 'MDSnd
+  CIFSSndComplete :: CIFileStatus 'MDSnd
   CIFSRcvInvitation :: CIFileStatus 'MDRcv
   CIFSRcvAccepted :: CIFileStatus 'MDRcv
   CIFSRcvTransfer :: CIFileStatus 'MDRcv
@@ -319,7 +326,9 @@ deriving instance Show ACIFileStatus
 instance MsgDirectionI d => StrEncoding (CIFileStatus d) where
   strEncode = \case
     CIFSSndStored -> "snd_stored"
+    CIFSSndTransfer -> "snd_transfer"
     CIFSSndCancelled -> "snd_cancelled"
+    CIFSSndComplete -> "snd_complete"
     CIFSRcvInvitation -> "rcv_invitation"
     CIFSRcvAccepted -> "rcv_accepted"
     CIFSRcvTransfer -> "rcv_transfer"
@@ -332,7 +341,9 @@ instance StrEncoding ACIFileStatus where
   strP =
     A.takeTill (== ' ') >>= \case
       "snd_stored" -> pure $ AFS SMDSnd CIFSSndStored
+      "snd_transfer" -> pure $ AFS SMDSnd CIFSSndTransfer
       "snd_cancelled" -> pure $ AFS SMDSnd CIFSSndCancelled
+      "snd_complete" -> pure $ AFS SMDSnd CIFSSndComplete
       "rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation
       "rcv_accepted" -> pure $ AFS SMDRcv CIFSRcvAccepted
       "rcv_transfer" -> pure $ AFS SMDRcv CIFSRcvTransfer

src/Simplex/Chat/Store.hs

@@ -142,6 +142,7 @@ module Simplex.Chat.Store
     getGroupChatItemIdByText,
     getChatItemByFileId,
     updateDirectChatItemStatus,
+    updateDirectCIFileStatus,
     updateDirectChatItem,
     deleteDirectChatItemInternal,
     deleteDirectChatItemRcvBroadcast,
@@ -182,6 +183,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
 import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
+import Data.Type.Equality
 import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError, (:.) (..))
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
@@ -1907,11 +1909,14 @@ updateFileCancelled st userId fileId =
     currentTs <- getCurrentTime
     DB.execute db "UPDATE files SET cancelled = 1, updated_at = ? WHERE user_id = ? AND file_id = ?" (currentTs, userId, fileId)
 
-updateCIFileStatus :: MsgDirectionI d => MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> CIFileStatus d -> m ()
+updateCIFileStatus :: (MsgDirectionI d, MonadUnliftIO m) => SQLiteStore -> UserId -> Int64 -> CIFileStatus d -> m ()
 updateCIFileStatus st userId fileId ciFileStatus =
-  liftIO . withTransaction st $ \db -> do
-    currentTs <- getCurrentTime
-    DB.execute db "UPDATE files SET ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" (ciFileStatus, currentTs, userId, fileId)
+  liftIO . withTransaction st $ \db -> updateCIFileStatus_ db userId fileId ciFileStatus
+
+updateCIFileStatus_ :: MsgDirectionI d => DB.Connection -> UserId -> Int64 -> CIFileStatus d -> IO ()
+updateCIFileStatus_ db userId fileId ciFileStatus = do
+  currentTs <- getCurrentTime
+  DB.execute db "UPDATE files SET ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" (ciFileStatus, currentTs, userId, fileId)
 
 getSharedMsgIdByFileId :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m SharedMsgId
 getSharedMsgIdByFileId st userId fileId =
@@ -3554,6 +3559,16 @@ getChatItemIdByFileId_ db userId fileId =
       |]
       (userId, fileId)
 
+updateDirectCIFileStatus :: forall d m. (MsgDirectionI d, StoreMonad m) => SQLiteStore -> User -> Int64 -> CIFileStatus d -> m AChatItem
+updateDirectCIFileStatus st user@User {userId} fileId fileStatus =
+  liftIOEither . withTransaction st $ \db -> runExceptT $ do
+    aci@(AChatItem cType d cInfo ci) <- ExceptT $ getChatItemByFileId_ db user fileId
+    case (cType, testEquality d $ msgDirection @d) of
+      (SCTDirect, Just Refl) -> do
+        liftIO $ updateCIFileStatus_ db userId fileId fileStatus
+        pure $ AChatItem SCTDirect d cInfo $ updateFileStatus ci fileStatus
+      _ -> pure aci
+
 toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64) -> Either StoreError (ChatItemId, ChatRef)
 toChatItemRef = \case
   (itemId, Just contactId, Nothing) -> Right (itemId, ChatRef CTDirect contactId)