ui: show XFTP servers used for a file in message info (#7088)

Surface the XFTP servers that hosted a file's chunks in the message info
screen (Android, desktop, iOS), so a user can see which servers they are
downloading from (or, for sent files, uploading to) whenever they want to know.

APIGetChatItemInfo now returns fileXftpServers, derived from the stored file
description (private snd descr for sent items, rcv descr for received items);
extraction is best-effort and never fails the call.

src/Simplex/Chat/Library/Commands.hs

@@ -693,7 +693,8 @@ processChatCommand cxt nm = \case
       (SCTGroup, SMDSnd) -> L.nonEmpty <$> withFastStore' (`getGroupSndStatuses` itemId)
       _ -> pure Nothing
     forwardedFromChatItem <- getForwardedFromItem user ci
-    pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses, forwardedFromChatItem}
+    fileXftpServers <- getChatItemFileServers user dir ci
+    pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses, forwardedFromChatItem, fileXftpServers}
     where
       getForwardedFromItem :: User -> ChatItem c d -> CM (Maybe AChatItem)
       getForwardedFromItem user ChatItem {meta = CIMeta {itemForwarded}} = case itemForwarded of

src/Simplex/Chat/Library/Internal.hs

@@ -764,7 +764,7 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
     if userApprovedRelays
       then receive' rd True
       else do
-        let srvs = fileServers rd
+        let srvs = fileDescrServers rd
         unknownSrvs <- getUnknownSrvs srvs
         let approved = null unknownSrvs
         ifM
@@ -777,9 +777,6 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
       aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs approved
       startReceivingFile user fileId
       withStore' $ \db -> updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId)
-    fileServers :: ValidFileDescription 'FRecipient -> [XFTPServer]
-    fileServers (FD.ValidFileDescription FD.FileDescription {chunks}) =
-      S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks
     getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer]
     getUnknownSrvs srvs = do
       knownSrvs <- L.map protoServer' <$> getKnownAgentServers SPXFTP user
@@ -1747,6 +1744,30 @@ parseFileDescription :: FilePartyI p => Text -> CM (ValidFileDescription p)
 parseFileDescription =
   liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8)
 
+-- | Unique XFTP servers hosting the file's chunks, parsed from a stored file description.
+fileDescrServers :: ValidFileDescription p -> [XFTPServer]
+fileDescrServers (FD.ValidFileDescription FD.FileDescription {chunks}) =
+  S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks
+
+-- | XFTP servers the file's data chunks were uploaded to (sender's servers for sent items,
+-- the same servers via the recipient description for received items).
+-- Returns [] for non-XFTP/inline files or when no description is available; never fails the caller.
+getChatItemFileServers :: User -> SMsgDirection d -> ChatItem c d -> CM [XFTPServer]
+getChatItemFileServers user dir ci = case ci of
+  ChatItem {file = Just CIFile {fileId, fileProtocol = FPXFTP}} ->
+    itemFileServers fileId `catchAllErrors` \_ -> pure []
+  _ -> pure []
+  where
+    itemFileServers fileId = case dir of
+      SMDSnd -> do
+        sfd_ <- withStore' $ \db -> getSndFTPrivateSndDescr db user fileId
+        case sfd_ of
+          Just sfdText -> fileDescrServers <$> (parseFileDescription sfdText :: CM (ValidFileDescription 'FSender))
+          Nothing -> pure []
+      SMDRcv -> do
+        RcvFileDescr {fileDescrText} <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
+        fileDescrServers <$> (parseFileDescription fileDescrText :: CM (ValidFileDescription 'FRecipient))
+
 sendDirectFileInline :: User -> Contact -> FileTransferMeta -> SharedMsgId -> CM ()
 sendDirectFileInline user ct ft sharedMsgId = do
   msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage user ct

src/Simplex/Chat/Messages.hs

@@ -55,7 +55,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, sumTypeJSON)
-import Simplex.Messaging.Protocol (BlockingInfo, MsgBody)
+import Simplex.Messaging.Protocol (BlockingInfo, MsgBody, XFTPServer)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 
 data ChatType = CTDirect | CTGroup | CTLocal | CTContactRequest | CTContactConnection
@@ -1345,7 +1345,8 @@ instance TextEncoding CIForwardedFromTag where
 data ChatItemInfo = ChatItemInfo
   { itemVersions :: [ChatItemVersion],
     memberDeliveryStatuses :: Maybe (NonEmpty MemberDeliveryStatus),
-    forwardedFromChatItem :: Maybe AChatItem
+    forwardedFromChatItem :: Maybe AChatItem,
+    fileXftpServers :: [XFTPServer]
   }
   deriving (Show)
 

src/Simplex/Chat/Store/Files.hs

@@ -20,6 +20,7 @@ module Simplex.Chat.Store.Files
     createSndFileTransferXFTP,
     createSndFTDescrXFTP,
     setSndFTPrivateSndDescr,
+    getSndFTPrivateSndDescr,
     updateSndFTDescrXFTP,
     createExtraSndFTDescrs,
     updateSndFTDeliveryXFTP,
@@ -210,6 +211,15 @@ setSndFTPrivateSndDescr db User {userId} fileId sfdText = do
     "UPDATE files SET private_snd_file_descr = ?, updated_at = ? WHERE user_id = ? AND file_id = ?"
     (sfdText, currentTs, userId, fileId)
 
+getSndFTPrivateSndDescr :: DB.Connection -> User -> FileTransferId -> IO (Maybe Text)
+getSndFTPrivateSndDescr db User {userId} fileId =
+  fmap (maybe Nothing fromOnly) $
+    maybeFirstRow id $
+      DB.query
+        db
+        "SELECT private_snd_file_descr FROM files WHERE user_id = ? AND file_id = ?"
+        (userId, fileId)
+
 updateSndFTDescrXFTP :: DB.Connection -> User -> SndFileTransfer -> Text -> IO ()
 updateSndFTDescrXFTP db user@User {userId} sft@SndFileTransfer {fileId, fileDescrId} rfdText = do
   currentTs <- getCurrentTime