From f379fd0f8c7fd21f24cf533fcdfbaf2b0ccccbdb Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 16 Mar 2023 13:58:01 +0000
Subject: [PATCH] xftp: sending file completion status (#2016)

* xftp: sending file completion status

* fix type

* fix type 2

* fix
---
 src/Simplex/Chat.hs | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 51b0c5278f..e8c0790bcc 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -2198,13 +2198,17 @@ processAgentMsgSndFile _corrId aFileId msg =
             (Just sharedMsgId, Nothing) -> do
               (ft, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId
               when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send"
+              -- TODO either update database status or move to SFPROG
               toView $ CRSndFileProgressXFTP user ci ft 1 1
               case (rfds, sfts, d, cInfo) of
-                (rfd : _, sft : _, SMDSnd, DirectChat ct) ->
-                  sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
+                (rfd : _, sft : _, SMDSnd, DirectChat ct) -> do
+                  msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
+                  withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
                 (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
                   ms <- withStore' $ \db -> getGroupMembers db user g
                   forM_ (zip rfds $ memberFTs ms) $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user))
+                  -- TODO update database status and send event to view CRSndFileCompleteXFTP
+                  pure ()
                   where
                     memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
                     memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
@@ -2217,18 +2221,16 @@ processAgentMsgSndFile _corrId aFileId msg =
                         useMember _ = Nothing
                     sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
                     sendToMember (rfd, (conn, sft)) =
-                      sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
+                      void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
                 _ -> pure ()
             _ -> pure () -- TODO error?
       where
-        sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m ()
+        sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m Int64
         sendFileDescription sft rfd msgId sendMsg = do
           let rfdText = safeDecodeUtf8 $ strEncode rfd
           withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText
           partSize <- asks $ xftpDescrPartSize . config
-          msgDeliveryId <- sendParts 1 partSize rfdText
-          -- msgDeliveryId <- sendFileDescription_ rfd sharedMsgId sendMsg
-          withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
+          sendParts 1 partSize rfdText
           where
             sendParts partNo partSize rfdText = do
               let (part, rest) = T.splitAt partSize rfdText