Merge branch 'develop' of github.com:wireapp/wire-server into mls

- Introduce CallsFed to endpoints that are not on `develop` yet

changelog.d/5-internal/federated-calls-brig

@@ -0,0 +1 @@
+Added typeclasses to track uses of federated calls across the codebase.

changelog.d/5-internal/pr-2940

@@ -0,0 +1 @@
+Track federated calls in types across the codebase.

changelog.d/5-internal/rm-unused-remote-conv-list-store-effect

@@ -0,0 +1 @@
+Remove an unused effect for remote conversation listing

hack/bin/upload-image.sh

@@ -35,29 +35,24 @@ function retry {
     local maxAttempts=$1
     local secondsDelay=1
     local attemptCount=1
-    local output=
     shift 1
 
     while [ $attemptCount -le "$maxAttempts" ]; do
-        output=$("$@")
-        local status=$?
-
-        if [ $status -eq 0 ]; then
+        if "$@"; then
             break
-        fi
-
-        if [ $attemptCount -lt "$maxAttempts" ]; then
-            echo "Command [$*] failed after attempt $attemptCount of $maxAttempts. Retrying in $secondsDelay second(s)." >&2
-            sleep $secondsDelay
-        elif [ $attemptCount -eq "$maxAttempts" ]; then
-            echo "Command [$*] failed after $attemptCount attempt(s)" >&2
-            return $status
+        else
+            local status=$?
+            if [ $attemptCount -lt "$maxAttempts" ]; then
+                echo "Command [$*] failed after attempt $attemptCount of $maxAttempts. Retrying in $secondsDelay second(s)." >&2
+                sleep $secondsDelay
+            elif [ $attemptCount -eq "$maxAttempts" ]; then
+                echo "Command [$*] failed after $attemptCount attempt(s)" >&2
+                return $status
+            fi
         fi
         attemptCount=$((attemptCount + 1))
         secondsDelay=$((secondsDelay * 2))
     done
-
-    echo "$output"
 }
 
 tmp_link_store=$(mktemp -d)

libs/wire-api-federation/src/Wire/API/Federation/API.hs

@@ -20,6 +20,7 @@ module Wire.API.Federation.API
     HasFedEndpoint,
     fedClient,
     fedClientIn,
+    CallsFed,
 
     -- * Re-exports
     Component (..),
@@ -48,12 +49,14 @@ type instance FedApi 'Brig = BrigApi
 
 type instance FedApi 'Cargohold = CargoholdApi
 
-type HasFedEndpoint comp api name = ('Just api ~ LookupEndpoint (FedApi comp) name)
+type HasFedEndpoint comp api name = ('Just api ~ LookupEndpoint (FedApi comp) name, CallsFed comp name)
+
+class CallsFed (comp :: Component) (name :: Symbol)
 
 -- | Return a client for a named endpoint.
 fedClient ::
   forall (comp :: Component) (name :: Symbol) m api.
-  (HasFedEndpoint comp api name, HasClient m api, m ~ FederatorClient comp) =>
+  (CallsFed comp name, HasFedEndpoint comp api name, HasClient m api, m ~ FederatorClient comp) =>
   Client m api
 fedClient = clientIn (Proxy @api) (Proxy @m)
 

services/brig/src/Brig/API.hs

@@ -32,20 +32,23 @@ import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
 import qualified Data.Swagger.Build.Api as Doc
 import Network.Wai.Routing (Routes)
 import Polysemy
+import Wire.API.Federation.API
 import Wire.Sem.Concurrency
 
 sitemap ::
   forall r p.
-  Members
-    '[ BlacklistPhonePrefixStore,
-       BlacklistStore,
-       GalleyProvider,
-       CodeStore,
-       Concurrency 'Unsafe,
-       PasswordResetStore,
-       UserPendingActivationStore p
-     ]
-    r =>
+  ( Members
+      '[ BlacklistPhonePrefixStore,
+         BlacklistStore,
+         GalleyProvider,
+         CodeStore,
+         Concurrency 'Unsafe,
+         PasswordResetStore,
+         UserPendingActivationStore p
+       ]
+      r,
+    CallsFed 'Brig "on-user-deleted-connections"
+  ) =>
   Routes Doc.ApiBuilder (Handler r) ()
 sitemap = do
   Public.sitemap

services/brig/src/Brig/API/Auth.hs

@@ -43,13 +43,15 @@ import Network.HTTP.Types
 import Network.Wai.Utilities ((!>>))
 import qualified Network.Wai.Utilities.Error as Wai
 import Polysemy
+import Wire.API.Federation.API
 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
 
 accessH ::
+  CallsFed 'Brig "on-user-deleted-connections" =>
   Maybe ClientId ->
   [Either Text SomeUserToken] ->
   Maybe (Either Text SomeAccessToken) ->
@@ -61,7 +63,7 @@ accessH mcid ut' mat' = do
     >>= either (uncurry (access mcid)) (uncurry (access mcid))
 
 access ::
-  TokenPair u a =>
+  (TokenPair u a, CallsFed 'Brig "on-user-deleted-connections") =>
   Maybe ClientId ->
   NonEmpty (Token u) ->
   Maybe (Token a) ->
@@ -76,7 +78,7 @@ sendLoginCode (SendLoginCode phone call force) = do
   c <- wrapClientE (Auth.sendLoginCode phone call force) !>> sendLoginCodeError
   pure $ LoginCodeTimeout (pendingLoginTimeout c)
 
-login :: Member GalleyProvider r => Login -> Maybe Bool -> Handler r SomeAccess
+login :: (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") => Login -> Maybe Bool -> Handler r SomeAccess
 login l (fromMaybe False -> persist) = do
   let typ = if persist then PersistentCookie else SessionCookie
   c <- Auth.login l typ !>> loginError
@@ -128,13 +130,13 @@ removeCookies :: Local UserId -> RemoveCookies -> Handler r ()
 removeCookies lusr (RemoveCookies pw lls ids) =
   wrapClientE (Auth.revokeAccess (tUnqualified lusr) pw ids lls) !>> authError
 
-legalHoldLogin :: Member GalleyProvider r => LegalHoldLogin -> Handler r SomeAccess
+legalHoldLogin :: (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") => LegalHoldLogin -> Handler r SomeAccess
 legalHoldLogin lhl = do
   let typ = PersistentCookie -- Session cookie isn't a supported use case here
   c <- Auth.legalHoldLogin lhl typ !>> legalHoldLoginError
   traverse mkUserTokenCookie c
 
-ssoLogin :: SsoLogin -> Maybe Bool -> Handler r SomeAccess
+ssoLogin :: CallsFed 'Brig "on-user-deleted-connections" => SsoLogin -> Maybe Bool -> Handler r SomeAccess
 ssoLogin l (fromMaybe False -> persist) = do
   let typ = if persist then PersistentCookie else SessionCookie
   c <- wrapHttpClientE (Auth.ssoLogin l typ) !>> loginError

services/brig/src/Brig/API/Client.hs

@@ -93,6 +93,7 @@ import Polysemy (Member, Members)
 import Servant (Link, ToHttpApiData (toUrlPiece))
 import System.Logger.Class (field, msg, val, (~~))
 import qualified System.Logger.Class as Log
+import Wire.API.Federation.API
 import Wire.API.Federation.API.Brig (GetUserClients (GetUserClients))
 import Wire.API.Federation.Error
 import Wire.API.MLS.Credential (ClientIdentity (..))
@@ -115,12 +116,12 @@ lookupLocalClient uid = wrapClient . Data.lookupClient uid
 lookupLocalClients :: UserId -> (AppT r) [Client]
 lookupLocalClients = wrapClient . Data.lookupClients
 
-lookupPubClient :: Qualified UserId -> ClientId -> ExceptT ClientError (AppT r) (Maybe PubClient)
+lookupPubClient :: CallsFed 'Brig "get-user-clients" => Qualified UserId -> ClientId -> ExceptT ClientError (AppT r) (Maybe PubClient)
 lookupPubClient qid cid = do
   clients <- lookupPubClients qid
   pure $ find ((== cid) . pubClientId) clients
 
-lookupPubClients :: Qualified UserId -> ExceptT ClientError (AppT r) [PubClient]
+lookupPubClients :: CallsFed 'Brig "get-user-clients" => Qualified UserId -> ExceptT ClientError (AppT r) [PubClient]
 lookupPubClients qid@(Qualified uid domain) = do
   getForUser <$> lookupPubClientsBulk [qid]
   where
@@ -129,7 +130,7 @@ lookupPubClients qid@(Qualified uid domain) = do
       um <- userMap <$> Map.lookup domain (qualifiedUserMap qmap)
       Set.toList <$> Map.lookup uid um
 
-lookupPubClientsBulk :: [Qualified UserId] -> ExceptT ClientError (AppT r) (QualifiedUserMap (Set PubClient))
+lookupPubClientsBulk :: CallsFed 'Brig "get-user-clients" => [Qualified UserId] -> ExceptT ClientError (AppT r) (QualifiedUserMap (Set PubClient))
 lookupPubClientsBulk qualifiedUids = do
   loc <- qualifyLocal ()
   let (localUsers, remoteUsers) = partitionQualified loc qualifiedUids
@@ -145,7 +146,7 @@ lookupLocalPubClientsBulk :: [UserId] -> ExceptT ClientError (AppT r) (UserMap (
 lookupLocalPubClientsBulk = lift . wrapClient . Data.lookupPubClientsBulk
 
 addClient ::
-  Members '[GalleyProvider] r =>
+  (Members '[GalleyProvider] r, CallsFed 'Brig "on-user-deleted-connections") =>
   UserId ->
   Maybe ConnId ->
   Maybe IP ->
@@ -157,7 +158,7 @@ addClient = addClientWithReAuthPolicy Data.reAuthForNewClients
 -- a superset of the clients known to galley.
 addClientWithReAuthPolicy ::
   forall r.
-  Members '[GalleyProvider] r =>
+  (Members '[GalleyProvider] r, CallsFed 'Brig "on-user-deleted-connections") =>
   Data.ReAuthPolicy ->
   UserId ->
   Maybe ConnId ->
@@ -238,6 +239,7 @@ rmClient u con clt pw =
       lift $ execDelete u (Just con) client
 
 claimPrekey ::
+  CallsFed 'Brig "claim-prekey" =>
   LegalholdProtectee ->
   UserId ->
   Domain ->
@@ -264,14 +266,15 @@ claimLocalPrekey protectee user client = do
 claimRemotePrekey ::
   ( MonadReader Env m,
     Log.MonadLogger m,
-    MonadClient m
+    MonadClient m,
+    CallsFed 'Brig "claim-prekey"
   ) =>
   Qualified UserId ->
   ClientId ->
   ExceptT ClientError m (Maybe ClientPrekey)
 claimRemotePrekey quser client = fmapLT ClientFederationError $ Federation.claimPrekey quser client
 
-claimPrekeyBundle :: LegalholdProtectee -> Domain -> UserId -> ExceptT ClientError (AppT r) PrekeyBundle
+claimPrekeyBundle :: CallsFed 'Brig "claim-prekey-bundle" => LegalholdProtectee -> Domain -> UserId -> ExceptT ClientError (AppT r) PrekeyBundle
 claimPrekeyBundle protectee domain uid = do
   isLocalDomain <- (domain ==) <$> viewFederationDomain
   if isLocalDomain
@@ -284,13 +287,13 @@ claimLocalPrekeyBundle protectee u = do
   guardLegalhold protectee (mkUserClients [(u, clients)])
   PrekeyBundle u . catMaybes <$> lift (mapM (wrapHttp . Data.claimPrekey u) clients)
 
-claimRemotePrekeyBundle :: Qualified UserId -> ExceptT ClientError (AppT r) PrekeyBundle
+claimRemotePrekeyBundle :: CallsFed 'Brig "claim-prekey-bundle" => Qualified UserId -> ExceptT ClientError (AppT r) PrekeyBundle
 claimRemotePrekeyBundle quser = do
   Federation.claimPrekeyBundle quser !>> ClientFederationError
 
 claimMultiPrekeyBundles ::
   forall r.
-  Members '[Concurrency 'Unsafe] r =>
+  (Members '[Concurrency 'Unsafe] r, CallsFed 'Brig "claim-multi-prekey-bundle") =>
   LegalholdProtectee ->
   QualifiedUserClients ->
   ExceptT ClientError (AppT r) QualifiedUserClientPrekeyMap
@@ -410,7 +413,7 @@ pubClient c =
       pubClientClass = clientClass c
     }
 
-legalHoldClientRequested :: UserId -> LegalHoldClientRequest -> (AppT r) ()
+legalHoldClientRequested :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> LegalHoldClientRequest -> (AppT r) ()
 legalHoldClientRequested targetUser (LegalHoldClientRequest _requester lastPrekey') =
   wrapHttpClient $ Intra.onUserEvent targetUser Nothing lhClientEvent
   where
@@ -421,7 +424,7 @@ legalHoldClientRequested targetUser (LegalHoldClientRequest _requester lastPreke
     lhClientEvent :: UserEvent
     lhClientEvent = LegalHoldClientRequested eventData
 
-removeLegalHoldClient :: UserId -> (AppT r) ()
+removeLegalHoldClient :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> (AppT r) ()
 removeLegalHoldClient uid = do
   clients <- wrapClient $ Data.lookupClients uid
   -- Should only be one; but just in case we'll treat it as a list

services/brig/src/Brig/API/Connection.hs

@@ -60,6 +60,7 @@ import Wire.API.Connection hiding (relationWithHistory)
 import Wire.API.Conversation
 import Wire.API.Error
 import qualified Wire.API.Error.Brig as E
+import Wire.API.Federation.API
 import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..))
 
 ensureIsActivated :: Local UserId -> MaybeT (AppT r) ()
@@ -75,7 +76,7 @@ ensureNotSameTeam self target = do
     throwE ConnectSameBindingTeamUsers
 
 createConnection ::
-  Members '[GalleyProvider] r =>
+  (Members '[GalleyProvider] r, CallsFed 'Brig "send-connection-action") =>
   Local UserId ->
   ConnId ->
   Qualified UserId ->
@@ -210,6 +211,7 @@ checkLegalholdPolicyConflict uid1 uid2 = do
   oneway status2 status1
 
 updateConnection ::
+  CallsFed 'Brig "send-connection-action" =>
   Local UserId ->
   Qualified UserId ->
   Relation ->

services/brig/src/Brig/API/Connection/Remote.hs

@@ -39,6 +39,7 @@ import Galley.Types.Conversations.Intra (Actor (..), DesiredMembership (..), Ups
 import Imports
 import Network.Wai.Utilities.Error
 import Wire.API.Connection
+import Wire.API.Federation.API
 import Wire.API.Federation.API.Brig
   ( NewConnectionResponse (..),
     RemoteConnectionAction (..),
@@ -187,6 +188,7 @@ pushEvent self mzcon connection = do
   Intra.onConnectionEvent (tUnqualified self) mzcon event
 
 performLocalAction ::
+  CallsFed 'Brig "send-connection-action" =>
   Local UserId ->
   Maybe ConnId ->
   Remote UserId ->
@@ -251,6 +253,7 @@ performRemoteAction self other mconnection action = do
     reaction _ = Nothing
 
 createConnectionToRemoteUser ::
+  CallsFed 'Brig "send-connection-action" =>
   Local UserId ->
   ConnId ->
   Remote UserId ->
@@ -260,6 +263,7 @@ createConnectionToRemoteUser self zcon other = do
   fst <$> performLocalAction self (Just zcon) other mconnection LocalConnect
 
 updateConnectionToRemoteUser ::
+  CallsFed 'Brig "send-connection-action" =>
   Local UserId ->
   Remote UserId ->
   Relation ->