send files to groups (#97)

* add sender/recipient info to file types

* send file to group (WIP)

* send file to group, test

* show file status when sending file to group

* notification when cancelled sending to group, remove chunks when file complete or canceleld

src/Simplex/Chat.hs

@@ -51,7 +51,7 @@ import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (parseAll)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util (bshow, raceAny_)
+import Simplex.Messaging.Util (bshow, raceAny_, tryError)
 import System.Exit (exitFailure, exitSuccess)
 import System.FilePath (combine, splitExtensions, takeFileName)
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
@@ -163,6 +163,8 @@ inputSubscriber = do
             case cmd of
               SendMessage c msg -> showSentMessage c msg
               SendGroupMessage g msg -> showSentGroupMessage g msg
+              SendFile c f -> showSentFileInvitation c f
+              SendGroupFile g f -> showSentGroupFileInvitation g f
               _ -> printToView [plain s]
             user <- readTVarIO =<< asks currentUser
             withAgentLock a . withLock l . void . runExceptT $
@@ -264,33 +266,47 @@ processChatCommand user@User {userId, profile} = \case
     sendGroupMessage members msgEvent
     setActive $ ActiveG gName
   SendFile cName f -> do
-    unlessM (doesFileExist f) . chatError $ CEFileNotFound f
+    (fileSize, chSize) <- checkSndFile f
-    contact@Contact {contactId} <- withStore $ \st -> getContact st userId cName
+    contact <- withStore $ \st -> getContact st userId cName
     (agentConnId, fileQInfo) <- withAgent createConnection
-    fileSize <- getFileSize f
     let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileQInfo}
-    chSize <- asks $ fileChunkSize . config
+    SndFileTransfer {fileId} <- withStore $ \st ->
-    ft <- withStore $ \st -> createSndFileTransfer st userId contactId f fileInv agentConnId chSize
+      createSndFileTransfer st userId contact f fileInv agentConnId chSize
     sendDirectMessage (contactConnId contact) $ XFile fileInv
-    showSentFileInvitation cName ft
+    showSentFileInfo fileId
     setActive $ ActiveC cName
-  SendGroupFile _gName _file -> pure ()
+  SendGroupFile gName f -> do
+    (fileSize, chSize) <- checkSndFile f
+    group@Group {members, membership} <- withStore $ \st -> getGroup st user gName
+    unless (memberActive membership) $ chatError CEGroupMemberUserRemoved
+    let fileName = takeFileName f
+    ms <- forM (filter memberActive members) $ \m -> do
+      (connId, fileQInfo) <- withAgent createConnection
+      pure (m, connId, FileInvitation {fileName, fileSize, fileQInfo})
+    fileId <- withStore $ \st -> createSndGroupFileTransfer st userId group ms f fileSize chSize
+    forM_ ms $ \(m, _, fileInv) ->
+      traverse (`sendDirectMessage` XFile fileInv) $ memberConnId m
+    showSentFileInfo fileId
+    setActive $ ActiveG gName
   ReceiveFile fileId filePath_ -> do
-    RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileQInfo}, fileStatus} <- withStore $ \st -> getRcvFileTransfer st userId fileId
+    ft@RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileQInfo}, fileStatus} <- withStore $ \st -> getRcvFileTransfer st userId fileId
     unless (fileStatus == RFSNew) . chatError $ CEFileAlreadyReceiving fileName
-    agentConnId <- withAgent $ \a -> joinConnection a fileQInfo . directMessage $ XFileAcpt fileName
+    tryError (withAgent $ \a -> joinConnection a fileQInfo . directMessage $ XFileAcpt fileName) >>= \case
-    filePath <- getRcvFilePath fileId filePath_ fileName
+      Right agentConnId -> do
-    withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
+        filePath <- getRcvFilePath fileId filePath_ fileName
-    -- TODO include file sender in the message
+        withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
-    showRcvFileAccepted fileId filePath
+        showRcvFileAccepted ft filePath
+      Left (ChatErrorAgent (SMP SMP.AUTH)) -> showRcvFileSndCancelled ft
+      Left (ChatErrorAgent (CONN DUPLICATE)) -> showRcvFileSndCancelled ft
+      Left e -> throwError e
   CancelFile fileId ->
     withStore (\st -> getFileTransfer st userId fileId) >>= \case
       FTSnd fts -> do
-        mapM_ cancelSndFileTransfer fts
+        forM_ fts $ \ft -> cancelSndFileTransfer ft
-        showSndFileCancelled fileId
+        showSndGroupFileCancelled fts
       FTRcv ft -> do
         cancelRcvFileTransfer ft
-        showRcvFileCancelled fileId
+        showRcvFileCancelled ft
   FileStatus fileId ->
     withStore (\st -> getFileTransferProgress st userId fileId) >>= showFileTransferStatus
   UpdateProfile p -> unless (p == profile) $ do
@@ -306,6 +322,10 @@ processChatCommand user@User {userId, profile} = \case
     contactMember Contact {contactId} =
       find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
         cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft
+    checkSndFile :: FilePath -> m (Integer, Integer)
+    checkSndFile f = do
+      unlessM (doesFileExist f) . chatError $ CEFileNotFound f
+      (,) <$> getFileSize f <*> asks (fileChunkSize . config)
     getRcvFilePath :: Int64 -> Maybe FilePath -> String -> m FilePath
     getRcvFilePath fileId filePath fileName = case filePath of
       Nothing -> do
@@ -449,7 +469,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
           ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
           case chatMsgEvent of
             XMsgNew (MsgContent MTText [] body) -> newTextMessage c meta $ find (isSimplexContentType XCText) body
-            XFile fInv -> processFileInvitation ct fInv
+            XFile fInv -> processFileInvitation ct meta fInv
             XInfo p -> xInfo ct p
             XGrpInv gInv -> processGroupInvitation ct gInv
             XInfoProbe probe -> xInfoProbe ct probe
@@ -567,6 +587,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
         case chatMsgEvent of
           XMsgNew (MsgContent MTText [] body) ->
             newGroupTextMessage gName m meta $ find (isSimplexContentType XCText) body
+          XFile fInv -> processGroupFileInvitation gName m meta fInv
           XGrpMemNew memInfo -> xGrpMemNew gName m memInfo
           XGrpMemIntro memInfo -> xGrpMemIntro gName m memInfo
           XGrpMemInv memId introInv -> xGrpMemInv gName m memId introInv
@@ -591,7 +612,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
             _ -> messageError "REQ from file connection must have x.file.acpt"
         CON -> do
           withStore $ \st -> updateSndFileStatus st ft FSConnected
-          showSndFileStart fileId
+          showSndFileStart ft
           sendFileChunk ft
         SENT msgId -> do
           withStore $ \st -> updateSndFileChunkSent st ft msgId
@@ -599,7 +620,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
         MERR _ err -> do
           cancelSndFileTransfer ft
           case err of
-            SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ showSndFileRcvCancelled fileId
+            SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ showSndFileRcvCancelled ft
             _ -> chatError $ CEFileSend fileId err
         MSG meta _ ->
           withAckMessage agentConnId meta $ pure ()
@@ -610,12 +631,12 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
       case agentMsg of
         CON -> do
           withStore $ \st -> updateRcvFileStatus st ft FSConnected
-          showRcvFileStart fileId
+          showRcvFileStart ft
         MSG meta@MsgMeta {recipient = (msgId, _), integrity} msgBody -> withAckMessage agentConnId meta $ do
           parseFileChunk msgBody >>= \case
             (0, _) -> do
               cancelRcvFileTransfer ft
-              showRcvFileSndCancelled fileId
+              showRcvFileSndCancelled ft
             (chunkNo, chunk) -> do
               case integrity of
                 MsgOk -> pure ()
@@ -632,8 +653,10 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
                     then badRcvFileChunk ft "incorrect chunk size"
                     else do
                       appendFileChunk ft chunkNo chunk
-                      withStore $ \st -> updateRcvFileStatus st ft FSComplete
+                      withStore $ \st -> do
-                      showRcvFileComplete fileId
+                        updateRcvFileStatus st ft FSComplete
+                        deleteRcvFileChunks st ft
+                      showRcvFileComplete ft
                       closeFileHandle fileId rcvFiles
                       withAgent (`deleteConnection` agentConnId)
                 RcvChunkDuplicate -> pure ()
@@ -681,7 +704,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     newTextMessage c meta = \case
       Just MsgContentBody {contentData = bs} -> do
         let text = safeDecodeUtf8 bs
-        showReceivedMessage c (snd $ broker meta) text (integrity meta)
+        showReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity meta)
         showToast (c <> "> ") text
         setActive $ ActiveC c
       _ -> messageError "x.msg.new: no expected message body"
@@ -690,19 +713,26 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     newGroupTextMessage gName GroupMember {localDisplayName = c} meta = \case
       Just MsgContentBody {contentData = bs} -> do
         let text = safeDecodeUtf8 bs
-        showReceivedGroupMessage gName c (snd $ broker meta) text (integrity meta)
+        showReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity meta)
         showToast ("#" <> gName <> " " <> c <> "> ") text
         setActive $ ActiveG gName
       _ -> messageError "x.msg.new: no expected message body"
 
-    processFileInvitation :: Contact -> FileInvitation -> m ()
+    processFileInvitation :: Contact -> MsgMeta -> FileInvitation -> m ()
-    processFileInvitation Contact {contactId, localDisplayName = c} fInv = do
+    processFileInvitation contact@Contact {localDisplayName = c} meta fInv = do
       -- TODO chunk size has to be sent as part of invitation
       chSize <- asks $ fileChunkSize . config
-      ft <- withStore $ \st -> createRcvFileTransfer st userId contactId fInv chSize
+      ft <- withStore $ \st -> createRcvFileTransfer st userId contact fInv chSize
-      showReceivedFileInvitation c ft
+      showReceivedMessage c (snd $ broker meta) (receivedFileInvitation ft) (integrity meta)
       setActive $ ActiveC c
 
+    processGroupFileInvitation :: GroupName -> GroupMember -> MsgMeta -> FileInvitation -> m ()
+    processGroupFileInvitation gName m@GroupMember {localDisplayName = c} meta fInv = do
+      chSize <- asks $ fileChunkSize . config
+      ft <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize
+      showReceivedGroupMessage gName c (snd $ broker meta) (receivedFileInvitation ft) (integrity meta)
+      setActive $ ActiveG gName
+
     processGroupInvitation :: Contact -> GroupInvitation -> m ()
     processGroupInvitation ct@Contact {localDisplayName} inv@(GroupInvitation (fromMemId, fromRole) (memId, memRole) _ _) = do
       when (fromRole < GRAdmin || fromRole < memRole) $ chatError (CEGroupContactRole localDisplayName)
@@ -852,8 +882,10 @@ sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
     withStore (`createSndFileChunk` ft) >>= \case
       Just chunkNo -> sendFileChunkNo ft chunkNo
       Nothing -> do
-        withStore $ \st -> updateSndFileStatus st ft FSComplete
+        withStore $ \st -> do
-        showSndFileComplete fileId
+          updateSndFileStatus st ft FSComplete
+          deleteSndFileChunks st ft
+        showSndFileComplete ft
         closeFileHandle fileId sndFiles
         withAgent (`deleteConnection` agentConnId)
 
@@ -915,7 +947,9 @@ isFileActive fileId files = do
 cancelRcvFileTransfer :: ChatMonad m => RcvFileTransfer -> m ()
 cancelRcvFileTransfer ft@RcvFileTransfer {fileId, fileStatus} = do
   closeFileHandle fileId rcvFiles
-  withStore $ \st -> updateRcvFileStatus st ft FSCancelled
+  withStore $ \st -> do
+    updateRcvFileStatus st ft FSCancelled
+    deleteRcvFileChunks st ft
   case fileStatus of
     RFSAccepted RcvFileInfo {agentConnId} -> withAgent (`suspendConnection` agentConnId)
     RFSConnected RcvFileInfo {agentConnId} -> withAgent (`suspendConnection` agentConnId)
@@ -924,9 +958,11 @@ cancelRcvFileTransfer ft@RcvFileTransfer {fileId, fileStatus} = do
 cancelSndFileTransfer :: ChatMonad m => SndFileTransfer -> m ()
 cancelSndFileTransfer ft@SndFileTransfer {agentConnId, fileStatus} =
   unless (fileStatus == FSCancelled || fileStatus == FSComplete) $ do
-    withStore $ \st -> updateSndFileStatus st ft FSCancelled
+    withStore $ \st -> do
+      updateSndFileStatus st ft FSCancelled
+      deleteSndFileChunks st ft
     withAgent $ \a -> do
-      void $ sendMessage a agentConnId "0 "
+      void (sendMessage a agentConnId "0 ") `catchError` \_ -> pure ()
       suspendConnection a agentConnId
 
 closeFileHandle :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m ()

src/Simplex/Chat/Store.hs

@@ -63,21 +63,26 @@ module Simplex.Chat.Store
     matchSentProbe,
     mergeContactRecords,
     createSndFileTransfer,
+    createSndGroupFileTransfer,
     updateSndFileStatus,
     createSndFileChunk,
     updateSndFileChunkMsg,
     updateSndFileChunkSent,
+    deleteSndFileChunks,
     createRcvFileTransfer,
+    createRcvGroupFileTransfer,
     getRcvFileTransfer,
     acceptRcvFileTransfer,
     updateRcvFileStatus,
     createRcvFileChunk,
     updatedRcvFileChunkStored,
+    deleteRcvFileChunks,
     getFileTransfer,
     getFileTransferProgress,
   )
 where
 
+import Control.Applicative ((<|>))
 import Control.Concurrent.STM (stateTVar)
 import Control.Exception (Exception)
 import qualified Control.Exception as E
@@ -107,7 +112,7 @@ import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Util (bshow, liftIOEither, (<$$>))
-import System.FilePath (takeBaseName, takeExtension)
+import System.FilePath (takeBaseName, takeExtension, takeFileName)
 import UnliftIO.STM
 
 -- | The list of migrations in ascending order by date
@@ -635,7 +640,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
           [sql|
             SELECT
               g.local_display_name,
-              m.group_member_id, m.member_id, m.member_role, m.member_category, m.member_status,
+              m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
               m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name
             FROM group_members m
             JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
@@ -655,14 +660,19 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
           <$> DB.query
             db
             [sql|
-              SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path
+              SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, cs.local_display_name, m.local_display_name
               FROM snd_files s
               JOIN files f USING (file_id)
+              LEFT JOIN contacts cs USING (contact_id)
+              LEFT JOIN group_members m USING (group_member_id)    
               WHERE f.user_id = ? AND f.file_id = ? AND s.connection_id = ?
             |]
             (userId, fileId, connId)
-    sndFileTransfer_ :: Int64 -> Int64 -> [(FileStatus, String, Integer, Integer, FilePath)] -> Either StoreError SndFileTransfer
+    sndFileTransfer_ :: Int64 -> Int64 -> [(FileStatus, String, Integer, Integer, FilePath, Maybe ContactName, Maybe ContactName)] -> Either StoreError SndFileTransfer
-    sndFileTransfer_ fileId connId [(fileStatus, fileName, fileSize, chunkSize, filePath)] = Right SndFileTransfer {..}
+    sndFileTransfer_ fileId connId [(fileStatus, fileName, fileSize, chunkSize, filePath, contactName_, memberName_)] =
+      case contactName_ <|> memberName_ of
+        Just recipientDisplayName -> Right SndFileTransfer {..}
+        Nothing -> Left $ SESndFileInvalid fileId
     sndFileTransfer_ fileId _ _ = Left $ SESndFileNotFound fileId
 
 updateConnectionStatus :: MonadUnliftIO m => SQLiteStore -> Connection -> ConnStatus -> m ()
@@ -738,7 +748,7 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
           db
           [sql|
             SELECT
-              m.group_member_id, m.member_id, m.member_role, m.member_category, m.member_status,
+              m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
               m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
               c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
               c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
@@ -790,13 +800,14 @@ getGroupInvitation st user localDisplayName =
     findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId)
     findFromContact _ = const Nothing
 
-type GroupMemberRow = (Int64, ByteString, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text)
+type GroupMemberRow = (Int64, Int64, ByteString, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text)
 
 toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
-toGroupMember userContactId (groupMemberId, memberId, memberRole, memberCategory, memberStatus, invitedById, localDisplayName, memberContactId, displayName, fullName) =
+toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, localDisplayName, memberContactId, displayName, fullName) =
   let memberProfile = Profile {displayName, fullName}
       invitedBy = toInvitedBy userContactId invitedById
-   in GroupMember {groupMemberId, memberId, memberRole, memberCategory, memberStatus, invitedBy, localDisplayName, memberProfile, memberContactId, activeConn = Nothing}
+      activeConn = Nothing
+   in GroupMember {..}
 
 createContactGroupMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> m GroupMember
 createContactGroupMember st gVar user groupId contact memberRole agentConnId =
@@ -861,6 +872,7 @@ createNewMember_
       memProfileId
     } = do
     let invitedById = fromInvitedBy userContactId invitedBy
+        activeConn = Nothing
     DB.execute
       db
       [sql|
@@ -870,19 +882,7 @@ createNewMember_
       |]
       (groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, userId, localDisplayName, memProfileId, memberContactId)
     groupMemberId <- insertedRowId db
-    pure $
+    pure GroupMember {..}
-      GroupMember
-        { groupMemberId,
-          memberId,
-          memberRole,
-          memberStatus,
-          memberCategory,
-          invitedBy,
-          memberProfile,
-          localDisplayName,
-          memberContactId,
-          activeConn = Nothing
-        }
 
 deleteGroupMemberConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> GroupMember -> m ()
 deleteGroupMemberConnection st userId m =
@@ -982,11 +982,11 @@ getIntroduction_ db reMember toMember = ExceptT $ do
     toIntro _ = Left SEIntroNotFound
 
 createIntroReMember :: StoreMonad m => SQLiteStore -> User -> Group -> GroupMember -> MemberInfo -> ConnId -> ConnId -> m GroupMember
-createIntroReMember st user@User {userId} group _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) groupAgentConnId directAgentConnId =
+createIntroReMember st user@User {userId} group@Group {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) groupAgentConnId directAgentConnId =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
     let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
     Connection {connId = directConnId} <- liftIO $ createConnection_ db userId directAgentConnId memberContactId cLevel
-    (localDisplayName, contactId, memProfileId) <- ExceptT $ createContact_ db userId directConnId memberProfile (Just $ groupId group)
+    (localDisplayName, contactId, memProfileId) <- ExceptT $ createContact_ db userId directConnId memberProfile (Just groupId)
     liftIO $ do
       let newMember =
             NewGroupMember
@@ -1059,7 +1059,8 @@ createContactMember_ db User {userId, userContactId} groupId userOrContact (memb
   let memberProfile = profile' userOrContact
       memberContactId = Just $ contactId' userOrContact
       localDisplayName = localDisplayName' userOrContact
-  pure GroupMember {groupMemberId, memberId, memberRole, memberCategory, memberStatus, invitedBy, localDisplayName, memberProfile, memberContactId, activeConn = Nothing}
+      activeConn = Nothing
+  pure GroupMember {..}
   where
     insertMember_ =
       DB.executeNamed
@@ -1094,7 +1095,7 @@ getViaGroupMember st User {userId, userContactId} Contact {contactId} =
         [sql|
           SELECT
             g.local_display_name,
-            m.group_member_id, m.member_id, m.member_role, m.member_category, m.member_status,
+            m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
             m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
             c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
             c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
@@ -1148,8 +1149,8 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} =
        in Just Contact {contactId, localDisplayName, profile, activeConn, viaGroup}
     toContact _ = Nothing
 
-createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> FilePath -> FileInvitation -> ConnId -> Integer -> m SndFileTransfer
+createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> m SndFileTransfer
-createSndFileTransfer st userId contactId filePath FileInvitation {fileName, fileSize} agentConnId chunkSize =
+createSndFileTransfer st userId Contact {contactId, localDisplayName = recipientDisplayName} filePath FileInvitation {fileName, fileSize} agentConnId chunkSize =
   liftIO . withTransaction st $ \db -> do
     DB.execute db "INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size) VALUES (?, ?, ?, ?, ?, ?)" (userId, contactId, fileName, filePath, fileSize, chunkSize)
     fileId <- insertedRowId db
@@ -1158,6 +1159,17 @@ createSndFileTransfer st userId contactId filePath FileInvitation {fileName, fil
     DB.execute db "INSERT INTO snd_files (file_id, file_status, connection_id) VALUES (?, ?, ?)" (fileId, fileStatus, connId)
     pure SndFileTransfer {..}
 
+createSndGroupFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Group -> [(GroupMember, ConnId, FileInvitation)] -> FilePath -> Integer -> Integer -> m Int64
+createSndGroupFileTransfer st userId Group {groupId} ms filePath fileSize chunkSize =
+  liftIO . withTransaction st $ \db -> do
+    let fileName = takeFileName filePath
+    DB.execute db "INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size) VALUES (?, ?, ?, ?, ?, ?)" (userId, groupId, fileName, filePath, fileSize, chunkSize)
+    fileId <- insertedRowId db
+    forM_ ms $ \(GroupMember {groupMemberId}, agentConnId, _) -> do
+      Connection {connId} <- createSndFileConnection_ db userId fileId agentConnId
+      DB.execute db "INSERT INTO snd_files (file_id, file_status, connection_id, group_member_id) VALUES (?, ?, ?, ?)" (fileId, FSNew, connId, groupMemberId)
+    pure fileId
+
 createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> IO Connection
 createSndFileConnection_ db userId fileId agentConnId = do
   createdAt <- getCurrentTime
@@ -1218,13 +1230,26 @@ updateSndFileChunkSent st SndFileTransfer {fileId, connId} msgId =
       |]
       (fileId, connId, msgId)
 
-createRcvFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> FileInvitation -> Integer -> m RcvFileTransfer
+deleteSndFileChunks :: MonadUnliftIO m => SQLiteStore -> SndFileTransfer -> m ()
-createRcvFileTransfer st userId contactId f@FileInvitation {fileName, fileSize, fileQInfo} chunkSize =
+deleteSndFileChunks st SndFileTransfer {fileId, connId} =
+  liftIO . withTransaction st $ \db ->
+    DB.execute db "DELETE FROM snd_file_chunks WHERE file_id = ? AND connection_id = ?" (fileId, connId)
+
+createRcvFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FileInvitation -> Integer -> m RcvFileTransfer
+createRcvFileTransfer st userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileQInfo} chunkSize =
   liftIO . withTransaction st $ \db -> do
     DB.execute db "INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size) VALUES (?, ?, ?, ?, ?)" (userId, contactId, fileName, fileSize, chunkSize)
     fileId <- insertedRowId db
     DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info) VALUES (?, ?, ?)" (fileId, FSNew, fileQInfo)
-    pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, chunkSize}
+    pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize}
+
+createRcvGroupFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> GroupMember -> FileInvitation -> Integer -> m RcvFileTransfer
+createRcvGroupFileTransfer st userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileQInfo} chunkSize =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size) VALUES (?, ?, ?, ?, ?)" (userId, groupId, fileName, fileSize, chunkSize)
+    fileId <- insertedRowId db
+    DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info, group_member_id) VALUES (?, ?, ?, ?)" (fileId, FSNew, fileQInfo, groupMemberId)
+    pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize}
 
 getRcvFileTransfer :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m RcvFileTransfer
 getRcvFileTransfer st userId fileId =
@@ -1238,28 +1263,34 @@ getRcvFileTransfer_ db userId fileId =
       db
       [sql|
           SELECT r.file_status, r.file_queue_info, f.file_name,
-            f.file_size, f.chunk_size, f.file_path, c.connection_id, c.agent_conn_id
+            f.file_size, f.chunk_size, cs.local_display_name, m.local_display_name,
+            f.file_path, c.connection_id, c.agent_conn_id
           FROM rcv_files r
           JOIN files f USING (file_id)
           LEFT JOIN connections c ON r.file_id = c.rcv_file_id
+          LEFT JOIN contacts cs USING (contact_id)
+          LEFT JOIN group_members m USING (group_member_id)
           WHERE f.user_id = ? AND f.file_id = ?
         |]
       (userId, fileId)
   where
     rcvFileTransfer ::
-      [(FileStatus, SMPQueueInfo, String, Integer, Integer, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
+      [(FileStatus, SMPQueueInfo, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
       Either StoreError RcvFileTransfer
-    rcvFileTransfer [(fileStatus', fileQInfo, fileName, fileSize, chunkSize, filePath_, connId_, agentConnId_)] =
+    rcvFileTransfer [(fileStatus', fileQInfo, fileName, fileSize, chunkSize, contactName_, memberName_, filePath_, connId_, agentConnId_)] =
       let fileInv = FileInvitation {fileName, fileSize, fileQInfo}
           fileInfo = (filePath_, connId_, agentConnId_)
-       in case fileStatus' of
+       in case contactName_ <|> memberName_ of
-            FSNew -> Right RcvFileTransfer {fileId, fileInvitation = fileInv, fileStatus = RFSNew, chunkSize}
+            Nothing -> Left $ SERcvFileInvalid fileId
-            FSAccepted -> ft fileInv RFSAccepted fileInfo
+            Just name ->
-            FSConnected -> ft fileInv RFSConnected fileInfo
+              case fileStatus' of
-            FSComplete -> ft fileInv RFSComplete fileInfo
+                FSNew -> Right RcvFileTransfer {fileId, fileInvitation = fileInv, fileStatus = RFSNew, senderDisplayName = name, chunkSize}
-            FSCancelled -> ft fileInv RFSCancelled fileInfo
+                FSAccepted -> ft name fileInv RFSAccepted fileInfo
+                FSConnected -> ft name fileInv RFSConnected fileInfo
+                FSComplete -> ft name fileInv RFSComplete fileInfo
+                FSCancelled -> ft name fileInv RFSCancelled fileInfo
       where
-        ft fileInvitation rfs = \case
+        ft senderDisplayName fileInvitation rfs = \case
           (Just filePath, Just connId, Just agentConnId) ->
             let fileStatus = rfs RcvFileInfo {filePath, connId, agentConnId}
              in Right RcvFileTransfer {..}
@@ -1315,6 +1346,11 @@ updatedRcvFileChunkStored st RcvFileTransfer {fileId} chunkNo =
       |]
       (fileId, chunkNo)
 
+deleteRcvFileChunks :: MonadUnliftIO m => SQLiteStore -> RcvFileTransfer -> m ()
+deleteRcvFileChunks st RcvFileTransfer {fileId} =
+  liftIO . withTransaction st $ \db ->
+    DB.execute db "DELETE FROM rcv_file_chunks WHERE file_id = ?" (Only fileId)
+
 getFileTransfer :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m FileTransfer
 getFileTransfer st userId fileId =
   liftIOEither . withTransaction st $ \db ->
@@ -1354,18 +1390,24 @@ getSndFileTransfers_ db userId fileId =
     <$> DB.query
       db
       [sql|
-        SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.connection_id, c.agent_conn_id
+        SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.connection_id, c.agent_conn_id,
+          cs.local_display_name, m.local_display_name
         FROM snd_files s
         JOIN files f USING (file_id)
         JOIN connections c USING (connection_id)
+        LEFT JOIN contacts cs USING (contact_id)
+        LEFT JOIN group_members m USING (group_member_id)
         WHERE f.user_id = ? AND f.file_id = ?
       |]
       (userId, fileId)
   where
-    sndFileTransfers :: [(FileStatus, String, Integer, Integer, FilePath, Int64, ConnId)] -> Either StoreError [SndFileTransfer]
+    sndFileTransfers :: [(FileStatus, String, Integer, Integer, FilePath, Int64, ConnId, Maybe ContactName, Maybe ContactName)] -> Either StoreError [SndFileTransfer]
     sndFileTransfers [] = Left $ SESndFileNotFound fileId
-    sndFileTransfers fts = Right $ map sndFileTransfer fts
+    sndFileTransfers fts = mapM sndFileTransfer fts
-    sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, connId, agentConnId) = SndFileTransfer {..}
+    sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, connId, agentConnId, contactName_, memberName_) =
+      case contactName_ <|> memberName_ of
+        Just recipientDisplayName -> Right SndFileTransfer {..}
+        Nothing -> Left $ SESndFileInvalid fileId
 
 -- | Saves unique local display name based on passed displayName, suffixed with _N if required.
 -- This function should be called inside transaction.
@@ -1432,6 +1474,7 @@ data StoreError
   | SEGroupAlreadyJoined
   | SEGroupInvitationNotFound
   | SESndFileNotFound Int64
+  | SESndFileInvalid Int64
   | SERcvFileNotFound Int64
   | SEFileNotFound Int64
   | SERcvFileInvalid Int64

src/Simplex/Chat/Types.hs

@@ -123,6 +123,7 @@ data ReceivedGroupInvitation = ReceivedGroupInvitation
 
 data GroupMember = GroupMember
   { groupMemberId :: Int64,
+    groupId :: Int64,
     memberId :: MemberId,
     memberRole :: GroupMemberRole,
     memberCategory :: GroupMemberCategory,
@@ -305,6 +306,7 @@ data SndFileTransfer = SndFileTransfer
     filePath :: String,
     fileSize :: Integer,
     chunkSize :: Integer,
+    recipientDisplayName :: ContactName,
     connId :: Int64,
     agentConnId :: ConnId,
     fileStatus :: FileStatus
@@ -322,6 +324,7 @@ data RcvFileTransfer = RcvFileTransfer
   { fileId :: Int64,
     fileInvitation :: FileInvitation,
     fileStatus :: RcvFileStatus,
+    senderDisplayName :: ContactName,
     chunkSize :: Integer
   }
   deriving (Eq, Show)
@@ -343,7 +346,7 @@ data RcvFileInfo = RcvFileInfo
 
 data FileTransfer = FTSnd [SndFileTransfer] | FTRcv RcvFileTransfer
 
-data FileStatus = FSNew | FSAccepted | FSConnected | FSComplete | FSCancelled deriving (Eq, Show)
+data FileStatus = FSNew | FSAccepted | FSConnected | FSComplete | FSCancelled deriving (Eq, Ord, Show)
 
 instance FromField FileStatus where fromField = fromTextField_ fileStatusT
 

src/Simplex/Chat/View.hs

@@ -25,11 +25,14 @@ module Simplex.Chat.View
     showSentMessage,
     showSentGroupMessage,
     showSentFileInvitation,
+    showSentGroupFileInvitation,
+    showSentFileInfo,
     showSndFileStart,
     showSndFileComplete,
     showSndFileCancelled,
+    showSndGroupFileCancelled,
     showSndFileRcvCancelled,
-    showReceivedFileInvitation,
+    receivedFileInvitation,
     showRcvFileAccepted,
     showRcvFileStart,
     showRcvFileComplete,
@@ -58,6 +61,7 @@ module Simplex.Chat.View
     showContactUpdated,
     showMessageError,
     safeDecodeUtf8,
+    msgPlain,
   )
 where
 
@@ -65,7 +69,9 @@ import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)
 import Data.Composition ((.:), (.:.))
+import Data.Function (on)
 import Data.Int (Int64)
+import Data.List (groupBy, intersperse, sortOn)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (DiffTime, UTCTime)
@@ -123,13 +129,13 @@ showGroupRemoved = printToView . groupRemoved
 showMemberSubError :: ChatReader m => GroupName -> ContactName -> ChatError -> m ()
 showMemberSubError = printToView .:. memberSubError
 
-showReceivedMessage :: ChatReader m => ContactName -> UTCTime -> Text -> MsgIntegrity -> m ()
+showReceivedMessage :: ChatReader m => ContactName -> UTCTime -> [StyledString] -> MsgIntegrity -> m ()
 showReceivedMessage = showReceivedMessage_ . ttyFromContact
 
-showReceivedGroupMessage :: ChatReader m => GroupName -> ContactName -> UTCTime -> Text -> MsgIntegrity -> m ()
+showReceivedGroupMessage :: ChatReader m => GroupName -> ContactName -> UTCTime -> [StyledString] -> MsgIntegrity -> m ()
 showReceivedGroupMessage = showReceivedMessage_ .: ttyFromGroup
 
-showReceivedMessage_ :: ChatReader m => StyledString -> UTCTime -> Text -> MsgIntegrity -> m ()
+showReceivedMessage_ :: ChatReader m => StyledString -> UTCTime -> [StyledString] -> MsgIntegrity -> m ()
 showReceivedMessage_ from utcTime msg mOk = printToView =<< liftIO (receivedMessage from utcTime msg mOk)
 
 showSentMessage :: ChatReader m => ContactName -> ByteString -> m ()
@@ -141,37 +147,46 @@ showSentGroupMessage = showSentMessage_ . ttyToGroup
 showSentMessage_ :: ChatReader m => StyledString -> ByteString -> m ()
 showSentMessage_ to msg = printToView =<< liftIO (sentMessage to msg)
 
-showSentFileInvitation :: ChatReader m => ContactName -> SndFileTransfer -> m ()
+showSentFileInvitation :: ChatReader m => ContactName -> FilePath -> m ()
-showSentFileInvitation = printToView .: sentFileInvitation
+showSentFileInvitation = showSentFileInvitation_ . ttyToContact
 
-showSndFileStart :: ChatReader m => Int64 -> m ()
+showSentGroupFileInvitation :: ChatReader m => GroupName -> FilePath -> m ()
+showSentGroupFileInvitation = showSentFileInvitation_ . ttyToGroup
+
+showSentFileInvitation_ :: ChatReader m => StyledString -> FilePath -> m ()
+showSentFileInvitation_ to filePath = printToView =<< liftIO (sentFileInvitation to filePath)
+
+showSentFileInfo :: ChatReader m => Int64 -> m ()
+showSentFileInfo = printToView . sentFileInfo
+
+showSndFileStart :: ChatReader m => SndFileTransfer -> m ()
 showSndFileStart = printToView . sndFileStart
 
-showSndFileComplete :: ChatReader m => Int64 -> m ()
+showSndFileComplete :: ChatReader m => SndFileTransfer -> m ()
 showSndFileComplete = printToView . sndFileComplete
 
-showSndFileCancelled :: ChatReader m => Int64 -> m ()
+showSndFileCancelled :: ChatReader m => SndFileTransfer -> m ()
 showSndFileCancelled = printToView . sndFileCancelled
 
-showSndFileRcvCancelled :: ChatReader m => Int64 -> m ()
+showSndGroupFileCancelled :: ChatReader m => [SndFileTransfer] -> m ()
+showSndGroupFileCancelled = printToView . sndGroupFileCancelled
+
+showSndFileRcvCancelled :: ChatReader m => SndFileTransfer -> m ()
 showSndFileRcvCancelled = printToView . sndFileRcvCancelled
 
-showReceivedFileInvitation :: ChatReader m => ContactName -> RcvFileTransfer -> m ()
+showRcvFileAccepted :: ChatReader m => RcvFileTransfer -> FilePath -> m ()
-showReceivedFileInvitation = printToView .: receivedFileInvitation
-
-showRcvFileAccepted :: ChatReader m => Int64 -> FilePath -> m ()
 showRcvFileAccepted = printToView .: rcvFileAccepted
 
-showRcvFileStart :: ChatReader m => Int64 -> m ()
+showRcvFileStart :: ChatReader m => RcvFileTransfer -> m ()
 showRcvFileStart = printToView . rcvFileStart
 
-showRcvFileComplete :: ChatReader m => Int64 -> m ()
+showRcvFileComplete :: ChatReader m => RcvFileTransfer -> m ()
 showRcvFileComplete = printToView . rcvFileComplete
 
-showRcvFileCancelled :: ChatReader m => Int64 -> m ()
+showRcvFileCancelled :: ChatReader m => RcvFileTransfer -> m ()
 showRcvFileCancelled = printToView . rcvFileCancelled
 
-showRcvFileSndCancelled :: ChatReader m => Int64 -> m ()
+showRcvFileSndCancelled :: ChatReader m => RcvFileTransfer -> m ()
 showRcvFileSndCancelled = printToView . rcvFileSndCancelled
 
 showFileTransferStatus :: ChatReader m => (FileTransfer, [Integer]) -> m ()
@@ -409,10 +424,10 @@ contactUpdated
 messageError :: Text -> Text -> [StyledString]
 messageError prefix err = [plain prefix <> ": " <> plain err]
 
-receivedMessage :: StyledString -> UTCTime -> Text -> MsgIntegrity -> IO [StyledString]
+receivedMessage :: StyledString -> UTCTime -> [StyledString] -> MsgIntegrity -> IO [StyledString]
 receivedMessage from utcTime msg mOk = do
   t <- formatUTCTime <$> getCurrentTimeZone <*> getZonedTime
-  pure $ prependFirst (t <> " " <> from) (msgPlain msg) ++ showIntegrity mOk
+  pure $ prependFirst (t <> " " <> from) msg ++ showIntegrity mOk
   where
     formatUTCTime :: TimeZone -> ZonedTime -> StyledString
     formatUTCTime localTz currentTime =
@@ -436,9 +451,15 @@ receivedMessage from utcTime msg mOk = do
     msgError s = [styled (Colored Red) s]
 
 sentMessage :: StyledString -> ByteString -> IO [StyledString]
-sentMessage to msg = do
+sentMessage to msg = sendWithTime_ to . msgPlain $ safeDecodeUtf8 msg
+
+sentFileInvitation :: StyledString -> FilePath -> IO [StyledString]
+sentFileInvitation to f = sendWithTime_ ("/f " <> to) [ttyFilePath f]
+
+sendWithTime_ :: StyledString -> [StyledString] -> IO [StyledString]
+sendWithTime_ to styledMsg = do
   time <- formatTime defaultTimeLocale "%H:%M" <$> getZonedTime
-  pure $ prependFirst (styleTime time <> " " <> to) (msgPlain $ safeDecodeUtf8 msg)
+  pure $ prependFirst (styleTime time <> " " <> to) styledMsg
 
 prependFirst :: StyledString -> [StyledString] -> [StyledString]
 prependFirst s [] = [s]
@@ -447,27 +468,39 @@ prependFirst s (s' : ss) = (s <> s') : ss
 msgPlain :: Text -> [StyledString]
 msgPlain = map styleMarkdownText . T.lines
 
-sentFileInvitation :: ContactName -> SndFileTransfer -> [StyledString]
+sentFileInfo :: Int64 -> [StyledString]
-sentFileInvitation cName SndFileTransfer {fileId, fileName} =
+sentFileInfo fileId =
-  [ "offered to send the file " <> plain fileName <> " to " <> ttyContact cName,
+  ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"]
-    "use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"
-  ]
 
-sndFileStart :: Int64 -> [StyledString]
+sndFileStart :: SndFileTransfer -> [StyledString]
-sndFileStart fileId = ["started sending the file " <> sShow fileId]
+sndFileStart = sendingFile_ "started"
 
-sndFileComplete :: Int64 -> [StyledString]
+sndFileComplete :: SndFileTransfer -> [StyledString]
-sndFileComplete fileId = ["completed sending the file " <> sShow fileId]
+sndFileComplete = sendingFile_ "completed"
 
-sndFileCancelled :: Int64 -> [StyledString]
+sndFileCancelled :: SndFileTransfer -> [StyledString]
-sndFileCancelled fileId = ["cancelled sending the file " <> sShow fileId]
+sndFileCancelled = sendingFile_ "cancelled"
 
-sndFileRcvCancelled :: Int64 -> [StyledString]
+sndGroupFileCancelled :: [SndFileTransfer] -> [StyledString]
-sndFileRcvCancelled fileId = ["recipient cancelled receiving the file " <> sShow fileId]
+sndGroupFileCancelled fts =
+  case filter (\SndFileTransfer {fileStatus = s} -> s /= FSCancelled && s /= FSComplete) fts of
+    [] -> ["sending file can't be cancelled"]
+    ts@(ft : _) -> ["cancelled sending " <> sndFile ft <> " to " <> listMembers ts]
 
-receivedFileInvitation :: ContactName -> RcvFileTransfer -> [StyledString]
+sendingFile_ :: StyledString -> SndFileTransfer -> [StyledString]
-receivedFileInvitation c RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} =
+sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
-  [ ttyContact c <> " wants to send you the file " <> plain fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
+  [status <> " sending " <> sndFile ft <> " to " <> ttyContact c]
+
+sndFileRcvCancelled :: SndFileTransfer -> [StyledString]
+sndFileRcvCancelled ft@SndFileTransfer {recipientDisplayName = c} =
+  [ttyContact c <> " cancelled receiving " <> sndFile ft]
+
+sndFile :: SndFileTransfer -> StyledString
+sndFile SndFileTransfer {fileId, fileName} = fileTransfer fileId fileName
+
+receivedFileInvitation :: RcvFileTransfer -> [StyledString]
+receivedFileInvitation RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} =
+  [ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
     "use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
   ]
 
@@ -483,41 +516,71 @@ humanReadableSize size
     mB = kB * 1024
     gB = mB * 1024
 
-rcvFileAccepted :: Int64 -> FilePath -> [StyledString]
+rcvFileAccepted :: RcvFileTransfer -> FilePath -> [StyledString]
-rcvFileAccepted fileId filePath = ["saving file " <> sShow fileId <> " to " <> plain filePath]
+rcvFileAccepted RcvFileTransfer {fileId, senderDisplayName = c} filePath =
+  ["saving file " <> sShow fileId <> " from " <> ttyContact c <> " to " <> plain filePath]
 
-rcvFileStart :: Int64 -> [StyledString]
+rcvFileStart :: RcvFileTransfer -> [StyledString]
-rcvFileStart fileId = ["started receiving the file " <> sShow fileId]
+rcvFileStart = receivingFile_ "started"
 
-rcvFileComplete :: Int64 -> [StyledString]
+rcvFileComplete :: RcvFileTransfer -> [StyledString]
-rcvFileComplete fileId = ["completed receiving the file " <> sShow fileId]
+rcvFileComplete = receivingFile_ "completed"
 
-rcvFileCancelled :: Int64 -> [StyledString]
+rcvFileCancelled :: RcvFileTransfer -> [StyledString]
-rcvFileCancelled fileId = ["cancelled receiving the file " <> sShow fileId]
+rcvFileCancelled = receivingFile_ "cancelled"
 
-rcvFileSndCancelled :: Int64 -> [StyledString]
+receivingFile_ :: StyledString -> RcvFileTransfer -> [StyledString]
-rcvFileSndCancelled fileId = ["sender cancelled sending the file " <> sShow fileId]
+receivingFile_ status ft@RcvFileTransfer {senderDisplayName = c} =
+  [status <> " receiving " <> rcvFile ft <> " from " <> ttyContact c]
+
+rcvFileSndCancelled :: RcvFileTransfer -> [StyledString]
+rcvFileSndCancelled ft@RcvFileTransfer {senderDisplayName = c} =
+  [ttyContact c <> " cancelled sending " <> rcvFile ft]
+
+rcvFile :: RcvFileTransfer -> StyledString
+rcvFile RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} = fileTransfer fileId fileName
+
+fileTransfer :: Int64 -> String -> StyledString
+fileTransfer fileId fileName = "file " <> sShow fileId <> " (" <> ttyFilePath fileName <> ")"
 
 fileTransferStatus :: (FileTransfer, [Integer]) -> [StyledString]
-fileTransferStatus (FTSnd [SndFileTransfer {fileStatus, fileSize, chunkSize}], chunksNum) =
+fileTransferStatus (FTSnd [ft@SndFileTransfer {fileStatus, fileSize, chunkSize}], chunksNum) =
-  ["sent file transfer " <> sndStatus]
+  ["sending " <> sndFile ft <> " " <> sndStatus]
   where
     sndStatus = case fileStatus of
-      FSNew -> "is not accepted yet"
+      FSNew -> "not accepted yet"
       FSAccepted -> "just started"
-      FSConnected -> "progress: " <> fileProgress chunksNum chunkSize fileSize
+      FSConnected -> "progress " <> fileProgress chunksNum chunkSize fileSize
-      FSComplete -> "is complete"
+      FSComplete -> "complete"
-      FSCancelled -> "is cancelled"
+      FSCancelled -> "cancelled"
-fileTransferStatus (FTSnd _fts, _chunks) = [] -- TODO group transfer
+fileTransferStatus (FTSnd [], _) = ["no file transfers (empty group)"]
-fileTransferStatus (FTRcv RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileSize}, fileStatus, chunkSize}, chunksNum) =
+fileTransferStatus (FTSnd fts@(ft : _), chunksNum) =
-  ["received file transfer " <> rcvStatus]
+  case concatMap membersTransferStatus $ groupBy ((==) `on` fs) $ sortOn fs fts of
+    [membersStatus] -> ["sending " <> sndFile ft <> " " <> membersStatus]
+    membersStatuses -> ("sending " <> sndFile ft <> ": ") : map ("  " <>) membersStatuses
+  where
+    fs = fileStatus :: SndFileTransfer -> FileStatus
+    membersTransferStatus [] = []
+    membersTransferStatus ts@(SndFileTransfer {fileStatus, fileSize, chunkSize} : _) = [sndStatus <> ": " <> listMembers ts]
+      where
+        sndStatus = case fileStatus of
+          FSNew -> "not accepted"
+          FSAccepted -> "just started"
+          FSConnected -> "in progress (" <> sShow (sum chunksNum * chunkSize * 100 `div` (toInteger (length chunksNum) * fileSize)) <> "%)"
+          FSComplete -> "complete"
+          FSCancelled -> "cancelled"
+fileTransferStatus (FTRcv ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileSize}, fileStatus, chunkSize}, chunksNum) =
+  ["receiving " <> rcvFile ft <> " " <> rcvStatus]
   where
     rcvStatus = case fileStatus of
-      RFSNew -> "is not accepted yet, use " <> highlight ("/fr " <> show fileId) <> " to receive file"
+      RFSNew -> "not accepted yet, use " <> highlight ("/fr " <> show fileId) <> " to receive file"
       RFSAccepted _ -> "just started"
-      RFSConnected _ -> "progress: " <> fileProgress chunksNum chunkSize fileSize
+      RFSConnected _ -> "progress " <> fileProgress chunksNum chunkSize fileSize
-      RFSComplete RcvFileInfo {filePath} -> "is complete, path: " <> plain filePath
+      RFSComplete RcvFileInfo {filePath} -> "complete, path: " <> plain filePath
-      RFSCancelled RcvFileInfo {filePath} -> "is cancelled, received part path: " <> plain filePath
+      RFSCancelled RcvFileInfo {filePath} -> "cancelled, received part path: " <> plain filePath
+
+listMembers :: [SndFileTransfer] -> StyledString
+listMembers = mconcat . intersperse ", " . map (ttyContact . recipientDisplayName)
 
 fileProgress :: [Integer] -> Integer -> Integer -> StyledString
 fileProgress chunksNum chunkSize fileSize =
@@ -606,6 +669,9 @@ ttyFromGroup g c = styled (Colored Yellow) $ "#" <> g <> " " <> c <> "> "
 ttyToGroup :: GroupName -> StyledString
 ttyToGroup g = styled (Colored Cyan) $ "#" <> g <> " "
 
+ttyFilePath :: FilePath -> StyledString
+ttyFilePath = plain
+
 optFullName :: ContactName -> Text -> StyledString
 optFullName localDisplayName fullName
   | T.null fullName || localDisplayName == fullName = ""

stack.yaml

@@ -43,7 +43,7 @@ extra-deps:
   # - simplexmq-0.3.1@sha256:f247aaff3c16c5d3974a4ab4d5882ab50ac78073110997c0bceb05a74d10a325,6688
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 2ac903a2dd37c11a8612b19cd132cf43fe771fe4
+    commit: e07bedac0e59346f076d71635ce6cd25de67ca7e
 #
 # extra-deps: []
 

tests/ChatTests.hs

@@ -44,6 +44,7 @@ chatTests = do
     it "send and receive file" testFileTransfer
     it "sender cancelled file transfer" testFileSndCancel
     it "recipient cancelled file transfer" testFileRcvCancel
+    it "send and receive file to group" testGroupFileTransfer
 
 testAddContact :: IO ()
 testAddContact =
@@ -410,10 +411,10 @@ testFileTransfer =
       concurrentlyN_
         [ do
             bob #> "@alice receiving here..."
-            bob <## "completed receiving the file 1",
+            bob <## "completed receiving file 1 (test.jpg) from alice",
           do
             alice <# "bob> receiving here..."
-            alice <## "completed sending the file 1"
+            alice <## "completed sending file 1 (test.jpg) to bob"
         ]
       src <- B.readFile "./tests/fixtures/test.jpg"
       dest <- B.readFile "./tests/tmp/test.jpg"
@@ -428,13 +429,13 @@ testFileSndCancel =
       alice ##> "/fc 1"
       concurrentlyN_
         [ do
-            alice <## "cancelled sending the file 1"
+            alice <## "cancelled sending file 1 (test.jpg) to bob"
             alice ##> "/fs 1"
-            alice <## "sent file transfer is cancelled",
+            alice <## "sending file 1 (test.jpg) cancelled",
           do
-            bob <## "sender cancelled sending the file 1"
+            bob <## "alice cancelled sending file 1 (test.jpg)"
             bob ##> "/fs 1"
-            bob <## "received file transfer is cancelled, received part path: ./tests/tmp/test.jpg"
+            bob <## "receiving file 1 (test.jpg) cancelled, received part path: ./tests/tmp/test.jpg"
         ]
       checkPartialTransfer
 
@@ -445,35 +446,77 @@ testFileRcvCancel =
       connectUsers alice bob
       startFileTransfer alice bob
       bob ##> "/fs 1"
-      getTermLine bob >>= (`shouldStartWith` "received file transfer progress:")
+      getTermLine bob >>= (`shouldStartWith` "receiving file 1 (test.jpg) progress")
       waitFileExists "./tests/tmp/test.jpg"
       bob ##> "/fc 1"
       concurrentlyN_
         [ do
-            bob <## "cancelled receiving the file 1"
+            bob <## "cancelled receiving file 1 (test.jpg) from alice"
             bob ##> "/fs 1"
-            bob <## "received file transfer is cancelled, received part path: ./tests/tmp/test.jpg",
+            bob <## "receiving file 1 (test.jpg) cancelled, received part path: ./tests/tmp/test.jpg",
           do
-            alice <## "recipient cancelled receiving the file 1"
+            alice <## "bob cancelled receiving file 1 (test.jpg)"
             alice ##> "/fs 1"
-            alice <## "sent file transfer is cancelled"
+            alice <## "sending file 1 (test.jpg) cancelled"
         ]
       checkPartialTransfer
   where
     waitFileExists f = unlessM (doesFileExist f) $ waitFileExists f
 
+testGroupFileTransfer :: IO ()
+testGroupFileTransfer =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup3 "team" alice bob cath
+      alice #> "/f #team ./tests/fixtures/test.jpg"
+      alice <## "use /fc 1 to cancel sending"
+      concurrentlyN_
+        [ do
+            bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
+            bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
+          do
+            cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
+            cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
+        ]
+      alice ##> "/fs 1"
+      getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg) not accepted")
+      bob ##> "/fr 1 ./tests/tmp/"
+      bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
+      concurrentlyN_
+        [ do
+            alice <## "started sending file 1 (test.jpg) to bob"
+            alice <## "completed sending file 1 (test.jpg) to bob"
+            alice ##> "/fs 1"
+            alice <## "sending file 1 (test.jpg):"
+            alice <### ["  complete: bob", "  not accepted: cath"],
+          do
+            bob <## "started receiving file 1 (test.jpg) from alice"
+            bob <## "completed receiving file 1 (test.jpg) from alice"
+        ]
+      cath ##> "/fr 1 ./tests/tmp/"
+      cath <## "saving file 1 from alice to ./tests/tmp/test_1.jpg"
+      concurrentlyN_
+        [ do
+            alice <## "started sending file 1 (test.jpg) to cath"
+            alice <## "completed sending file 1 (test.jpg) to cath"
+            alice ##> "/fs 1"
+            getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg) complete"),
+          do
+            cath <## "started receiving file 1 (test.jpg) from alice"
+            cath <## "completed receiving file 1 (test.jpg) from alice"
+        ]
+
 startFileTransfer :: TestCC -> TestCC -> IO ()
 startFileTransfer alice bob = do
-  alice ##> "/f bob ./tests/fixtures/test.jpg"
+  alice #> "/f @bob ./tests/fixtures/test.jpg"
-  alice <## "offered to send the file test.jpg to bob"
   alice <## "use /fc 1 to cancel sending"
-  bob <## "alice wants to send you the file test.jpg (136.5 KiB / 139737 bytes)"
+  bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
   bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
   bob ##> "/fr 1 ./tests/tmp"
-  bob <## "saving file 1 to ./tests/tmp/test.jpg"
+  bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
   concurrently_
-    (bob <## "started receiving the file 1")
+    (bob <## "started receiving file 1 (test.jpg) from alice")
-    (alice <## "started sending the file 1")
+    (alice <## "started sending file 1 (test.jpg) to bob")
 
 checkPartialTransfer :: IO ()
 checkPartialTransfer = do