IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: subscribe all users (#1743)

Browse Source
This commit is contained in:
JRoberts 2023-01-14 15:45:13 +04:00 committed by GitHub
parent 9290fcc6b2
commit e452edb781
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 68 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/Simplex/Chat.hs
View File

@ -32,7 +32,7 @@ import Data.Either (fromRight)
import Data.Fixed (div') import Data.Fixed (div')
import Data.Functor (($>)) import Data.Functor (($>))
import Data.Int (Int64) import Data.Int (Int64)
import Data.List (find, isSuffixOf, sortOn) import Data.List (find, isSuffixOf, partition, sortOn)
import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.List.NonEmpty (NonEmpty, nonEmpty)
import qualified Data.List.NonEmpty as L import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
@ -198,7 +198,7 @@ startChatController currentUser subConns enableExpireCIs = do
a1 <- async $ race_ notificationSubscriber agentSubscriber a1 <- async $ race_ notificationSubscriber agentSubscriber
a2 <- a2 <-
if subConns if subConns
then Just <$> async (void . runExceptT $ subscribeUserConnections Agent.subscribeConnections currentUser) then Just <$> async (subscribeUsers users)
else pure Nothing else pure Nothing
atomically . writeTVar s $ Just (a1, a2) atomically . writeTVar s $ Just (a1, a2)
startCleanupManager startCleanupManager
@ -229,6 +229,15 @@ startChatController currentUser subConns enableExpireCIs = do
forM_ ttl $ \t -> expireChatItems u t False forM_ ttl $ \t -> expireChatItems u t False
threadDelay $ 1800 * 1000000 -- 30 minutes threadDelay $ 1800 * 1000000 -- 30 minutes
subscribeUsers :: forall m. (MonadUnliftIO m, MonadReader ChatController m) => [User] -> m ()
subscribeUsers users = do
let (us, us') = partition activeUser users
subscribe us
subscribe us'
where
subscribe :: [User] -> m ()
subscribe = mapM_ $ runExceptT . subscribeUserConnections Agent.subscribeConnections
restoreCalls :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m () restoreCalls :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m ()
restoreCalls user = do restoreCalls user = do
savedCalls <- fromRight [] <$> runExceptT (withStore' $ \db -> getCalls db user) savedCalls <- fromRight [] <$> runExceptT (withStore' $ \db -> getCalls db user)
@ -316,8 +325,9 @@ processChatCommand = \case
setAllExpireCIFlags False setAllExpireCIFlags False
withAgent (`suspendAgent` t) withAgent (`suspendAgent` t)
pure $ CRCmdOk Nothing pure $ CRCmdOk Nothing
ResubscribeAllConnections -> withUser $ \user -> do ResubscribeAllConnections -> do
subscribeUserConnections Agent.resubscribeConnections user users <- withStore' getUsers
subscribeUsers users
pure $ CRCmdOk Nothing pure $ CRCmdOk Nothing
SetFilesFolder filesFolder' -> do SetFilesFolder filesFolder' -> do
createDirectoryIfMissing True filesFolder' createDirectoryIfMissing True filesFolder'
@ -1805,19 +1815,19 @@ subscribeUserConnections agentBatchSubscribe user = do
let connIds = map aConnId' pcs let connIds = map aConnId' pcs
pure (connIds, M.fromList $ zip connIds pcs) pure (connIds, M.fromList $ zip connIds pcs)
contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> m () contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> m ()
contactSubsToView rs = toView . CRContactSubSummary . map (uncurry ContactSubStatus) . resultsFor rs contactSubsToView rs = toView . CRContactSubSummary user . map (uncurry ContactSubStatus) . resultsFor rs
contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> m () contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> m ()
contactLinkSubsToView rs = toView . CRUserContactSubSummary . map (uncurry UserContactSubStatus) . resultsFor rs contactLinkSubsToView rs = toView . CRUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs
groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> m () groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> m ()
groupSubsToView rs gs ms ce = do groupSubsToView rs gs ms ce = do
mapM_ groupSub $ mapM_ groupSub $
sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs
toView . CRMemberSubSummary $ map (uncurry MemberSubStatus) mRs toView . CRMemberSubSummary user $ map (uncurry MemberSubStatus) mRs
where where
mRs = resultsFor rs ms mRs = resultsFor rs ms
groupSub :: Group -> m () groupSub :: Group -> m ()
groupSub (Group g@GroupInfo {membership, groupId = gId} members) = do groupSub (Group g@GroupInfo {membership, groupId = gId} members) = do
when ce $ mapM_ (toView . uncurry (CRMemberSubError g)) mErrors when ce $ mapM_ (toView . uncurry (CRMemberSubError user g)) mErrors
toView groupEvent toView groupEvent
where where
mErrors :: [(GroupMember, ChatError)] mErrors :: [(GroupMember, ChatError)]
@ -1827,26 +1837,26 @@ subscribeUserConnections agentBatchSubscribe user = do
$ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs $ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs
groupEvent :: ChatResponse groupEvent :: ChatResponse
groupEvent groupEvent
| memberStatus membership == GSMemInvited = CRGroupInvitation g | memberStatus membership == GSMemInvited = CRGroupInvitation user g
| all (\GroupMember {activeConn} -> isNothing activeConn) members = | all (\GroupMember {activeConn} -> isNothing activeConn) members =
if memberActive membership if memberActive membership
then CRGroupEmpty g then CRGroupEmpty user g
else CRGroupRemoved g else CRGroupRemoved user g
| otherwise = CRGroupSubscribed g | otherwise = CRGroupSubscribed user g
sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> m () sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> m ()
sndFileSubsToView rs sfts = do sndFileSubsToView rs sfts = do
let sftRs = resultsFor rs sfts let sftRs = resultsFor rs sfts
forM_ sftRs $ \(ft@SndFileTransfer {fileId, fileStatus}, err_) -> do forM_ sftRs $ \(ft@SndFileTransfer {fileId, fileStatus}, err_) -> do
forM_ err_ $ toView . CRSndFileSubError ft forM_ err_ $ toView . CRSndFileSubError user ft
void . forkIO $ do void . forkIO $ do
threadDelay 1000000 threadDelay 1000000
l <- asks chatLock l <- asks chatLock
when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withLock l "subscribe sendFileChunk" $ when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withLock l "subscribe sendFileChunk" $
sendFileChunk user ft sendFileChunk user ft
rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> m () rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> m ()
rcvFileSubsToView rs = mapM_ (toView . uncurry CRRcvFileSubError) . filterErrors . resultsFor rs rcvFileSubsToView rs = mapM_ (toView . uncurry (CRRcvFileSubError user)) . filterErrors . resultsFor rs
pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> m () pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> m ()
pendingConnSubsToView rs = toView . CRPendingSubSummary . map (uncurry PendingSubStatus) . resultsFor rs pendingConnSubsToView rs = toView . CRPendingSubSummary user . map (uncurry PendingSubStatus) . resultsFor rs
withStore_ :: (DB.Connection -> User -> IO [a]) -> m [a] withStore_ :: (DB.Connection -> User -> IO [a]) -> m [a]
withStore_ a = withStore' (`a` user) `catchError` \e -> toView (CRChatError (Just user) e) >> pure [] withStore_ a = withStore' (`a` user) `catchError` \e -> toView (CRChatError (Just user) e) >> pure []
filterErrors :: [(a, Maybe ChatError)] -> [(a, ChatError)] filterErrors :: [(a, Maybe ChatError)] -> [(a, ChatError)]

28
src/Simplex/Chat/Controller.hs
View File

@ -395,12 +395,12 @@ data ChatResponse
| CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity} | CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
| CRContactsDisconnected {user :: User, server :: SMPServer, contactRefs :: [ContactRef]} | CRContactsDisconnected {user :: User, server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactsSubscribed {user :: User, server :: SMPServer, contactRefs :: [ContactRef]} | CRContactsSubscribed {user :: User, server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactSubError {contact :: Contact, chatError :: ChatError} | CRContactSubError {contact :: Contact, chatError :: ChatError} -- TODO delete
| CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]} | CRContactSubSummary {user :: User, contactSubscriptions :: [ContactSubStatus]}
| CRUserContactSubSummary {userContactSubscriptions :: [UserContactSubStatus]} | CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
| CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost} | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost} | CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRGroupInvitation {groupInfo :: GroupInfo} | CRGroupInvitation {user :: User, groupInfo :: GroupInfo}
| CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole} | CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
| CRUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember} | CRUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember} | CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
@ -411,8 +411,8 @@ data ChatResponse
| CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember} | CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
| CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember} | CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember} | CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupEmpty {groupInfo :: GroupInfo} | CRGroupEmpty {user :: User, groupInfo :: GroupInfo}
| CRGroupRemoved {groupInfo :: GroupInfo} | CRGroupRemoved {user :: User, groupInfo :: GroupInfo}
| CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember} | CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember} | CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
| CRGroupProfile {user :: User, groupInfo :: GroupInfo} | CRGroupProfile {user :: User, groupInfo :: GroupInfo}
@ -420,20 +420,20 @@ data ChatResponse
| CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact} | CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
| CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo} | CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
| CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact} | CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact}
| CRMemberSubError {groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError} | CRMemberSubError {user :: User, groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
| CRMemberSubSummary {memberSubscriptions :: [MemberSubStatus]} | CRMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]}
| CRGroupSubscribed {groupInfo :: GroupInfo} | CRGroupSubscribed {user :: User, groupInfo :: GroupInfo}
| CRPendingSubSummary {pendingSubscriptions :: [PendingSubStatus]} | CRPendingSubSummary {user :: User, pendingSubscriptions :: [PendingSubStatus]}
| CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError} | CRSndFileSubError {user :: User, sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
| CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError} | CRRcvFileSubError {user :: User, rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
| CRCallInvitation {user :: User, callInvitation :: RcvCallInvitation} | CRCallInvitation {user :: User, callInvitation :: RcvCallInvitation}
| CRCallOffer {user :: User, contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool} | CRCallOffer {user :: User, contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool}
| CRCallAnswer {user :: User, contact :: Contact, answer :: WebRTCSession} | CRCallAnswer {user :: User, contact :: Contact, answer :: WebRTCSession}
| CRCallExtraInfo {user :: User, contact :: Contact, extraInfo :: WebRTCExtraInfo} | CRCallExtraInfo {user :: User, contact :: Contact, extraInfo :: WebRTCExtraInfo}
| CRCallEnded {user :: User, contact :: Contact} | CRCallEnded {user :: User, contact :: Contact}
| CRCallInvitations {user :: User, callInvitations :: [RcvCallInvitation]} | CRCallInvitations {user :: User, callInvitations :: [RcvCallInvitation]}
| CRUserContactLinkSubscribed | CRUserContactLinkSubscribed -- TODO delete
| CRUserContactLinkSubError {chatError :: ChatError} | CRUserContactLinkSubError {chatError :: ChatError} -- TODO delete
| CRNtfTokenStatus {status :: NtfTknStatus} | CRNtfTokenStatus {status :: NtfTknStatus}
| CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode} | CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode}
| CRNtfMessages {user :: User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]} | CRNtfMessages {user :: User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}

35
src/Simplex/Chat/View.hs
View File

@ -146,7 +146,7 @@ responseToView user_ testView liveItems ts = \case
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} -> CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
ttyUser u $ [ttyContact c <> " cancelled receiving " <> sndFile ft] ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
CRContactConnecting u _ -> ttyUser u [] CRContactConnecting u _ -> ttyUser u []
CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView
CRContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"] CRContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"]
@ -154,18 +154,19 @@ responseToView user_ testView liveItems ts = \case
CRContactsDisconnected u srv cs -> ttyUser u [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] 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 <> ")"] CRContactsSubscribed u srv cs -> ttyUser u [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e] CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e]
CRContactSubSummary summary -> CRContactSubSummary u summary ->
[sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors" ttyUser u $ [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
where where
(errors, subscribed) = partition (isJust . contactError) summary (errors, subscribed) = partition (isJust . contactError) summary
CRUserContactSubSummary summary -> CRUserContactSubSummary u summary ->
map addressSS addresses ttyUser u $
<> ([sShow (length groupLinksSubscribed) <> " group links active" | not (null groupLinksSubscribed)] <> viewErrorsSummary groupLinkErrors " group link errors") map addressSS addresses
<> ([sShow (length groupLinksSubscribed) <> " group links active" | not (null groupLinksSubscribed)] <> viewErrorsSummary groupLinkErrors " group link errors")
where where
(addresses, groupLinks) = partition (\UserContactSubStatus {userContact} -> isNothing . userContactGroupId $ userContact) summary (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 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 (groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
CRGroupInvitation g -> [groupInvitation' g] CRGroupInvitation u g -> ttyUser u [groupInvitation' g]
CRReceivedGroupInvitation u g c role -> ttyUser u $ viewReceivedGroupInvitation g c role CRReceivedGroupInvitation u g c role -> ttyUser u $ viewReceivedGroupInvitation g c role
CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
CRJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m CRJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m
@ -178,8 +179,8 @@ responseToView user_ testView liveItems ts = \case
CRDeletedMemberUser u g by -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g 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"] 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"] CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"] CRGroupEmpty u g -> ttyUser u [ttyFullGroup g <> ": group is empty"]
CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"] CRGroupRemoved u g -> ttyUser u [ttyFullGroup g <> ": you are no longer a member or group deleted"]
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"] 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 CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
CRGroupProfile u g -> ttyUser u $ viewGroupProfile g CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
@ -187,14 +188,14 @@ responseToView user_ testView liveItems ts = \case
CRGroupLink u g cReq -> ttyUser u $ groupLink_ "Group link:" g cReq CRGroupLink u g cReq -> ttyUser u $ groupLink_ "Group link:" g cReq
CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' 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] CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors" CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
CRGroupSubscribed g -> viewGroupSubscribed g CRGroupSubscribed u g -> ttyUser u $ viewGroupSubscribed g
CRPendingSubSummary _ -> [] CRPendingSubSummary u _ -> ttyUser u []
CRSndFileSubError SndFileTransfer {fileId, fileName} e -> CRSndFileSubError u SndFileTransfer {fileId, fileName} e ->
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e] ttyUser u ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e -> CRRcvFileSubError u RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e] ttyUser u ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRCallInvitation u RcvCallInvitation {contact, callType, sharedKey} -> ttyUser u $ viewCallInvitation contact callType sharedKey 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 CRCallOffer {user = u, contact, callType, offer, sharedKey} -> ttyUser u $ viewCallOffer contact callType offer sharedKey
CRCallAnswer {user = u, contact, answer} -> ttyUser u $ viewCallAnswer contact answer CRCallAnswer {user = u, contact, answer} -> ttyUser u $ viewCallAnswer contact answer

19
tests/MobileTests.hs
View File

@ -46,32 +46,35 @@ chatStarted = "{\"resp\":{\"type\":\"chatStarted\"}}"
contactSubSummary :: String contactSubSummary :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
contactSubSummary = "{\"resp\":{\"contactSubSummary\":{\"contactSubscriptions\":[]}}}" contactSubSummary = "{\"resp\":{\"contactSubSummary\":{" <> userJSON <> ",\"contactSubscriptions\":[]}}}"
#else #else
contactSubSummary = "{\"resp\":{\"type\":\"contactSubSummary\",\"contactSubscriptions\":[]}}" contactSubSummary = "{\"resp\":{\"type\":\"contactSubSummary\"," <> userJSON <> ",\"contactSubscriptions\":[]}}"
#endif #endif
memberSubSummary :: String memberSubSummary :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
memberSubSummary = "{\"resp\":{\"memberSubSummary\":{\"memberSubscriptions\":[]}}}" memberSubSummary = "{\"resp\":{\"memberSubSummary\":{" <> userJSON <> ",\"memberSubscriptions\":[]}}}"
#else #else
memberSubSummary = "{\"resp\":{\"type\":\"memberSubSummary\",\"memberSubscriptions\":[]}}" memberSubSummary = "{\"resp\":{\"type\":\"memberSubSummary\"," <> userJSON <> ",\"memberSubscriptions\":[]}}"
#endif #endif
userContactSubSummary :: String userContactSubSummary :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
userContactSubSummary = "{\"resp\":{\"userContactSubSummary\":{\"userContactSubscriptions\":[]}}}" userContactSubSummary = "{\"resp\":{\"userContactSubSummary\":{" <> userJSON <> ",\"userContactSubscriptions\":[]}}}"
#else #else
userContactSubSummary = "{\"resp\":{\"type\":\"userContactSubSummary\",\"userContactSubscriptions\":[]}}" userContactSubSummary = "{\"resp\":{\"type\":\"userContactSubSummary\"," <> userJSON <> ",\"userContactSubscriptions\":[]}}"
#endif #endif
pendingSubSummary :: String pendingSubSummary :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
pendingSubSummary = "{\"resp\":{\"pendingSubSummary\":{\"pendingSubscriptions\":[]}}}" pendingSubSummary = "{\"resp\":{\"pendingSubSummary\":{" <> userJSON <> ",\"pendingSubscriptions\":[]}}}"
#else #else
pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\",\"pendingSubscriptions\":[]}}" pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\"," <> userJSON <> ",\"pendingSubscriptions\":[]}}"
#endif #endif
userJSON :: String
userJSON = "\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"no\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"}},\"activeUser\":false}"
parsedMarkdown :: String parsedMarkdown :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
parsedMarkdown = "{\"formattedText\":[{\"format\":{\"bold\":{}},\"text\":\"hello\"}]}" parsedMarkdown = "{\"formattedText\":[{\"format\":{\"bold\":{}},\"text\":\"hello\"}]}"