mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-06-07 04:32:05 +00:00
core: multiple users view, tests (#1710)
This commit is contained in:
JRoberts
@@ -423,6 +423,7 @@ createUser :: DB.Connection -> Profile -> Bool -> ExceptT StoreError IO User
|
||||
createUser db Profile {displayName, fullName, image, preferences = userPreferences} activeUser =
|
||||
checkConstraint SEDuplicateName . liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO users (local_display_name, active_user, contact_id, created_at, updated_at) VALUES (?,?,0,?,?)"
|
||||
|
||||
@@ -88,7 +88,7 @@ data User = User
|
||||
fullPreferences :: FullPreferences,
|
||||
activeUser :: Bool
|
||||
}
|
||||
deriving (Show, Generic, FromJSON)
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
|
||||
instance ToJSON User where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
|
||||
+109
-104
@@ -64,31 +64,31 @@ responseToView user_ testView liveItems ts = \case
|
||||
CRChatRunning -> ["chat is running"]
|
||||
CRChatStopped -> ["chat stopped"]
|
||||
CRChatSuspended -> ["chat suspended"]
|
||||
CRApiChats _u chats -> if testView then testViewChats chats else [plain . bshow $ J.encode chats]
|
||||
CRApiChat _u chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat]
|
||||
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]
|
||||
CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
|
||||
CRUserSMPServers _u smpServers _ -> viewSMPServers (L.toList smpServers) testView
|
||||
CRUserSMPServers u smpServers _ -> withOtherUser u $ viewSMPServers (L.toList smpServers) testView
|
||||
CRSmpTestResult testFailure -> viewSMPTestResult testFailure
|
||||
CRChatItemTTL _u ttl -> viewChatItemTTL ttl
|
||||
CRChatItemTTL u ttl -> withOtherUser u $ viewChatItemTTL ttl
|
||||
CRNetworkConfig cfg -> viewNetworkConfig cfg
|
||||
CRContactInfo _u ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile
|
||||
CRGroupMemberInfo _u g m cStats -> viewGroupMemberInfo g m cStats
|
||||
CRContactSwitch _u ct progress -> viewContactSwitch ct progress
|
||||
CRGroupMemberSwitch _u g m progress -> viewGroupMemberSwitch g m progress
|
||||
CRConnectionVerified _u verified code -> [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
|
||||
CRContactCode _u ct code -> viewContactCode ct code testView
|
||||
CRGroupMemberCode _u g m code -> viewGroupMemberCode g m code testView
|
||||
CRNewChatItem _u (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False ts
|
||||
CRChatItems _u chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
|
||||
CRChatItemId _u itemId -> [plain $ maybe "no item" show itemId]
|
||||
CRChatItemStatusUpdated _u _ -> []
|
||||
CRChatItemUpdated _u (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item liveItems ts
|
||||
CRChatItemDeleted _u (AChatItem _ _ chat deletedItem) toItem byUser timed -> unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts
|
||||
CRChatItemDeletedNotFound _u Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"]
|
||||
CRBroadcastSent _u mc n t -> viewSentBroadcast mc n ts t
|
||||
CRMsgIntegrityError _u mErr -> viewMsgIntegrityError mErr
|
||||
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
|
||||
CRCmdAccepted _ -> []
|
||||
CRCmdOk _u -> ["ok"]
|
||||
CRCmdOk u_ -> withOtherUser' u_ ["ok"]
|
||||
CRChatHelp section -> case section of
|
||||
HSMain -> chatHelpInfo
|
||||
HSFiles -> filesHelpInfo
|
||||
@@ -98,64 +98,61 @@ responseToView user_ testView liveItems ts = \case
|
||||
HSMarkdown -> markdownInfo
|
||||
HSSettings -> settingsInfo
|
||||
CRWelcome user -> chatWelcome user
|
||||
CRContactsList _u cs -> viewContactsList cs
|
||||
CRUserContactLink _u UserContactLink {connReqContact, autoAccept} -> connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept
|
||||
CRUserContactLinkUpdated _u UserContactLink {autoAccept} -> autoAcceptStatus_ autoAccept
|
||||
CRContactRequestRejected _u UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"]
|
||||
CRGroupCreated _u g -> viewGroupCreated g
|
||||
CRGroupMembers _u g -> viewGroupMembers g
|
||||
CRGroupsList _u gs -> viewGroupsList gs
|
||||
CRSentGroupInvitation _u g c _ ->
|
||||
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 -> viewFileTransferStatus ftStatus
|
||||
CRUserProfile _u p -> viewUserProfile p
|
||||
CRUserProfileNoChange _u -> ["user profile did not change"]
|
||||
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
|
||||
CRSentGroupInvitation u g c _ ->
|
||||
withOtherUser 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"]
|
||||
CRVersionInfo _ -> [plain versionStr, plain updateStr]
|
||||
CRInvitation _u cReq -> viewConnReqInvitation cReq
|
||||
CRSentConfirmation _u -> ["confirmation sent!"]
|
||||
CRSentInvitation _u customUserProfile -> viewSentInvitation customUserProfile testView
|
||||
CRContactDeleted _u c -> [ttyContact' c <> ": contact is deleted"]
|
||||
CRChatCleared _u chatInfo -> viewChatCleared chatInfo
|
||||
CRAcceptingContactRequest _u c -> [ttyFullContact c <> ": accepting contact request..."]
|
||||
CRContactAlreadyExists _u c -> [ttyFullContact c <> ": contact already exists"]
|
||||
CRContactRequestAlreadyAccepted _u c -> [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
|
||||
CRUserContactLinkCreated _u cReq -> connReqContact_ "Your new chat address is created!" cReq
|
||||
CRUserContactLinkDeleted _u -> viewUserContactLinkDeleted
|
||||
CRUserAcceptedGroupSent _u _g _ -> [] -- [ttyGroup' g <> ": joining the group..."]
|
||||
CRUserDeletedMember _u g m -> [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMemberUser _u g -> [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRGroupDeletedUser _u g -> [ttyGroup' g <> ": you deleted the group"]
|
||||
CRRcvFileAccepted _u ci -> savingFile' ci
|
||||
CRRcvFileAcceptedSndCancelled _u ft -> viewRcvFileSndCancelled ft
|
||||
CRSndGroupFileCancelled _u _ ftm fts -> viewSndGroupFileCancelled ftm fts
|
||||
CRRcvFileCancelled _u ft -> receivingFile_ "cancelled" ft
|
||||
CRUserProfileUpdated _u p p' -> viewUserProfileUpdated p p'
|
||||
CRContactPrefsUpdated {user = _u, fromContact, toContact} -> case user_ of
|
||||
Just user -> viewUserContactPrefsUpdated user fromContact toContact
|
||||
_ -> ["unexpected chat event CRContactPrefsUpdated without current user"]
|
||||
CRContactAliasUpdated _u c -> viewContactAliasUpdated c
|
||||
CRConnectionAliasUpdated _u c -> viewConnectionAliasUpdated c
|
||||
CRContactUpdated {user = _u, fromContact = c, toContact = c'} -> case user_ of
|
||||
Just user -> viewContactUpdated c c' <> viewContactPrefsUpdated user c c'
|
||||
_ -> ["unexpected chat event CRContactUpdated without current user"]
|
||||
CRContactsMerged _u intoCt mergedCt -> viewContactsMerged intoCt mergedCt
|
||||
CRReceivedContactRequest _u UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
|
||||
CRRcvFileStart _u ci -> receivingFile_' "started" ci
|
||||
CRRcvFileComplete _u ci -> receivingFile_' "completed" ci
|
||||
CRRcvFileSndCancelled _u ft -> viewRcvFileSndCancelled ft
|
||||
CRSndFileStart _u _ ft -> sendingFile_ "started" ft
|
||||
CRSndFileComplete _u _ ft -> sendingFile_ "completed" ft
|
||||
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
|
||||
CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft
|
||||
CRSndFileRcvCancelled _u _ ft@SndFileTransfer {recipientDisplayName = c} ->
|
||||
[ttyContact c <> " cancelled receiving " <> sndFile ft]
|
||||
CRContactConnecting _u _ -> []
|
||||
CRContactConnected _u ct userCustomProfile -> viewContactConnected ct userCustomProfile testView
|
||||
CRContactAnotherClient _u c -> [ttyContact' c <> ": contact is connected to another client"]
|
||||
CRSubscriptionEnd _u acEntity -> [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"]
|
||||
CRContactsDisconnected _u srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
CRContactsSubscribed _u srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
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 <> ")"]
|
||||
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"
|
||||
@@ -169,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 -> viewReceivedGroupInvitation g c role
|
||||
CRUserJoinedGroup _u g _ -> viewUserJoinedGroup g
|
||||
CRJoinedGroupMember _u g m -> viewJoinedGroupMember g m
|
||||
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
|
||||
CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h]
|
||||
CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h]
|
||||
CRJoinedGroupMemberConnecting _u g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
|
||||
CRConnectedToGroupMember _u g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
|
||||
CRMemberRole _u g by m r r' -> viewMemberRoleChanged g by m r r'
|
||||
CRMemberRoleUser _u g m r r' -> viewMemberRoleUserChanged g m r r'
|
||||
CRDeletedMemberUser _u g by -> [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
|
||||
CRDeletedMember _u g by m -> [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMember _u g m -> [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
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"]
|
||||
CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"]
|
||||
CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"]
|
||||
CRGroupDeleted _u g m -> [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 -> viewGroupUpdated g g' m
|
||||
CRGroupProfile _u g -> viewGroupProfile g
|
||||
CRGroupLinkCreated _u g cReq -> groupLink_ "Group link is created!" g cReq
|
||||
CRGroupLink _u g cReq -> groupLink_ "Group link:" g cReq
|
||||
CRGroupLinkDeleted _u g -> viewGroupLinkDeleted g
|
||||
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
|
||||
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"
|
||||
@@ -198,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} -> viewCallInvitation contact callType sharedKey
|
||||
CRCallOffer {user = _u, contact, callType, offer, sharedKey} -> viewCallOffer contact callType offer sharedKey
|
||||
CRCallAnswer {user = _u, contact, answer} -> viewCallAnswer contact answer
|
||||
CRCallExtraInfo {user = _u, contact} -> ["call extra info from " <> ttyContact' contact]
|
||||
CRCallEnded {user = _u, contact} -> ["call with " <> ttyContact' contact <> " ended"]
|
||||
CRCallInvitations _u _ -> []
|
||||
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 []
|
||||
CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
|
||||
CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
|
||||
CRNewContactConnection _u _ -> []
|
||||
CRContactConnectionDeleted _u PendingContactConnection {pccConnId} -> ["connection :" <> sShow pccConnId <> " deleted"]
|
||||
CRNewContactConnection u _ -> withOtherUser u []
|
||||
CRContactConnectionDeleted u PendingContactConnection {pccConnId} -> withOtherUser 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 {} -> []
|
||||
@@ -218,10 +215,18 @@ responseToView user_ testView liveItems ts = \case
|
||||
]
|
||||
CRAgentStats stats -> map (plain . intercalate ",") stats
|
||||
CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
|
||||
CRMessageError _u prefix err -> [plain prefix <> ": " <> plain err]
|
||||
CRChatCmdError _u e -> viewChatError e
|
||||
CRChatError _u e -> viewChatError e
|
||||
CRMessageError u prefix err -> withOtherUser u [plain prefix <> ": " <> plain err]
|
||||
CRChatCmdError u e -> withOtherUser' u $ viewChatError e
|
||||
CRChatError u e -> withOtherUser' 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
|
||||
testViewChats :: [AChat] -> [StyledString]
|
||||
testViewChats chats = [sShow $ map toChatView chats]
|
||||
where
|
||||
|
||||
+152
-2
@@ -172,6 +172,9 @@ chatTests = do
|
||||
describe "mute/unmute messages" $ do
|
||||
it "mute/unmute contact" testMuteContact
|
||||
it "mute/unmute group" testMuteGroup
|
||||
describe "multiple users" $ do
|
||||
it "create second user" testCreateSecondUser
|
||||
it "both users have contact link" testMultipleUserAddresses
|
||||
describe "chat item expiration" $ do
|
||||
it "set chat item TTL" testSetChatItemTTL
|
||||
describe "queue rotation" $ do
|
||||
@@ -4348,6 +4351,126 @@ testMuteGroup =
|
||||
bob ##> "/gs"
|
||||
bob <## "#team"
|
||||
|
||||
testCreateSecondUser :: IO ()
|
||||
testCreateSecondUser =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
|
||||
alice ##> "/create user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
|
||||
-- connect using second user
|
||||
connectUsers alice bob
|
||||
alice #> "@bob hello"
|
||||
bob <# "alisa> hello"
|
||||
bob #> "@alisa hey"
|
||||
alice <# "bob> hey"
|
||||
|
||||
alice ##> "/user"
|
||||
showActiveUser alice "alisa"
|
||||
|
||||
alice ##> "/users"
|
||||
alice <## "alice (Alice)"
|
||||
alice <## "alisa (active)"
|
||||
|
||||
-- receive message to first user
|
||||
bob #> "@alice hey alice"
|
||||
(alice, "alice") $<# "bob> hey alice"
|
||||
|
||||
connectUsers alice cath
|
||||
|
||||
-- set active user to first user
|
||||
alice ##> "/user alice"
|
||||
showActiveUser alice "alice (Alice)"
|
||||
|
||||
alice ##> "/user"
|
||||
showActiveUser alice "alice (Alice)"
|
||||
|
||||
alice ##> "/users"
|
||||
alice <## "alice (Alice) (active)"
|
||||
alice <## "alisa"
|
||||
|
||||
alice <##> bob
|
||||
|
||||
cath #> "@alisa hey alisa"
|
||||
(alice, "alisa") $<# "cath> hey alisa"
|
||||
alice ##> "@cath hi cath"
|
||||
alice <## "no contact cath"
|
||||
|
||||
-- set active user to second user
|
||||
alice ##> "/_user 2"
|
||||
showActiveUser alice "alisa"
|
||||
|
||||
testMultipleUserAddresses :: IO ()
|
||||
testMultipleUserAddresses =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/ad"
|
||||
cLinkAlice <- getContactLink alice True
|
||||
bob ##> ("/c " <> cLinkAlice)
|
||||
alice <#? bob
|
||||
alice @@@ [("<@bob", "")]
|
||||
alice ##> "/ac bob"
|
||||
alice <## "bob (Bob): accepting contact request..."
|
||||
concurrently_
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
alice @@@ [("@bob", "Voice messages: enabled")]
|
||||
alice <##> bob
|
||||
|
||||
alice ##> "/create user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
|
||||
-- connect using second user address
|
||||
alice ##> "/ad"
|
||||
cLinkAlisa <- getContactLink alice True
|
||||
bob ##> ("/c " <> cLinkAlisa)
|
||||
alice <#? bob
|
||||
alice #$> ("/_get chats 2 pcc=on", chats, [("<@bob", "")])
|
||||
alice ##> "/ac bob"
|
||||
alice <## "bob (Bob): accepting contact request..."
|
||||
concurrently_
|
||||
(bob <## "alisa: contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
alice #$> ("/_get chats 2 pcc=on", chats, [("@bob", "Voice messages: enabled")])
|
||||
alice <##> bob
|
||||
|
||||
bob #> "@alice hey alice"
|
||||
(alice, "alice") $<# "bob> hey alice"
|
||||
|
||||
-- delete first user address
|
||||
alice ##> "/user alice"
|
||||
showActiveUser alice "alice (Alice)"
|
||||
|
||||
alice ##> "/da"
|
||||
alice <## "Your chat address is deleted - accepted contacts will remain connected."
|
||||
alice <## "To create a new chat address use /ad"
|
||||
|
||||
-- second user receives request when not active
|
||||
cath ##> ("/c " <> cLinkAlisa)
|
||||
cath <## "connection request sent!"
|
||||
alice <## "[user: alisa] cath (Catherine) wants to connect to you!"
|
||||
alice <## "to accept: /ac cath"
|
||||
alice <## "to reject: /rc cath (the sender will NOT be notified)"
|
||||
|
||||
-- accept request
|
||||
alice ##> "/user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
|
||||
alice ##> "/ac cath"
|
||||
alice <## "cath (Catherine): accepting contact request..."
|
||||
concurrently_
|
||||
(cath <## "alisa: contact is connected")
|
||||
(alice <## "cath (Catherine): contact is connected")
|
||||
alice #$> ("/_get chats 2 pcc=on", chats, [("@cath", "Voice messages: enabled"), ("@bob", "hey")])
|
||||
alice <##> cath
|
||||
|
||||
-- first user doesn't have cath as contact
|
||||
alice ##> "/user alice"
|
||||
showActiveUser alice "alice (Alice)"
|
||||
alice @@@ [("@bob", "hey alice")]
|
||||
|
||||
testSetChatItemTTL :: IO ()
|
||||
testSetChatItemTTL =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
@@ -4990,7 +5113,7 @@ connectUsers cc1 cc2 = do
|
||||
showName :: TestCC -> IO String
|
||||
showName (TestCC ChatController {currentUser} _ _ _ _) = do
|
||||
Just User {localDisplayName, profile = LocalProfile {fullName}} <- readTVarIO currentUser
|
||||
pure . T.unpack $ localDisplayName <> " (" <> fullName <> ")"
|
||||
pure . T.unpack $ localDisplayName <> optionalFullName localDisplayName fullName
|
||||
|
||||
createGroup2 :: String -> TestCC -> TestCC -> IO ()
|
||||
createGroup2 gName cc1 cc2 = do
|
||||
@@ -5100,7 +5223,13 @@ itemId :: Int -> String
|
||||
itemId i = show $ length chatFeatures + i
|
||||
|
||||
(@@@) :: TestCC -> [(String, String)] -> Expectation
|
||||
(@@@) = getChats . map $ \(ldn, msg, _) -> (ldn, msg)
|
||||
(@@@) = getChats mapChats
|
||||
|
||||
mapChats :: [(String, String, Maybe ConnStatus)] -> [(String, String)]
|
||||
mapChats = map $ \(ldn, msg, _) -> (ldn, msg)
|
||||
|
||||
chats :: String -> [(String, String)]
|
||||
chats = mapChats . read
|
||||
|
||||
(@@@!) :: TestCC -> [(String, String, Maybe ConnStatus)] -> Expectation
|
||||
(@@@!) = getChats id
|
||||
@@ -5174,6 +5303,9 @@ cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line
|
||||
(?<#) :: TestCC -> String -> Expectation
|
||||
cc ?<# line = (dropTime <$> getTermLine cc) `shouldReturn` "i " <> line
|
||||
|
||||
($<#) :: (TestCC, String) -> String -> Expectation
|
||||
(cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine cc) `shouldReturn` line
|
||||
|
||||
(</) :: TestCC -> Expectation
|
||||
(</) = (<// 500000)
|
||||
|
||||
@@ -5186,6 +5318,18 @@ cc1 <#? cc2 = do
|
||||
cc1 <## ("to accept: /ac " <> name)
|
||||
cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)")
|
||||
|
||||
dropUser :: String -> String -> String
|
||||
dropUser uName msg = fromMaybe err $ dropUser_ uName msg
|
||||
where
|
||||
err = error $ "invalid user: " <> msg
|
||||
|
||||
dropUser_ :: String -> String -> Maybe String
|
||||
dropUser_ uName msg = do
|
||||
let userPrefix = "[user: " <> uName <> "] "
|
||||
if userPrefix `isPrefixOf` msg
|
||||
then Just $ drop (length userPrefix) msg
|
||||
else Nothing
|
||||
|
||||
dropTime :: String -> String
|
||||
dropTime msg = fromMaybe err $ dropTime_ msg
|
||||
where
|
||||
@@ -5245,3 +5389,9 @@ lastItemId :: TestCC -> IO String
|
||||
lastItemId cc = do
|
||||
cc ##> "/last_item_id"
|
||||
getTermLine cc
|
||||
|
||||
showActiveUser :: TestCC -> String -> Expectation
|
||||
showActiveUser cc name = do
|
||||
cc <## ("user profile: " <> name)
|
||||
cc <## "use /p <display name> [<full name>] to change it"
|
||||
cc <## "(the updated profile will be sent to all your contacts)"
|
||||
|
||||
Reference in New Issue
Block a user