Brig Polysemy: Galley RPC effect

changelog.d/5-internal/galley-rpc

@@ -0,0 +1 @@
+Add RPC, ServiceRPC and GalleyProvider effects to brig

services/brig/brig.cabal

@@ -62,10 +62,16 @@ library
     Brig.Effects.CodeStore
     Brig.Effects.CodeStore.Cassandra
     Brig.Effects.Delay
+    Brig.Effects.GalleyProvider
+    Brig.Effects.GalleyProvider.RPC
     Brig.Effects.JwtTools
     Brig.Effects.PasswordResetStore
     Brig.Effects.PasswordResetStore.CodeStore
     Brig.Effects.PublicKeyBundle
+    Brig.Effects.RPC
+    Brig.Effects.RPC.IO
+    Brig.Effects.ServiceRPC
+    Brig.Effects.ServiceRPC.IO
     Brig.Effects.SFT
     Brig.Effects.UserPendingActivationStore
     Brig.Effects.UserPendingActivationStore.Cassandra

services/brig/src/Brig/API.hs

@@ -26,6 +26,7 @@ import qualified Brig.API.Public as Public
 import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore)
 import Brig.Effects.BlacklistStore (BlacklistStore)
 import Brig.Effects.CodeStore
+import Brig.Effects.GalleyProvider (GalleyProvider)
 import Brig.Effects.PasswordResetStore (PasswordResetStore)
 import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
 import qualified Data.Swagger.Build.Api as Doc
@@ -39,6 +40,7 @@ sitemap ::
        PasswordResetStore,
        BlacklistStore,
        BlacklistPhonePrefixStore,
+       GalleyProvider,
        UserPendingActivationStore p
      ]
     r =>

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

@@ -54,6 +54,8 @@ import Brig.App
 import qualified Brig.Data.Client as Data
 import Brig.Data.Nonce as Nonce
 import qualified Brig.Data.User as Data
+import Brig.Effects.GalleyProvider (GalleyProvider)
+import qualified Brig.Effects.GalleyProvider as GalleyProvider
 import Brig.Effects.JwtTools (JwtTools)
 import qualified Brig.Effects.JwtTools as JwtTools
 import Brig.Effects.PublicKeyBundle (PublicKeyBundle)
@@ -90,7 +92,7 @@ import Data.String.Conversions (cs)
 import Imports
 import Network.HTTP.Types.Method (StdMethod)
 import Network.Wai.Utilities
-import Polysemy (Member)
+import Polysemy (Member, Members)
 import Servant (Link, ToHttpApiData (toUrlPiece))
 import System.Logger.Class (field, msg, val, (~~))
 import qualified System.Logger.Class as Log
@@ -146,6 +148,7 @@ lookupLocalPubClientsBulk :: [UserId] -> ExceptT ClientError (AppT r) (UserMap (
 lookupLocalPubClientsBulk = lift . wrapClient . Data.lookupPubClientsBulk
 
 addClient ::
+  Members '[GalleyProvider] r =>
   UserId ->
   Maybe ConnId ->
   Maybe IP ->
@@ -156,6 +159,8 @@ addClient = addClientWithReAuthPolicy Data.reAuthForNewClients
 -- nb. We must ensure that the set of clients known to brig is always
 -- a superset of the clients known to galley.
 addClientWithReAuthPolicy ::
+  forall r.
+  Members '[GalleyProvider] r =>
   Data.ReAuthPolicy ->
   UserId ->
   Maybe ConnId ->
@@ -164,7 +169,7 @@ addClientWithReAuthPolicy ::
   ExceptT ClientError (AppT r) Client
 addClientWithReAuthPolicy policy u con ip new = do
   acc <- lift (wrapClient $ Data.lookupAccount u) >>= maybe (throwE (ClientUserNotFound u)) pure
-  wrapHttpClientE $ verifyCode (newClientVerificationCode new) (userId . accountUser $ acc)
+  verifyCode (newClientVerificationCode new) (userId . accountUser $ acc)
   loc <- maybe (pure Nothing) locationOf ip
   maxPermClients <- fromMaybe Opt.defUserMaxPermClients . Opt.setUserMaxPermClients <$> view settings
   let caps :: Maybe (Set ClientCapability)
@@ -183,9 +188,8 @@ addClientWithReAuthPolicy policy u con ip new = do
   let usr = accountUser acc
   lift $ do
     for_ old $ execDelete u con
-    wrapHttp $ do
-      Intra.newClient u (clientId clt)
-      Intra.onClientEvent u con (ClientAdded u clt)
+    liftSem $ GalleyProvider.newClient u (clientId clt)
+    wrapHttp $ Intra.onClientEvent u con (ClientAdded u clt)
     when (clientType clt == LegalHoldClientType) $ wrapHttpClient $ Intra.onUserEvent u con (UserLegalHoldEnabled u)
     when (count > 1) $
       for_ (userEmail usr) $
@@ -196,16 +200,9 @@ addClientWithReAuthPolicy policy u con ip new = do
     clientId' = clientIdFromPrekey (unpackLastPrekey $ newClientLastKey new)
 
     verifyCode ::
-      ( MonadReader Env m,
-        MonadMask m,
-        MonadHttp m,
-        HasRequestId m,
-        Log.MonadLogger m,
-        MonadClient m
-      ) =>
       Maybe Code.Value ->
       UserId ->
-      ExceptT ClientError m ()
+      ExceptT ClientError (AppT r) ()
     verifyCode mbCode userId =
       -- this only happens inside the login flow (in particular, when logging in from a new device)
       -- the code obtained for logging in is used a second time for adding the device

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

@@ -39,6 +39,8 @@ import Brig.App
 import qualified Brig.Data.Connection as Data
 import Brig.Data.Types (resultHasMore, resultList)
 import qualified Brig.Data.User as Data
+import Brig.Effects.GalleyProvider (GalleyProvider)
+import qualified Brig.Effects.GalleyProvider as GalleyProvider
 import qualified Brig.IO.Intra as Intra
 import Brig.Types.Connection
 import Brig.Types.User.Event
@@ -51,6 +53,7 @@ import Data.Qualified
 import Data.Range
 import qualified Data.UUID.V4 as UUID
 import Imports
+import Polysemy (Members)
 import qualified System.Logger.Class as Log
 import System.Logger.Message
 import Wire.API.Connection hiding (relationWithHistory)
@@ -64,14 +67,15 @@ ensureIsActivated lusr = do
   active <- lift . wrapClient $ Data.isActivated (tUnqualified lusr)
   guard active
 
-ensureNotSameTeam :: Local UserId -> Local UserId -> (ConnectionM r) ()
+ensureNotSameTeam :: Members '[GalleyProvider] r => Local UserId -> Local UserId -> (ConnectionM r) ()
 ensureNotSameTeam self target = do
-  selfTeam <- lift $ wrapHttp $ Intra.getTeamId (tUnqualified self)
-  targetTeam <- lift $ wrapHttp $ Intra.getTeamId (tUnqualified target)
+  selfTeam <- lift $ liftSem $ GalleyProvider.getTeamId (tUnqualified self)
+  targetTeam <- lift $ liftSem $ GalleyProvider.getTeamId (tUnqualified target)
   when (isJust selfTeam && selfTeam == targetTeam) $
     throwE ConnectSameBindingTeamUsers
 
 createConnection ::
+  Members '[GalleyProvider] r =>
   Local UserId ->
   ConnId ->
   Qualified UserId ->
@@ -91,6 +95,7 @@ createConnection self con target = do
     target
 
 createConnectionToLocalUser ::
+  Members '[GalleyProvider] r =>
   Local UserId ->
   ConnId ->
   Local UserId ->
@@ -178,15 +183,19 @@ createConnectionToLocalUser self conn target = do
 --
 -- FUTUREWORK: we may want to move this to the LH application logic, so we can recycle it for
 -- group conv creation and possibly other situations.
-checkLegalholdPolicyConflict :: UserId -> UserId -> ExceptT ConnectionError (AppT r) ()
+checkLegalholdPolicyConflict ::
+  Members '[GalleyProvider] r =>
+  UserId ->
+  UserId ->
+  ExceptT ConnectionError (AppT r) ()
 checkLegalholdPolicyConflict uid1 uid2 = do
   let catchProfileNotFound =
         -- Does not fit into 'ExceptT', so throw in '(AppT r)'.  Anyway at the time of writing
         -- this, users are guaranteed to exist when called from 'createConnectionToLocalUser'.
         maybe (throwM (errorToWai @'E.UserNotFound)) pure
 
-  status1 <- lift (wrapHttpClient $ getLegalHoldStatus uid1) >>= catchProfileNotFound
-  status2 <- lift (wrapHttpClient $ getLegalHoldStatus uid2) >>= catchProfileNotFound
+  status1 <- lift (getLegalHoldStatus uid1) >>= catchProfileNotFound
+  status2 <- lift (getLegalHoldStatus uid2) >>= catchProfileNotFound
 
   let oneway s1 s2 = case (s1, s2) of
         (LH.UserLegalHoldNoConsent, LH.UserLegalHoldNoConsent) -> pure ()

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

@@ -19,8 +19,6 @@
 
 module Brig.API.Federation (federationSitemap, FederationAPI) where
 
-import Bilge.IO
-import Bilge.RPC
 import qualified Brig.API.Client as API
 import Brig.API.Connection.Remote (performRemoteAction)
 import Brig.API.Error
@@ -32,14 +30,12 @@ import Brig.API.Util (lookupSearchPolicy)
 import Brig.App
 import qualified Brig.Data.Connection as Data
 import qualified Brig.Data.User as Data
+import Brig.Effects.GalleyProvider (GalleyProvider)
 import Brig.IO.Intra (notify)
 import Brig.Types.User.Event
 import Brig.User.API.Handle
-import Brig.User.Search.Index
 import qualified Brig.User.Search.SearchIndex as Q
-import Cassandra (MonadClient)
 import Control.Error.Util
-import Control.Monad.Catch (MonadMask)
 import Control.Monad.Trans.Except
 import Data.Domain
 import Data.Handle (Handle (..), parseHandle)
@@ -51,9 +47,9 @@ import Data.Range
 import qualified Gundeck.Types.Push as Push
 import Imports
 import Network.Wai.Utilities.Error ((!>>))
+import Polysemy (Members)
 import Servant (ServerT)
 import Servant.API
-import qualified System.Logger.Class as Log
 import UnliftIO.Async (pooledForConcurrentlyN_)
 import Wire.API.Connection
 import Wire.API.Federation.API.Brig
@@ -71,15 +67,20 @@ import Wire.API.UserMap (UserMap)
 
 type FederationAPI = "federation" :> BrigApi
 
-federationSitemap :: ServerT FederationAPI (Handler r)
+federationSitemap ::
+  Members
+    '[ GalleyProvider
+     ]
+    r =>
+  ServerT FederationAPI (Handler r)
 federationSitemap =
   Named @"api-version" (\_ _ -> pure versionInfo)
-    :<|> Named @"get-user-by-handle" (\d h -> wrapHttpClientE $ getUserByHandle d h)
-    :<|> Named @"get-users-by-ids" (\d us -> wrapHttpClientE $ getUsersByIds d us)
+    :<|> Named @"get-user-by-handle" (\d h -> getUserByHandle d h)
+    :<|> Named @"get-users-by-ids" (\d us -> getUsersByIds d us)
     :<|> Named @"claim-prekey" claimPrekey
     :<|> Named @"claim-prekey-bundle" claimPrekeyBundle
     :<|> Named @"claim-multi-prekey-bundle" claimMultiPrekeyBundle
-    :<|> Named @"search-users" (\d sr -> wrapHttpClientE $ searchUsers d sr)
+    :<|> Named @"search-users" (\d sr -> searchUsers d sr)
     :<|> Named @"get-user-clients" getUserClients
     :<|> Named @"get-mls-clients" getMLSClients
     :<|> Named @"send-connection-action" sendConnectionAction
@@ -99,16 +100,13 @@ sendConnectionAction originDomain NewConnectionRequest {..} = do
     else pure NewConnectionResponseUserNotActivated
 
 getUserByHandle ::
-  ( HasRequestId m,
-    Log.MonadLogger m,
-    MonadClient m,
-    MonadHttp m,
-    MonadMask m,
-    MonadReader Env m
-  ) =>
+  Members
+    '[ GalleyProvider
+     ]
+    r =>
   Domain ->
   Handle ->
-  ExceptT Error m (Maybe UserProfile)
+  ExceptT Error (AppT r) (Maybe UserProfile)
 getUserByHandle domain handle = do
   searchPolicy <- lookupSearchPolicy domain
 
@@ -120,24 +118,21 @@ getUserByHandle domain handle = do
   if not performHandleLookup
     then pure Nothing
     else lift $ do
-      maybeOwnerId <- API.lookupHandle handle
+      maybeOwnerId <- wrapClient $ API.lookupHandle handle
       case maybeOwnerId of
         Nothing ->
           pure Nothing
         Just ownerId ->
           listToMaybe <$> API.lookupLocalProfiles Nothing [ownerId]
 
 getUsersByIds ::
-  ( MonadClient m,
-    MonadReader Env m,
-    Log.MonadLogger m,
-    MonadMask m,
-    MonadHttp m,
-    HasRequestId m
-  ) =>
+  Members
+    '[ GalleyProvider
+     ]
+    r =>
   Domain ->
   [UserId] ->
-  ExceptT Error m [UserProfile]
+  ExceptT Error (AppT r) [UserProfile]
 getUsersByIds _ uids =
   lift (API.lookupLocalProfiles Nothing uids)
 
@@ -163,18 +158,11 @@ fedClaimKeyPackages domain ckpr = do
 -- only search by exact handle search, not in elasticsearch.
 -- (This decision may change in the future)
 searchUsers ::
-  forall m.
-  ( HasRequestId m,
-    Log.MonadLogger m,
-    MonadClient m,
-    MonadHttp m,
-    MonadIndexIO m,
-    MonadMask m,
-    MonadReader Env m
-  ) =>
+  forall r.
+  Members '[GalleyProvider] r =>
   Domain ->
   SearchRequest ->
-  ExceptT Error m SearchResponse
+  ExceptT Error (AppT r) SearchResponse
 searchUsers domain (SearchRequest searchTerm) = do
   searchPolicy <- lift $ lookupSearchPolicy domain
 
@@ -188,22 +176,22 @@ searchUsers domain (SearchRequest searchTerm) = do
   contacts <- go [] maxResults searches
   pure $ SearchResponse contacts searchPolicy
   where
-    go :: [Contact] -> Int -> [Int -> ExceptT Error m [Contact]] -> ExceptT Error m [Contact]
+    go :: [Contact] -> Int -> [Int -> ExceptT Error (AppT r) [Contact]] -> ExceptT Error (AppT r) [Contact]
     go contacts _ [] = pure contacts
     go contacts maxResult (search : searches) = do
       contactsNew <- search maxResult
       go (contacts <> contactsNew) (maxResult - length contactsNew) searches
 
-    fullSearch :: Int -> ExceptT Error m [Contact]
+    fullSearch :: Int -> ExceptT Error (AppT r) [Contact]
     fullSearch n
       | n > 0 = lift $ searchResults <$> Q.searchIndex Q.FederatedSearch searchTerm n
       | otherwise = pure []
 
-    exactHandleSearch :: Int -> ExceptT Error m [Contact]
+    exactHandleSearch :: Int -> ExceptT Error (AppT r) [Contact]
     exactHandleSearch n
       | n > 0 = do
         let maybeHandle = parseHandle searchTerm
-        maybeOwnerId <- maybe (pure Nothing) (lift . API.lookupHandle) maybeHandle
+        maybeOwnerId <- maybe (pure Nothing) (wrapHttpClientE . API.lookupHandle) maybeHandle
         case maybeOwnerId of
           Nothing -> pure []
           Just foundUser -> lift $ contactFromProfile <$$> API.lookupLocalProfiles Nothing [foundUser]