blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into ab/self-chat

Browse Source
This commit is contained in:
IC Rainbow
2024-01-02 14:56:50 +02:00
parent d49a7ff784 c9b1d54f13
commit 4eebb4e746
189 changed files with 9827 additions and 5620 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Messages.hs
+3 -2
View File
@@ -5,7 +5,6 @@
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
@@ -372,7 +371,9 @@ contactTimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessag
| forUser enabled && forContact enabled = Just ttl
| otherwise = Nothing
where
TimedMessagesPreference {ttl} = userPreference.preference
TimedMessagesPreference {ttl} = case userPreference of
CUPContact {preference} -> preference
CUPUser {preference} -> preference
groupTimedTTL :: GroupInfo -> Maybe (Maybe Int)
groupTimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}}
src/Simplex/Chat/Messages/Batch.hs
-1
View File
@@ -16,7 +16,6 @@ import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
import Simplex.Chat.Messages
data MsgBatch = MsgBatch Builder [SndMessage]
deriving (Show)
-- | Batches [SndMessage] into batches of ByteString builders in form of JSON arrays.
-- Does not check if the resulting batch is a valid JSON.
src/Simplex/Chat/Mobile/Shared.hs
+3 -3
View File
@@ -16,12 +16,12 @@ type JSONByteString = LB.ByteString
getByteString :: Ptr Word8 -> CInt -> IO ByteString
getByteString ptr len = do
fp <- newForeignPtr_ ptr
pure $ BS fp $ fromIntegral len
pure $ PS fp 0 (fromIntegral len)
{-# INLINE getByteString #-}
putByteString :: Ptr Word8 -> ByteString -> IO ()
putByteString ptr (BS fp len) =
withForeignPtr fp $ \p -> memcpy ptr p len
putByteString ptr (PS fp offset len) =
withForeignPtr fp $ \p -> memcpy ptr (p `plusPtr` offset) len
{-# INLINE putByteString #-}
putLazyByteString :: Ptr Word8 -> LB.ByteString -> IO ()
src/Simplex/Chat/Protocol.hs
+5 -1
View File
@@ -56,7 +56,7 @@ import Simplex.Messaging.Version hiding (version)
-- This indirection is needed for backward/forward compatibility testing.
-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
currentChatVersion :: Version
currentChatVersion = 5
currentChatVersion = 6
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
supportedChatVRange :: VersionRange
@@ -82,6 +82,10 @@ groupForwardVRange = mkVersionRange 4 currentChatVersion
batchSendVRange :: VersionRange
batchSendVRange = mkVersionRange 5 currentChatVersion
-- version range that supports sending group welcome message in group history
groupHistoryIncludeWelcomeVRange :: VersionRange
groupHistoryIncludeWelcomeVRange = mkVersionRange 6 currentChatVersion
data ConnectionEntity
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
src/Simplex/Chat/Store/Direct.hs
+1 -2
View File
@@ -2,7 +2,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -490,7 +489,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
ExceptT $
maybeM getContactRequestByXContactId xContactId_ >>= \case
Nothing -> createContactRequest
Just cr -> updateContactRequest cr $> Right cr.contactRequestId
Just cr@UserContactRequest {contactRequestId} -> updateContactRequest cr $> Right contactRequestId
getContactRequest db user cReqId
createContactRequest :: IO (Either StoreError Int64)
createContactRequest = do
src/Simplex/Chat/Store/Files.hs
+1 -2
View File
@@ -3,7 +3,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -978,7 +977,7 @@ getLocalCryptoFile db userId fileId sent =
[(Just _, Nothing, _)] -> do
unless sent $ throwError $ SEFileNotFound fileId
FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId
pure $ CryptoFile filePath $ xftpSndFile >>= \f -> f.cryptoArgs
pure $ CryptoFile filePath $ xftpSndFile >>= \XFTPSndFile {cryptoArgs} -> cryptoArgs
[(Nothing, Nothing, FPLocal)] -> do
LocalFileMeta {filePath, fileCryptoArgs} <- getLocalFileMeta db userId fileId
pure $ CryptoFile filePath fileCryptoArgs
src/Simplex/Chat/Store/Groups.hs
+4 -5
View File
@@ -2,7 +2,6 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
@@ -320,7 +319,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
-- | creates a new group record for the group the current user was invited to, or returns an existing one
createGroupInvitation :: DB.Connection -> VersionRange -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activeConn = Just hostConn@Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId, peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
liftIO getInvitationGroupId_ >>= \case
Nothing -> createGroupInvitation_
Just gId -> do
@@ -358,7 +357,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
"INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?,?)"
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs)
insertedRowId db
let JVersionRange hostVRange = hostConn.peerChatVRange
let JVersionRange hostVRange = peerChatVRange
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
@@ -1041,7 +1040,7 @@ updateIntroStatus db introId introStatus = do
[":intro_status" := introStatus, ":updated_at" := currentTs, ":intro_id" := introId]
saveIntroInvitation :: DB.Connection -> GroupMember -> GroupMember -> IntroInvitation -> ExceptT StoreError IO GroupMemberIntro
saveIntroInvitation db reMember toMember introInv = do
saveIntroInvitation db reMember toMember introInv@IntroInvitation {groupConnReq} = do
intro <- getIntroduction db reMember toMember
liftIO $ do
currentTs <- getCurrentTime
@@ -1056,7 +1055,7 @@ saveIntroInvitation db reMember toMember introInv = do
WHERE group_member_intro_id = :intro_id
|]
[ ":intro_status" := GMIntroInvReceived,
":group_queue_info" := introInv.groupConnReq,
":group_queue_info" := groupConnReq,
":direct_queue_info" := directConnReq introInv,
":updated_at" := currentTs,
":intro_id" := introId intro
src/Simplex/Chat/Terminal.hs
+28 -13
View File
@@ -1,12 +1,16 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Terminal where
import Control.Exception (handle, throwIO)
import Control.Monad
import qualified Data.ByteArray as BA
import qualified Data.List.NonEmpty as L
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Database.SQLite.Simple (SQLError (..))
import qualified Database.SQLite.Simple as DB
import Simplex.Chat (defaultChatConfig)
@@ -19,7 +23,7 @@ import Simplex.Chat.Terminal.Output
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
import Simplex.Messaging.Client (defaultNetworkConfig)
import Simplex.Messaging.Util (raceAny_)
import System.Exit (exitFailure)
import System.IO (hFlush, hSetEcho, stdin, stdout)
terminalChatConfig :: ChatConfig
terminalChatConfig =
@@ -40,18 +44,29 @@ terminalChatConfig =
}
simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
simplexChatTerminal cfg opts t =
handle checkDBKeyError . simplexChatCore cfg opts $ \u cc -> do
ct <- newChatTerminal t opts
when (firstTime cc) . printToTerminal ct $ chatWelcome u
runChatTerminal ct cc opts
checkDBKeyError :: SQLError -> IO ()
checkDBKeyError e = case sqlError e of
DB.ErrorNotADatabase -> do
putStrLn "Database file is invalid or you passed an incorrect encryption key"
exitFailure
_ -> throwIO e
simplexChatTerminal cfg options t = run options
where
run opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {dbKey}} =
handle checkDBKeyError . simplexChatCore cfg opts $ \u cc -> do
ct <- newChatTerminal t opts
when (firstTime cc) . printToTerminal ct $ chatWelcome u
runChatTerminal ct cc opts
where
checkDBKeyError :: SQLError -> IO ()
checkDBKeyError e = case sqlError e of
DB.ErrorNotADatabase -> do
putStrLn $ "Database file is invalid or " <> if BA.null dbKey then "encrypted." else "you passed an incorrect encryption key."
run =<< getKeyOpts
_ -> throwIO e
getKeyOpts :: IO ChatOpts
getKeyOpts = do
putStr "Enter database encryption key (Ctrl-C to exit):"
hFlush stdout
hSetEcho stdin False
key <- getLine
hSetEcho stdin True
putStrLn ""
pure opts {coreOptions = coreOptions {dbKey = BA.convert $ encodeUtf8 $ T.pack key}}
runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runChatTerminal ct cc opts = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc opts, runInputLoop ct cc]
src/Simplex/Chat/Types.hs
+7 -8
View File
@@ -9,7 +9,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -61,21 +60,21 @@ class IsContact a where
preferences' :: a -> Maybe Preferences
instance IsContact User where
contactId' u = u.userContactId
contactId' User {userContactId} = userContactId
{-# INLINE contactId' #-}
profile' u = u.profile
profile' User {profile} = profile
{-# INLINE profile' #-}
localDisplayName' u = u.localDisplayName
localDisplayName' User {localDisplayName} = localDisplayName
{-# INLINE localDisplayName' #-}
preferences' User {profile = LocalProfile {preferences}} = preferences
{-# INLINE preferences' #-}
instance IsContact Contact where
contactId' c = c.contactId
contactId' Contact {contactId} = contactId
{-# INLINE contactId' #-}
profile' c = c.profile
profile' Contact {profile} = profile
{-# INLINE profile' #-}
localDisplayName' c = c.localDisplayName
localDisplayName' Contact {localDisplayName} = localDisplayName
{-# INLINE localDisplayName' #-}
preferences' Contact {profile = LocalProfile {preferences}} = preferences
{-# INLINE preferences' #-}
@@ -196,7 +195,7 @@ directOrUsed ct@Contact {contactUsed} =
contactDirect ct || contactUsed
anyDirectOrUsed :: Contact -> Bool
anyDirectOrUsed Contact {contactUsed, activeConn} = ((\c -> c.connLevel) <$> activeConn) == Just 0 || contactUsed
anyDirectOrUsed Contact {contactUsed, activeConn} = ((\Connection {connLevel} -> connLevel) <$> activeConn) == Just 0 || contactUsed
contactReady :: Contact -> Bool
contactReady Contact {activeConn} = maybe False connReady activeConn
src/Simplex/Chat/Types/Preferences.hs
+51 -54
View File
@@ -7,7 +7,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
@@ -79,12 +78,12 @@ allChatFeatures =
]
chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f)
chatPrefSel f ps = case f of
SCFTimedMessages -> ps.timedMessages
SCFFullDelete -> ps.fullDelete
SCFReactions -> ps.reactions
SCFVoice -> ps.voice
SCFCalls -> ps.calls
chatPrefSel f Preferences {timedMessages, fullDelete, reactions, voice, calls} = case f of
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
SCFReactions -> reactions
SCFVoice -> voice
SCFCalls -> calls
chatFeature :: SChatFeature f -> ChatFeature
chatFeature = \case
@@ -104,12 +103,12 @@ instance PreferenceI (Maybe Preferences) where
getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs)
instance PreferenceI FullPreferences where
getPreference f ps = case f of
SCFTimedMessages -> ps.timedMessages
SCFFullDelete -> ps.fullDelete
SCFReactions -> ps.reactions
SCFVoice -> ps.voice
SCFCalls -> ps.calls
getPreference f FullPreferences {timedMessages, fullDelete, reactions, voice, calls} = case f of
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
SCFReactions -> reactions
SCFVoice -> voice
SCFCalls -> calls
{-# INLINE getPreference #-}
setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
@@ -184,28 +183,26 @@ groupFeatureAllowed' :: GroupFeatureI f => SGroupFeature f -> FullGroupPreferenc
groupFeatureAllowed' feature prefs =
getField @"enable" (getGroupPreference feature prefs) == FEOn
allGroupFeatureItems :: [AGroupFeature]
allGroupFeatureItems =
allGroupFeatures :: [AGroupFeature]
allGroupFeatures =
[ AGF SGFTimedMessages,
AGF SGFDirectMessages,
AGF SGFFullDelete,
AGF SGFReactions,
AGF SGFVoice,
AGF SGFFiles
AGF SGFFiles,
AGF SGFHistory
]
allGroupFeatures :: [AGroupFeature]
allGroupFeatures = allGroupFeatureItems <> [AGF SGFHistory]
groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
groupPrefSel f ps = case f of
SGFTimedMessages -> ps.timedMessages
SGFDirectMessages -> ps.directMessages
SGFFullDelete -> ps.fullDelete
SGFReactions -> ps.reactions
SGFVoice -> ps.voice
SGFFiles -> ps.files
SGFHistory -> ps.history
groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, history} = case f of
SGFTimedMessages -> timedMessages
SGFDirectMessages -> directMessages
SGFFullDelete -> fullDelete
SGFReactions -> reactions
SGFVoice -> voice
SGFFiles -> files
SGFHistory -> history
toGroupFeature :: SGroupFeature f -> GroupFeature
toGroupFeature = \case
@@ -227,14 +224,14 @@ instance GroupPreferenceI (Maybe GroupPreferences) where
getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
instance GroupPreferenceI FullGroupPreferences where
getGroupPreference f ps = case f of
SGFTimedMessages -> ps.timedMessages
SGFDirectMessages -> ps.directMessages
SGFFullDelete -> ps.fullDelete
SGFReactions -> ps.reactions
SGFVoice -> ps.voice
SGFFiles -> ps.files
SGFHistory -> ps.history
getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, history} = case f of
SGFTimedMessages -> timedMessages
SGFDirectMessages -> directMessages
SGFFullDelete -> fullDelete
SGFReactions -> reactions
SGFVoice -> voice
SGFFiles -> files
SGFHistory -> history
{-# INLINE getGroupPreference #-}
-- collection of optional group preferences
@@ -384,19 +381,19 @@ class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureA
prefParam :: FeaturePreference f -> Maybe Int
instance HasField "allow" TimedMessagesPreference FeatureAllowed where
hasField p = (\allow -> p {allow}, p.allow)
hasField p@TimedMessagesPreference {allow} = (\a -> p {allow = a}, allow)
instance HasField "allow" FullDeletePreference FeatureAllowed where
hasField p = (\allow -> p {allow}, p.allow)
hasField p@FullDeletePreference {allow} = (\a -> p {allow = a}, allow)
instance HasField "allow" ReactionsPreference FeatureAllowed where
hasField p = (\allow -> p {allow}, p.allow)
hasField p@ReactionsPreference {allow} = (\a -> p {allow = a}, allow)
instance HasField "allow" VoicePreference FeatureAllowed where
hasField p = (\allow -> p {allow}, p.allow)
hasField p@VoicePreference {allow} = (\a -> p {allow = a}, allow)
instance HasField "allow" CallsPreference FeatureAllowed where
hasField p = (\allow -> p {allow}, p.allow)
hasField p@CallsPreference {allow} = (\a -> p {allow = a}, allow)
instance FeatureI 'CFTimedMessages where
type FeaturePreference 'CFTimedMessages = TimedMessagesPreference
@@ -463,28 +460,28 @@ class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference
groupPrefParam :: GroupFeaturePreference f -> Maybe Int
instance HasField "enable" GroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
hasField p@GroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" TimedMessagesGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
hasField p@TimedMessagesGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" DirectMessagesGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
hasField p@DirectMessagesGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" ReactionsGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
hasField p@ReactionsGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" FullDeleteGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
hasField p@FullDeleteGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
hasField p@VoiceGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
hasField p@FilesGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
hasField p@HistoryGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance GroupFeatureI 'GFTimedMessages where
type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
@@ -722,12 +719,12 @@ preferenceState pref =
in (allow, param)
getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f)
getContactUserPreference f ps = case f of
SCFTimedMessages -> ps.timedMessages
SCFFullDelete -> ps.fullDelete
SCFReactions -> ps.reactions
SCFVoice -> ps.voice
SCFCalls -> ps.calls
getContactUserPreference f ContactUserPreferences {timedMessages, fullDelete, reactions, voice, calls} = case f of
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
SCFReactions -> reactions
SCFVoice -> voice
SCFCalls -> calls
$(J.deriveJSON (enumJSON $ dropPrefix "CF") ''ChatFeature)
src/Simplex/Chat/View.hs
+7 -6
View File
@@ -3,7 +3,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -213,7 +212,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
CRContactConnecting u _ -> ttyUser u []
CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView
CRContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"]
CRSubscriptionEnd u acEntity -> ttyUser u [sShow ((entityConnection acEntity).connId) <> ": END"]
CRSubscriptionEnd u acEntity ->
let Connection {connId} = entityConnection acEntity
in ttyUser u [sShow connId <> ": END"]
CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactSubError u c e -> ttyUser u [ttyContact' c <> ": contact error " <> sShow e]
@@ -496,7 +497,7 @@ viewGroupSubscribed :: GroupInfo -> [StyledString]
viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"]
showSMPServer :: SMPServer -> String
showSMPServer srv = B.unpack $ strEncode srv.host
showSMPServer ProtocolServer {host} = B.unpack $ strEncode host
viewHostEvent :: AProtocolType -> TransportHost -> String
viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h)
@@ -980,7 +981,7 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt
removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
groupMember m = memIncognito m <> ttyFullMember m <> ": " <> plain (intercalate ", " $ [role m] <> category m <> status m <> muted m)
role :: GroupMember -> String
role m = B.unpack . strEncode $ m.memberRole
role GroupMember {memberRole} = B.unpack $ strEncode memberRole
category m = case memberCategory m of
GCUserMember -> ["you"]
GCInviteeMember -> ["invited"]
@@ -1018,7 +1019,7 @@ viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <nam
viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs
where
ldn_ :: GroupInfo -> Text
ldn_ g = T.toLower g.localDisplayName
ldn_ GroupInfo {localDisplayName} = T.toLower localDisplayName
groupSS (g@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}}, GroupSummary {currentMembers}) =
case memberStatus membership of
GSMemInvited -> groupInvitation' g
@@ -1942,7 +1943,7 @@ viewChatError logLevel testView = \case
"[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] "
Nothing -> ""
cId :: Connection -> StyledString
cId conn = sShow conn.connId
cId Connection {connId} = sShow connId
ChatErrorRemoteCtrl e -> [plain $ "remote controller error: " <> show e]
ChatErrorRemoteHost RHNew e -> [plain $ "new remote host error: " <> show e]
ChatErrorRemoteHost (RHId rhId) e -> [plain $ "remote host " <> show rhId <> " error: " <> show e]