diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index c75713ed4d..6093f0e4ce 100644 --- a/src/Simplex/Chat.hs +++ b/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) diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 6a1097d065..525d283067 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/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 diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 00db6f444e..39795d5b6d 100644 --- a/src/Simplex/Chat/Store.hs +++ b/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)