mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: compatibility with GHC 8.10.7 (#3608)
* GHC-8.10 compatibility * tweak setters * restore membership * remove Show Batch * fix bytestring-10 compat * preserve membership qualifier in names * a few more memberships * rename * remove with-compiler * ci: add 8.10 builds, limit releases to 9.6 * use matrix.asset_name as release guard * fix windows_build * actually use ghc version from matrix * fix typo * revert build/hash split * add ghc to cache key * Force cache between build and tests * use explicit caching steps * skip unneeded tasks --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Co-authored-by: Avently <7953703+avently@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko
committed by
GitHub
GitHub
parent
478bb32cdb
commit
e253c55ba4
@@ -5,7 +5,6 @@
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
@@ -345,7 +344,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}}}
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -2,7 +2,6 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
@@ -489,7 +488,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
|
||||
|
||||
@@ -2,7 +2,6 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
@@ -929,7 +928,7 @@ getLocalCryptoFile db userId fileId sent =
|
||||
_ -> 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
|
||||
|
||||
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRange -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
|
||||
updateDirectCIFileStatus db vr user fileId fileStatus = do
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -196,14 +195,14 @@ allGroupFeatures =
|
||||
]
|
||||
|
||||
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
|
||||
@@ -225,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
|
||||
@@ -382,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
|
||||
@@ -461,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
|
||||
@@ -720,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)
|
||||
|
||||
|
||||
@@ -3,7 +3,6 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
@@ -212,7 +211,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]
|
||||
@@ -494,7 +495,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)
|
||||
@@ -953,7 +954,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"]
|
||||
@@ -991,7 +992,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
|
||||
@@ -1906,7 +1907,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]
|
||||
|
||||
Reference in New Issue
Block a user