mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-26 13:08:02 +00:00
core: refactor withUserId (#1735)
* refactor withUserId * update * more
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
892b91e958
commit
e63e158b2d
@@ -175,7 +175,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
|
||||
pure InitialAgentServers {smp = smp', ntf, netCfg}
|
||||
where
|
||||
initialServers :: [User] -> IO [(UserId, NonEmpty SMPServerWithAuth)]
|
||||
initialServers = mapM (\u -> (aUserId u,) <$> userServers u)
|
||||
initialServers = mapM $ \u -> (aUserId u,) <$> userServers u
|
||||
userServers :: User -> IO (NonEmpty SMPServerWithAuth)
|
||||
userServers user' = activeAgentServers config <$> withTransaction chatStore (`getSMPServers` user')
|
||||
|
||||
@@ -328,8 +328,7 @@ processChatCommand = \case
|
||||
APIStorageEncryption cfg -> withStoreChanged $ sqlCipherExport cfg
|
||||
ExecChatStoreSQL query -> CRSQLResult <$> withStore' (`execSQL` query)
|
||||
ExecAgentStoreSQL query -> CRSQLResult <$> withAgent (`execAgentStoreSQL` query)
|
||||
APIGetChats cmdUserId withPCC -> withUser' $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APIGetChats userId withPCC -> withUserId userId $ \user -> do
|
||||
chats <- withStore' $ \db -> getChatPreviews db user withPCC
|
||||
pure $ CRApiChats user chats
|
||||
APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
|
||||
@@ -739,8 +738,7 @@ processChatCommand = \case
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallEnd callId)
|
||||
updateCallItemStatus userId ct call WCSDisconnected $ Just msgId
|
||||
pure Nothing
|
||||
APIGetCallInvitations cmdUserId -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APIGetCallInvitations userId -> withUserId userId $ \user -> do
|
||||
calls <- asks currentCalls >>= readTVarIO
|
||||
let invs = mapMaybe callInvitation $ M.elems calls
|
||||
rcvCallInvitations <- mapM (rcvCallInvitation user) invs
|
||||
@@ -755,9 +753,7 @@ processChatCommand = \case
|
||||
APICallStatus contactId receivedStatus ->
|
||||
withCurrentCall contactId $ \userId ct call ->
|
||||
updateCallItemStatus userId ct call receivedStatus Nothing $> Just call
|
||||
APIUpdateProfile cmdUserId profile -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
updateProfile user profile
|
||||
APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile)
|
||||
APISetContactPrefs contactId prefs' -> withUser $ \user -> do
|
||||
ct <- withStore $ \db -> getContact db user contactId
|
||||
updateContactPrefs user ct prefs'
|
||||
@@ -778,15 +774,13 @@ processChatCommand = \case
|
||||
pure $ CRNtfTokenStatus tokenStatus
|
||||
APIVerifyToken token nonce code -> withUser $ \_ -> withAgent (\a -> verifyNtfToken a token nonce code) $> CRCmdOk Nothing
|
||||
APIDeleteToken token -> withUser $ \_ -> withAgent (`deleteNtfToken` token) $> CRCmdOk Nothing
|
||||
APIGetNtfMessage cmdUserId nonce encNtfInfo -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APIGetNtfMessage userId nonce encNtfInfo -> withUserId userId $ \user -> do
|
||||
(NotificationInfo {ntfConnId, ntfMsgMeta}, msgs) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo
|
||||
let ntfMessages = map (\SMP.SMPMsgMeta {msgTs, msgFlags} -> NtfMsgInfo {msgTs = systemToUTCTime msgTs, msgFlags}) msgs
|
||||
msgTs' = systemToUTCTime . (SMP.msgTs :: SMP.NMsgMeta -> SystemTime) <$> ntfMsgMeta
|
||||
connEntity <- withStore (\db -> Just <$> getConnectionEntity db user (AgentConnId ntfConnId)) `catchError` \_ -> pure Nothing
|
||||
pure CRNtfMessages {user, connEntity, msgTs = msgTs', ntfMessages}
|
||||
APIGetUserSMPServers cmdUserId -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APIGetUserSMPServers userId -> withUserId userId $ \user -> do
|
||||
ChatConfig {defaultServers = DefaultAgentServers {smp = defaultSMPServers}} <- asks config
|
||||
smpServers <- withStore' (`getSMPServers` user)
|
||||
let smpServers' = fromMaybe (L.map toServerCfg defaultSMPServers) $ nonEmpty smpServers
|
||||
@@ -795,19 +789,17 @@ processChatCommand = \case
|
||||
toServerCfg server = ServerCfg {server, preset = True, tested = Nothing, enabled = True}
|
||||
GetUserSMPServers -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIGetUserSMPServers userId
|
||||
APISetUserSMPServers cmdUserId (SMPServersConfig smpServers) -> withUser $ \user -> withChatLock "setUserSMPServers" $ do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APISetUserSMPServers userId (SMPServersConfig smpServers) -> withUserId userId $ \user -> withChatLock "setUserSMPServers" $ do
|
||||
withStore $ \db -> overwriteSMPServers db user smpServers
|
||||
cfg <- asks config
|
||||
withAgent $ \a -> setSMPServers a (aUserId user) $ activeAgentServers cfg smpServers
|
||||
pure $ CRCmdOk (Just user)
|
||||
SetUserSMPServers smpServersConfig -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APISetUserSMPServers userId smpServersConfig
|
||||
TestSMPServer cmdUserId smpServer -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
TestSMPServer userId smpServer -> withUserId userId $ \user ->
|
||||
CRSmpTestResult <$> (withAgent $ \a -> testSMPServerConnection a (aUserId user) smpServer)
|
||||
APISetChatItemTTL cmdUserId newTTL_ -> withUser' $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APISetChatItemTTL userId newTTL_ -> withUser' $ \user -> do
|
||||
checkSameUser userId user
|
||||
checkStoreNotChanged $
|
||||
withChatLock "setChatItemTTL" $ do
|
||||
case newTTL_ of
|
||||
@@ -824,8 +816,7 @@ processChatCommand = \case
|
||||
pure $ CRCmdOk (Just user)
|
||||
SetChatItemTTL newTTL_ -> withUser' $ \User {userId} -> do
|
||||
processChatCommand $ APISetChatItemTTL userId newTTL_
|
||||
APIGetChatItemTTL cmdUserId -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APIGetChatItemTTL userId -> withUserId userId $ \user -> do
|
||||
ttl <- withStore' (`getChatItemTTL` user)
|
||||
pure $ CRChatItemTTL user ttl
|
||||
GetChatItemTTL -> withUser' $ \User {userId} -> do
|
||||
@@ -932,31 +923,26 @@ processChatCommand = \case
|
||||
EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId
|
||||
ChatHelp section -> pure $ CRChatHelp section
|
||||
Welcome -> withUser $ pure . CRWelcome
|
||||
APIAddContact cmdUserId -> withUser $ \user@User {userId} -> withChatLock "addContact" . procCmd $ do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APIAddContact userId -> withUserId userId $ \user -> withChatLock "addContact" . procCmd $ do
|
||||
-- [incognito] generate profile for connection
|
||||
incognito <- readTVarIO =<< asks incognitoMode
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing
|
||||
conn <- withStore' $ \db -> createDirectConnection db userId connId cReq ConnNew incognitoProfile
|
||||
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile
|
||||
toView $ CRNewContactConnection user conn
|
||||
pure $ CRInvitation user cReq
|
||||
AddContact -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIAddContact userId
|
||||
APIConnect cmdUserId (Just (ACR SCMInvitation cReq)) -> withUser $ \user@User {userId} -> withChatLock "connect" . procCmd $ do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APIConnect userId (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do
|
||||
-- [incognito] generate profile to send
|
||||
incognito <- readTVarIO =<< asks incognitoMode
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let profileToSend = userProfileToSend user incognitoProfile Nothing
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq . directMessage $ XInfo profileToSend
|
||||
conn <- withStore' $ \db -> createDirectConnection db userId connId cReq ConnJoined $ incognitoProfile $> profileToSend
|
||||
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined $ incognitoProfile $> profileToSend
|
||||
toView $ CRNewContactConnection user conn
|
||||
pure $ CRSentConfirmation user
|
||||
APIConnect cmdUserId (Just (ACR SCMContact cReq)) -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
-- [incognito] generate profile to send
|
||||
connectViaContact user cReq
|
||||
APIConnect userId (Just (ACR SCMContact cReq)) -> withUserId userId (`connectViaContact` cReq)
|
||||
APIConnect _ Nothing -> throwChatError CEInvalidConnReq
|
||||
Connect cReqUri -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIConnect userId cReqUri
|
||||
@@ -965,21 +951,17 @@ processChatCommand = \case
|
||||
connectViaContact user adminContactReq
|
||||
DeleteContact cName -> withContactName cName $ APIDeleteChat . ChatRef CTDirect
|
||||
ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect
|
||||
APIListContacts cmdUserId -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
contacts <- withStore' (`getUserContacts` user)
|
||||
pure $ CRContactsList user contacts
|
||||
APIListContacts userId -> withUserId userId $ \user ->
|
||||
CRContactsList user <$> withStore' (`getUserContacts` user)
|
||||
ListContacts -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIListContacts userId
|
||||
APICreateMyAddress cmdUserId -> withUser $ \user@User {userId} -> withChatLock "createMyAddress" . procCmd $ do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APICreateMyAddress userId -> withUserId userId $ \user -> withChatLock "createMyAddress" . procCmd $ do
|
||||
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing
|
||||
withStore $ \db -> createUserContactLink db userId connId cReq
|
||||
withStore $ \db -> createUserContactLink db user connId cReq
|
||||
pure $ CRUserContactLinkCreated user cReq
|
||||
CreateMyAddress -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APICreateMyAddress userId
|
||||
APIDeleteMyAddress cmdUserId -> withUser $ \user -> withChatLock "deleteMyAddress" $ do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APIDeleteMyAddress userId -> withUserId userId $ \user -> withChatLock "deleteMyAddress" $ do
|
||||
conns <- withStore (`getUserAddressConnections` user)
|
||||
procCmd $ do
|
||||
forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure ()
|
||||
@@ -987,15 +969,13 @@ processChatCommand = \case
|
||||
pure $ CRUserContactLinkDeleted user
|
||||
DeleteMyAddress -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIDeleteMyAddress userId
|
||||
APIShowMyAddress cmdUserId -> withUser $ \user@User {userId} -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
contactLink <- withStore (`getUserAddress` userId)
|
||||
APIShowMyAddress userId -> withUserId userId $ \user -> do
|
||||
contactLink <- withStore (`getUserAddress` user)
|
||||
pure $ CRUserContactLink user contactLink
|
||||
ShowMyAddress -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIShowMyAddress userId
|
||||
APIAddressAutoAccept cmdUserId autoAccept_ -> withUser $ \user@User {userId} -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
contactLink <- withStore (\db -> updateUserAddressAutoAccept db userId autoAccept_)
|
||||
APIAddressAutoAccept userId autoAccept_ -> withUserId userId $ \user -> do
|
||||
contactLink <- withStore (\db -> updateUserAddressAutoAccept db user autoAccept_)
|
||||
pure $ CRUserContactLinkUpdated user contactLink
|
||||
AddressAutoAccept autoAccept_ -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIAddressAutoAccept userId autoAccept_
|
||||
@@ -1038,10 +1018,9 @@ processChatCommand = \case
|
||||
chatRef <- getChatRef user chatName
|
||||
let mc = MCText $ safeDecodeUtf8 msg
|
||||
processChatCommand $ APIUpdateChatItem chatRef chatItemId live mc
|
||||
APINewGroup cmdUserId gProfile -> withUser $ \user -> do
|
||||
checkCorrectCmdUser cmdUserId user
|
||||
APINewGroup userId gProfile -> withUserId userId $ \user -> do
|
||||
gVar <- asks idsDrg
|
||||
groupInfo <- withStore (\db -> createNewGroup db gVar user gProfile)
|
||||
groupInfo <- withStore $ \db -> createNewGroup db gVar user gProfile
|
||||
pure $ CRGroupCreated user groupInfo
|
||||
NewGroup gProfile -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APINewGroup userId gProfile
|
||||
@@ -1361,8 +1340,6 @@ processChatCommand = \case
|
||||
withStoreChanged a = checkChatStopped $ a >> setStoreChanged $> CRCmdOk Nothing
|
||||
checkStoreNotChanged :: m ChatResponse -> m ChatResponse
|
||||
checkStoreNotChanged = ifM (asks chatStoreChanged >>= readTVarIO) (throwChatError CEChatStoreChanged)
|
||||
checkCorrectCmdUser :: UserId -> User -> m ()
|
||||
checkCorrectCmdUser cmdUserId User {userId = activeUserId} = when (cmdUserId /= activeUserId) $ throwChatError (CEDifferentActiveUser cmdUserId activeUserId)
|
||||
withUserName :: UserName -> (UserId -> ChatCommand) -> m ChatResponse
|
||||
withUserName uName cmd = withStore (`getUserIdByName` uName) >>= processChatCommand . cmd
|
||||
withContactName :: ContactName -> (ContactId -> ChatCommand) -> m ChatResponse
|
||||
@@ -3773,6 +3750,14 @@ withUser :: ChatMonad m => (User -> m ChatResponse) -> m ChatResponse
|
||||
withUser action = withUser' $ \user ->
|
||||
ifM chatStarted (action user) (throwChatError CEChatNotStarted)
|
||||
|
||||
withUserId :: ChatMonad m => UserId -> (User -> m ChatResponse) -> m ChatResponse
|
||||
withUserId userId action = withUser $ \user -> do
|
||||
checkSameUser userId user
|
||||
action user
|
||||
|
||||
checkSameUser :: ChatMonad m => UserId -> User -> m ()
|
||||
checkSameUser userId User {userId = activeUserId} = when (userId /= activeUserId) $ throwChatError (CEDifferentActiveUser userId activeUserId)
|
||||
|
||||
chatStarted :: ChatMonad m => m Bool
|
||||
chatStarted = fmap isJust . readTVarIO =<< asks agentAsync
|
||||
|
||||
|
||||
@@ -543,8 +543,8 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
|
||||
"SELECT xcontact_id FROM connections WHERE user_id = ? AND via_contact_uri_hash = ? LIMIT 1"
|
||||
(userId, cReqHash)
|
||||
|
||||
createDirectConnection :: DB.Connection -> UserId -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> IO PendingContactConnection
|
||||
createDirectConnection db userId acId cReq pccConnStatus incognitoProfile = do
|
||||
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> IO PendingContactConnection
|
||||
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile = do
|
||||
createdAt <- getCurrentTime
|
||||
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
|
||||
DB.execute
|
||||
@@ -882,8 +882,8 @@ getUserContactProfiles db User {userId} =
|
||||
toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe Preferences) -> (Profile)
|
||||
toContactProfile (displayName, fullName, image, preferences) = Profile {displayName, fullName, image, preferences}
|
||||
|
||||
createUserContactLink :: DB.Connection -> UserId -> ConnId -> ConnReqContact -> ExceptT StoreError IO ()
|
||||
createUserContactLink db userId agentConnId cReq =
|
||||
createUserContactLink :: DB.Connection -> User -> ConnId -> ConnReqContact -> ExceptT StoreError IO ()
|
||||
createUserContactLink db User {userId} agentConnId cReq =
|
||||
checkConstraint SEDuplicateContactLink . liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
@@ -991,8 +991,8 @@ toUserContactLink (connReq, autoAccept, acceptIncognito, autoReply) =
|
||||
UserContactLink connReq $
|
||||
if autoAccept then Just AutoAccept {acceptIncognito, autoReply} else Nothing
|
||||
|
||||
getUserAddress :: DB.Connection -> UserId -> ExceptT StoreError IO UserContactLink
|
||||
getUserAddress db userId =
|
||||
getUserAddress :: DB.Connection -> User -> ExceptT StoreError IO UserContactLink
|
||||
getUserAddress db User {userId} =
|
||||
ExceptT . firstRow toUserContactLink SEUserContactLinkNotFound $
|
||||
DB.query
|
||||
db
|
||||
@@ -1016,9 +1016,9 @@ getUserContactLinkById db userId userContactLinkId =
|
||||
|]
|
||||
(userId, userContactLinkId)
|
||||
|
||||
updateUserAddressAutoAccept :: DB.Connection -> UserId -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink
|
||||
updateUserAddressAutoAccept db userId autoAccept = do
|
||||
link <- getUserAddress db userId
|
||||
updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink
|
||||
updateUserAddressAutoAccept db user@User {userId} autoAccept = do
|
||||
link <- getUserAddress db user
|
||||
liftIO updateUserAddressAutoAccept_ $> link {autoAccept}
|
||||
where
|
||||
updateUserAddressAutoAccept_ =
|
||||
|
||||
@@ -111,7 +111,7 @@ data User = User
|
||||
fullPreferences :: FullPreferences,
|
||||
activeUser :: Bool
|
||||
}
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
deriving (Show, Generic, FromJSON)
|
||||
|
||||
instance ToJSON User where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
|
||||
@@ -64,31 +64,31 @@ responseToView user_ testView liveItems ts = \case
|
||||
CRChatRunning -> ["chat is running"]
|
||||
CRChatStopped -> ["chat stopped"]
|
||||
CRChatSuspended -> ["chat suspended"]
|
||||
CRApiChats u chats -> withOtherUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats]
|
||||
CRApiChat u chat -> withOtherUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat]
|
||||
CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats]
|
||||
CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat]
|
||||
CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
|
||||
CRUserSMPServers u smpServers _ -> withOtherUser u $ viewSMPServers (L.toList smpServers) testView
|
||||
CRUserSMPServers u smpServers _ -> ttyUser u $ viewSMPServers (L.toList smpServers) testView
|
||||
CRSmpTestResult testFailure -> viewSMPTestResult testFailure
|
||||
CRChatItemTTL u ttl -> withOtherUser u $ viewChatItemTTL ttl
|
||||
CRChatItemTTL u ttl -> ttyUser u $ viewChatItemTTL ttl
|
||||
CRNetworkConfig cfg -> viewNetworkConfig cfg
|
||||
CRContactInfo u ct cStats customUserProfile -> withOtherUser u $ viewContactInfo ct cStats customUserProfile
|
||||
CRGroupMemberInfo u g m cStats -> withOtherUser u $ viewGroupMemberInfo g m cStats
|
||||
CRContactSwitch u ct progress -> withOtherUser u $ viewContactSwitch ct progress
|
||||
CRGroupMemberSwitch u g m progress -> withOtherUser u $ viewGroupMemberSwitch g m progress
|
||||
CRConnectionVerified u verified code -> withOtherUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
|
||||
CRContactCode u ct code -> withOtherUser u $ viewContactCode ct code testView
|
||||
CRGroupMemberCode u g m code -> withOtherUser u $ viewGroupMemberCode g m code testView
|
||||
CRNewChatItem u (AChatItem _ _ chat item) -> withOtherUser u $ unmuted chat item $ viewChatItem chat item False ts
|
||||
CRChatItems u chatItems -> withOtherUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
|
||||
CRChatItemId u itemId -> withOtherUser u [plain $ maybe "no item" show itemId]
|
||||
CRChatItemStatusUpdated u _ -> withOtherUser u []
|
||||
CRChatItemUpdated u (AChatItem _ _ chat item) -> withOtherUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts
|
||||
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> withOtherUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts
|
||||
CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> withOtherUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
|
||||
CRBroadcastSent u mc n t -> withOtherUser u $ viewSentBroadcast mc n ts t
|
||||
CRMsgIntegrityError u mErr -> withOtherUser u $ viewMsgIntegrityError mErr
|
||||
CRContactInfo u ct cStats customUserProfile -> ttyUser u $ viewContactInfo ct cStats customUserProfile
|
||||
CRGroupMemberInfo u g m cStats -> ttyUser u $ viewGroupMemberInfo g m cStats
|
||||
CRContactSwitch u ct progress -> ttyUser u $ viewContactSwitch ct progress
|
||||
CRGroupMemberSwitch u g m progress -> ttyUser u $ viewGroupMemberSwitch g m progress
|
||||
CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
|
||||
CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
|
||||
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
|
||||
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts
|
||||
CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
|
||||
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
|
||||
CRChatItemStatusUpdated u _ -> ttyUser u []
|
||||
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts
|
||||
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts
|
||||
CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
|
||||
CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts t
|
||||
CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr
|
||||
CRCmdAccepted _ -> []
|
||||
CRCmdOk u_ -> withOtherUser' u_ ["ok"]
|
||||
CRCmdOk u_ -> ttyUser' u_ ["ok"]
|
||||
CRChatHelp section -> case section of
|
||||
HSMain -> chatHelpInfo
|
||||
HSFiles -> filesHelpInfo
|
||||
@@ -98,61 +98,61 @@ responseToView user_ testView liveItems ts = \case
|
||||
HSMarkdown -> markdownInfo
|
||||
HSSettings -> settingsInfo
|
||||
CRWelcome user -> chatWelcome user
|
||||
CRContactsList u cs -> withOtherUser u $ viewContactsList cs
|
||||
CRUserContactLink u UserContactLink {connReqContact, autoAccept} -> withOtherUser u $ connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept
|
||||
CRUserContactLinkUpdated u UserContactLink {autoAccept} -> withOtherUser u $ autoAcceptStatus_ autoAccept
|
||||
CRContactRequestRejected u UserContactRequest {localDisplayName = c} -> withOtherUser u [ttyContact c <> ": contact request rejected"]
|
||||
CRGroupCreated u g -> withOtherUser u $ viewGroupCreated g
|
||||
CRGroupMembers u g -> withOtherUser u $ viewGroupMembers g
|
||||
CRGroupsList u gs -> withOtherUser u $ viewGroupsList gs
|
||||
CRContactsList u cs -> ttyUser u $ viewContactsList cs
|
||||
CRUserContactLink u UserContactLink {connReqContact, autoAccept} -> ttyUser u $ connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept
|
||||
CRUserContactLinkUpdated u UserContactLink {autoAccept} -> ttyUser u $ autoAcceptStatus_ autoAccept
|
||||
CRContactRequestRejected u UserContactRequest {localDisplayName = c} -> ttyUser u [ttyContact c <> ": contact request rejected"]
|
||||
CRGroupCreated u g -> ttyUser u $ viewGroupCreated g
|
||||
CRGroupMembers u g -> ttyUser u $ viewGroupMembers g
|
||||
CRGroupsList u gs -> ttyUser u $ viewGroupsList gs
|
||||
CRSentGroupInvitation u g c _ ->
|
||||
withOtherUser u $
|
||||
ttyUser u $
|
||||
if viaGroupLink . contactConn $ c
|
||||
then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
|
||||
else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
|
||||
CRFileTransferStatus u ftStatus -> withOtherUser u $ viewFileTransferStatus ftStatus
|
||||
CRUserProfile u p -> withOtherUser u $ viewUserProfile p
|
||||
CRUserProfileNoChange u -> withOtherUser u ["user profile did not change"]
|
||||
CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
|
||||
CRUserProfile u p -> ttyUser u $ viewUserProfile p
|
||||
CRUserProfileNoChange u -> ttyUser u ["user profile did not change"]
|
||||
CRVersionInfo _ -> [plain versionStr, plain updateStr]
|
||||
CRInvitation u cReq -> withOtherUser u $ viewConnReqInvitation cReq
|
||||
CRSentConfirmation u -> withOtherUser u ["confirmation sent!"]
|
||||
CRSentInvitation u customUserProfile -> withOtherUser u $ viewSentInvitation customUserProfile testView
|
||||
CRContactDeleted u c -> withOtherUser u [ttyContact' c <> ": contact is deleted"]
|
||||
CRChatCleared u chatInfo -> withOtherUser u $ viewChatCleared chatInfo
|
||||
CRAcceptingContactRequest u c -> withOtherUser u [ttyFullContact c <> ": accepting contact request..."]
|
||||
CRContactAlreadyExists u c -> withOtherUser u [ttyFullContact c <> ": contact already exists"]
|
||||
CRContactRequestAlreadyAccepted u c -> withOtherUser u [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
|
||||
CRUserContactLinkCreated u cReq -> withOtherUser u $ connReqContact_ "Your new chat address is created!" cReq
|
||||
CRUserContactLinkDeleted u -> withOtherUser u viewUserContactLinkDeleted
|
||||
CRUserAcceptedGroupSent u _g _ -> withOtherUser u [] -- [ttyGroup' g <> ": joining the group..."]
|
||||
CRUserDeletedMember u g m -> withOtherUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMemberUser u g -> withOtherUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRGroupDeletedUser u g -> withOtherUser u [ttyGroup' g <> ": you deleted the group"]
|
||||
CRRcvFileAccepted u ci -> withOtherUser u $ savingFile' ci
|
||||
CRRcvFileAcceptedSndCancelled u ft -> withOtherUser u $ viewRcvFileSndCancelled ft
|
||||
CRSndGroupFileCancelled u _ ftm fts -> withOtherUser u $ viewSndGroupFileCancelled ftm fts
|
||||
CRRcvFileCancelled u ft -> withOtherUser u $ receivingFile_ "cancelled" ft
|
||||
CRUserProfileUpdated u p p' -> withOtherUser u $ viewUserProfileUpdated p p'
|
||||
CRContactPrefsUpdated {user = u, fromContact, toContact} -> withOtherUser u $ viewUserContactPrefsUpdated u fromContact toContact
|
||||
CRContactAliasUpdated u c -> withOtherUser u $ viewContactAliasUpdated c
|
||||
CRConnectionAliasUpdated u c -> withOtherUser u $ viewConnectionAliasUpdated c
|
||||
CRContactUpdated {user = u, fromContact = c, toContact = c'} -> withOtherUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
|
||||
CRContactsMerged u intoCt mergedCt -> withOtherUser u $ viewContactsMerged intoCt mergedCt
|
||||
CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> withOtherUser u $ viewReceivedContactRequest c profile
|
||||
CRRcvFileStart u ci -> withOtherUser u $ receivingFile_' "started" ci
|
||||
CRRcvFileComplete u ci -> withOtherUser u $ receivingFile_' "completed" ci
|
||||
CRRcvFileSndCancelled u ft -> withOtherUser u $ viewRcvFileSndCancelled ft
|
||||
CRSndFileStart u _ ft -> withOtherUser u $ sendingFile_ "started" ft
|
||||
CRSndFileComplete u _ ft -> withOtherUser u $ sendingFile_ "completed" ft
|
||||
CRInvitation u cReq -> ttyUser u $ viewConnReqInvitation cReq
|
||||
CRSentConfirmation u -> ttyUser u ["confirmation sent!"]
|
||||
CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
|
||||
CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
|
||||
CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo
|
||||
CRAcceptingContactRequest u c -> ttyUser u [ttyFullContact c <> ": accepting contact request..."]
|
||||
CRContactAlreadyExists u c -> ttyUser u [ttyFullContact c <> ": contact already exists"]
|
||||
CRContactRequestAlreadyAccepted u c -> ttyUser u [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
|
||||
CRUserContactLinkCreated u cReq -> ttyUser u $ connReqContact_ "Your new chat address is created!" cReq
|
||||
CRUserContactLinkDeleted u -> ttyUser u viewUserContactLinkDeleted
|
||||
CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
|
||||
CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
|
||||
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
|
||||
CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
|
||||
CRSndGroupFileCancelled u _ ftm fts -> ttyUser u $ viewSndGroupFileCancelled ftm fts
|
||||
CRRcvFileCancelled u ft -> ttyUser u $ receivingFile_ "cancelled" ft
|
||||
CRUserProfileUpdated u p p' -> ttyUser u $ viewUserProfileUpdated p p'
|
||||
CRContactPrefsUpdated {user = u, fromContact, toContact} -> ttyUser u $ viewUserContactPrefsUpdated u fromContact toContact
|
||||
CRContactAliasUpdated u c -> ttyUser u $ viewContactAliasUpdated c
|
||||
CRConnectionAliasUpdated u c -> ttyUser u $ viewConnectionAliasUpdated c
|
||||
CRContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
|
||||
CRContactsMerged u intoCt mergedCt -> ttyUser u $ viewContactsMerged intoCt mergedCt
|
||||
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
|
||||
CRRcvFileSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
|
||||
CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
|
||||
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
|
||||
CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft
|
||||
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
|
||||
withOtherUser u $ [ttyContact c <> " cancelled receiving " <> sndFile ft]
|
||||
CRContactConnecting u _ -> withOtherUser u []
|
||||
CRContactConnected u ct userCustomProfile -> withOtherUser u $ viewContactConnected ct userCustomProfile testView
|
||||
CRContactAnotherClient u c -> withOtherUser u [ttyContact' c <> ": contact is connected to another client"]
|
||||
CRSubscriptionEnd u acEntity -> withOtherUser u [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"]
|
||||
CRContactsDisconnected u srv cs -> withOtherUser u [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
CRContactsSubscribed u srv cs -> withOtherUser u [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
ttyUser u $ [ttyContact c <> " cancelled receiving " <> sndFile ft]
|
||||
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 (connId (entityConnection acEntity :: Connection)) <> ": END"]
|
||||
CRContactsDisconnected u srv cs -> ttyUser u [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
CRContactsSubscribed u srv cs -> ttyUser u [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e]
|
||||
CRContactSubSummary summary ->
|
||||
[sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
|
||||
@@ -166,26 +166,26 @@ responseToView user_ testView liveItems ts = \case
|
||||
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
|
||||
CRGroupInvitation g -> [groupInvitation' g]
|
||||
CRReceivedGroupInvitation u g c role -> withOtherUser u $ viewReceivedGroupInvitation g c role
|
||||
CRUserJoinedGroup u g _ -> withOtherUser u $ viewUserJoinedGroup g
|
||||
CRJoinedGroupMember u g m -> withOtherUser u $ viewJoinedGroupMember g m
|
||||
CRReceivedGroupInvitation u g c role -> ttyUser u $ viewReceivedGroupInvitation g c role
|
||||
CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
|
||||
CRJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m
|
||||
CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h]
|
||||
CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h]
|
||||
CRJoinedGroupMemberConnecting u g host m -> withOtherUser u [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
|
||||
CRConnectedToGroupMember u g m -> withOtherUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
|
||||
CRMemberRole u g by m r r' -> withOtherUser u $ viewMemberRoleChanged g by m r r'
|
||||
CRMemberRoleUser u g m r r' -> withOtherUser u $ viewMemberRoleUserChanged g m r r'
|
||||
CRDeletedMemberUser u g by -> withOtherUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
|
||||
CRDeletedMember u g by m -> withOtherUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMember u g m -> withOtherUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
CRJoinedGroupMemberConnecting u g host m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
|
||||
CRConnectedToGroupMember u g m -> ttyUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
|
||||
CRMemberRole u g by m r r' -> ttyUser u $ viewMemberRoleChanged g by m r r'
|
||||
CRMemberRoleUser u g m r r' -> ttyUser u $ viewMemberRoleUserChanged g m r r'
|
||||
CRDeletedMemberUser u g by -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
|
||||
CRDeletedMember u g by m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"]
|
||||
CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"]
|
||||
CRGroupDeleted u g m -> withOtherUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
|
||||
CRGroupUpdated u g g' m -> withOtherUser u $ viewGroupUpdated g g' m
|
||||
CRGroupProfile u g -> withOtherUser u $ viewGroupProfile g
|
||||
CRGroupLinkCreated u g cReq -> withOtherUser u $ groupLink_ "Group link is created!" g cReq
|
||||
CRGroupLink u g cReq -> withOtherUser u $ groupLink_ "Group link:" g cReq
|
||||
CRGroupLinkDeleted u g -> withOtherUser u $ viewGroupLinkDeleted g
|
||||
CRGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
|
||||
CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
|
||||
CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
|
||||
CRGroupLinkCreated u g cReq -> ttyUser u $ groupLink_ "Group link is created!" g cReq
|
||||
CRGroupLink u g cReq -> ttyUser u $ groupLink_ "Group link:" g cReq
|
||||
CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
|
||||
CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."]
|
||||
CRMemberSubError g m e -> [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
|
||||
CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
|
||||
@@ -195,16 +195,16 @@ responseToView user_ testView liveItems ts = \case
|
||||
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
|
||||
CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
|
||||
["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
|
||||
CRCallInvitation u RcvCallInvitation {contact, callType, sharedKey} -> withOtherUser u $ viewCallInvitation contact callType sharedKey
|
||||
CRCallOffer {user = u, contact, callType, offer, sharedKey} -> withOtherUser u $ viewCallOffer contact callType offer sharedKey
|
||||
CRCallAnswer {user = u, contact, answer} -> withOtherUser u $ viewCallAnswer contact answer
|
||||
CRCallExtraInfo {user = u, contact} -> withOtherUser u ["call extra info from " <> ttyContact' contact]
|
||||
CRCallEnded {user = u, contact} -> withOtherUser u ["call with " <> ttyContact' contact <> " ended"]
|
||||
CRCallInvitations u _ -> withOtherUser u []
|
||||
CRCallInvitation u RcvCallInvitation {contact, callType, sharedKey} -> ttyUser u $ viewCallInvitation contact callType sharedKey
|
||||
CRCallOffer {user = u, contact, callType, offer, sharedKey} -> ttyUser u $ viewCallOffer contact callType offer sharedKey
|
||||
CRCallAnswer {user = u, contact, answer} -> ttyUser u $ viewCallAnswer contact answer
|
||||
CRCallExtraInfo {user = u, contact} -> ttyUser u ["call extra info from " <> ttyContact' contact]
|
||||
CRCallEnded {user = u, contact} -> ttyUser u ["call with " <> ttyContact' contact <> " ended"]
|
||||
CRCallInvitations u _ -> ttyUser u []
|
||||
CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
|
||||
CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
|
||||
CRNewContactConnection u _ -> withOtherUser u []
|
||||
CRContactConnectionDeleted u PendingContactConnection {pccConnId} -> withOtherUser u ["connection :" <> sShow pccConnId <> " deleted"]
|
||||
CRNewContactConnection u _ -> ttyUser u []
|
||||
CRContactConnectionDeleted u PendingContactConnection {pccConnId} -> ttyUser u ["connection :" <> sShow pccConnId <> " deleted"]
|
||||
CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
|
||||
CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
|
||||
CRNtfMessages {} -> []
|
||||
@@ -215,18 +215,20 @@ responseToView user_ testView liveItems ts = \case
|
||||
]
|
||||
CRAgentStats stats -> map (plain . intercalate ",") stats
|
||||
CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
|
||||
CRMessageError u prefix err -> withOtherUser u [plain prefix <> ": " <> plain err]
|
||||
CRChatCmdError u e -> withOtherUser' u $ viewChatError e
|
||||
CRChatError u e -> withOtherUser' u $ viewChatError e
|
||||
CRMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err]
|
||||
CRChatCmdError u e -> ttyUser' u $ viewChatError e
|
||||
CRChatError u e -> ttyUser' u $ viewChatError e
|
||||
where
|
||||
withOtherUser :: User -> [StyledString] -> [StyledString]
|
||||
withOtherUser = withOtherUser' . Just
|
||||
withOtherUser' :: Maybe User -> [StyledString] -> [StyledString]
|
||||
withOtherUser' cmdUser@(Just User {localDisplayName = u}) ss@(s : ss')
|
||||
| cmdUser /= user_ = "[user: " <> highlight u <> "] " <> s : ss'
|
||||
| otherwise = ss
|
||||
withOtherUser' (Just _) [] = []
|
||||
withOtherUser' Nothing ss = ss
|
||||
ttyUser :: User -> [StyledString] -> [StyledString]
|
||||
ttyUser _ [] = []
|
||||
ttyUser User {userId, localDisplayName = u} ss = prependFirst userPrefix ss
|
||||
where
|
||||
userPrefix = case user_ of
|
||||
Just User {userId = activeUserId} -> if userId /= activeUserId then prefix else ""
|
||||
_ -> prefix
|
||||
prefix = "[user: " <> highlight u <> "] "
|
||||
ttyUser' :: Maybe User -> [StyledString] -> [StyledString]
|
||||
ttyUser' = maybe id ttyUser
|
||||
testViewChats :: [AChat] -> [StyledString]
|
||||
testViewChats chats = [sShow $ map toChatView chats]
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user