WPB-6258 Connection request from deleted user (#3861)

wireapp · Feb 21, 2024 · d3d495a · d3d495a
1 parent e793394
commit d3d495a
Show file tree

Hide file tree

Showing 22 changed files with 541 additions and 109 deletions.
diff --git a/changelog.d/3-bug-fixes/WPB-6258 b/changelog.d/3-bug-fixes/WPB-6258
@@ -0,0 +1 @@
+Send connection cancelled event to local pending connection when user gets deleted
diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs
@@ -113,6 +113,12 @@ isConvDeleteNotif n = fieldEquals n "payload.0.type" "conversation.delete"
 isTeamMemberLeaveNotif :: MakesValue a => a -> App Bool
 isTeamMemberLeaveNotif n = nPayload n %. "type" `isEqual` "team.member-leave"
 
+isConnectionNotif :: MakesValue a => String -> a -> App Bool
+isConnectionNotif status n =
+  (&&)
+    <$> nPayload n %. "type" `isEqual` "user.connection"
+    <*> nPayload n %. "connection.status" `isEqual` status
+
 assertLeaveNotification ::
   ( HasCallStack,
     MakesValue fromUser,

diff --git a/integration/test/Test/Connection.hs b/integration/test/Test/Connection.hs
@@ -19,6 +19,7 @@ module Test.Connection where
 import API.Brig (getConnection, postConnection, putConnection)
 import API.BrigInternal
 import API.Galley
+import Notifications
 import SetupHelpers
 import Testlib.Prelude
 import UnliftIO.Async (forConcurrently_)
@@ -401,3 +402,14 @@ testFederationAllowMixedConnectWithRemote =
     connectTwoUsers alice bob
   where
     defSearchPolicy = "full_search"
+
+testPendingConnectionUserDeleted :: HasCallStack => Domain -> App ()
+testPendingConnectionUserDeleted bobsDomain = do
+  alice <- randomUser OwnDomain def
+  bob <- randomUser bobsDomain def
+
+  withWebSockets [bob] $ \[bobWs] -> do
+    void $ postConnection alice bob >>= getBody 201
+    void $ awaitMatch (isConnectionNotif "pending") bobWs
+    void $ deleteUser alice
+    void $ awaitMatch (isConnectionNotif "cancelled") bobWs
diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs
@@ -36,6 +36,7 @@ import Data.Id
 import Data.Qualified
 import Data.Range
 import Imports
+import Wire.API.Connection (UserConnection)
 import Wire.API.Team.Member (HardTruncationLimit, TeamMember)
 import qualified Wire.Sem.Paging as E
 
@@ -97,6 +98,8 @@ type instance E.PagingBounds CassandraPaging TeamMember = Range 1 HardTruncation
 
 type instance E.PagingBounds InternalPaging TeamId = Range 1 100 Int32
 
+type instance E.PagingBounds InternalPaging (Remote UserConnection) = Range 1 1000 Int32
+
 instance E.Paging InternalPaging where
   pageItems (InternalPage (_, _, items)) = items
   pageHasMore (InternalPage (p, _, _)) = hasMore p

diff --git a/libs/types-common/src/Data/Range.hs b/libs/types-common/src/Data/Range.hs
@@ -98,7 +98,7 @@ import Test.QuickCheck qualified as QC
 newtype Range (n :: Nat) (m :: Nat) a = Range
   { fromRange :: a
   }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Functor)
 
 toRange :: (n <= x, x <= m, KnownNat x, Num a) => Proxy x -> Range n m a
 toRange = Range . fromIntegral . natVal

diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs
@@ -173,6 +173,7 @@ type AccountAPI =
     "createUserNoVerify"
     ( "users"
         :> MakesFederatedCall 'Brig "on-user-deleted-connections"
+        :> MakesFederatedCall 'Brig "send-connection-action"
         :> ReqBody '[Servant.JSON] NewUser
         :> MultiVerb 'POST '[Servant.JSON] RegisterInternalResponses (Either RegisterError SelfProfile)
     )
@@ -181,6 +182,7 @@ type AccountAPI =
            ( "users"
                :> "spar"
                :> MakesFederatedCall 'Brig "on-user-deleted-connections"
+               :> MakesFederatedCall 'Brig "send-connection-action"
                :> ReqBody '[Servant.JSON] NewUserSpar
                :> MultiVerb 'POST '[Servant.JSON] CreateUserSparInternalResponses (Either CreateUserSparError SelfProfile)
            )
@@ -679,13 +681,15 @@ type AuthAPI =
     "legalhold-login"
     ( "legalhold-login"
         :> MakesFederatedCall 'Brig "on-user-deleted-connections"
+        :> MakesFederatedCall 'Brig "send-connection-action"
         :> ReqBody '[JSON] LegalHoldLogin
         :> MultiVerb1 'POST '[JSON] TokenResponse
     )
     :<|> Named
            "sso-login"
            ( "sso-login"
                :> MakesFederatedCall 'Brig "on-user-deleted-connections"
+               :> MakesFederatedCall 'Brig "send-connection-action"
                :> ReqBody '[JSON] SsoLogin
                :> QueryParam' [Optional, Strict] "persist" Bool
                :> MultiVerb1 'POST '[JSON] TokenResponse

diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs
@@ -316,6 +316,7 @@ type SelfAPI =
                \password, it must be provided. if password is correct, or if neither \
                \a verified identity nor a password exists, account deletion \
                \is scheduled immediately."
+          :> MakesFederatedCall 'Brig "send-connection-action"
           :> CanThrow 'InvalidUser
           :> CanThrow 'InvalidCode
           :> CanThrow 'BadCredentials
@@ -333,6 +334,7 @@ type SelfAPI =
     Named
       "put-self"
       ( Summary "Update your profile."
+          :> MakesFederatedCall 'Brig "send-connection-action"
           :> ZUser
           :> ZConn
           :> "self"
@@ -358,6 +360,7 @@ type SelfAPI =
           :> Description
                "Your phone number can only be removed if you also have an \
                \email address and a password."
+          :> MakesFederatedCall 'Brig "send-connection-action"
           :> ZUser
           :> ZConn
           :> "self"
@@ -373,6 +376,7 @@ type SelfAPI =
           :> Description
                "Your email address can only be removed if you also have a \
                \phone number."
+          :> MakesFederatedCall 'Brig "send-connection-action"
           :> ZUser
           :> ZConn
           :> "self"
@@ -405,6 +409,7 @@ type SelfAPI =
     :<|> Named
            "change-locale"
            ( Summary "Change your locale."
+               :> MakesFederatedCall 'Brig "send-connection-action"
                :> ZUser
                :> ZConn
                :> "self"
@@ -415,6 +420,8 @@ type SelfAPI =
     :<|> Named
            "change-handle"
            ( Summary "Change your handle."
+               :> MakesFederatedCall 'Brig "send-connection-action"
+               :> MakesFederatedCall 'Brig "send-connection-action"
                :> ZUser
                :> ZConn
                :> "self"
@@ -477,6 +484,7 @@ type AccountAPI =
              "If the environment where the registration takes \
              \place is private and a registered email address or phone \
              \number is not whitelisted, a 403 error is returned."
+        :> MakesFederatedCall 'Brig "send-connection-action"
         :> "register"
         :> ReqBody '[JSON] NewUserPublic
         :> MultiVerb 'POST '[JSON] RegisterResponses (Either RegisterError RegisterSuccess)
@@ -487,6 +495,7 @@ type AccountAPI =
     :<|> Named
            "verify-delete"
            ( Summary "Verify account deletion with a code."
+               :> MakesFederatedCall 'Brig "send-connection-action"
                :> CanThrow 'InvalidCode
                :> "delete"
                :> ReqBody '[JSON] VerifyDeleteUser
@@ -498,6 +507,7 @@ type AccountAPI =
     :<|> Named
            "get-activate"
            ( Summary "Activate (i.e. confirm) an email address or phone number."
+               :> MakesFederatedCall 'Brig "send-connection-action"
                :> Description "See also 'POST /activate' which has a larger feature set."
                :> CanThrow 'UserKeyExists
                :> CanThrow 'InvalidActivationCodeWrongUser
@@ -524,6 +534,7 @@ type AccountAPI =
                :> Description
                     "Activation only succeeds once and the number of \
                     \failed attempts for a valid key is limited."
+               :> MakesFederatedCall 'Brig "send-connection-action"
                :> CanThrow 'UserKeyExists
                :> CanThrow 'InvalidActivationCodeWrongUser
                :> CanThrow 'InvalidActivationCodeWrongCode
@@ -728,6 +739,7 @@ type UserClientAPI =
   Named
     "add-client"
     ( Summary "Register a new client"
+        :> MakesFederatedCall 'Brig "send-connection-action"
         :> CanThrow 'TooManyClients
         :> CanThrow 'MissingAuth
         :> CanThrow 'MalformedPrekeys
@@ -1334,6 +1346,7 @@ type AuthAPI =
              \ Every other combination is invalid.\
              \ Access tokens can be given as query parameter or authorisation\
              \ header, with the latter being preferred."
+        :> MakesFederatedCall 'Brig "send-connection-action"
         :> QueryParam "client_id" ClientId
         :> Cookies '["zuid" ::: SomeUserToken]
         :> Bearer SomeAccessToken
@@ -1364,6 +1377,7 @@ type AuthAPI =
            ( "login"
                :> Summary "Authenticate a user to obtain a cookie and first access token"
                :> Description "Logins are throttled at the server's discretion"
+               :> MakesFederatedCall 'Brig "send-connection-action"
                :> ReqBody '[JSON] Login
                :> QueryParam'
                     [ Optional,

diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
@@ -125,6 +125,8 @@ library
     Brig.Effects.BlacklistStore.Cassandra
     Brig.Effects.CodeStore
     Brig.Effects.CodeStore.Cassandra
+    Brig.Effects.ConnectionStore
+    Brig.Effects.ConnectionStore.Cassandra
     Brig.Effects.FederationConfigStore
     Brig.Effects.FederationConfigStore.Cassandra
     Brig.Effects.GalleyProvider

diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs
@@ -24,6 +24,7 @@ import Brig.API.User
 import Brig.App
 import Brig.Data.User qualified as User
 import Brig.Effects.BlacklistStore
+import Brig.Effects.ConnectionStore (ConnectionStore)
 import Brig.Effects.GalleyProvider
 import Brig.Options
 import Brig.User.Auth qualified as Auth
@@ -37,24 +38,30 @@ import Data.List1 (List1 (..))
 import Data.Qualified
 import Data.Text qualified as T
 import Data.Text.Lazy qualified as LT
+import Data.Time.Clock (UTCTime)
 import Data.ZAuth.Token qualified as ZAuth
 import Imports
 import Network.HTTP.Types
 import Network.Wai.Utilities ((!>>))
 import Network.Wai.Utilities.Error qualified as Wai
 import Polysemy
+import Polysemy.Input (Input)
 import Polysemy.TinyLog (TinyLog)
 import Wire.API.User
 import Wire.API.User.Auth hiding (access)
 import Wire.API.User.Auth.LegalHold
 import Wire.API.User.Auth.ReAuth
 import Wire.API.User.Auth.Sso
 import Wire.NotificationSubsystem
+import Wire.Sem.Paging.Cassandra (InternalPaging)
 
 accessH ::
   ( Member TinyLog r,
     Member (Embed HttpClientIO) r,
-    Member NotificationSubsystem r
+    Member NotificationSubsystem r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   Maybe ClientId ->
   [Either Text SomeUserToken] ->
@@ -70,7 +77,10 @@ access ::
   ( TokenPair u a,
     Member TinyLog r,
     Member (Embed HttpClientIO) r,
-    Member NotificationSubsystem r
+    Member NotificationSubsystem r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   Maybe ClientId ->
   NonEmpty (Token u) ->
@@ -90,7 +100,10 @@ login ::
   ( Member GalleyProvider r,
     Member TinyLog r,
     Member (Embed HttpClientIO) r,
-    Member NotificationSubsystem r
+    Member NotificationSubsystem r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   Login ->
   Maybe Bool ->
@@ -150,7 +163,10 @@ legalHoldLogin ::
   ( Member GalleyProvider r,
     Member (Embed HttpClientIO) r,
     Member NotificationSubsystem r,
-    Member TinyLog r
+    Member TinyLog r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   LegalHoldLogin ->
   Handler r SomeAccess
@@ -162,7 +178,10 @@ legalHoldLogin lhl = do
 ssoLogin ::
   ( Member TinyLog r,
     Member (Embed HttpClientIO) r,
-    Member NotificationSubsystem r
+    Member NotificationSubsystem r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   SsoLogin ->
   Maybe Bool ->

diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs
@@ -53,6 +53,7 @@ import Brig.App
 import Brig.Data.Client qualified as Data
 import Brig.Data.Nonce as Nonce
 import Brig.Data.User qualified as Data
+import Brig.Effects.ConnectionStore (ConnectionStore)
 import Brig.Effects.GalleyProvider (GalleyProvider)
 import Brig.Effects.GalleyProvider qualified as GalleyProvider
 import Brig.Effects.JwtTools (JwtTools)
@@ -86,10 +87,12 @@ import Data.Map.Strict qualified as Map
 import Data.Misc (PlainTextPassword6)
 import Data.Qualified
 import Data.Set qualified as Set
+import Data.Time.Clock (UTCTime)
 import Imports
 import Network.HTTP.Types.Method (StdMethod)
 import Network.Wai.Utilities
 import Polysemy
+import Polysemy.Input (Input)
 import Polysemy.TinyLog
 import Servant (Link, ToHttpApiData (toUrlPiece))
 import System.Logger.Class (field, msg, val, (~~))
@@ -110,6 +113,7 @@ import Wire.NotificationSubsystem
 import Wire.Sem.Concurrency
 import Wire.Sem.FromUTC (FromUTC (fromUTCTime))
 import Wire.Sem.Now as Now
+import Wire.Sem.Paging.Cassandra (InternalPaging)
 
 lookupLocalClient :: UserId -> ClientId -> (AppT r) (Maybe Client)
 lookupLocalClient uid = wrapClient . Data.lookupClient uid
@@ -158,7 +162,10 @@ addClient ::
   ( Member GalleyProvider r,
     Member (Embed HttpClientIO) r,
     Member NotificationSubsystem r,
-    Member TinyLog r
+    Member TinyLog r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   UserId ->
   Maybe ConnId ->
@@ -173,7 +180,10 @@ addClientWithReAuthPolicy ::
   ( Member GalleyProvider r,
     Member (Embed HttpClientIO) r,
     Member NotificationSubsystem r,
-    Member TinyLog r
+    Member TinyLog r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   Data.ReAuthPolicy ->
   UserId ->
@@ -475,7 +485,10 @@ pubClient c =
 legalHoldClientRequested ::
   ( Member (Embed HttpClientIO) r,
     Member NotificationSubsystem r,
-    Member TinyLog r
+    Member TinyLog r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   UserId ->
   LegalHoldClientRequest ->
@@ -493,7 +506,10 @@ legalHoldClientRequested targetUser (LegalHoldClientRequest _requester lastPreke
 removeLegalHoldClient ::
   ( Member (Embed HttpClientIO) r,
     Member NotificationSubsystem r,
-    Member TinyLog r
+    Member TinyLog r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   UserId ->
   AppT r ()
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		Send connection cancelled event to local pending connection when user gets deleted