dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-12 17:25:19 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into master-ghc8107

Browse Source
This commit is contained in:
Evgeny Poberezkin
2023-10-15 18:53:23 +01:00
parent 7692195bfa e6b0983c3e
commit d8fb31f167
30 changed files with 995 additions and 339 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/View.hs
+34 -25
View File
@@ -18,7 +18,7 @@ import Data.Char (isSpace, toUpper)
import Data.Function (on)
import Data.Int (Int64)
import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
@@ -165,7 +165,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRRcvFileDescrReady _ _ -> []
CRRcvFileDescrNotReady _ _ -> []
CRRcvFileProgressXFTP {} -> []
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' testView ci
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts
CRRcvFileCancelled u _ ft -> ttyUser u $ receivingFile_ "cancelled" ft
@@ -177,10 +177,10 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
CRContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
CRRcvFileStart u ci -> ttyUser u $ receivingFile_' "started" ci
CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' "completed" ci
CRRcvFileStart u ci -> ttyUser u $ receivingFile_' testView "started" ci
CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' testView "completed" ci
CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
CRRcvFileError u ci e -> ttyUser u $ receivingFile_' "error" ci <> [sShow e]
CRRcvFileError u ci e -> ttyUser u $ receivingFile_' testView "error" ci <> [sShow e]
CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
CRSndFileStartXFTP {} -> []
@@ -209,6 +209,8 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
(addresses, groupLinks) = partition (\UserContactSubStatus {userContact} -> isNothing . userContactGroupId $ userContact) summary
addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError
(groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
CRNetworkStatus status conns -> if testView then [plain $ show (length conns) <> " connections " <> netStatusStr status] else []
CRNetworkStatuses u statuses -> if testView then ttyUser' u $ viewNetworkStatuses statuses else []
CRGroupInvitation u g -> ttyUser u [groupInvitation' g]
CRReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g c r
CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
@@ -797,6 +799,12 @@ viewDirectMessagesProhibited :: MsgDirection -> Contact -> [StyledString]
viewDirectMessagesProhibited MDSnd c = ["direct messages to indirect contact " <> ttyContact' c <> " are prohibited"]
viewDirectMessagesProhibited MDRcv c = ["received prohibited direct message from indirect contact " <> ttyContact' c <> " (discarded)"]
viewNetworkStatuses :: [ConnNetworkStatus] -> [StyledString]
viewNetworkStatuses = map viewStatuses . L.groupBy ((==) `on` netStatus) . sortOn netStatus
where
netStatus ConnNetworkStatus {networkStatus} = networkStatus
viewStatuses ss@(s :| _) = plain $ show (L.length ss) <> " connections " <> netStatusStr (netStatus s)
viewUserJoinedGroup :: GroupInfo -> [StyledString]
viewUserJoinedGroup g =
case incognitoMembershipProfile g of
@@ -1438,27 +1446,28 @@ humanReadableSize size
mB = kB * 1024
gB = mB * 1024
savingFile' :: Bool -> AChatItem -> [StyledString]
savingFile' testView (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource = Just (CryptoFile filePath cfArgs_)}, chatDir}) =
let from = case (chat, chatDir) of
(DirectChat Contact {localDisplayName = c}, CIDirectRcv) -> " from " <> ttyContact c
(_, CIGroupRcv GroupMember {localDisplayName = m}) -> " from " <> ttyContact m
_ -> ""
in ["saving file " <> sShow fileId <> from <> " to " <> plain filePath] <> cfArgsStr
where
cfArgsStr = case cfArgs_ of
Just cfArgs@(CFArgs key nonce)
| testView -> [plain $ LB.unpack $ J.encode cfArgs]
| otherwise -> [plain $ "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce]
_ -> []
savingFile' _ _ = ["saving file"] -- shouldn't happen
savingFile' :: AChatItem -> [StyledString]
savingFile' (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource = Just (CryptoFile filePath _)}, chatDir}) =
["saving file " <> sShow fileId <> fileFrom chat chatDir <> " to " <> plain filePath]
savingFile' _ = ["saving file"] -- shouldn't happen
receivingFile_' :: StyledString -> AChatItem -> [StyledString]
receivingFile_' status (AChatItem _ _ (DirectChat c) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectRcv}) =
[status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact' c]
receivingFile_' status (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupRcv m}) =
[status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyMember m]
receivingFile_' status _ = [status <> " receiving file"] -- shouldn't happen
receivingFile_' :: Bool -> String -> AChatItem -> [StyledString]
receivingFile_' testView status (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileName, fileSource = Just (CryptoFile _ cfArgs_)}, chatDir}) =
[plain status <> " receiving " <> fileTransferStr fileId fileName <> fileFrom chat chatDir] <> cfArgsStr cfArgs_
where
cfArgsStr (Just cfArgs@(CFArgs key nonce)) = [plain s | status == "completed"]
where
s =
if testView
then LB.toStrict $ J.encode cfArgs
else "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce
cfArgsStr _ = []
receivingFile_' _ status _ = [plain status <> " receiving file"] -- shouldn't happen
fileFrom :: ChatInfo c -> CIDirection c d -> StyledString
fileFrom (DirectChat ct) CIDirectRcv = " from " <> ttyContact' ct
fileFrom _ (CIGroupRcv m) = " from " <> ttyMember m
fileFrom _ _ = ""
receivingFile_ :: StyledString -> RcvFileTransfer -> [StyledString]
receivingFile_ status ft@RcvFileTransfer {senderDisplayName = c} =