diff --git a/changelog.d/5-internal/WPB-0000-consolidate-brig_galley-api-access-effects-from-spar-into-wire-subsystems b/changelog.d/5-internal/WPB-0000-consolidate-brig_galley-api-access-effects-from-spar-into-wire-subsystems new file mode 100644 index 00000000000..3ee68c70c2f --- /dev/null +++ b/changelog.d/5-internal/WPB-0000-consolidate-brig_galley-api-access-effects-from-spar-into-wire-subsystems @@ -0,0 +1 @@ +Consolidate brig/galley api access effects from spar into wire-subsystems. diff --git a/integration/test/Testlib/JSON.hs b/integration/test/Testlib/JSON.hs index d7688a7a0f6..04ae74ef192 100644 --- a/integration/test/Testlib/JSON.hs +++ b/integration/test/Testlib/JSON.hs @@ -243,7 +243,7 @@ lookupField :: lookupField val selector = do v <- make val vp <- prettyJSON v - addFailureContext ("Loooking up (nested) field " <> selector <> " of object:\n" <> vp) $ do + addFailureContext ("Looking up (nested) field " <> selector <> " of object:\n" <> vp) $ do let keys = splitOn "." selector case keys of (k : ks) -> go k ks v diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 88cd2d1e2e9..24131b80a51 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -30,6 +30,7 @@ , constraints , containers , contravariant +, cookie , cql , crypton , crypton-pem @@ -171,6 +172,7 @@ mkDerivation { constraints containers contravariant + cookie cql crypton crypton-pem @@ -298,6 +300,7 @@ mkDerivation { constraints containers contravariant + cookie cql crypton crypton-pem diff --git a/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs b/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs index 1f9dabb13b6..ceec1624944 100644 --- a/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs @@ -17,69 +17,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.BrigAPIAccess - ( -- * Brig access effect - BrigAPIAccess (..), - - -- * Connections - getConnectionsUnqualified, - getConnectionsUnqualifiedBidi, - getConnections, - putConnectionInternal, - - -- * Users - reauthUser, - lookupActivatedUsers, - getUser, - getUsers, - deleteUser, - getContactList, - getRichInfoMultiUser, - getUserExportData, - updateSearchIndex, - getAccountsBy, - getUsersByVariousKeys, - - -- * Teams - getSize, - - -- * Clients - lookupClients, - lookupClientsFull, - notifyClientsAboutLegalHoldRequest, - getLegalHoldAuthToken, - addLegalHoldClientToUser, - removeLegalHoldClientFromUser, - OpaqueAuthToken (..), - - -- * MLS - getLocalMLSClients, - getLocalMLSClient, - - -- * Features - getAccountConferenceCallingConfigClient, - updateSearchVisibilityInbound, - - -- * Bots - deleteBot, - getAppIdsForTeam, - - -- * User Groups - createGroupInternal, - getGroupInternal, - getGroupsInternal, - updateGroup, - deleteGroupInternal, - deleteApp, - DeleteGroupManagedError (..), - - -- * Account status - setAccountStatus, - - -- * Assertions - ensureConnectedToLocals, - ) -where +module Wire.BrigAPIAccess where import Data.Aeson import Data.ByteString.Conversion @@ -93,18 +31,23 @@ import Network.HTTP.Types.Status import Network.Wai.Utilities.Error qualified as Wai import Polysemy import Polysemy.Error +import SAML2.WebSSO qualified as SAML +import Web.Cookie (SetCookie) import Web.Scim.Filter qualified as Scim import Wire.API.Connection import Wire.API.Error import Wire.API.Error.Galley +import Wire.API.Locale import Wire.API.MLS.CipherSuite import Wire.API.Routes.Internal.Brig import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi import Wire.API.Team.Export import Wire.API.Team.Feature +import Wire.API.Team.Role (Role) import Wire.API.Team.Size import Wire.API.User +import Wire.API.User.Auth (CookieLabel) import Wire.API.User.Auth.ReAuth import Wire.API.User.Client import Wire.API.User.Client.Prekey @@ -180,6 +123,46 @@ data BrigAPIAccess m a where DeleteApp :: TeamId -> UserId -> BrigAPIAccess m () GetAppIdsForTeam :: TeamId -> BrigAPIAccess m [UserId] SetAccountStatus :: UserId -> AccountStatus -> BrigAPIAccess m () + -- SAML / SCIM user management (migrated from Spar.Sem.BrigAccess) + CreateSAML :: + SAML.UserRef -> + UserId -> + TeamId -> + Name -> + ManagedBy -> + Maybe Handle -> + Maybe RichInfo -> + Maybe Locale -> + Role -> + BrigAPIAccess m UserId + CreateNoSAML :: + Text -> + EmailAddress -> + UserId -> + TeamId -> + Name -> + Maybe Locale -> + Role -> + BrigAPIAccess m UserId + UpdateEmail :: UserId -> EmailAddress -> EmailActivation -> BrigAPIAccess m () + GetAccount :: HavePendingInvitations -> UserId -> BrigAPIAccess m (Maybe User) + GetAccountByHandle :: Handle -> BrigAPIAccess m (Maybe User) + GetByEmail :: EmailAddress -> BrigAPIAccess m (Maybe User) + SetName :: UserId -> Name -> BrigAPIAccess m () + SetHandle :: UserId -> Handle -> BrigAPIAccess m () + SetManagedBy :: UserId -> ManagedBy -> BrigAPIAccess m () + SetSSOId :: UserId -> UserSSOId -> BrigAPIAccess m () + SetRichInfo :: UserId -> RichInfo -> BrigAPIAccess m () + SetLocale :: UserId -> Maybe Locale -> BrigAPIAccess m () + GetRichInfo :: UserId -> BrigAPIAccess m RichInfo + CheckHandleAvailable :: Handle -> BrigAPIAccess m Bool + SsoLogin :: UserId -> Maybe CookieLabel -> BrigAPIAccess m SetCookie + GetStatus :: UserId -> BrigAPIAccess m AccountStatus + GetStatusMaybe :: UserId -> BrigAPIAccess m (Maybe AccountStatus) + SetStatus :: UserId -> AccountStatus -> BrigAPIAccess m () + GetDefaultUserLocale :: BrigAPIAccess m Locale + CheckAdminGetTeamId :: UserId -> BrigAPIAccess m (Either Wai.Error TeamId) + SendSAMLIdPChangedEmail :: IdpChangedNotification -> BrigAPIAccess m () makeSem ''BrigAPIAccess diff --git a/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs index 32703e2f923..f4bd3d9ea47 100644 --- a/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs @@ -22,7 +22,7 @@ import Control.Monad.Catch (throwM) import Data.Aeson import Data.ByteString.Char8 qualified as BSC import Data.ByteString.Conversion -import Data.Handle (Handle) +import Data.Handle import Data.HavePendingInvitations (HavePendingInvitations (..)) import Data.Id import Data.Misc @@ -39,37 +39,44 @@ import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog +import SAML2.WebSSO qualified as SAML import System.Logger.Message qualified as Logger import Util.Options +import Web.Cookie (SetCookie, parseSetCookie) import Web.HttpApiData import Web.Scim.Filter as Scim import Wire.API.Connection import Wire.API.Error.Galley +import Wire.API.Locale import Wire.API.MLS.CipherSuite -import Wire.API.Routes.Internal.Brig (CreateGroupInternalRequest (..), GetBy, UpdateGroupInternalRequest (..)) +import Wire.API.Routes.Internal.Brig (CreateGroupInternalRequest (..), GetBy, IdpChangedNotification (..), UpdateGroupInternalRequest (..)) import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi import Wire.API.Team.Export import Wire.API.Team.Feature import Wire.API.Team.LegalHold.Internal +import Wire.API.Team.Role (Role) import Wire.API.Team.Size -import Wire.API.User (AccountStatus (..), AccountStatusUpdate (..), EmailAddress, UpdateConnectionsInternal, User, UserIds (..), UserSet (..)) +import Wire.API.User hiding (DeleteUser (..)) +import Wire.API.User.Auth (CookieLabel) import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth +import Wire.API.User.Auth.Sso qualified as Sso import Wire.API.User.Client import Wire.API.User.Client.Prekey -import Wire.API.User.Profile (ManagedBy) import Wire.API.User.RichInfo import Wire.API.UserGroup (NewUserGroup, UserGroup) import Wire.API.UserGroup.Pagination import Wire.BrigAPIAccess (BrigAPIAccess (..), DeleteGroupManagedError (..), OpaqueAuthToken (..)) import Wire.ParseException import Wire.Rpc +import Wire.RpcException interpretBrigAccess :: ( Member TinyLog r, Member Rpc r, - Member (Error ParseException) r + Member (Error ParseException) r, + Member (Error RpcException) r ) => Endpoint -> Sem (BrigAPIAccess ': r) a -> @@ -136,12 +143,54 @@ interpretBrigAccess brigEndpoint = updateGroup req DeleteGroupInternal managedBy teamId groupId -> deleteGroupInternal managedBy teamId groupId - DeleteApp teamId userId -> - deleteApp teamId userId GetAppIdsForTeam teamId -> getAppIdsForTeam teamId SetAccountStatus uid status -> setAccountStatus uid status + DeleteApp teamId uid -> + deleteApp teamId uid + CreateSAML uref buid teamid name managedBy handle richInfo mLocale role -> + createSAML uref buid teamid name managedBy handle richInfo mLocale role + CreateNoSAML extId email uid teamid uname locale role -> + createNoSAML extId email uid teamid uname locale role + UpdateEmail uid email activation -> + updateEmail uid email activation + GetAccount havePending uid -> + getAccount havePending uid + GetAccountByHandle handle -> + getByHandle handle + GetByEmail email -> + getByEmail email + SetName uid name -> + setName uid name + SetHandle uid handle -> + setHandle uid handle + SetManagedBy uid managedBy -> + setManagedBy uid managedBy + SetSSOId uid ssoId -> + setSSOId uid ssoId + SetRichInfo uid richInfo -> + setRichInfo uid richInfo + SetLocale uid mLocale -> + setLocale uid mLocale + GetRichInfo uid -> + getRichInfo uid + CheckHandleAvailable handle -> + checkHandleAvailable handle + SsoLogin uid mLabel -> + ssoLogin uid mLabel + GetStatus uid -> + getStatus uid + GetStatusMaybe uid -> + getStatusMaybe uid + SetStatus uid status -> + setStatus uid status + GetDefaultUserLocale -> + getDefaultUserLocale + CheckAdminGetTeamId uid -> + checkAdminGetTeamId uid + SendSAMLIdPChangedEmail notif -> + sendSAMLIdPChangedEmail notif brigRequest :: (Member Rpc r, Member (Input Endpoint) r) => (Request -> Request) -> Sem r (Response (Maybe LByteString)) brigRequest req = do @@ -713,11 +762,11 @@ deleteApp :: TeamId -> UserId -> Sem r () -deleteApp teamId userId = do +deleteApp teamId uid = do void $ brigRequest $ method DELETE - . paths ["i", "teams", toByteString' teamId, "apps", toByteString' userId] + . paths ["i", "teams", toByteString' teamId, "apps", toByteString' uid] . expect2xx getAppIdsForTeam :: @@ -750,3 +799,376 @@ is2xx = statusIs2xx . statusCode statusIs2xx :: Int -> Bool statusIs2xx s = s >= 200 && s < 300 + +-- SAML / SCIM user management (migrated from Spar.Intra.Brig) + +createSAML :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + SAML.UserRef -> + UserId -> + TeamId -> + Name -> + ManagedBy -> + Maybe Handle -> + Maybe RichInfo -> + Maybe Locale -> + Role -> + Sem r UserId +createSAML uref (Id buid) teamid name managedBy handle richInfo mLocale role = do + let newUser = + NewUserSpar + { newUserSparUUID = buid, + newUserSparDisplayName = name, + newUserSparSSOId = UserSSOId uref, + newUserSparTeamId = teamid, + newUserSparManagedBy = managedBy, + newUserSparHandle = handle, + newUserSparRichInfo = richInfo, + newUserSparLocale = mLocale, + newUserSparRole = role + } + resp <- brigRequest $ method POST . path "/i/users/spar" . json newUser + if statusCode resp `elem` [200, 201] + then userId . selfUser <$> decodeBodyOrThrow @SelfProfile "brig" resp + else rethrow "brig" resp + +createNoSAML :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + Text -> + EmailAddress -> + UserId -> + TeamId -> + Name -> + Maybe Locale -> + Role -> + Sem r UserId +createNoSAML extId email uid teamid uname locale role = do + let newUser = NewUserScimInvitation teamid uid extId locale uname email role + resp <- + brigRequest $ + method POST + . paths ["/i/teams", toByteString' teamid, "invitations"] + . json newUser + if statusCode resp `elem` [200, 201] + then userId <$> decodeBodyOrThrow @User "brig" resp + else + rethrow "brig" resp + +updateEmail :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + UserId -> + EmailAddress -> + EmailActivation -> + Sem r () +updateEmail buid email activation = do + resp <- + brigRequest $ + method PUT + . path "/i/self/email" + . header "Z-User" (toByteString' buid) + . query + [ ("activation", Just (toByteString' activation)), + ("validate", Just (fromBool validate)), + ("activate", Just (fromBool activate)) + ] + . json (EmailUpdate email) + case statusCode resp of + 204 -> pure () + 202 -> pure () + _ -> rethrow "brig" resp + where + (validate, activate) = case activation of + AutoActivate -> (False, True) + SendActivationEmail -> (True, False) + + fromBool :: Bool -> ByteString + fromBool True = "true" + fromBool False = "false" + +getAccount :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + HavePendingInvitations -> + UserId -> + Sem r (Maybe User) +getAccount havePending buid = do + resp <- + brigRequest $ + method GET + . paths ["/i/users"] + . query + [ ("ids", Just $ toByteString' buid), + ( "includePendingInvitations", + Just . toByteString' $ + case havePending of + WithPendingInvitations -> True + NoPendingInvitations -> False + ) + ] + case statusCode resp of + 200 -> + decodeBodyOrThrow @[User] "brig" resp >>= \case + [account] -> + pure $ + if userDeleted account + then Nothing + else Just account + _ -> pure Nothing + 404 -> pure Nothing + _ -> rethrow "brig" resp + +getByHandle :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + Handle -> + Sem r (Maybe User) +getByHandle handle = do + resp <- + brigRequest $ + method GET + . path "/i/users" + . queryItem "handles" (toByteString' handle) + . queryItem "includePendingInvitations" "true" + case statusCode resp of + 200 -> listToMaybe <$> decodeBodyOrThrow @[User] "brig" resp + 404 -> pure Nothing + _ -> rethrow "brig" resp + +getByEmail :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + EmailAddress -> + Sem r (Maybe User) +getByEmail email = do + resp <- + brigRequest $ + method GET + . path "/i/users" + . queryItem "email" (toByteString' email) + . queryItem "includePendingInvitations" "true" + case statusCode resp of + 200 -> do + macc <- listToMaybe <$> decodeBodyOrThrow @[User] "brig" resp + case userEmail =<< macc of + Just email' | email' == email -> pure macc + _ -> pure Nothing + 404 -> pure Nothing + _ -> rethrow "brig" resp + +setName :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + UserId -> + Name -> + Sem r () +setName buid (Name name) = do + resp <- + brigRequest $ + method PUT + . paths ["/i/users", toByteString' buid, "name"] + . json (NameUpdate name) + if statusCode resp < 300 + then pure () + else rethrow "brig" resp + +setHandle :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + UserId -> + Handle -> + Sem r () +setHandle buid handle = do + resp <- + brigRequest $ + method PUT + . paths ["/i/users", toByteString' buid, "handle"] + . json (HandleUpdate (fromHandle handle)) + case (statusCode resp, Wai.label <$> responseJsonMaybe @Wai.Error resp) of + (200, Nothing) -> pure () + _ -> rethrow "brig" resp + +setManagedBy :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + UserId -> + ManagedBy -> + Sem r () +setManagedBy buid managedBy = do + resp <- + brigRequest $ + method PUT + . paths ["/i/users", toByteString' buid, "managed-by"] + . json (ManagedByUpdate managedBy) + unless (statusCode resp == 200) $ + rethrow "brig" resp + +setSSOId :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + UserId -> + UserSSOId -> + Sem r () +setSSOId buid ssoId = do + resp <- + brigRequest $ + method PUT + . paths ["i", "users", toByteString' buid, "sso-id"] + . json ssoId + unless (statusCode resp == 200) $ + rethrow "brig" resp + +setRichInfo :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + UserId -> + RichInfo -> + Sem r () +setRichInfo buid richInfo = do + resp <- + brigRequest $ + method PUT + . paths ["i", "users", toByteString' buid, "rich-info"] + . json (RichInfoUpdate $ unRichInfo richInfo) + unless (statusCode resp == 200) $ + rethrow "brig" resp + +setLocale :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + UserId -> + Maybe Locale -> + Sem r () +setLocale buid = \case + Just locale -> do + resp <- + brigRequest $ + method PUT + . paths ["i", "users", toByteString' buid, "locale"] + . json (LocaleUpdate locale) + unless (statusCode resp == 200) $ + rethrow "brig" resp + Nothing -> do + resp <- + brigRequest $ + method DELETE + . paths ["i", "users", toByteString' buid, "locale"] + unless (statusCode resp == 200) $ + rethrow "brig" resp + +getRichInfo :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + UserId -> + Sem r RichInfo +getRichInfo buid = do + resp <- + brigRequest $ + method GET + . paths ["/i/users", toByteString' buid, "rich-info"] + if statusCode resp == 200 + then decodeBodyOrThrow "brig" resp + else rethrow "brig" resp + +checkHandleAvailable :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + Handle -> + Sem r Bool +checkHandleAvailable hnd = do + resp <- + brigRequest $ + method HEAD + . paths ["/i/users/handles", toByteString' hnd] + case statusCode resp of + 200 -> pure False -- handle exists + 404 -> pure True -- 404: handle not found + _ -> rethrow "brig" resp + +ssoLogin :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + UserId -> + Maybe CookieLabel -> + Sem r SetCookie +ssoLogin buid mlabel = do + resp <- + brigRequest $ + method POST + . path "/i/sso-login" + . json (Sso.SsoLogin buid mlabel) + . queryItem "persist" "true" + case statusCode resp of + 200 -> + case getHeader "Set-Cookie" resp of + Nothing -> throw $ ParseException "brig" "Missing Set-Cookie header in SSO login response" + Just cky -> pure $ parseSetCookie cky + _ -> rethrow "brig" resp + +getStatusRaw :: + (Member Rpc r, Member (Input Endpoint) r) => + UserId -> + Sem r ResponseLBS +getStatusRaw uid = + brigRequest $ + check [status200, status404] + . method GET + . paths ["/i/users", toByteString' uid, "status"] + +getStatus :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + UserId -> + Sem r AccountStatus +getStatus uid = do + resp <- getStatusRaw uid + case statusCode resp of + 200 -> fromAccountStatusResp <$> decodeBodyOrThrow @AccountStatusResp "brig" resp + _ -> rethrow "brig" resp + +getStatusMaybe :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + UserId -> + Sem r (Maybe AccountStatus) +getStatusMaybe uid = do + resp <- getStatusRaw uid + case statusCode resp of + 200 -> Just . fromAccountStatusResp <$> decodeBodyOrThrow @AccountStatusResp "brig" resp + 404 -> pure Nothing + _ -> rethrow "brig" resp + +setStatus :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + UserId -> + AccountStatus -> + Sem r () +setStatus uid status = do + resp <- + brigRequest $ + method PUT + . paths ["/i/users", toByteString' uid, "status"] + . json (AccountStatusUpdate status) + unless (statusCode resp == 200) $ + rethrow "brig" resp + +getDefaultUserLocale :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + Sem r Locale +getDefaultUserLocale = do + resp <- brigRequest $ method GET . path "/i/users/locale" + case statusCode resp of + 200 -> luLocale <$> decodeBodyOrThrow @LocaleUpdate "brig" resp + _ -> rethrow "brig" resp + +checkAdminGetTeamId :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r, Member (Error RpcException) r) => + UserId -> + Sem r (Either Wai.Error TeamId) +checkAdminGetTeamId uid = do + resp <- + brigRequest $ + check [status200, status403] + . method GET + . paths ["/i/users", toByteString' uid, "check-admin-get-team-id"] + case statusCode resp of + 200 -> Right <$> decodeBodyOrThrow "brig" resp + _ -> rethrow "brig" resp + +sendSAMLIdPChangedEmail :: + (Member Rpc r, Member (Input Endpoint) r, Member (Error RpcException) r) => + IdpChangedNotification -> + Sem r () +sendSAMLIdPChangedEmail notif = do + resp <- + brigRequest $ + method POST + . path "/i/idp/send-idp-changed-email" + . json notif + unless (statusCode resp == 200) $ + rethrow "brig" resp diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs index e3fa6bc3bc4..65d16aeb063 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs @@ -172,5 +172,13 @@ data GalleyAPIAccess m a where GuardLegalHold :: LegalholdProtectee -> UserClients -> GalleyAPIAccess m () GetUserLHStatus :: Maybe TeamId -> UserId -> GalleyAPIAccess m UserLegalHoldStatus GetUsersLHStatus :: [UserId] -> GalleyAPIAccess m [(UserId, UserLegalHoldStatus)] + UpdateTeamMember :: + UserId -> + TeamId -> + Role -> + GalleyAPIAccess m () + IsEmailValidationEnabledTeam :: + TeamId -> + GalleyAPIAccess m Bool makeSem ''GalleyAPIAccess diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs index ae8f54d772d..91267f7cc84 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs @@ -115,6 +115,8 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint = GuardLegalHold protectee userClient -> guardLegalhold protectee userClient GetUserLHStatus mtid uid -> getUserLHStatus mtid uid GetUsersLHStatus uids -> getUsersLHStatus uids + UpdateTeamMember uid tid role -> updateTeamMember uid tid role + IsEmailValidationEnabledTeam tid -> isEmailValidationEnabledTeam tid getUserLegalholdStatus :: ( Member (Error ParseException) r, @@ -818,3 +820,39 @@ getUsersLHStatus uids = do . header "Content-Type" "application/json" . lbytes (encode bdy) . expect2xx + +updateTeamMember :: + ( Member Rpc r, + Member (Input Endpoint) r + ) => + UserId -> + TeamId -> + Role -> + Sem r () +updateTeamMember uid tid role = do + let reqBody = mkNewTeamMember uid (rolePermissions role) Nothing + void $ + galleyRequest $ + method PUT + . paths ["i", "teams", toByteString' tid, "members"] + . header "Content-Type" "application/json" + . lbytes (encode reqBody) + +isEmailValidationEnabledTeam :: + ( Member Rpc r, + Member (Input Endpoint) r + ) => + TeamId -> + Sem r Bool +isEmailValidationEnabledTeam tid = do + rs <- galleyRequest req + pure + ( Bilge.statusCode rs == 200 + && ( ((.status) <$> responseJsonMaybe @(LockableFeature RequireExternalEmailVerificationConfig) rs) + == Just FeatureStatusEnabled + ) + ) + where + req = + method GET + . paths ["i", "teams", toByteString' tid, "features", featureNameBS @RequireExternalEmailVerificationConfig] diff --git a/libs/wire-subsystems/src/Wire/ParseException.hs b/libs/wire-subsystems/src/Wire/ParseException.hs index 525fe80cfb5..1d836548ddf 100644 --- a/libs/wire-subsystems/src/Wire/ParseException.hs +++ b/libs/wire-subsystems/src/Wire/ParseException.hs @@ -15,6 +15,8 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +-- | See also: "Wire.RpcException" (some of the uses of ParseException +-- should probably be RpcExceptions instead). module Wire.ParseException where import Data.Text qualified as Text diff --git a/libs/wire-subsystems/src/Wire/RpcException.hs b/libs/wire-subsystems/src/Wire/RpcException.hs new file mode 100644 index 00000000000..04a28a63a24 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/RpcException.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-partial-fields #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +-- | See also: "Wire.ParseException" +module Wire.RpcException where + +import Bilge +import Data.ByteString.Lazy qualified as LBS +import Data.Text qualified as Text +import Data.Text.Encoding (decodeUtf8) +import Data.Text.Lazy qualified as LText +import Imports +import Network.HTTP.Types.Status qualified as Http +import Network.Wai.Utilities.Error qualified as Wai +import Polysemy +import Polysemy.Error + +data RpcException + = RpcExceptionWai + { service :: Text, + waiError :: Wai.Error + } + | RpcExceptionInternal + { service :: Text, + status :: Int, + message :: Text + } + deriving (Eq, Show) + +instance Exception RpcException + +rpcExcepctionToWaiError :: RpcException -> Wai.Error +rpcExcepctionToWaiError (RpcExceptionWai {..}) = + waiError {Wai.message = "[" <> LText.fromStrict service <> "] " <> (Wai.message waiError)} +rpcExcepctionToWaiError (RpcExceptionInternal {..}) = + Wai.mkError + Http.status502 + "internal-error" + ( LText.fromStrict $ + "Could not parse " + <> service + <> " response body: " + <> message + <> " (status: " + <> Text.pack (show status) + <> ")" + ) + +-- | If a call to another backend service fails, just respond with whatever it said. +rethrow :: (HasCallStack, Member (Error RpcException) r) => Text -> ResponseLBS -> Sem r a +rethrow serviceName resp = throw err + where + err :: RpcException + err = maybe fallback (RpcExceptionWai serviceName) (responseJsonMaybe resp) + + fallback :: RpcException + fallback = RpcExceptionInternal serviceName (Bilge.statusCode resp) (maybe "" (decodeUtf8 . LBS.toStrict) (responseBody resp)) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs index eea44efb430..2e0186e9499 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs @@ -96,6 +96,8 @@ miniGalleyAPIAccess teams configs = interpret $ \case GetUserLHStatus _ _ -> error "GetUserLHStatus not implemented in miniGalleyAPIAccess" GetUsersLHStatus _ -> error "GetUsersLHStatus not implemented in miniGalleyAPIAccess" GuardLegalHold {} -> pure () + UpdateTeamMember {} -> error "UpdateTeamMember not implemented in miniGalleyAPIAccess" + IsEmailValidationEnabledTeam {} -> error "IsEmailValidationEnabledTeam not implemented in miniGalleyAPIAccess" -- this is called but the result is not needed in unit tests selectTeamMemberInfosImpl :: Map TeamId [TeamMember] -> TeamId -> [UserId] -> TeamMemberInfoList diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index dd2e897a6c3..6aa8541f47a 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -109,6 +109,7 @@ common common-all , constraints , containers , contravariant + , cookie , cql , crypton , crypton-pem @@ -391,6 +392,7 @@ library Wire.RateLimit Wire.RateLimit.Interpreter Wire.Rpc + Wire.RpcException Wire.SAMLEmailSubsystem Wire.SAMLEmailSubsystem.Interpreter Wire.ScimSubsystem diff --git a/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs index 842dec6ec80..e595330f457 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs @@ -94,6 +94,7 @@ import Wire.ProposalStore.Cassandra (interpretProposalStoreToCassandra) import Wire.RateLimit (RateLimitExceeded) import Wire.RateLimit.Interpreter (interpretRateLimit) import Wire.Rpc +import Wire.RpcException import Wire.Sem.Concurrency (ConcurrencySafety (Unsafe)) import Wire.Sem.Concurrency.IO (unsafelyPerformConcurrency) import Wire.Sem.Delay (runDelay) @@ -206,6 +207,7 @@ dispatchJob job = do . mapError @DynError (.eMessage) . mapError @JSONResponse (T.pack . show . (.value)) . mapError @ConversationSubsystemError toResponse + . mapError @RpcException (T.pack . displayException) . mapError @ClientError (T.pack . displayException) . mapError @FederationError (T.pack . displayException) . mapError @UsageError (T.pack . show) diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index e27c5e45ce0..bfbaebf886e 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -148,6 +148,7 @@ import Wire.ProposalStore.Cassandra import Wire.RateLimit import Wire.RateLimit.Interpreter import Wire.Rpc +import Wire.RpcException import Wire.Sem.Concurrency import Wire.Sem.Concurrency.IO import Wire.Sem.Delay @@ -264,6 +265,7 @@ type GalleyEffects = ErrorS 'NotATeamMember, ErrorS 'MeetingNotFound, ErrorS 'InvalidOperation, + Error RpcException, Input ClientState, Input Hasql.Pool, Input Env, @@ -483,6 +485,7 @@ evalGalley e = . runInputConst e . runInputConst (e ^. hasqlPool) . runInputConst (e ^. cstate) + . mapError (toResponse . rpcExcepctionToWaiError) -- Error RpcException . mapError toResponse -- ErrorS 'InvalidOperation . mapError toResponse -- ErrorS 'MeetingNotFound . mapError toResponse -- ErrorS 'NotATeamMember diff --git a/services/spar/default.nix b/services/spar/default.nix index 315c3c5d75a..5ad0fbf1fad 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -19,6 +19,7 @@ , cookie , crypton , crypton-x509 +, data-default , exceptions , extended , filepath @@ -208,6 +209,7 @@ mkDerivation { bytestring-conversion containers cookie + data-default filepath hscim hspec diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 42885b16c33..6512673b66b 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -30,9 +30,7 @@ library Spar.Data Spar.Data.Instances Spar.Error - Spar.Intra.Brig - Spar.Intra.BrigApp - Spar.Intra.Galley + Spar.Intra.RpcApp Spar.Options Spar.Orphans Spar.Run @@ -71,14 +69,10 @@ library Spar.Sem.AssIDStore Spar.Sem.AssIDStore.Cassandra Spar.Sem.AssIDStore.Mem - Spar.Sem.BrigAccess - Spar.Sem.BrigAccess.Http Spar.Sem.DefaultSsoCode Spar.Sem.DefaultSsoCode.Cassandra Spar.Sem.DefaultSsoCode.Mem Spar.Sem.DefaultSsoCode.Spec - Spar.Sem.GalleyAccess - Spar.Sem.GalleyAccess.Http Spar.Sem.IdPRawMetadataStore Spar.Sem.IdPRawMetadataStore.Cassandra Spar.Sem.IdPRawMetadataStore.Mem @@ -282,7 +276,6 @@ executable spar-integration Test.Spar.APISpec Test.Spar.AppSpec Test.Spar.DataSpec - Test.Spar.Intra.BrigSpec Test.Spar.Scim.AuthSpec Test.Spar.Scim.UserSpec Util @@ -630,6 +623,7 @@ test-suite spec , bytestring-conversion , containers , cookie + , data-default , filepath , hscim , hspec diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index bd8e285b66a..d1e255da57c 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -75,6 +75,7 @@ import qualified Data.X509 as X509 import Data.X509.Extended import Imports import Network.Wai (Request, requestHeaders) +import qualified Network.Wai.Utilities.Error as Wai import Network.Wai.Utilities.Request import Network.Wai.Utilities.Server (defaultRequestIdHeaderName) import Polysemy @@ -87,18 +88,14 @@ import Servant.Server.Experimental.Auth import Spar.App import Spar.CanonicalInterpreter import Spar.Error -import qualified Spar.Intra.BrigApp as Brig +import qualified Spar.Intra.RpcApp as Intra import Spar.Options import Spar.Orphans () import Spar.Scim hiding (handle) import Spar.Sem.AReqIDStore (AReqIDStore) import Spar.Sem.AssIDStore (AssIDStore) -import Spar.Sem.BrigAccess (BrigAccess, getAccount) -import qualified Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode -import Spar.Sem.GalleyAccess (GalleyAccess) -import qualified Spar.Sem.GalleyAccess as GalleyAccess import Spar.Sem.IdPRawMetadataStore (IdPRawMetadataStore) import qualified Spar.Sem.IdPRawMetadataStore as IdPRawMetadataStore import Spar.Sem.Reporter (Reporter) @@ -128,6 +125,9 @@ import Wire.API.User import Wire.API.User.Auth (CookieLabel) import Wire.API.User.IdentityProvider import Wire.API.User.Saml +import Wire.BrigAPIAccess (BrigAPIAccess) +import qualified Wire.BrigAPIAccess as BrigAPIAccess +import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.IdPConfigStore (IdPConfigStore, Replaced (..), Replacing (..)) import qualified Wire.IdPConfigStore as IdPConfigStore import Wire.IdPSubsystem (IdPSubsystem) @@ -159,8 +159,8 @@ app ctx0 req cont = do cont api :: - ( Member GalleyAccess r, - Member BrigAccess r, + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member (Input Opts) r, Member AssIDStore r, Member AReqIDStore r, @@ -198,10 +198,10 @@ api opts = :<|> apiINTERNAL apiSSO :: - ( Member GalleyAccess r, + ( Member GalleyAPIAccess r, Member (Logger String) r, Member (Input Opts) r, - Member BrigAccess r, + Member BrigAPIAccess r, Member AssIDStore r, Member VerdictFormatStore r, Member AReqIDStore r, @@ -233,8 +233,8 @@ apiIDP :: ( Member Random r, Member (Logger String) r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member IdPConfigStore r, Member IdPRawMetadataStore r, @@ -261,8 +261,8 @@ apiINTERNAL :: Member ScimUserTimesStore r, Member (Logger (Msg -> Msg)) r, Member Random r, - Member GalleyAccess r, - Member BrigAccess r + Member GalleyAPIAccess r, + Member BrigAPIAccess r ) => ServerT InternalAPI (Sem r) apiINTERNAL = @@ -384,8 +384,8 @@ authresp :: ( Member Random r, Member (Logger String) r, Member (Input Opts) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member AssIDStore r, Member VerdictFormatStore r, Member AReqIDStore r, @@ -491,7 +491,7 @@ authHandler :: Env -> AuthHandler Request TeamId authHandler ctx = mkAuthHandler $ \req -> (either throwError' pure =<<) $ runSparToHandler ctx $ runError $ do bs <- maybe (throwSparSem SparMissingZUsr) pure $ lookup "Z-User" (requestHeaders req) uid <- maybe (throwSparSem $ SparNoPermission "[internal error] Can't parse Z-User header") pure $ fromByteString bs - BrigAccess.checkAdminGetTeamId uid + BrigAPIAccess.checkAdminGetTeamId uid >>= either (\e -> throwSparSem $ SparNoPermission (Wai.message e)) pure where throwError' se = Spar.Error.sparToServerErrorWithLogging (sparCtxLogger ctx) se >>= throwError @@ -501,8 +501,8 @@ authContext e = authHandler e :. EmptyContext idpGet :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member IdPConfigStore r, Member (Error SparError) r ) => @@ -515,8 +515,8 @@ idpGet zusr idpid = withDebugLog "idpGet" (Just . show . (^. SAML.idpId)) $ do pure idp idpGetRaw :: - ( Member GalleyAccess r, - Member BrigAccess r, + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member IdPConfigStore r, Member IdPRawMetadataStore r, Member (Error SparError) r @@ -534,22 +534,22 @@ idpGetRaw zusr idpid = do idpGetAll :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member IdPConfigStore r, Member (Error SparError) r ) => Maybe UserId -> Sem r IdPList idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do - teamid <- Brig.getZUsrCheckPerm zusr ReadIdp + teamid <- Intra.getZUsrCheckPerm zusr ReadIdp idpGetAllByTeamId teamid idpGetAllByTeamId :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member IdPConfigStore r, Member (Error SparError) r ) => @@ -571,8 +571,8 @@ idpDelete :: forall r. ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member SAMLUserStore r, Member IdPConfigStore r, @@ -603,7 +603,7 @@ idpDelete samlConfig mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idp IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid when (SAML.isMultiIngressConfig samlConfig) $ - BrigAccess.sendSAMLIdPChangedEmail $ + BrigAPIAccess.sendSAMLIdPChangedEmail $ IdPDeleted zusr idp logIdPAction "IdP deleted" @@ -615,13 +615,13 @@ idpDelete samlConfig mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idp assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () assertEmptyOrPurge teamId page = do forM_ (Cas.result page) $ \(uref, uid) -> do - mAccount <- BrigAccess.getAccount NoPendingInvitations uid + mAccount <- BrigAPIAccess.getAccount NoPendingInvitations uid let mUserTeam = userTeam =<< mAccount when (mUserTeam == Just teamId) $ do if purge then do SAMLUserStore.delete uid uref - void $ BrigAccess.deleteUser uid + void $ BrigAPIAccess.deleteUser uid else do throwSparSem SparIdPHasBoundUsers when (Cas.hasMore page) $ @@ -648,7 +648,7 @@ idpDelete samlConfig mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idp idpDoesAuthSelf :: IdP -> UserId -> Sem r Bool idpDoesAuthSelf idp uid = do let idpIssuer = idp ^. SAML.idpMetadata . SAML.edIssuer - mUserIssuer <- (>>= userIssuer) <$> getAccount NoPendingInvitations uid + mUserIssuer <- (>>= userIssuer) <$> BrigAPIAccess.getAccount NoPendingInvitations uid pure $ mUserIssuer == Just idpIssuer -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. @@ -664,8 +664,8 @@ idpDelete samlConfig mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idp idpCreate :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member IdPConfigStore r, Member IdPRawMetadataStore r, @@ -682,7 +682,7 @@ idpCreate :: Sem r IdP idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmeta) mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do let mbHost = filterMultiIngressZHost (samlConfig._cfgDomainConfigs) uncheckedMbHost - GalleyAccess.assertSSOEnabled tid + Intra.assertSSOEnabled tid guardMultiIngressDuplicateDomain tid mbHost idp <- maybe (IdPConfigStore.newHandle tid) (pure . IdPHandle . fromRange) mHandle @@ -692,7 +692,7 @@ idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) when (SAML.isMultiIngressConfig samlConfig) $ - BrigAccess.sendSAMLIdPChangedEmail $ + BrigAPIAccess.sendSAMLIdPChangedEmail $ IdPCreated zUser idp logIdPAction "IdP created" @@ -737,8 +737,8 @@ filterMultiIngressZHost _ _ = Nothing idpCreateV7 :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member IdPConfigStore r, Member IdPRawMetadataStore r, @@ -841,8 +841,8 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces idpDomain idHandle = wit idpUpdate :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member IdPConfigStore r, Member IdPRawMetadataStore r, Member (Error SparError) r @@ -861,8 +861,8 @@ idpUpdate samlConfig zusr uncheckedMbHost (IdPMetadataValue raw xml) = idpUpdateXML :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member IdPConfigStore r, Member IdPRawMetadataStore r, Member (Error SparError) r @@ -877,7 +877,7 @@ idpUpdateXML :: Sem r IdP idpUpdateXML samlConfig mbZUsr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML" (Just . show . (^. SAML.idpId)) $ do (zUsr, teamid, idp, previousIdP) <- validateIdPUpdate mbZUsr idpmeta idpid - GalleyAccess.assertSSOEnabled teamid + Intra.assertSSOEnabled teamid guardMultiIngressDuplicateDomain teamid mDomain idpid IdPRawMetadataStore.store (idp ^. SAML.idpId) raw let idp' :: IdP = case mHandle of @@ -895,7 +895,7 @@ idpUpdateXML samlConfig mbZUsr mDomain raw idpmeta idpid mHandle = withDebugLog WireIdPAPIV2 -> Just teamid forM_ (idp'' ^. SAML.idpExtraInfo . oldIssuers) (flip IdPConfigStore.deleteIssuer mbteamid) when (SAML.isMultiIngressConfig samlConfig) $ - BrigAccess.sendSAMLIdPChangedEmail $ + BrigAPIAccess.sendSAMLIdPChangedEmail $ IdPUpdated zUsr previousIdP idp'' logIdPUpdate zUsr idp'' previousIdP pure idp'' @@ -982,8 +982,8 @@ validateIdPUpdate :: (HasCallStack, m ~ Sem r) => ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member IdPConfigStore r, Member (Error SparError) r ) => @@ -1048,8 +1048,8 @@ withDebugLog msg showval action = do authorizeIdP :: ( HasCallStack, - ( Member GalleyAccess r, - Member BrigAccess r, + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member (Error SparError) r ) ) => @@ -1063,7 +1063,7 @@ authorizeIdP Nothing _ = ) authorizeIdP (Just zusr) idp = do let teamid = idp ^. SAML.idpExtraInfo . team - GalleyAccess.assertHasPermission teamid CreateUpdateDeleteIdp zusr + Intra.assertHasPermission teamid CreateUpdateDeleteIdp zusr pure (zusr, teamid) enforceHttps :: (Member (Error SparError) r) => URI.URI -> Sem r () diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index f43a93abddd..8ec7c658523 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -71,14 +71,10 @@ import qualified SAML2.WebSSO as SAML import Servant import qualified Servant.Multipart as Multipart import Spar.Error hiding (sparToServerErrorWithLogging) -import qualified Spar.Intra.BrigApp as Intra +import qualified Spar.Intra.RpcApp as Intra import Spar.Options import Spar.Orphans () import Spar.Sem.AReqIDStore (AReqIDStore) -import Spar.Sem.BrigAccess (BrigAccess, getAccount) -import qualified Spar.Sem.BrigAccess as BrigAccess -import Spar.Sem.GalleyAccess (GalleyAccess) -import qualified Spar.Sem.GalleyAccess as GalleyAccess import Spar.Sem.Reporter (Reporter) import qualified Spar.Sem.Reporter as Reporter import Spar.Sem.SAMLUserStore (SAMLUserStore) @@ -97,7 +93,11 @@ import Wire.API.User import Wire.API.User.Auth import Wire.API.User.IdentityProvider import Wire.API.User.Saml +import Wire.BrigAPIAccess (BrigAPIAccess) +import qualified Wire.BrigAPIAccess as BrigAPIAccess import Wire.Error +import Wire.GalleyAPIAccess (GalleyAPIAccess) +import qualified Wire.GalleyAPIAccess as GalleyAPIAccess import Wire.IdPConfigStore (IdPConfigStore) import qualified Wire.IdPConfigStore as IdPConfigStore import Wire.ScimSubsystem.Interpreter @@ -139,17 +139,17 @@ data Env = Env -- -- FUTUREWORK: https://wearezeta.atlassian.net/browse/SQSERVICES-1655 getUserByUrefUnsafe :: - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member SAMLUserStore r ) => SAML.UserRef -> Sem r (Maybe User) getUserByUrefUnsafe uref = do - maybe (pure Nothing) (getAccount Intra.WithPendingInvitations) =<< SAMLUserStore.get uref + maybe (pure Nothing) (BrigAPIAccess.getAccount Intra.WithPendingInvitations) =<< SAMLUserStore.get uref -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR getUserIdByScimExternalId :: - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member ScimExternalIdStore r ) => TeamId -> @@ -182,7 +182,7 @@ getUserIdByScimExternalId tid eid = do -- undeletable in the team admin page, and ask admins to go talk to their IdP system. createSamlUserWithId :: ( Member (Error SparError) r, - Member BrigAccess r, + Member BrigAPIAccess r, Member SAMLUserStore r ) => TeamId -> @@ -194,7 +194,7 @@ createSamlUserWithId teamid buid suid role = do uname <- either (throwSparSem . SparBadUserName . LText.pack) pure $ Intra.mkUserName Nothing (That suid) - buid' <- BrigAccess.createSAML suid buid teamid uname ManagedByWire Nothing Nothing Nothing role + buid' <- BrigAPIAccess.createSAML suid buid teamid uname ManagedByWire Nothing Nothing Nothing role assert (buid == buid') $ pure () SAMLUserStore.insert suid buid @@ -203,8 +203,8 @@ createSamlUserWithId teamid buid suid role = do -- https://wearezeta.atlassian.net/browse/SQSERVICES-1655) autoprovisionSamlUser :: forall r. - ( Member GalleyAccess r, - Member BrigAccess r, + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member IdPConfigStore r, Member (Error SparError) r, @@ -237,8 +237,8 @@ autoprovisionSamlUser idp buid suid = do -- make brig initiate the email validate procedure. validateSamlEmailIfExists :: forall r. - ( Member GalleyAccess r, - Member BrigAccess r + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r ) => UserId -> SAML.UserRef -> @@ -251,17 +251,17 @@ validateSamlEmailIfExists uid = \case validateEmail :: forall r. - ( Member GalleyAccess r, - Member BrigAccess r + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r ) => Maybe TeamId -> UserId -> EmailAddress -> Sem r () validateEmail (Just tid) uid email = do - enabled <- GalleyAccess.isEmailValidationEnabledTeam tid + enabled <- GalleyAPIAccess.isEmailValidationEnabledTeam tid let activation = if enabled then SendActivationEmail else AutoActivate - BrigAccess.updateEmail uid email activation + BrigAPIAccess.updateEmail uid email activation validateEmail _ _ _ = pure () -- | The from of the response on the finalize-login request depends on the verdict (denied or @@ -277,8 +277,8 @@ verdictHandler :: (HasCallStack) => ( Member Random r, Member (Logger String) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member AReqIDStore r, Member VerdictFormatStore r, Member ScimTokenStore r, @@ -324,8 +324,8 @@ verdictHandlerResult :: (HasCallStack) => ( Member Random r, Member (Logger String) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member IdPConfigStore r, Member (Error SparError) r, @@ -368,7 +368,7 @@ catchVerdictErrors = (`catch` hndlr) -- FUTUREWORK: https://wearezeta.atlassian.net/browse/SQSERVICES-1655 getUserByUrefViaOldIssuerUnsafe :: forall r. - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member SAMLUserStore r ) => IdP -> @@ -386,7 +386,7 @@ getUserByUrefViaOldIssuerUnsafe idp (SAML.UserRef _ subject) = do -- | After a user has been found using 'findUserWithOldIssuer', update it everywhere so that -- the old IdP is not needed any more next time. moveUserToNewIssuer :: - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member SAMLUserStore r ) => SAML.UserRef -> @@ -395,15 +395,15 @@ moveUserToNewIssuer :: Sem r () moveUserToNewIssuer oldUserRef newUserRef uid = do SAMLUserStore.insert newUserRef uid - BrigAccess.setSSOId uid (UserSSOId newUserRef) + BrigAPIAccess.setSSOId uid (UserSSOId newUserRef) SAMLUserStore.delete uid oldUserRef verdictHandlerResultCore :: (HasCallStack) => ( Member Random r, Member (Logger String) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member IdPConfigStore r, Member (Error SparError) r, @@ -439,7 +439,7 @@ verdictHandlerResultCore idp verdict mlabel = case verdict of pure buid Logger.log Logger.Debug ("granting sso login for " <> show uid) - cky <- BrigAccess.ssoLogin uid mlabel + cky <- BrigAPIAccess.ssoLogin uid mlabel pure $ VerifyHandlerGranted cky uid -- | If the client is web, it will be served with an HTML page that it can process to decide whether diff --git a/services/spar/src/Spar/CanonicalInterpreter.hs b/services/spar/src/Spar/CanonicalInterpreter.hs index 884a534b4d1..235a7f78392 100644 --- a/services/spar/src/Spar/CanonicalInterpreter.hs +++ b/services/spar/src/Spar/CanonicalInterpreter.hs @@ -41,12 +41,8 @@ import Spar.Sem.AReqIDStore (AReqIDStore) import Spar.Sem.AReqIDStore.Cassandra (aReqIDStoreToCassandra) import Spar.Sem.AssIDStore (AssIDStore) import Spar.Sem.AssIDStore.Cassandra (assIDStoreToCassandra) -import Spar.Sem.BrigAccess (BrigAccess) -import Spar.Sem.BrigAccess.Http (brigAccessToHttp) import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import Spar.Sem.DefaultSsoCode.Cassandra (defaultSsoCodeToCassandra) -import Spar.Sem.GalleyAccess (GalleyAccess) -import Spar.Sem.GalleyAccess.Http (galleyAccessToHttp) import Spar.Sem.IdPRawMetadataStore (IdPRawMetadataStore) import Spar.Sem.IdPRawMetadataStore.Cassandra (idpRawMetadataStoreToCassandra) import Spar.Sem.Reporter (Reporter) @@ -63,23 +59,24 @@ import Spar.Sem.ScimTokenStore (ScimTokenStore) import Spar.Sem.ScimTokenStore.Cassandra (scimTokenStoreToCassandra) import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) import Spar.Sem.ScimUserTimesStore.Cassandra (scimUserTimesStoreToCassandra) -import Spar.Sem.Utils (idpDbErrorToSparError, interpretClientToIO, ttlErrorToSparError) +import Spar.Sem.Utils import Spar.Sem.VerdictFormatStore (VerdictFormatStore) import Spar.Sem.VerdictFormatStore.Cassandra (verdictFormatStoreToCassandra) import qualified System.Logger as TinyLog import Wire.API.Routes.Version (expandVersionExp) import Wire.API.User.Saml (TTLError) -import Wire.BrigAPIAccess (BrigAPIAccess) -import Wire.BrigAPIAccess.Rpc (interpretBrigAccess) +import Wire.BrigAPIAccess +import Wire.BrigAPIAccess.Rpc import Wire.ClientSubsystem.Error (ClientError, clientErrorToHttpError) -import Wire.GalleyAPIAccess (GalleyAPIAccess) -import Wire.GalleyAPIAccess.Rpc (interpretGalleyAPIAccessToRpc) +import Wire.GalleyAPIAccess +import Wire.GalleyAPIAccess.Rpc import Wire.IdPConfigStore (IdPConfigStore) import Wire.IdPConfigStore.Cassandra (idPToCassandra) import Wire.IdPSubsystem (IdPSubsystem) import Wire.IdPSubsystem.Interpreter (IdPSubsystemError, interpretIdPSubsystem) import Wire.ParseException (ParseException, parseExceptionToHttpError) import Wire.Rpc (Rpc, runRpcWithHttp) +import Wire.RpcException import Wire.ScimSubsystem import Wire.ScimSubsystem.Interpreter import Wire.Sem.Logger.TinyLog (loggerToTinyLog, stringLoggerToTinyLog) @@ -114,10 +111,9 @@ type LowerLevelCanonicalEffs = IdPRawMetadataStore, SAMLUserStore, Embed Cas.Client, - BrigAccess, - GalleyAccess, Error IdpDbError, Error TTLError, + Error RpcException, Error SparError, Reporter, Logger String, @@ -142,10 +138,9 @@ runSparToIO ctx = . stringLoggerToTinyLog . reporterToTinyLogWai . runError @SparError + . rpcExceptionToSparError . ttlErrorToSparError . idpDbErrorToSparError - . galleyAccessToHttp (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx) - . brigAccessToHttp (sparCtxHttpManager ctx) (sparCtxHttpBrig ctx) . interpretClientToIO (sparCtxCas ctx) . samlUserStoreToCassandra . idpRawMetadataStoreToCassandra diff --git a/services/spar/src/Spar/Error.hs b/services/spar/src/Spar/Error.hs index 328c4725b3f..2dbc8675461 100644 --- a/services/spar/src/Spar/Error.hs +++ b/services/spar/src/Spar/Error.hs @@ -31,8 +31,6 @@ module Spar.Error IdpDbError (..), throwSpar, sparToServerErrorWithLogging, - rethrow, - parseResponse, -- FUTUREWORK: we really shouldn't export this, but that requires that we can use our -- custom servant monad in the 'MakeCustomError' instances. sparToServerError, @@ -44,15 +42,11 @@ module Spar.Error ) where -import Bilge (ResponseLBS, responseBody, responseJsonMaybe) -import qualified Bilge import Control.Monad.Except import Data.Aeson import qualified Data.ByteString.Lazy as LBS import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Encoding as LText -import Data.Typeable (typeRep) -import GHC.Stack (callStack, prettyCallStack) import Imports import Network.HTTP.Types.Status import qualified Network.Wai as Wai @@ -67,6 +61,7 @@ import Wire.API.User.Saml (TTLError) import Wire.Error import Wire.IdPConfigStore import Wire.IdPSubsystem.Interpreter +import Wire.RpcException import Wire.ScimSubsystem.Interpreter type SparError = SAML.Error SparCustomError @@ -99,11 +94,13 @@ data SparCustomError | SparCannotCreateUsersOnReplacedIdP LText | SparCouldNotParseRfcResponse LText LText | SparReAuthRequired + | SparReAuthRateLimitExceeded | SparReAuthCodeAuthFailed | SparReAuthCodeAuthRequired | SparCouldNotRetrieveCookie | SparCassandraError LText | SparCassandraTTLError TTLError + | SparRpcException RpcException | SparNewIdPBadMetadata LText | SparNewIdPPubkeyMismatch | SparNewIdPAlreadyInUse LText @@ -163,6 +160,7 @@ renderSparError (SAML.CustomError (SparCannotCreateUsersOnReplacedIdP replacingI -- RFC-specific errors renderSparError (SAML.CustomError (SparCouldNotParseRfcResponse service msg)) = StdError $ Wai.mkError status502 "bad-upstream" ("Could not parse " <> service <> " response body: " <> msg) renderSparError (SAML.CustomError SparReAuthRequired) = StdError $ Wai.mkError status403 "access-denied" "This operation requires reauthentication." +renderSparError (SAML.CustomError SparReAuthRateLimitExceeded) = StdError $ Wai.mkError status429 "rate-limit-exceeded" "Please use exponential backoff throttling to mitigate this." renderSparError (SAML.CustomError SparReAuthCodeAuthFailed) = StdError $ Wai.mkError status403 "code-authentication-failed" "Reauthentication failed with invalid verification code." renderSparError (SAML.CustomError SparReAuthCodeAuthRequired) = StdError $ Wai.mkError status403 "code-authentication-required" "Reauthentication failed. Verification code required." renderSparError (SAML.CustomError SparCouldNotRetrieveCookie) = StdError $ Wai.mkError status502 "bad-upstream" "Unable to get a cookie from an upstream server." @@ -173,6 +171,7 @@ renderSparError (SAML.CustomError (SparCassandraTTLError ttlerr)) = status400 "ttl-error" (LText.pack $ show ttlerr) +renderSparError (SAML.CustomError (SparRpcException err)) = StdError $ rpcExcepctionToWaiError err renderSparError (SAML.UnknownIdP msg) = StdError $ Wai.mkError status404 "not-found" ("IdP not found: " <> msg) renderSparError (SAML.Forbidden msg) = StdError $ Wai.mkError status403 "forbidden" ("Forbidden: " <> msg) renderSparError (SAML.BadSamlResponseBase64Error msg) = @@ -239,47 +238,6 @@ renderSparError (SAML.CustomError (SparSomeHttpError err)) = err -- Other renderSparError (SAML.CustomServant err) = serverErrorToHttpError err --- | If a call to another backend service fails, just respond with whatever it said. --- --- FUTUREWORK: with servant, there will be a way for the type checker to confirm that we --- handle all exceptions that brig can legally throw! -rethrow :: LText -> ResponseLBS -> (HasCallStack, Log.MonadLogger m, MonadError SparError m) => m a -rethrow serviceName resp = do - Log.info - ( Log.msg ("rfc error" :: Text) - . Log.field "status" (Bilge.statusCode resp) - . Log.field "error" (show err) - . Log.field "callstack" (prettyCallStack callStack) - ) - throwError err - where - err :: SparError - err = - responseJsonMaybe resp - & maybe - ( SAML.CustomError - . SparCouldNotParseRfcResponse serviceName - . ("internal error: " <>) - . LText.pack - . show - . (Bilge.statusCode resp,) - . fromMaybe "" - . responseBody - $ resp - ) - (SAML.CustomServant . waiToServant) - -parseResponse :: forall a m. (FromJSON a, MonadError SparError m, Typeable a) => LText -> ResponseLBS -> m a -parseResponse serviceName resp = do - let typeinfo :: LText - typeinfo = LText.pack $ show (typeRep ([] @a)) <> ": " - - err :: forall a'. LText -> m a' - err = throwSpar . SparCouldNotParseRfcResponse serviceName . (typeinfo <>) - - bdy <- maybe (err "no body") pure $ responseBody resp - either (err . LText.pack) pure $ eitherDecode' bdy - mapScimSubsystemErrors :: (Member (Error SparError) r) => InterpreterFor (Error ScimSubsystemError) r mapScimSubsystemErrors = Polysemy.Error.mapError (SAML.CustomError . SparScimError . scimSubsystemErrorToScimError) diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs deleted file mode 100644 index fef947f5c28..00000000000 --- a/services/spar/src/Spar/Intra/Brig.hs +++ /dev/null @@ -1,463 +0,0 @@ --- Disabling to stop warnings on HasCallStack -{-# OPTIONS_GHC -Wno-redundant-constraints #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- | Client functions for interacting with the Brig API. -module Spar.Intra.Brig - ( MonadSparToBrig (..), - getBrigUserAccount, - getBrigUserByHandle, - getBrigUserByEmail, - getBrigUserRichInfo, - setBrigUserName, - setBrigUserHandle, - setBrigUserManagedBy, - setBrigUserSSOId, - setBrigUserRichInfo, - setBrigUserLocale, - checkHandleAvailable, - deleteBrigUserInternal, - createBrigUserSAML, - createBrigUserNoSAML, - updateEmail, - ensureReAuthorised, - ssoLogin, - getStatus, - getStatusMaybe, - setStatus, - getDefaultUserLocale, - checkAdminGetTeamId, - sendSAMLIdPChangedEmail, - ) -where - -import Bilge -import Control.Monad.Except -import Data.ByteString.Conversion -import Data.Code as Code -import Data.Handle (Handle (fromHandle)) -import Data.Id (Id (Id), TeamId, UserId) -import Data.Misc (PlainTextPassword6) -import qualified Data.Text.Lazy as Lazy -import Imports -import Network.HTTP.Types.Method -import qualified Network.Wai.Utilities.Error as Wai -import qualified SAML2.WebSSO as SAML -import Spar.Error -import qualified System.Logger.Class as Log -import Web.Cookie -import Wire.API.Locale -import Wire.API.Routes.Internal.Brig (IdpChangedNotification) -import Wire.API.Team.Role (Role) -import Wire.API.User -import Wire.API.User.Auth -import Wire.API.User.Auth.ReAuth -import Wire.API.User.Auth.Sso -import Wire.API.User.RichInfo as RichInfo -import Wire.UserSubsystem (HavePendingInvitations (..)) - ----------------------------------------------------------------------- - --- | Similar to 'Network.Wire.Client.API.Auth.tokenResponse', but easier: we just need to set the --- cookie in the response, and the redirect will make the client negotiate a fresh auth token. --- (This is the easiest way, since the login-request that we are in the middle of responding to here --- is not from the wire client, but from a browser that is still processing a redirect from the --- IdP.) -respToCookie :: (HasCallStack, MonadError SparError m) => ResponseLBS -> m SetCookie -respToCookie resp = do - let crash = throwSpar SparCouldNotRetrieveCookie - unless (statusCode resp == 200) crash - maybe crash (pure . parseSetCookie) $ getHeader "Set-Cookie" resp - ----------------------------------------------------------------------- - -class (Log.MonadLogger m, MonadError SparError m) => MonadSparToBrig m where - call :: (Request -> Request) -> m ResponseLBS - -createBrigUserSAML :: - (HasCallStack, MonadSparToBrig m) => - SAML.UserRef -> - UserId -> - TeamId -> - -- | User name - Name -> - -- | Who should have control over the user - ManagedBy -> - Maybe Handle -> - Maybe RichInfo -> - Maybe Locale -> - Role -> - m UserId -createBrigUserSAML uref (Id buid) teamid name managedBy handle richInfo mLocale role = do - let newUser = - NewUserSpar - { newUserSparUUID = buid, - newUserSparDisplayName = name, - newUserSparSSOId = UserSSOId uref, - newUserSparTeamId = teamid, - newUserSparManagedBy = managedBy, - newUserSparHandle = handle, - newUserSparRichInfo = richInfo, - newUserSparLocale = mLocale, - newUserSparRole = role - } - resp :: ResponseLBS <- - call $ - method POST - . path "/i/users/spar" - . json newUser - if statusCode resp `elem` [200, 201] - then userId . selfUser <$> parseResponse @SelfProfile "brig" resp - else rethrow "brig" resp - -createBrigUserNoSAML :: - (HasCallStack, MonadSparToBrig m) => - Text -> - EmailAddress -> - UserId -> - TeamId -> - -- | User name - Name -> - Maybe Locale -> - Role -> - m UserId -createBrigUserNoSAML extId email uid teamid uname locale role = do - let newUser = NewUserScimInvitation teamid uid extId locale uname email role - resp :: ResponseLBS <- - call $ - method POST - . paths ["/i/teams", toByteString' teamid, "invitations"] - . json newUser - - if statusCode resp `elem` [200, 201] - then userId <$> parseResponse @User "brig" resp - else rethrow "brig" resp - -updateEmail :: (HasCallStack, MonadSparToBrig m) => UserId -> EmailAddress -> EmailActivation -> m () -updateEmail buid email activation = do - resp <- - call $ - method PUT - . path "/i/self/email" - . header "Z-User" (toByteString' buid) - . query - [ ("activation", Just (toByteString' activation)), - -- FUTUREWORK: the following two are for backwards compatibility during deployment - -- of the release containing https://github.com/wireapp/wire-server/pull/4617, can - -- be removed later (fisx, 2025-06-19) - ("validate", Just (fromBool validate)), - ("activate", Just (fromBool activate)) - ] - . json (EmailUpdate email) - case statusCode resp of - 204 -> pure () - 202 -> pure () - _ -> rethrow "brig" resp - where - (validate, activate) = case activation of - AutoActivate -> (False, True) - SendActivationEmail -> (True, False) - - fromBool :: Bool -> ByteString - fromBool True = "true" - fromBool False = "false" - --- | Get a user; returns 'Nothing' if the user was not found or has been deleted. -getBrigUserAccount :: (HasCallStack, MonadSparToBrig m) => HavePendingInvitations -> UserId -> m (Maybe User) -getBrigUserAccount havePending buid = do - resp :: ResponseLBS <- - call $ - method GET - . paths ["/i/users"] - . query - [ ("ids", Just $ toByteString' buid), - ( "includePendingInvitations", - Just . toByteString' $ - case havePending of - WithPendingInvitations -> True - NoPendingInvitations -> False - ) - ] - - case statusCode resp of - 200 -> - parseResponse @[User] "brig" resp >>= \case - [account] -> - pure $ - if userDeleted account - then Nothing - else Just account - _ -> pure Nothing - 404 -> pure Nothing - _ -> rethrow "brig" resp - --- | Get a user; returns 'Nothing' if the user was not found. --- --- TODO: currently this is not used, but it might be useful later when/if --- @hscim@ stops doing checks during user creation. -getBrigUserByHandle :: (HasCallStack, MonadSparToBrig m) => Handle -> m (Maybe User) -getBrigUserByHandle handle = do - resp :: ResponseLBS <- - call $ - method GET - . path "/i/users" - . queryItem "handles" (toByteString' handle) - . queryItem "includePendingInvitations" "true" - case statusCode resp of - 200 -> listToMaybe <$> parseResponse @[User] "brig" resp - 404 -> pure Nothing - _ -> rethrow "brig" resp - -getBrigUserByEmail :: (HasCallStack, MonadSparToBrig m) => EmailAddress -> m (Maybe User) -getBrigUserByEmail email = do - resp :: ResponseLBS <- - call $ - method GET - . path "/i/users" - . queryItem "email" (toByteString' email) - . queryItem "includePendingInvitations" "true" - case statusCode resp of - 200 -> do - macc <- listToMaybe <$> parseResponse @[User] "brig" resp - case userEmail =<< macc of - Just email' | email' == email -> pure macc - _ -> pure Nothing - 404 -> pure Nothing - _ -> rethrow "brig" resp - --- | Set user' name. Fails with status <500 if brig fails with <500, and with 500 if brig --- fails with >= 500. -setBrigUserName :: (HasCallStack, MonadSparToBrig m) => UserId -> Name -> m () -setBrigUserName buid (Name name) = do - resp <- - call $ - method PUT - . paths ["/i/users", toByteString' buid, "name"] - . json (NameUpdate name) - let sCode = statusCode resp - if sCode < 300 - then pure () - else rethrow "brig" resp - --- | Set user's handle. Fails with status <500 if brig fails with <500, and with 500 if brig fails --- with >= 500. --- --- NB: that this doesn't take a 'HandleUpdate', since we already construct a valid handle in --- 'validateScimUser' to increase the odds that user creation doesn't fail half-way through --- the many database write operations. -setBrigUserHandle :: (HasCallStack, MonadSparToBrig m) => UserId -> Handle {- not 'HandleUpdate'! -} -> m () -setBrigUserHandle buid handle = do - resp <- - call $ - method PUT - . paths ["/i/users", toByteString' buid, "handle"] - . json (HandleUpdate (fromHandle handle)) - case (statusCode resp, Wai.label <$> responseJsonMaybe @Wai.Error resp) of - (200, Nothing) -> - pure () - _ -> - rethrow "brig" resp - --- | Set user's managedBy. Fails with status <500 if brig fails with <500, and with 500 if --- brig fails with >= 500. -setBrigUserManagedBy :: (HasCallStack, MonadSparToBrig m) => UserId -> ManagedBy -> m () -setBrigUserManagedBy buid managedBy = do - resp <- - call $ - method PUT - . paths ["/i/users", toByteString' buid, "managed-by"] - . json (ManagedByUpdate managedBy) - unless (statusCode resp == 200) $ - rethrow "brig" resp - --- | Set user's UserSSOId. -setBrigUserSSOId :: (HasCallStack, MonadSparToBrig m) => UserId -> UserSSOId -> m () -setBrigUserSSOId buid ssoId = do - resp <- - call $ - method PUT - . paths ["i", "users", toByteString' buid, "sso-id"] - . json ssoId - case statusCode resp of - 200 -> pure () - _ -> rethrow "brig" resp - --- | Set user's richInfo. Fails with status <500 if brig fails with <500, and with 500 if --- brig fails with >= 500. -setBrigUserRichInfo :: (HasCallStack, MonadSparToBrig m) => UserId -> RichInfo -> m () -setBrigUserRichInfo buid richInfo = do - resp <- - call $ - method PUT - . paths ["i", "users", toByteString' buid, "rich-info"] - . json (RichInfoUpdate $ unRichInfo richInfo) - unless (statusCode resp == 200) $ - rethrow "brig" resp - -setBrigUserLocale :: (HasCallStack, MonadSparToBrig m) => UserId -> Maybe Locale -> m () -setBrigUserLocale buid = \case - Just locale -> do - resp <- - call $ - method PUT - . paths ["i", "users", toByteString' buid, "locale"] - . json (LocaleUpdate locale) - unless (statusCode resp == 200) $ - rethrow "brig" resp - Nothing -> do - resp <- - call $ - method DELETE - . paths ["i", "users", toByteString' buid, "locale"] - unless (statusCode resp == 200) $ - rethrow "brig" resp - -getBrigUserRichInfo :: (HasCallStack, MonadSparToBrig m) => UserId -> m RichInfo -getBrigUserRichInfo buid = do - resp <- - call $ - method GET - . paths ["/i/users", toByteString' buid, "rich-info"] - case statusCode resp of - 200 -> parseResponse "brig" resp - _ -> rethrow "brig" resp - -checkHandleAvailable :: (HasCallStack, MonadSparToBrig m) => Handle -> m Bool -checkHandleAvailable hnd = do - resp <- - call $ - method HEAD - . paths ["/i/users/handles", toByteString' hnd] - let sCode = statusCode resp - if - | sCode == 200 -> -- handle exists - pure False - | sCode == 404 -> -- handle not found - pure True - | otherwise -> - rethrow "brig" resp - --- | Call brig to delete a user. --- If the user wasn't deleted completely before, another deletion attempt will be made. -deleteBrigUserInternal :: (HasCallStack, MonadSparToBrig m) => UserId -> m DeleteUserResult -deleteBrigUserInternal buid = do - resp <- - call $ - method DELETE - . paths ["/i/users", toByteString' buid] - case statusCode resp of - 200 -> pure AccountAlreadyDeleted - 202 -> pure AccountDeleted - 404 -> pure NoUser - _ -> rethrow "brig" resp - --- | Verify user's password (needed for certain powerful operations). -ensureReAuthorised :: - (HasCallStack, MonadSparToBrig m) => - Maybe UserId -> - Maybe PlainTextPassword6 -> - Maybe Code.Value -> - Maybe VerificationAction -> - m () -ensureReAuthorised Nothing _ _ _ = throwSpar SparMissingZUsr -ensureReAuthorised (Just uid) secret mbCode mbAction = do - resp <- - call $ - method GET - . paths ["/i/users", toByteString' uid, "reauthenticate"] - . json (ReAuthUser secret mbCode mbAction) - case (statusCode resp, errorLabel resp) of - (200, _) -> pure () - (403, Just "code-authentication-required") -> throwSpar SparReAuthCodeAuthRequired - (403, Just "code-authentication-failed") -> throwSpar SparReAuthCodeAuthFailed - (403, _) -> throwSpar SparReAuthRequired - (_, _) -> rethrow "brig" resp - where - errorLabel :: ResponseLBS -> Maybe Lazy.Text - errorLabel = fmap Wai.label . responseJsonMaybe - --- | Get persistent cookie from brig and redirect user past login process. --- --- If brig responds with status >=400;<500, return Nothing. Otherwise, crash (500). -ssoLogin :: - (HasCallStack, MonadSparToBrig m) => - UserId -> - Maybe CookieLabel -> - m SetCookie -ssoLogin buid mlabel = do - resp :: ResponseLBS <- - call $ - method POST - . path "/i/sso-login" - . json (SsoLogin buid mlabel) - . queryItem "persist" "true" - if statusCode resp == 200 - then respToCookie resp - else rethrow "brig" resp - -getStatus' :: (HasCallStack, MonadSparToBrig m) => UserId -> m ResponseLBS -getStatus' uid = call $ method GET . paths ["/i/users", toByteString' uid, "status"] - --- | FUTUREWORK: this is probably unnecessary, and we can get the status info from 'UserAccount'. -getStatus :: (HasCallStack, MonadSparToBrig m) => UserId -> m AccountStatus -getStatus uid = do - resp <- getStatus' uid - case statusCode resp of - 200 -> fromAccountStatusResp <$> parseResponse @AccountStatusResp "brig" resp - _ -> rethrow "brig" resp - --- | FUTUREWORK: this is probably unnecessary, and we can get the status info from 'UserAccount'. -getStatusMaybe :: (HasCallStack, MonadSparToBrig m) => UserId -> m (Maybe AccountStatus) -getStatusMaybe uid = do - resp <- getStatus' uid - case statusCode resp of - 200 -> Just . fromAccountStatusResp <$> parseResponse @AccountStatusResp "brig" resp - 404 -> pure Nothing - _ -> rethrow "brig" resp - -setStatus :: (HasCallStack, MonadSparToBrig m) => UserId -> AccountStatus -> m () -setStatus uid status = do - resp <- - call $ - method PUT - . paths ["/i/users", toByteString' uid, "status"] - . json (AccountStatusUpdate status) - case statusCode resp of - 200 -> pure () - _ -> rethrow "brig" resp - -getDefaultUserLocale :: (HasCallStack, MonadSparToBrig m) => m Locale -getDefaultUserLocale = do - resp <- call $ method GET . paths ["/i/users/locale"] - case statusCode resp of - 200 -> luLocale <$> parseResponse @LocaleUpdate "brig" resp - _ -> rethrow "brig" resp - -checkAdminGetTeamId :: (HasCallStack, MonadSparToBrig m) => UserId -> m TeamId -checkAdminGetTeamId uid = do - resp <- call $ method GET . paths ["/i/users", toByteString' uid, "check-admin-get-team-id"] - case statusCode resp of - 200 -> parseResponse @TeamId "brig" resp - _ -> rethrow "brig" resp - -sendSAMLIdPChangedEmail :: (HasCallStack, MonadSparToBrig m) => IdpChangedNotification -> m () -sendSAMLIdPChangedEmail notif = do - resp <- call $ method POST . path "/i/idp/send-idp-changed-email" . json notif - unless (statusCode resp == 200) $ - rethrow "brig" resp diff --git a/services/spar/src/Spar/Intra/Galley.hs b/services/spar/src/Spar/Intra/Galley.hs deleted file mode 100644 index 31e3e89ba88..00000000000 --- a/services/spar/src/Spar/Intra/Galley.hs +++ /dev/null @@ -1,131 +0,0 @@ --- Disabling to stop warnings on HasCallStack -{-# OPTIONS_GHC -Wno-redundant-constraints #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- | Client functions for interacting with the Galley API. -module Spar.Intra.Galley where - -import Bilge -import Control.Lens -import Control.Monad.Except -import Data.ByteString.Conversion -import Data.Id (TeamId, UserId) -import qualified Data.Text.Lazy as LText -import Imports -import Network.HTTP.Types.Method -import Spar.Error -import qualified System.Logger.Class as Log -import Wire.API.Team.Feature -import Wire.API.Team.Member -import Wire.API.Team.Role - ----------------------------------------------------------------------- - -class (Monad m, Log.MonadLogger m) => MonadSparToGalley m where - call :: (Request -> Request) -> m ResponseLBS - --- | Get all members of a team. -getTeamMembers :: - (HasCallStack, MonadError SparError m, MonadSparToGalley m) => - TeamId -> - m [TeamMember] -getTeamMembers tid = do - resp :: ResponseLBS <- - call $ - method GET - . paths ["i", "teams", toByteString' tid, "members"] - if statusCode resp == 200 - then (^. teamMembers) <$> parseResponse @TeamMemberList "galley" resp - else rethrow "galley" resp - --- | Get a single member of a team. -getTeamMember :: - (HasCallStack, MonadError SparError m, MonadSparToGalley m) => - TeamId -> - UserId -> - m (Maybe TeamMember) -getTeamMember tid uid = do - resp :: ResponseLBS <- - call $ - method GET - . paths ["i", "teams", toByteString' tid, "members", toByteString' uid] - if statusCode resp == 200 - then Just <$> parseResponse @TeamMember "galley" resp - else - if statusCode resp == 404 - then pure Nothing - else rethrow "galley" resp - --- | user is member of a given team and has a given permission there. -assertHasPermission :: - (HasCallStack, MonadSparToGalley m, MonadError SparError m, IsPerm TeamMember perm, Show perm) => - TeamId -> - perm -> - UserId -> - m () -assertHasPermission tid perm uid = do - resp <- - call $ - method GET - . paths ["i", "teams", toByteString' tid, "members", toByteString' uid] - case (statusCode resp, parseResponse @TeamMember "galley" resp) of - (200, Right member) | hasPermission member perm -> pure () - _ -> throwSpar (SparNoPermission (LText.pack $ show perm)) - -assertSSOEnabled :: - (HasCallStack, MonadError SparError m, MonadSparToGalley m) => - TeamId -> - m () -assertSSOEnabled tid = do - resp :: ResponseLBS <- - call $ - method GET - . paths ["i", "teams", toByteString' tid, "features", "sso"] - unless (statusCode resp == 200) $ - rethrow "galley" resp - ws :: LockableFeature SSOConfig <- parseResponse "galley" resp - unless (ws.status == FeatureStatusEnabled) $ - throwSpar SparSSODisabled - -isEmailValidationEnabledTeam :: (HasCallStack, MonadSparToGalley m) => TeamId -> m Bool -isEmailValidationEnabledTeam tid = do - resp <- call $ method GET . paths ["i", "teams", toByteString' tid, "features", "validateSAMLemails"] - pure - ( statusCode resp == 200 - && ( ((.status) <$> responseJsonMaybe @(LockableFeature RequireExternalEmailVerificationConfig) resp) - == Just FeatureStatusEnabled - ) - ) - --- | Update a team member. -updateTeamMember :: - (MonadIO m, HasCallStack, MonadSparToGalley m) => - UserId -> - TeamId -> - Role -> - m () -updateTeamMember u tid role = do - let reqBody = mkNewTeamMember u (rolePermissions role) Nothing - rs <- - call $ - method PUT - . paths ["i", "teams", toByteString' tid, "members"] - . contentJson - . json reqBody - print rs diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/RpcApp.hs similarity index 71% rename from services/spar/src/Spar/Intra/BrigApp.hs rename to services/spar/src/Spar/Intra/RpcApp.hs index c1729747b3a..7b959a9a094 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/RpcApp.hs @@ -19,8 +19,8 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . --- | Client functions for interacting with the Brig API. -module Spar.Intra.BrigApp +-- | Client functions for interacting with the APIs of Brig, Galley, and possibly others. +module Spar.Intra.RpcApp ( veidToUserSSOId, urefToExternalId, oldVeidFromBrigUser, @@ -31,8 +31,10 @@ module Spar.Intra.BrigApp getBrigUserTeam, getZUsrCheckPerm, authorizeScimTokenManagement, - parseResponse, giveDefaultHandle, + ensureReAuthorised, + assertHasPermission, + assertSSOEnabled, -- * re-exports, mostly for historical reasons and lazyness emailFromSAML, @@ -44,25 +46,31 @@ import Control.Monad.Except import Data.ByteString.Conversion import Data.CaseInsensitive (original) import qualified Data.CaseInsensitive as CI +import Data.Code as Code import Data.Handle (Handle, parseHandle) import Data.HavePendingInvitations import Data.Id (TeamId, UserId) +import Data.Misc (PlainTextPassword6) import Data.Text.Encoding import Data.Text.Encoding.Error +import qualified Data.Text.Lazy as LText import Data.These import Data.These.Combinators import Imports import Polysemy import Polysemy.Error import qualified SAML2.WebSSO as SAML -import Spar.Error -import Spar.Sem.BrigAccess (BrigAccess) -import qualified Spar.Sem.BrigAccess as BrigAccess -import Spar.Sem.GalleyAccess (GalleyAccess) -import qualified Spar.Sem.GalleyAccess as GalleyAccess -import Wire.API.Team.Member (HiddenPerm (CreateReadDeleteScimToken), IsPerm, TeamMember) +import Spar.Error (SparCustomError (..), SparError) +import Wire.API.Error.Galley (AuthenticationError (..)) +import Wire.API.Team.Feature +import Wire.API.Team.Member (HiddenPerm (CreateReadDeleteScimToken), IsPerm, TeamMember, hasPermission) import Wire.API.User +import Wire.API.User.Auth.ReAuth (ReAuthUser (..)) import Wire.API.User.Scim (ValidScimId (..)) +import Wire.BrigAPIAccess (BrigAPIAccess) +import qualified Wire.BrigAPIAccess as BrigAPIAccess +import Wire.GalleyAPIAccess (GalleyAPIAccess) +import qualified Wire.GalleyAPIAccess as GalleyAPIAccess ---------------------------------------------------------------------- @@ -138,16 +146,16 @@ mkUserName Nothing = -- | Check that an id maps to an user on brig that is 'Active' (or optionally -- 'PendingInvitation') and has a team id. -getBrigUserTeam :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe TeamId) -getBrigUserTeam ifpend = fmap (userTeam =<<) . BrigAccess.getAccount ifpend +getBrigUserTeam :: (HasCallStack, Member BrigAPIAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe TeamId) +getBrigUserTeam ifpend = fmap (userTeam =<<) . BrigAPIAccess.getAccount ifpend -- | Pull team id for z-user from brig. Check permission in galley. Return team id. Fail if -- permission check fails or the user is not in status 'Active'. getZUsrCheckPerm :: forall r perm. ( HasCallStack, - ( Member BrigAccess r, - Member GalleyAccess r, + ( Member BrigAPIAccess r, + Member GalleyAPIAccess r, Member (Error SparError) r ), IsPerm TeamMember perm, @@ -161,13 +169,13 @@ getZUsrCheckPerm (Just uid) perm = do getBrigUserTeam NoPendingInvitations uid >>= maybe (throw $ SAML.CustomError SparNotInTeam) - (\teamid -> teamid <$ GalleyAccess.assertHasPermission teamid perm uid) + (\teamid -> teamid <$ assertHasPermission teamid perm uid) authorizeScimTokenManagement :: forall r. ( HasCallStack, - ( Member BrigAccess r, - Member GalleyAccess r, + ( Member BrigAPIAccess r, + Member GalleyAPIAccess r, Member (Error SparError) r ) ) => @@ -178,7 +186,7 @@ authorizeScimTokenManagement (Just uid) = do getBrigUserTeam NoPendingInvitations uid >>= maybe (throw $ SAML.CustomError SparNotInTeam) - (\teamid -> teamid <$ GalleyAccess.assertHasPermission teamid CreateReadDeleteScimToken uid) + (\teamid -> teamid <$ assertHasPermission teamid CreateReadDeleteScimToken uid) -- | If the user has no 'Handle', set it to its 'UserId' and update the user in brig. -- Return the handle the user now has (the old one if it existed, the newly created one @@ -194,11 +202,61 @@ authorizeScimTokenManagement (Just uid) = do -- We cannot simply respond with 404 in this case, because the user exists. 404 would suggest -- do the scim peer that it should post the user to create it, but that would create a new -- user instead of finding the old that should be put under scim control. -giveDefaultHandle :: (HasCallStack, Member BrigAccess r) => User -> Sem r Handle +giveDefaultHandle :: (HasCallStack, Member BrigAPIAccess r) => User -> Sem r Handle giveDefaultHandle usr = case userHandle usr of Just handle -> pure handle Nothing -> do let handle = fromJust . parseHandle . decodeUtf8With lenientDecode . toByteString' $ uid uid = userId usr - BrigAccess.setHandle uid handle + BrigAPIAccess.setHandle uid handle pure handle + +-- | Verify user's password (needed for certain powerful operations). +ensureReAuthorised :: + ( Member BrigAPIAccess r, + Member (Error SparError) r + ) => + Maybe UserId -> + Maybe PlainTextPassword6 -> + Maybe Code.Value -> + Maybe VerificationAction -> + Sem r () +ensureReAuthorised Nothing _ _ _ = throw $ SAML.CustomError SparMissingZUsr +ensureReAuthorised (Just uid) mpwd mcode maction = do + result <- BrigAPIAccess.reauthUser uid (ReAuthUser mpwd mcode maction) + case result of + Right () -> pure () + Left ReAuthFailed -> throw $ SAML.CustomError SparReAuthRequired + Left VerificationCodeRequired -> throw $ SAML.CustomError SparReAuthCodeAuthRequired + Left VerificationCodeAuthFailed -> throw $ SAML.CustomError SparReAuthCodeAuthFailed + Left RateLimitExceeded -> throw $ SAML.CustomError SparReAuthRateLimitExceeded + +-- | User is member of a given team and has a given permission there. +assertHasPermission :: + ( Member GalleyAPIAccess r, + Member (Error SparError) r, + IsPerm TeamMember perm, + Show perm + ) => + TeamId -> + perm -> + UserId -> + Sem r () +assertHasPermission tid perm uid = do + mbMember <- GalleyAPIAccess.getTeamMember uid tid + case mbMember of + Just member | hasPermission member perm -> pure () + _ -> throw $ SAML.CustomError (SparNoPermission (LText.pack $ show perm)) + +-- | Check that SSO is enabled for the given team. +assertSSOEnabled :: + ( Member GalleyAPIAccess r, + Member (Error SparError) r + ) => + TeamId -> + Sem r () +assertSSOEnabled tid = do + feat <- GalleyAPIAccess.getFeatureConfigForTeam @_ @SSOConfig tid + unless (feat.status == FeatureStatusEnabled) $ + throw $ + SAML.CustomError SparSSODisabled diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs index f2095772ede..caf48e2e7bd 100644 --- a/services/spar/src/Spar/Scim.hs +++ b/services/spar/src/Spar/Scim.hs @@ -83,8 +83,6 @@ import Spar.Options import Spar.Scim.Auth import Spar.Scim.Group () import Spar.Scim.User -import Spar.Sem.BrigAccess (BrigAccess) -import Spar.Sem.GalleyAccess (GalleyAccess) import Spar.Sem.Reporter (Reporter) import Spar.Sem.SAMLUserStore (SAMLUserStore) import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) @@ -100,6 +98,8 @@ import qualified Web.Scim.Schema.Schema as Scim.Schema import qualified Web.Scim.Server as Scim import Wire.API.Routes.Public.Spar import Wire.API.User.Scim +import Wire.BrigAPIAccess (BrigAPIAccess) +import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.IdPConfigStore (IdPConfigStore) import Wire.ScimSubsystem import Wire.Sem.Logger (Logger) @@ -121,8 +121,8 @@ apiScim :: Member (Logger String) r, Member Now r, Member (Error SparError) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimSubsystem r, Member ScimExternalIdStore r, Member ScimUserTimesStore r, diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index c05a53defcb..a915a38bbd5 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -50,11 +50,8 @@ import qualified SAML2.WebSSO as SAML import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>))) import Spar.App (throwSparSem) import qualified Spar.Error as E -import qualified Spar.Intra.BrigApp as Intra.Brig +import qualified Spar.Intra.RpcApp as Intra import Spar.Options -import Spar.Sem.BrigAccess (BrigAccess) -import qualified Spar.Sem.BrigAccess as BrigAccess -import Spar.Sem.GalleyAccess (GalleyAccess) import Spar.Sem.ScimTokenStore (ScimTokenStore) import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import qualified Web.Scim.Class.Auth as Scim.Class.Auth @@ -64,6 +61,8 @@ import Wire.API.Routes.Named import Wire.API.Routes.Public.Spar (APIScimToken) import Wire.API.User as User import Wire.API.User.Scim as Api +import Wire.BrigAPIAccess +import Wire.GalleyAPIAccess import Wire.IdPConfigStore (IdPConfigStore) import qualified Wire.IdPConfigStore as IdPConfigStore import Wire.Sem.Now (Now) @@ -91,8 +90,8 @@ instance (Member ScimTokenStore r) => Scim.Class.Auth.AuthDB SparTag (Sem r) whe apiScimToken :: ( Member Random r, Member (Input Opts) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member Now r, Member IdPConfigStore r, @@ -108,17 +107,17 @@ apiScimToken = :<|> Named @"auth-tokens-list" listScimTokens updateScimTokenName :: - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member ScimTokenStore r, Member (Error E.SparError) r, - Member GalleyAccess r + Member GalleyAPIAccess r ) => UserId -> ScimTokenId -> ScimTokenName -> Sem r () updateScimTokenName lusr tokenId name = do - teamid <- Intra.Brig.authorizeScimTokenManagement (Just lusr) + teamid <- Intra.authorizeScimTokenManagement (Just lusr) ScimTokenStore.updateName teamid tokenId name.fromScimTokenName -- | > docs/reference/provisioning/scim-token.md {#RefScimTokenCreate} @@ -128,8 +127,8 @@ createScimTokenV7 :: forall r. ( Member Random r, Member (Input Opts) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member IdPConfigStore r, Member Now r, @@ -167,8 +166,8 @@ createScimToken :: forall r. ( Member Random r, Member (Input Opts) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member IdPConfigStore r, Member Now r, @@ -187,8 +186,8 @@ createScimToken zusr Api.CreateScimToken {..} = do guardScimTokenCreation :: forall r. ( Member (Input Opts) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member (Error E.SparError) r ) => @@ -198,8 +197,8 @@ guardScimTokenCreation :: Maybe Code.Value -> Sem r TeamId guardScimTokenCreation zusr password verificationCode = do - teamid <- Intra.Brig.authorizeScimTokenManagement zusr - BrigAccess.ensureReAuthorised zusr password verificationCode (Just User.CreateScimToken) + teamid <- Intra.authorizeScimTokenManagement zusr + Intra.ensureReAuthorised zusr password verificationCode (Just User.CreateScimToken) tokenNumber <- length <$> ScimTokenStore.lookupByTeam teamid maxTokens <- inputs maxScimTokens unless (tokenNumber < maxTokens) $ @@ -240,8 +239,8 @@ createScimTokenUnchecked teamid mName desc mIdPId = do -- -- Delete a token belonging to user's team. deleteScimToken :: - ( Member GalleyAccess r, - Member BrigAccess r, + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member (Error E.SparError) r ) => @@ -250,13 +249,13 @@ deleteScimToken :: ScimTokenId -> Sem r NoContent deleteScimToken zusr tokenid = do - teamid <- Intra.Brig.authorizeScimTokenManagement zusr + teamid <- Intra.authorizeScimTokenManagement zusr ScimTokenStore.delete teamid tokenid pure NoContent listScimTokensV7 :: - ( Member GalleyAccess r, - Member BrigAccess r, + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member (Error E.SparError) r ) => @@ -276,8 +275,8 @@ listScimTokensV7 zusr = toV7 <$> listScimTokens zusr -- List all tokens belonging to user's team. Tokens themselves are not available, only -- metadata about them. listScimTokens :: - ( Member GalleyAccess r, - Member BrigAccess r, + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimTokenStore r, Member (Error E.SparError) r ) => @@ -285,5 +284,5 @@ listScimTokens :: Maybe UserId -> Sem r ScimTokenList listScimTokens zusr = do - teamid <- Intra.Brig.authorizeScimTokenManagement zusr + teamid <- Intra.authorizeScimTokenManagement zusr ScimTokenList <$> ScimTokenStore.lookupByTeam teamid diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 1b8f7902628..118e00d2ed2 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -74,15 +74,11 @@ import Polysemy.Input import qualified SAML2.WebSSO as SAML import Spar.App (getUserByUrefUnsafe, getUserByUrefViaOldIssuerUnsafe, getUserIdByScimExternalId) import qualified Spar.App -import Spar.Intra.BrigApp as Intra -import qualified Spar.Intra.BrigApp as Brig +import Spar.Intra.RpcApp as Intra import Spar.Options import Spar.Scim.Auth () import Spar.Scim.Types import qualified Spar.Scim.Types as ST -import Spar.Sem.BrigAccess (BrigAccess, getAccount) -import qualified Spar.Sem.BrigAccess as BrigAccess -import Spar.Sem.GalleyAccess as GalleyAccess import Spar.Sem.SAMLUserStore (SAMLUserStore) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) @@ -112,6 +108,10 @@ import Wire.API.User.IdentityProvider (IdP) import qualified Wire.API.User.RichInfo as RI import Wire.API.User.Scim (ScimTokenInfo (..), ValidScimId (..)) import qualified Wire.API.User.Scim as ST +import Wire.BrigAPIAccess (BrigAPIAccess) +import qualified Wire.BrigAPIAccess as BrigAPIAccess +import Wire.GalleyAPIAccess (GalleyAPIAccess) +import qualified Wire.GalleyAPIAccess as GalleyAPIAccess import Wire.IdPConfigStore (IdPConfigStore) import qualified Wire.IdPConfigStore as IdPConfigStore import Wire.Sem.Logger (Logger) @@ -130,8 +130,8 @@ instance Member Random r, Member (Input Opts) r, Member Now r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimExternalIdStore r, Member ScimUserTimesStore r, Member IdPConfigStore r, @@ -208,7 +208,7 @@ validateScimUser :: forall r. ( Member (Logger (Msg -> Msg)) r, Member SAMLUserStore r, - Member BrigAccess r, + Member BrigAPIAccess r, Member (Input Opts) r, Member IdPConfigStore r ) => @@ -230,7 +230,7 @@ validateScimUser errloc tokinfo user = validateScimUserNoLogging :: forall r. ( Member SAMLUserStore r, - Member BrigAccess r, + Member BrigAPIAccess r, Member (Input Opts) r, Member IdPConfigStore r ) => @@ -289,7 +289,7 @@ validateHandle txt = case parseHandle txt of validateScimUser' :: forall r. ( Member (Error Scim.ScimError) r, - Member BrigAccess r, + Member BrigAPIAccess r, Member SAMLUserStore r ) => -- | Error location (call site, for debugging) @@ -315,7 +315,7 @@ validateScimUser' errloc midp richInfoLimit user = do <> " (" <> errloc <> ")" - either err pure $ Brig.mkUserName (Scim.displayName user) (ST.validScimIdAuthInfo veid) + either err pure $ Intra.mkUserName (Scim.displayName user) (ST.validScimIdAuthInfo veid) richInfo <- validateRichInfo (Scim.extra user ^. ST.sueRichInfo) let active = Scim.active user lang <- maybe (throw $ badRequest "Could not parse language. Expected format is ISO 639-1.") pure $ mapM parseLanguage $ Scim.preferredLanguage user @@ -377,7 +377,7 @@ validateScimUser' errloc midp richInfoLimit user = do -- recover the 'SAML.UserRef' of the scim user before the update from the database. mkValidScimId :: forall r. - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member SAMLUserStore r, Member (Error Scim.ScimError) r ) => @@ -508,8 +508,8 @@ createValidScimUser :: Member (Input Opts) r, Member (Logger (Msg -> Msg)) r, Member (Logger String) r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimExternalIdStore r, Member ScimUserTimesStore r, Member SAMLUserStore r, @@ -533,7 +533,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser {..} -- If this is the case we can safely create the user again, AFTER THE -- HALF-CREATED ACCOUNT HAS BEEN GARBAGE-COLLECTED. -- Otherwise we return a conflict error. - lift (BrigAccess.getStatusMaybe buid) >>= \case + lift (BrigAPIAccess.getStatusMaybe buid) >>= \case Just Active -> throwError (externalIdTakenError ("user with status Active exists: " <> Text.pack (show (externalId, buid)))) Just Suspended -> throwError (externalIdTakenError ("user with status Suspended exists" <> Text.pack (show (externalId, buid)))) Just Ephemeral -> throwError (externalIdTakenError ("user with status Ephemeral exists" <> Text.pack (show (externalId, buid)))) @@ -560,14 +560,14 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser {..} -- FUTUREWORK: outsource this and some other fragments from -- `createValidScimUser` into a function `createValidScimUserBrig` similar -- to `createValidScimUserSpar`? - void $ BrigAccess.createSAML uref buid stiTeam name ManagedByScim (Just handle) (Just richInfo) locale (fromMaybe defaultRole role) + void $ BrigAPIAccess.createSAML uref buid stiTeam name ManagedByScim (Just handle) (Just richInfo) locale (fromMaybe defaultRole role) doEmail email = do - void $ BrigAccess.createNoSAML externalId.validScimIdExternal email buid stiTeam name locale (fromMaybe defaultRole role) - BrigAccess.setHandle buid handle -- FUTUREWORK: possibly do the same one req as we do for saml? + void $ BrigAPIAccess.createNoSAML externalId.validScimIdExternal email buid stiTeam name locale (fromMaybe defaultRole role) + BrigAPIAccess.setHandle buid handle -- FUTUREWORK: possibly do the same one req as we do for saml? these doEmail doUref (\_ uref -> doUref uref) (validScimIdAuthInfo externalId) Logger.debug ("createValidScimUser: brig says " <> show buid) - BrigAccess.setRichInfo buid richInfo + BrigAPIAccess.setRichInfo buid richInfo -- {If we crash now, a POST retry will fail with 409 user already exists. -- Azure at some point will retry with GET /Users?filter=userName eq handle @@ -579,7 +579,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser {..} -- to reload the Account from brig. storedUser <- do acc <- - lift (BrigAccess.getAccount Brig.WithPendingInvitations buid) + lift (BrigAPIAccess.getAccount Intra.WithPendingInvitations buid) >>= maybe (throwError $ Scim.serverError "Server error: user vanished") pure synthesizeStoredUser acc externalId lift $ Logger.debug ("createValidScimUser: spar says " <> show storedUser) @@ -594,10 +594,10 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser {..} -- TODO: suspension via scim is brittle, and may leave active users behind: if we don't -- reach the following line due to a crash, the user will be active. lift $ do - old <- BrigAccess.getStatus buid + old <- BrigAPIAccess.getStatus buid let new = ST.scimActiveFlagToAccountStatus old (Scim.unScimBool <$> active') active' = Scim.active . Scim.value . Scim.thing $ storedUser - when (new /= old) $ BrigAccess.setStatus buid new + when (new /= old) $ BrigAPIAccess.setStatus buid new lift $ ScimExternalIdStore.insertStatus stiTeam externalId buid ScimUserCreated pure storedUser @@ -642,8 +642,8 @@ updateValidScimUser :: Member (Logger (Msg -> Msg)) r, Member (Logger String) r, Member Now r, - Member GalleyAccess r, - Member BrigAccess r, + Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimExternalIdStore r, Member ScimUserTimesStore r, Member IdPConfigStore r, @@ -670,7 +670,7 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid nvsu = -- if the locale of the new valid SCIM user is not set, -- we set it to default value from brig - defLocale <- lift BrigAccess.getDefaultUserLocale + defLocale <- lift BrigAPIAccess.getDefaultUserLocale let newValidScimUser = nvsu {ST.locale = ST.locale nvsu <|> Just defLocale} -- assertions about new valid scim user that cannot be checked in 'validateScimUser' because @@ -689,33 +689,33 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid nvsu = updateVsuUref stiTeam uid (oldValidScimUser.externalId) (newValidScimUser.externalId) when (newValidScimUser.name /= oldValidScimUser.name) $ - BrigAccess.setName uid (newValidScimUser.name) + BrigAPIAccess.setName uid (newValidScimUser.name) when (oldValidScimUser.handle /= newValidScimUser.handle) $ - BrigAccess.setHandle uid (newValidScimUser.handle) + BrigAPIAccess.setHandle uid (newValidScimUser.handle) when (oldValidScimUser.richInfo /= newValidScimUser.richInfo) $ - BrigAccess.setRichInfo uid (newValidScimUser.richInfo) + BrigAPIAccess.setRichInfo uid (newValidScimUser.richInfo) when (oldValidScimUser.locale /= newValidScimUser.locale) $ do - BrigAccess.setLocale uid (newValidScimUser.locale) + BrigAPIAccess.setLocale uid (newValidScimUser.locale) forM_ (newValidScimUser.role) $ \newRole -> do when (oldValidScimUser.role /= Just newRole) $ do - GalleyAccess.updateTeamMember uid stiTeam newRole + GalleyAPIAccess.updateTeamMember uid stiTeam newRole - BrigAccess.getStatusMaybe uid >>= \case + BrigAPIAccess.getStatusMaybe uid >>= \case Nothing -> pure () Just old -> do let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser.active) - when (new /= old) $ BrigAccess.setStatus uid new + when (new /= old) $ BrigAPIAccess.setStatus uid new ScimUserTimesStore.write newScimStoredUser Scim.getUser tokinfo uid updateVsuUref :: - ( Member GalleyAccess r, - Member BrigAccess r, + ( Member GalleyAPIAccess r, + Member BrigAPIAccess r, Member ScimExternalIdStore r, Member SAMLUserStore r ) => @@ -735,7 +735,7 @@ updateVsuUref team uid old new = do ScimExternalIdStore.insert team new.validScimIdExternal uid for_ (justThere new.validScimIdAuthInfo) (`SAMLUserStore.insert` uid) - BrigAccess.setSSOId uid $ veidToUserSSOId new + BrigAPIAccess.setSSOId uid $ veidToUserSSOId new toScimStoredUser :: (HasCallStack) => @@ -793,7 +793,7 @@ updScimStoredUser' now usr (Scim.WithMeta meta (Scim.WithId scimuid _)) = deleteScimUser :: ( Member (Logger (Msg -> Msg)) r, - Member BrigAccess r, + Member BrigAPIAccess r, Member ScimExternalIdStore r, Member ScimUserTimesStore r, Member SAMLUserStore r, @@ -814,7 +814,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- ("tombstones") would not have the needed values (`userIdentity = -- Nothing`) to delete a user in spar. I.e. `SAML.UserRef` and `Email` -- cannot be figured out when a `User` has status `Deleted`. - mbAccount <- lift $ BrigAccess.getAccount WithPendingInvitations uid + mbAccount <- lift $ BrigAPIAccess.getAccount WithPendingInvitations uid case mbAccount of Nothing -> -- Ensure there's no left-over of this user in brig. This is safe @@ -823,7 +823,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- be hard as the check relies on the data of `mbBrigUser`): The worst -- thing that could happen is that foreign users cleanup partially -- deleted users. - void . lift $ BrigAccess.deleteUser uid + void . lift $ BrigAPIAccess.deleteUser uid Just brigUser -> do if userTeam brigUser == Just stiTeam then do @@ -834,7 +834,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- (via the TM app) is blocked, though, so there is no legal way to enter -- that situation. deleteUserInSpar brigUser - void . lift $ BrigAccess.deleteUser uid + void . lift $ BrigAPIAccess.deleteUser uid else do -- if we find the user in another team, we pretend it wasn't even there, to -- avoid leaking data to attackers (very unlikely, but hey). @@ -852,14 +852,14 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = mIdpConfig <- mapM (lift . IdPConfigStore.getConfig) stiIdP -- delete user with idp associated *before* this update. - case Brig.oldVeidFromBrigUser account of + case Intra.oldVeidFromBrigUser account of Nothing -> pure () Just veid -> lift $ do for_ (justThere veid.validScimIdAuthInfo) (SAMLUserStore.delete uid) ScimExternalIdStore.delete stiTeam veid.validScimIdExternal -- delete user with idp associated to current scim token. - case Brig.newVeidFromBrigUser account ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of + case Intra.newVeidFromBrigUser account ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of Left _ -> pure () Right veid -> lift $ do for_ (justThere veid.validScimIdAuthInfo) (SAMLUserStore.delete uid) @@ -894,7 +894,7 @@ calculateVersion uid usr = Scim.Weak (Text.pack (show h)) -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds -- to a single `externalId`. assertExternalIdUnused :: - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member ScimExternalIdStore r, Member SAMLUserStore r ) => @@ -911,7 +911,7 @@ assertExternalIdUnused = -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds -- to a single `externalId`. assertExternalIdNotUsedElsewhere :: - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member ScimExternalIdStore r, Member SAMLUserStore r ) => @@ -927,7 +927,7 @@ assertExternalIdNotUsedElsewhere tid veid wireUserId = veid assertExternalIdInAllowedValues :: - ( Member BrigAccess r, + ( Member BrigAPIAccess r, Member ScimExternalIdStore r, Member SAMLUserStore r ) => @@ -945,18 +945,18 @@ assertExternalIdInAllowedValues allowedValues errmsg tid veid = do unless isGood $ throwError Scim.conflict {Scim.detail = Just errmsg} -assertHandleUnused :: (Member BrigAccess r) => Handle -> Scim.ScimHandler (Sem r) () +assertHandleUnused :: (Member BrigAPIAccess r) => Handle -> Scim.ScimHandler (Sem r) () assertHandleUnused = assertHandleUnused' "userName is already taken" -assertHandleUnused' :: (Member BrigAccess r) => Text -> Handle -> Scim.ScimHandler (Sem r) () +assertHandleUnused' :: (Member BrigAPIAccess r) => Text -> Handle -> Scim.ScimHandler (Sem r) () assertHandleUnused' msg hndl = - lift (BrigAccess.checkHandleAvailable hndl) >>= \case + lift (BrigAPIAccess.checkHandleAvailable hndl) >>= \case True -> pure () False -> throwError Scim.conflict {Scim.detail = Just msg} -assertHandleNotUsedElsewhere :: (Member BrigAccess r) => UserId -> Handle -> Scim.ScimHandler (Sem r) () +assertHandleNotUsedElsewhere :: (Member BrigAPIAccess r) => UserId -> Handle -> Scim.ScimHandler (Sem r) () assertHandleNotUsedElsewhere uid hndl = do - musr <- lift $ getAccount Brig.WithPendingInvitations uid + musr <- lift $ BrigAPIAccess.getAccount Intra.WithPendingInvitations uid unless ((userHandle =<< musr) == Just hndl) $ assertHandleUnused' "userName already in use by another wire user" hndl @@ -968,8 +968,8 @@ synthesizeStoredUser :: ( Member (Input Opts) r, Member Now r, Member (Logger (Msg -> Msg)) r, - Member BrigAccess r, - Member GalleyAccess r, + Member BrigAPIAccess r, + Member GalleyAPIAccess r, Member ScimUserTimesStore r ) => User -> @@ -991,7 +991,7 @@ synthesizeStoredUser acc veid = let readState :: Sem r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI, Role) readState = (,,,) - <$> BrigAccess.getRichInfo uid + <$> BrigAPIAccess.getRichInfo uid <*> ScimUserTimesStore.read uid <*> inputs scimBaseUri <*> getRole @@ -1001,16 +1001,16 @@ synthesizeStoredUser acc veid = when (isNothing oldAccessTimes) $ ScimUserTimesStore.write storedUser when (oldManagedBy /= ManagedByScim) $ - BrigAccess.setManagedBy uid ManagedByScim + BrigAPIAccess.setManagedBy uid ManagedByScim let newRichInfo = view ST.sueRichInfo . Scim.extra . Scim.value . Scim.thing $ storedUser when (oldRichInfo /= newRichInfo) $ - BrigAccess.setRichInfo uid newRichInfo + BrigAPIAccess.setRichInfo uid newRichInfo (richInfo, accessTimes, baseuri, role) <- lift readState now <- toUTCTimeMillis <$> lift Now.get let (createdAt, lastUpdatedAt) = fromMaybe (now, now) accessTimes - handle <- lift $ Brig.giveDefaultHandle acc + handle <- lift $ Intra.giveDefaultHandle acc let emails = maybeToList $ @@ -1036,7 +1036,7 @@ synthesizeStoredUser acc veid = getRole :: Sem r Role getRole = do let tmRoleOrDefault m = fromMaybe defaultRole $ m >>= \member -> member ^. Member.permissions . to Member.permissionsRole - maybe (pure defaultRole) (\tid -> tmRoleOrDefault <$> GalleyAccess.getTeamMember tid (userId acc)) (userTeam acc) + maybe (pure defaultRole) (fmap tmRoleOrDefault . GalleyAPIAccess.getTeamMember (userId acc)) (userTeam acc) synthesizeStoredUser' :: (MonadError Scim.ScimError m) => @@ -1094,8 +1094,8 @@ synthesizeScimUser info = -- TODO: now write a test, either in /integration or in spar, whichever is easier. (spar) getUserById :: forall r. - ( Member BrigAccess r, - Member GalleyAccess r, + ( Member BrigAPIAccess r, + Member GalleyAPIAccess r, Member (Input Opts) r, Member (Logger (Msg -> Msg)) r, Member Now r, @@ -1108,9 +1108,9 @@ getUserById :: UserId -> MaybeT (Scim.ScimHandler (Sem r)) (Scim.StoredUser ST.SparTag) getUserById midp stiTeam uid = do - brigUser <- MaybeT . lift $ BrigAccess.getAccount Brig.WithPendingInvitations uid - let mbOldVeid = Brig.oldVeidFromBrigUser brigUser - mbNewVeid = Brig.newVeidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> midp) + brigUser <- MaybeT . lift $ BrigAPIAccess.getAccount Intra.WithPendingInvitations uid + let mbOldVeid = Intra.oldVeidFromBrigUser brigUser + mbNewVeid = Intra.newVeidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> midp) case mbNewVeid of Right veid | userTeam brigUser == Just stiTeam -> lift $ do storedUser :: Scim.StoredUser ST.SparTag <- synthesizeStoredUser brigUser veid @@ -1126,10 +1126,10 @@ getUserById midp stiTeam uid = do handleVeidChange brigUser mbOldVeid newVeid = do -- set sso_id when (mbOldVeid /= Just newVeid) do - lift $ BrigAccess.setSSOId uid (veidToUserSSOId newVeid) + lift $ BrigAPIAccess.setSSOId uid (veidToUserSSOId newVeid) -- set managed_by when (userManagedBy brigUser /= ManagedByScim) do - lift $ BrigAccess.setManagedBy uid ManagedByScim + lift $ BrigAPIAccess.setManagedBy uid ManagedByScim -- remove dangling entry from spar.user_v2 table (cassandra) case mbOldVeid of Just oldVeid | ST.veidUref newVeid /= ST.veidUref oldVeid -> do @@ -1138,8 +1138,8 @@ getUserById midp stiTeam uid = do scimFindUserByHandle :: forall r. - ( Member BrigAccess r, - Member GalleyAccess r, + ( Member BrigAPIAccess r, + Member GalleyAPIAccess r, Member (Input Opts) r, Member (Logger (Msg -> Msg)) r, Member Now r, @@ -1153,7 +1153,7 @@ scimFindUserByHandle :: MaybeT (Scim.ScimHandler (Sem r)) (Scim.StoredUser ST.SparTag) scimFindUserByHandle mIdpConfig stiTeam hndl = do handle <- MaybeT . pure . parseHandle . Text.toLower $ hndl - brigUser <- MaybeT . lift . BrigAccess.getByHandle $ handle + brigUser <- MaybeT . lift . BrigAPIAccess.getAccountByHandle $ handle getUserById mIdpConfig stiTeam . userId $ brigUser -- | Construct a 'ValidScimId'. If it is an 'Email', find the non-SAML SCIM user in spar; if @@ -1164,8 +1164,8 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do -- successful authentication with their SAML credentials. scimFindUserByExternalId :: forall r. - ( Member BrigAccess r, - Member GalleyAccess r, + ( Member BrigAPIAccess r, + Member GalleyAPIAccess r, Member (Input Opts) r, Member (Logger (Msg -> Msg)) r, Member Now r, @@ -1186,11 +1186,11 @@ scimFindUserByExternalId mIdpConfig stiTeam eid = do -- there are a few ways to find a user. this should all be redundant, especially the where -- we lookup a user from brig by email, throw it away and only keep the uid, and then use -- the uid to lookup the account again. but cassandra, and also reasons. - mViaEmail :: Maybe UserId <- join <$> (for (justHere veid.validScimIdAuthInfo) ((userId <$$>) . BrigAccess.getByEmail)) + mViaEmail :: Maybe UserId <- join <$> (for (justHere veid.validScimIdAuthInfo) ((userId <$$>) . BrigAPIAccess.getByEmail)) mViaUref :: Maybe UserId <- join <$> (for (justThere veid.validScimIdAuthInfo) SAMLUserStore.get) pure $ mViaEmail <|> mViaUref Just uid -> pure uid - acc <- MaybeT . lift . BrigAccess.getAccount Brig.WithPendingInvitations $ uid + acc <- MaybeT . lift . BrigAPIAccess.getAccount Intra.WithPendingInvitations $ uid getUserById mIdpConfig stiTeam (userId acc) logFilter :: Filter -> (Msg -> Msg) diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs deleted file mode 100644 index b8765965f32..00000000000 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ /dev/null @@ -1,89 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Spar.Sem.BrigAccess - ( BrigAccess (..), - createSAML, - createNoSAML, - updateEmail, - getAccount, - getByHandle, - getByEmail, - setName, - setHandle, - setManagedBy, - setSSOId, - setRichInfo, - setLocale, - getRichInfo, - checkHandleAvailable, - deleteUser, - ensureReAuthorised, - ssoLogin, - getStatus, - getStatusMaybe, - setStatus, - getDefaultUserLocale, - checkAdminGetTeamId, - sendSAMLIdPChangedEmail, - ) -where - -import Data.Code as Code -import Data.Handle (Handle) -import Data.HavePendingInvitations -import Data.Id (TeamId, UserId) -import Data.Misc (PlainTextPassword6) -import Imports -import Polysemy -import qualified SAML2.WebSSO as SAML -import Web.Cookie -import Wire.API.Locale -import Wire.API.Routes.Internal.Brig (IdpChangedNotification) -import Wire.API.Team.Role -import Wire.API.User -import Wire.API.User.Auth -import Wire.API.User.RichInfo as RichInfo - -data BrigAccess m a where - CreateSAML :: SAML.UserRef -> UserId -> TeamId -> Name -> ManagedBy -> Maybe Handle -> Maybe RichInfo -> Maybe Locale -> Role -> BrigAccess m UserId - CreateNoSAML :: Text -> EmailAddress -> UserId -> TeamId -> Name -> Maybe Locale -> Role -> BrigAccess m UserId - UpdateEmail :: UserId -> EmailAddress -> EmailActivation -> BrigAccess m () - GetAccount :: HavePendingInvitations -> UserId -> BrigAccess m (Maybe User) - GetByHandle :: Handle -> BrigAccess m (Maybe User) - GetByEmail :: EmailAddress -> BrigAccess m (Maybe User) - SetName :: UserId -> Name -> BrigAccess m () - SetHandle :: UserId -> Handle {- not 'HandleUpdate'! -} -> BrigAccess m () - SetManagedBy :: UserId -> ManagedBy -> BrigAccess m () - SetSSOId :: UserId -> UserSSOId -> BrigAccess m () - SetRichInfo :: UserId -> RichInfo -> BrigAccess m () - SetLocale :: UserId -> Maybe Locale -> BrigAccess m () - GetRichInfo :: UserId -> BrigAccess m RichInfo - CheckHandleAvailable :: Handle -> BrigAccess m Bool - DeleteUser :: UserId -> BrigAccess m DeleteUserResult - EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword6 -> Maybe Code.Value -> Maybe VerificationAction -> BrigAccess m () - SsoLogin :: UserId -> Maybe CookieLabel -> BrigAccess m SetCookie - GetStatus :: UserId -> BrigAccess m AccountStatus - GetStatusMaybe :: UserId -> BrigAccess m (Maybe AccountStatus) - SetStatus :: UserId -> AccountStatus -> BrigAccess m () - GetDefaultUserLocale :: BrigAccess m Locale - CheckAdminGetTeamId :: UserId -> BrigAccess m TeamId - SendSAMLIdPChangedEmail :: IdpChangedNotification -> BrigAccess m () - -makeSem ''BrigAccess diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs deleted file mode 100644 index 08880ae3014..00000000000 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ /dev/null @@ -1,68 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Spar.Sem.BrigAccess.Http - ( brigAccessToHttp, - ) -where - -import Bilge -import Imports -import Polysemy -import Polysemy.Error (Error) -import Spar.Error (SparError) -import qualified Spar.Intra.Brig as Intra -import Spar.Sem.BrigAccess -import Spar.Sem.Utils (RunHttpEnv (..), viaRunHttp) -import qualified System.Logger as TinyLog -import Wire.Sem.Logger (Logger) - -brigAccessToHttp :: - ( Member (Logger (TinyLog.Msg -> TinyLog.Msg)) r, - Member (Error SparError) r, - Member (Embed IO) r - ) => - Bilge.Manager -> - Bilge.Request -> - Sem (BrigAccess ': r) a -> - Sem r a -brigAccessToHttp mgr req = - interpret $ - viaRunHttp (RunHttpEnv mgr req) . \case - CreateSAML u itlu itlt n m h ri ml r -> Intra.createBrigUserSAML u itlu itlt n m h ri ml r - CreateNoSAML eid e uid itlt n ml r -> Intra.createBrigUserNoSAML eid e uid itlt n ml r - UpdateEmail itlu e a -> Intra.updateEmail itlu e a - GetAccount h itlu -> Intra.getBrigUserAccount h itlu - GetByHandle h -> Intra.getBrigUserByHandle h - GetByEmail e -> Intra.getBrigUserByEmail e - SetName itlu n -> Intra.setBrigUserName itlu n - SetHandle itlu h -> Intra.setBrigUserHandle itlu h - SetManagedBy itlu m -> Intra.setBrigUserManagedBy itlu m - SetSSOId itlu v -> Intra.setBrigUserSSOId itlu v - SetRichInfo itlu r -> Intra.setBrigUserRichInfo itlu r - SetLocale itlu l -> Intra.setBrigUserLocale itlu l - GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu - CheckHandleAvailable h -> Intra.checkHandleAvailable h - DeleteUser itlu -> Intra.deleteBrigUserInternal itlu - EnsureReAuthorised mitlu mp mc ma -> Intra.ensureReAuthorised mitlu mp mc ma - SsoLogin itlu mlabel -> Intra.ssoLogin itlu mlabel - GetStatus itlu -> Intra.getStatus itlu - GetStatusMaybe itlu -> Intra.getStatusMaybe itlu - SetStatus itlu a -> Intra.setStatus itlu a - GetDefaultUserLocale -> Intra.getDefaultUserLocale - CheckAdminGetTeamId itlu -> Intra.checkAdminGetTeamId itlu - SendSAMLIdPChangedEmail notif -> Intra.sendSAMLIdPChangedEmail notif diff --git a/services/spar/src/Spar/Sem/GalleyAccess.hs b/services/spar/src/Spar/Sem/GalleyAccess.hs deleted file mode 100644 index 545395af4cd..00000000000 --- a/services/spar/src/Spar/Sem/GalleyAccess.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Spar.Sem.GalleyAccess - ( GalleyAccess (..), - getTeamMembers, - getTeamMember, - assertHasPermission, - assertSSOEnabled, - isEmailValidationEnabledTeam, - updateTeamMember, - ) -where - -import Data.Id (TeamId, UserId) -import Imports -import Polysemy -import Wire.API.Team.Member -import Wire.API.Team.Role - -data GalleyAccess m a where - GetTeamMembers :: TeamId -> GalleyAccess m [TeamMember] - GetTeamMember :: TeamId -> UserId -> GalleyAccess m (Maybe TeamMember) - AssertHasPermission :: (Show perm, IsPerm TeamMember perm) => TeamId -> perm -> UserId -> GalleyAccess m () - AssertSSOEnabled :: TeamId -> GalleyAccess m () - IsEmailValidationEnabledTeam :: TeamId -> GalleyAccess m Bool - UpdateTeamMember :: UserId -> TeamId -> Role -> GalleyAccess m () - -makeSem ''GalleyAccess diff --git a/services/spar/src/Spar/Sem/GalleyAccess/Http.hs b/services/spar/src/Spar/Sem/GalleyAccess/Http.hs deleted file mode 100644 index 793bac9c276..00000000000 --- a/services/spar/src/Spar/Sem/GalleyAccess/Http.hs +++ /dev/null @@ -1,53 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Spar.Sem.GalleyAccess.Http - ( RunHttpEnv (..), - viaRunHttp, - galleyAccessToHttp, - ) -where - -import Bilge -import Imports hiding (log) -import Polysemy -import Polysemy.Error -import Spar.Error (SparError) -import qualified Spar.Intra.Galley as Intra -import Spar.Sem.GalleyAccess -import Spar.Sem.Utils -import qualified System.Logger as TinyLog -import Wire.Sem.Logger (Logger) - -galleyAccessToHttp :: - ( Member (Logger (TinyLog.Msg -> TinyLog.Msg)) r, - Member (Error SparError) r, - Member (Embed IO) r - ) => - Bilge.Manager -> - Bilge.Request -> - Sem (GalleyAccess ': r) a -> - Sem r a -galleyAccessToHttp mgr req = - interpret $ - viaRunHttp (RunHttpEnv mgr req) . \case - GetTeamMembers itlt -> Intra.getTeamMembers itlt - GetTeamMember tid uid -> Intra.getTeamMember tid uid - AssertHasPermission itlt perm itlu -> Intra.assertHasPermission itlt perm itlu - AssertSSOEnabled itlt -> Intra.assertSSOEnabled itlt - IsEmailValidationEnabledTeam itlt -> Intra.isEmailValidationEnabledTeam itlt - UpdateTeamMember uid tid role -> Intra.updateTeamMember uid tid role diff --git a/services/spar/src/Spar/Sem/Utils.hs b/services/spar/src/Spar/Sem/Utils.hs index 0cac0ec9db4..11789114fa2 100644 --- a/services/spar/src/Spar/Sem/Utils.hs +++ b/services/spar/src/Spar/Sem/Utils.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -18,33 +16,24 @@ -- with this program. If not, see . module Spar.Sem.Utils - ( viaRunHttp, - RunHttpEnv (..), - interpretClientToIO, + ( interpretClientToIO, ttlErrorToSparError, + rpcExceptionToSparError, idpDbErrorToSparError, ) where -import Bilge import Cassandra as Cas import qualified Control.Monad.Catch as Catch -import Control.Monad.Except (ExceptT (..), MonadError, runExceptT) import qualified Data.Text.Lazy as LText -import Imports hiding (log) +import Imports import Polysemy import Polysemy.Error import Polysemy.Final import qualified SAML2.WebSSO as SAML import Spar.Error -import Spar.Intra.Brig (MonadSparToBrig (..)) -import Spar.Intra.Galley (MonadSparToGalley) -import qualified Spar.Intra.Galley as Intra -import qualified System.Logger as TinyLog -import qualified System.Logger.Class as TinyLog import Wire.API.User.Saml -import Wire.Sem.Logger (Logger) -import qualified Wire.Sem.Logger as Logger +import Wire.RpcException -- | Run an embedded Cassandra 'Client' in @Final IO@. interpretClientToIO :: @@ -70,62 +59,8 @@ interpretClientToIO ctx = interpret $ \case ttlErrorToSparError :: (Member (Error SparError) r) => Sem (Error TTLError ': r) a -> Sem r a ttlErrorToSparError = mapError (SAML.CustomError . SparCassandraTTLError) +rpcExceptionToSparError :: (Member (Error SparError) r) => Sem (Error RpcException ': r) a -> Sem r a +rpcExceptionToSparError = mapError (SAML.CustomError . SparRpcException) + idpDbErrorToSparError :: (Member (Error SparError) r) => Sem (Error IdpDbError ': r) a -> Sem r a idpDbErrorToSparError = mapError (SAML.CustomError . IdpDbError) - -data RunHttpEnv r = RunHttpEnv - { rheManager :: Bilge.Manager, - rheRequest :: Bilge.Request - } - -newtype RunHttp r a = RunHttp - { unRunHttp :: ReaderT (RunHttpEnv r) (ExceptT SparError (HttpT (Sem r))) a - } - deriving newtype (Functor, Applicative, Monad, MonadError SparError, MonadReader (RunHttpEnv r)) - -instance (Member (Embed IO) r) => MonadIO (RunHttp r) where - liftIO = semToRunHttp . embed - -instance (Member (Embed IO) r) => MonadHttp (RunHttp r) where - handleRequestWithCont r fribia = - RunHttp $ - lift $ - lift $ - handleRequestWithCont r fribia - -semToRunHttp :: Sem r a -> RunHttp r a -semToRunHttp = RunHttp . lift . lift . lift - -viaRunHttp :: - (Member (Error SparError) r) => - RunHttpEnv r -> - RunHttp r a -> - Sem r a -viaRunHttp env m = do - ma <- runHttpT (rheManager env) $ runExceptT $ flip runReaderT env $ unRunHttp m - case ma of - Left err -> throw err - Right a -> pure a - -instance (Member (Logger (TinyLog.Msg -> TinyLog.Msg)) r) => TinyLog.MonadLogger (RunHttp r) where - log lvl msg = semToRunHttp $ Logger.log lvl msg - -instance - ( Member (Logger (TinyLog.Msg -> TinyLog.Msg)) r, - Member (Embed IO) r - ) => - MonadSparToGalley (RunHttp r) - where - call modreq = do - req <- asks rheRequest - httpLbs req modreq - -instance - ( Member (Logger (TinyLog.Msg -> TinyLog.Msg)) r, - Member (Embed IO) r - ) => - MonadSparToBrig (RunHttp r) - where - call modreq = do - req <- asks rheRequest - httpLbs req modreq diff --git a/services/spar/test-integration/Main.hs b/services/spar/test-integration/Main.hs index f1a42c99847..b2c219c6147 100644 --- a/services/spar/test-integration/Main.hs +++ b/services/spar/test-integration/Main.hs @@ -47,7 +47,6 @@ import qualified Test.MetricsSpec import qualified Test.Spar.APISpec import qualified Test.Spar.AppSpec import qualified Test.Spar.DataSpec -import qualified Test.Spar.Intra.BrigSpec import qualified Test.Spar.Scim.AuthSpec import qualified Test.Spar.Scim.UserSpec import Util @@ -107,7 +106,6 @@ mkspecSaml = do describe "Spar.API" Test.Spar.APISpec.spec describe "Spar.App" Test.Spar.AppSpec.spec describe "Spar.Data" Test.Spar.DataSpec.spec - describe "Spar.Intra.Brig" Test.Spar.Intra.BrigSpec.spec mkspecScim :: SpecWith TestEnv mkspecScim = do diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index ec2fff5242f..315d798378c 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -25,6 +25,7 @@ import Bilge.Assert import Cassandra as Cas hiding (Client, Value) import Control.Lens hiding ((.=)) import Control.Monad.Catch (MonadThrow) +import Control.Monad.Error.Class import Control.Monad.Random.Class (getRandomR) import Data.Aeson as Aeson import Data.Aeson.Lens @@ -37,8 +38,9 @@ import Data.Misc import Data.Proxy import Data.String.Conversions import qualified Data.Text as ST -import qualified Data.Text as T import Data.Text.Ascii (decodeBase64, validateBase64) +import qualified Data.Text.Lazy as LT +import Data.Typeable (typeRep) import qualified Data.UUID as UUID hiding (fromByteString, null) import qualified Data.UUID.V4 as UUID (nextRandom) import qualified Data.Vector as Vec @@ -70,10 +72,10 @@ import SAML2.WebSSO.API.Example (SimpleSP) import SAML2.WebSSO.Test.Lenses import SAML2.WebSSO.Test.MockResponse import SAML2.WebSSO.Test.Util -import qualified Spar.Intra.BrigApp as Intra +import Spar.Error +import qualified Spar.Intra.RpcApp as Intra import Spar.Options import qualified Spar.Sem.AReqIDStore as AReqIDStore -import qualified Spar.Sem.BrigAccess as BrigAccess import Text.XML.DSig (SignPrivCreds, mkSignCredsWithCert) import qualified URI.ByteString as URI import URI.ByteString.QQ (uri) @@ -95,6 +97,7 @@ import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.User.IdentityProvider import Wire.API.User.Scim hiding (handle) +import qualified Wire.BrigAPIAccess as BrigAPIAccess import qualified Wire.IdPConfigStore as IdPEffect spec :: SpecWith TestEnv @@ -419,7 +422,7 @@ specFinalizeLogin = do subj <- createEmailSubject randEmail mbId1 <- loginWithSubject subj - subjUpper <- createEmailSubject (T.toUpper randEmail) + subjUpper <- createEmailSubject (ST.toUpper randEmail) mbId2 <- loginWithSubject subjUpper liftIO $ do @@ -1267,7 +1270,7 @@ specDeleteCornerCases = describe "delete corner cases" $ do brig <- view teBrig resp <- call . delete $ brig . paths ["i", "users", toByteString' uid] liftIO $ responseStatus resp `shouldBe` status202 - void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Deleted) + void $ aFewTimes (runSpar $ BrigAPIAccess.getStatus uid) (== Deleted) specScimAndSAML :: SpecWith TestEnv specScimAndSAML = do @@ -1431,8 +1434,20 @@ specAux = do . header "Z-User" (toByteString' $ if tryowner then owner else newmember) . expect2xx ) - parsedResp <- either (error . show) (pure . selfUser) (Intra.parseResponse @SelfProfile "brig" rawResp) + parsedResp <- either (error . show) (pure . selfUser) (parseResponse @SelfProfile "brig" rawResp) liftIO $ userTeam parsedResp `shouldSatisfy` isJust + + parseResponse :: forall a m. (FromJSON a, MonadError SparError m, Typeable a) => LText -> ResponseLBS -> m a + parseResponse serviceName resp = do + let typeinfo :: LText + typeinfo = LT.pack $ show (typeRep ([] @a)) <> ": " + + err :: forall a'. LText -> m a' + err = throwSpar . SparCouldNotParseRfcResponse serviceName . (typeinfo <>) + + bdy <- maybe (err "no body") pure $ responseBody resp + either (err . LT.pack) pure $ eitherDecode' bdy + permses :: [Permissions] permses = [ fullPermissions, diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs index 7d809b979f8..4251a61c859 100644 --- a/services/spar/test-integration/Test/Spar/DataSpec.hs +++ b/services/spar/test-integration/Test/Spar/DataSpec.hs @@ -29,7 +29,7 @@ import Imports import SAML2.WebSSO as SAML import Spar.App as App import Spar.Error (IdpDbError (IdpNotFound), SparCustomError (IdpDbError)) -import Spar.Intra.BrigApp (veidFromUserSSOId) +import Spar.Intra.RpcApp (veidFromUserSSOId) import Spar.Options import qualified Spar.Sem.AReqIDStore as AReqIDStore import qualified Spar.Sem.AssIDStore as AssIDStore diff --git a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs deleted file mode 100644 index c97ad084a90..00000000000 --- a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs +++ /dev/null @@ -1,65 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Spar.Intra.BrigSpec - ( spec, - ) -where - -import Control.Lens ((^.)) -import Data.Id (Id (Id), UserId) -import qualified Data.UUID as UUID -import Imports hiding (head) -import qualified Spar.Intra.BrigApp as Intra -import Spar.Sem.BrigAccess (getAccount) -import qualified Spar.Sem.BrigAccess as BrigAccess -import Test.QuickCheck -import Util -import qualified Web.Scim.Schema.User as Scim.User -import Wire.API.User (DeleteUserResult (..), fromEmail) - -spec :: SpecWith TestEnv -spec = do - describe "user deletion between brig and spar" $ do - it "if a user gets deleted on brig, it will be deleted on spar as well." $ do - pending - it "if a user gets deleted on spar, it will be deleted on brig as well." $ do - pendingWith "or deactivated? we should decide what we want here." - - describe "deleteBrigUserInternal" $ do - it "does not throw for non-existing users" $ do - uid :: UserId <- liftIO $ generate arbitrary - r <- runSpar $ BrigAccess.deleteUser uid - liftIO $ r `shouldBe` NoUser - - describe "getAccount" $ do - it "return Nothing if n/a" $ do - musr <- runSpar $ getAccount Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030") - liftIO $ musr `shouldSatisfy` isNothing - - it "return Just if /a" $ do - let setup = do - env <- ask - email <- randomEmail - scimUser <- randomScimUser <&> \u -> u {Scim.User.externalId = Just $ fromEmail email} - (_, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) - tok <- registerScimToken tid Nothing - scimUserId <$> createUser tok scimUser - - uid <- setup - musr <- runSpar $ getAccount Intra.WithPendingInvitations uid - liftIO $ musr `shouldSatisfy` isJust diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index fa651962ee1..97b7c036430 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -63,12 +63,11 @@ import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Test.MockResponse as SAML import SAML2.WebSSO.Test.Util.TestSP (makeSampleIdPMetadata) import qualified SAML2.WebSSO.Test.Util.Types as SAML -import qualified Spar.Intra.BrigApp as Intra +import qualified Spar.Intra.RpcApp as Intra import Spar.Options import Spar.Scim import Spar.Scim.Types (normalizeLikeStored) import qualified Spar.Scim.User as SU -import qualified Spar.Sem.BrigAccess as BrigAccess import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore import qualified Spar.Sem.ScimUserTimesStore as ScimUserTimesStore @@ -96,6 +95,7 @@ import qualified Wire.API.User.IdentityProvider as User import Wire.API.User.RichInfo import qualified Wire.API.User.Scim as Spar.Types import qualified Wire.API.User.Search as Search +import qualified Wire.BrigAPIAccess as BrigAPIAccess -- | Tests for @\/scim\/v2\/Users@. spec :: SpecWith TestEnv @@ -150,7 +150,7 @@ specImportToScimFromSAML = pure (uref, uid) let handle = fromRight undefined . parseHandleEither $ Scim.User.userName usr - runSpar (BrigAccess.setHandle uid handle) + runSpar (BrigAPIAccess.setHandle uid handle) assertSparCassandraUref (uref, Just uid) assertSparCassandraScim ((teamid, email), Nothing) @@ -219,7 +219,7 @@ specImportToScimFromSAML = -- the "get" has already changed the ssoid in brig: no more idp assertSparCassandraUref (uref, Nothing) - runSpar (BrigAccess.getAccount NoPendingInvitations uid) >>= \(Just acc) -> liftIO $ do + runSpar (BrigAPIAccess.getAccount NoPendingInvitations uid) >>= \(Just acc) -> liftIO $ do userIdentity acc `shouldBe` let emailText :: Text = decodeUtf8 $ toStrict $ toByteString email in Just (SSOIdentity (UserScimExternalId emailText) (Just email)) @@ -446,7 +446,7 @@ assertBrigCassandra :: ManagedBy -> TestSpar () assertBrigCassandra uid uref usr (valemail, emailValidated) managedBy = do - runSpar (BrigAccess.getAccount NoPendingInvitations uid) >>= \(Just acc) -> liftIO $ do + runSpar (BrigAPIAccess.getAccount NoPendingInvitations uid) >>= \(Just acc) -> liftIO $ do let handle = fromRight errmsg . parseHandleEither $ Scim.User.userName usr where errmsg = error . show . Scim.User.userName $ usr @@ -481,9 +481,9 @@ specSuspend = do -- NOTE: once SCIM is enabled, SSO Auto-provisioning is disabled tok <- registerScimToken teamid (Just (idp ^. SAML.idpId)) handle <- nextHandle - runSpar $ BrigAccess.setHandle member handle + runSpar $ BrigAPIAccess.setHandle member handle unless isActive $ do - runSpar $ BrigAccess.setStatus member Suspended + runSpar $ BrigAPIAccess.setStatus member Suspended [user] <- listUsers tok (Just (filterBy "userName" (fromHandle handle))) lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ user) `shouldBe` Just isActive it "pre-existing suspended users are inactive" $ do @@ -502,19 +502,19 @@ specSuspend = do -- Once we get rid of the `scim` table and make scim serve brig records directly, this is -- not an issue anymore. lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUserBlah) `shouldBe` Just True - void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Active) + void $ aFewTimes (runSpar $ BrigAPIAccess.getStatus uid) (== Active) do scimStoredUser <- putOrPatch tok uid user True lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just True - void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Active) + void $ aFewTimes (runSpar $ BrigAPIAccess.getStatus uid) (== Active) do scimStoredUser <- putOrPatch tok uid user False lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just False - void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Suspended) + void $ aFewTimes (runSpar $ BrigAPIAccess.getStatus uid) (== Suspended) do scimStoredUser <- putOrPatch tok uid user True lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just True - void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Active) + void $ aFewTimes (runSpar $ BrigAPIAccess.getStatus uid) (== Active) it "PUT will change state from active to inactive and back" $ do void . activeInactiveAndBack $ \tok uid user active -> @@ -553,10 +553,10 @@ specSuspend = do (tok, _) <- registerIdPAndScimToken scimStoredUserBlah <- createUser tok user let uid = Scim.id . Scim.thing $ scimStoredUserBlah - runSpar $ BrigAccess.setStatus uid Suspended - void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Suspended) + runSpar $ BrigAPIAccess.setStatus uid Suspended + void $ aFewTimes (runSpar $ BrigAPIAccess.getStatus uid) (== Suspended) void $ patchUser tok uid $ PatchOp.PatchOp [deleteAttrib "active"] - void $ aFewTimes (runSpar $ BrigAccess.getStatus uid) (== Active) + void $ aFewTimes (runSpar $ BrigAPIAccess.getStatus uid) (== Active) ---------------------------------------------------------------------------- -- User creation @@ -743,10 +743,10 @@ testCreateUserNoIdP = do -- get account from brig, status should be PendingInvitation do - aFewTimes (runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust + aFewTimes (runSpar $ BrigAPIAccess.getAccount Intra.NoPendingInvitations userid) isJust >>= maybe (pure ()) (error "pending user in brig is visible, even though it should not be") brigUser <- - aFewTimes (runSpar $ BrigAccess.getAccount Intra.WithPendingInvitations userid) isJust + aFewTimes (runSpar $ BrigAPIAccess.getAccount Intra.WithPendingInvitations userid) isJust >>= maybe (error "could not find user in brig") pure brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser liftIO $ brigUser.userStatus `shouldBe` PendingInvitation @@ -790,7 +790,7 @@ testCreateUserNoIdP = do -- user should now be active do brigUser <- - aFewTimes (runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust + aFewTimes (runSpar $ BrigAPIAccess.getAccount Intra.NoPendingInvitations userid) isJust >>= maybe (error "could not find user in brig") pure liftIO $ brigUser.userStatus `shouldBe` Active liftIO $ userManagedBy brigUser `shouldBe` ManagedByScim @@ -873,7 +873,7 @@ testCreateUserWithSamlIdP = do . expect2xx ) brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser - accStatus <- aFewTimes (runSpar $ BrigAccess.getStatus (userId brigUser)) (== Active) + accStatus <- aFewTimes (runSpar $ BrigAPIAccess.getStatus (userId brigUser)) (== Active) liftIO $ accStatus `shouldBe` Active liftIO $ userManagedBy brigUser `shouldBe` ManagedByScim @@ -1321,9 +1321,9 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do -- auto-provision user via saml memberWithSSO <- do uid <- loginSsoUserFirstTime idp privCreds - Just usr <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations uid + Just usr <- runSpar $ BrigAPIAccess.getAccount Intra.NoPendingInvitations uid handle <- nextHandle - runSpar $ BrigAccess.setHandle uid handle + runSpar $ BrigAPIAccess.setHandle uid handle pure usr let memberIdWithSSO = userId memberWithSSO idpIssuer = idp ^. SAML.idpMetadata . SAML.edIssuer @@ -1335,7 +1335,7 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do liftIO $ userManagedBy memberWithSSO `shouldBe` ManagedByWire users <- listUsers tok (Just (filterBy "externalId" externalId)) liftIO $ (scimUserId <$> users) `shouldContain` [memberIdWithSSO] - Just brigUser' <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations memberIdWithSSO + Just brigUser' <- runSpar $ BrigAPIAccess.getAccount Intra.NoPendingInvitations memberIdWithSSO liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim where veidToText :: (MonadError String m) => ValidScimId -> m Text @@ -1357,7 +1357,7 @@ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO = do users' <- listUsers tok (Just (filterBy "externalId" emailInvited)) liftIO $ (scimUserId <$> users') `shouldContain` [memberIdInvited] - Just brigUserInvited' <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations memberIdInvited + Just brigUserInvited' <- runSpar $ BrigAPIAccess.getAccount Intra.NoPendingInvitations memberIdInvited liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId :: TestSpar () @@ -1370,7 +1370,7 @@ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId = do let memberIdInvited = userId memberInvited _ <- getUser tok memberIdInvited - Just brigUserInvited' <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations memberIdInvited + Just brigUserInvited' <- runSpar $ BrigAPIAccess.getAccount Intra.NoPendingInvitations memberIdInvited liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim testFindProvisionedUserNoIdP :: TestSpar () @@ -1390,8 +1390,8 @@ testFindNonProvisionedUserNoIdP findBy = do email <- randomEmail uid <- userId <$> call (inviteAndRegisterUser (env ^. teBrig) owner teamid email) handle <- nextHandle - runSpar $ BrigAccess.setHandle uid handle - Just brigUser <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations uid + runSpar $ BrigAPIAccess.setHandle uid handle + Just brigUser <- runSpar $ BrigAPIAccess.getAccount Intra.NoPendingInvitations uid do -- inspect brig user @@ -1405,7 +1405,7 @@ testFindNonProvisionedUserNoIdP findBy = do do liftIO $ users `shouldBe` [uid] - Just brigUser' <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations uid + Just brigUser' <- runSpar $ BrigAPIAccess.getAccount Intra.NoPendingInvitations uid liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim liftIO $ brigUser' `shouldBe` scimifyBrigUserHack brigUser email @@ -1420,7 +1420,7 @@ testListNoDeletedUsers = do -- Delete the user _ <- deleteUser tok userid -- Make sure it is deleted in brig before pulling via SCIM (which would recreate it!) - Nothing <- aFewTimes (runSpar (BrigAccess.getAccount Intra.WithPendingInvitations userid)) isNothing + Nothing <- aFewTimes (runSpar (BrigAPIAccess.getAccount Intra.WithPendingInvitations userid)) isNothing -- Get all users users <- listUsers tok (Just (filterForStoredUser storedUser)) -- Check that the user is absent @@ -1492,7 +1492,7 @@ testGetUser = do shouldBeManagedBy :: (HasCallStack) => UserId -> ManagedBy -> TestSpar () shouldBeManagedBy uid flag = do - managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (BrigAccess.getAccount Intra.WithPendingInvitations uid) + managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (BrigAPIAccess.getAccount Intra.WithPendingInvitations uid) liftIO $ managedBy `shouldBe` flag -- | This is (roughly) the behavior on develop as well as on the branch where this test was @@ -1551,12 +1551,12 @@ testGetUserWithNoHandle = do uid <- loginSsoUserFirstTime idp privcreds tok <- registerScimToken tid (Just (idp ^. SAML.idpId)) - mhandle :: Maybe Handle <- maybe (error "user not found") userHandle <$> runSpar (BrigAccess.getAccount Intra.WithPendingInvitations uid) + mhandle :: Maybe Handle <- maybe (error "user not found") userHandle <$> runSpar (BrigAPIAccess.getAccount Intra.WithPendingInvitations uid) liftIO $ mhandle `shouldSatisfy` isNothing storedUser <- getUser tok uid liftIO $ (Scim.User.displayName . Scim.value . Scim.thing) storedUser `shouldSatisfy` isJust - mhandle' :: Maybe Handle <- aFewTimes (maybe (error "user not found") userHandle <$> runSpar (BrigAccess.getAccount Intra.WithPendingInvitations uid)) isJust + mhandle' :: Maybe Handle <- aFewTimes (maybe (error "user not found") userHandle <$> runSpar (BrigAPIAccess.getAccount Intra.WithPendingInvitations uid)) isJust liftIO $ mhandle' `shouldSatisfy` isJust liftIO $ (fromHandle <$> mhandle') `shouldBe` (Just . Scim.User.userName . Scim.value . Scim.thing $ storedUser) @@ -1945,7 +1945,7 @@ testBrigSideIsUpdated = do validScimUser <- runSpar . runScimErrorUnsafe $ validateScimUser' "testBrigSideIsUpdated" (Just idp) 999999 user' - brigUser <- maybe (error "no brig user") pure =<< runSpar (BrigAccess.getAccount Intra.WithPendingInvitations userid) + brigUser <- maybe (error "no brig user") pure =<< runSpar (BrigAPIAccess.getAccount Intra.WithPendingInvitations userid) let scimUserWithDefLocale = validScimUser {Spar.Types.locale = Spar.Types.locale validScimUser <|> Just (Locale (Language EN) Nothing)} brigUser `userShouldMatch` scimUserWithDefLocale @@ -2236,7 +2236,7 @@ specDeleteUser = do storedUser <- createUser tok user let uid :: UserId = scimUserId storedUser uref :: SAML.UserRef <- do - mUsr <- runSpar $ BrigAccess.getAccount Intra.WithPendingInvitations uid + mUsr <- runSpar $ BrigAPIAccess.getAccount Intra.WithPendingInvitations uid let cond usr = Intra.newVeidFromBrigUser usr (Just (idp ^. SAML.idpMetadata . SAML.edIssuer)) good bad = runValidScimIdEither pure (const $ err bad) err bad = error $ "brig user without UserRef: " <> show (bad, user) @@ -2247,7 +2247,7 @@ specDeleteUser = do deleteUser_ (Just tok) (Just uid) spar !!! const 204 === statusCode brigUser :: Maybe User <- - aFewTimes (runSpar $ BrigAccess.getAccount Intra.WithPendingInvitations uid) isNothing + aFewTimes (runSpar $ BrigAPIAccess.getAccount Intra.WithPendingInvitations uid) isNothing samlUser :: Maybe UserId <- aFewTimes (getUserIdViaRef' uref) isNothing scimUser <- diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index ce8f9cfb0f5..b172bac74b1 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -182,10 +182,9 @@ import qualified Spar.App as IdpConfigStire import qualified Spar.App as Spar import Spar.CanonicalInterpreter import Spar.Error (SparError) -import qualified Spar.Intra.BrigApp as Intra +import qualified Spar.Intra.RpcApp as Intra import Spar.Options import Spar.Run -import Spar.Sem.BrigAccess (getAccount) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore import qualified System.Logger.Extended as Log @@ -217,6 +216,7 @@ import qualified Wire.API.User as User import Wire.API.User.Auth hiding (Cookie) import Wire.API.User.IdentityProvider import Wire.API.User.Scim +import Wire.BrigAPIAccess (getAccount) import qualified Wire.IdPConfigStore as IdPConfigStore -- | Call 'mkEnv' with options from config files. diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index 02fb3bae4e0..9f8d1b1c023 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -42,7 +42,7 @@ import qualified Network.Wai.Utilities as Error import Polysemy.Error (runError) import qualified SAML2.WebSSO as SAML import SAML2.WebSSO.Types (IdPId, idpId) -import qualified Spar.Intra.BrigApp as Intra +import qualified Spar.Intra.RpcApp as Intra import Spar.Scim.User (synthesizeScimUser, validateScimUser') import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import Test.QuickCheck (arbitrary, generate) diff --git a/services/spar/test/Test/Spar/Intra/BrigSpec.hs b/services/spar/test/Test/Spar/Intra/BrigSpec.hs index 002a915528b..771ecf8968f 100644 --- a/services/spar/test/Test/Spar/Intra/BrigSpec.hs +++ b/services/spar/test/Test/Spar/Intra/BrigSpec.hs @@ -25,7 +25,7 @@ import Data.These import Data.These.Combinators import Imports import SAML2.WebSSO as SAML -import Spar.Intra.BrigApp +import Spar.Intra.RpcApp import Test.Hspec import Test.QuickCheck import URI.ByteString (URI, laxURIParserOptions, parseURI) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 31de2e30574..db2a588498f 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -1,6 +1,7 @@ module Test.Spar.Saml.IdPSpec where import Arbitrary () +import Data.Default (Default (..)) import Data.Domain import Data.Id (idToText, parseIdFromText) import qualified Data.List.NonEmpty as NonEmptyL @@ -18,8 +19,6 @@ import SAML2.WebSSO import qualified SAML2.WebSSO as SAML import Spar.API (idpCreate, idpCreateV7, idpDelete, idpUpdate) import Spar.Error -import Spar.Sem.BrigAccess -import Spar.Sem.GalleyAccess import Spar.Sem.IdPRawMetadataStore import Spar.Sem.IdPRawMetadataStore.Mem import Spar.Sem.SAMLUserStore @@ -35,8 +34,15 @@ import qualified Text.XML.DSig as DSig import URI.ByteString (parseURI, strictURIParserOptions) import URI.ByteString.QQ (uri) import Wire.API.Routes.Internal.Brig (IdpChangedNotification (..)) +import Wire.API.Team.Feature (FeatureStatus (FeatureStatusEnabled), LockableFeature (..)) +import Wire.API.Team.Member (mkNewTeamMember, ntmNewTeamMember, rolePermissions) +import Wire.API.Team.Role (Role (RoleOwner)) import Wire.API.User (User (..)) import Wire.API.User.IdentityProvider (IdPMetadataInfo (..), WireIdPAPIVersion (..)) +import Wire.BrigAPIAccess (BrigAPIAccess) +import qualified Wire.BrigAPIAccess +import Wire.GalleyAPIAccess (GalleyAPIAccess) +import qualified Wire.GalleyAPIAccess import Wire.IdPConfigStore import Wire.IdPConfigStore.Mem import Wire.Sem.Logger.TinyLog (LogRecorder (..), newLogRecorder, recordLogs) @@ -519,41 +525,18 @@ interpretWithLoggingMock mbAccount action = do let (notifs, res) = either (error . show) id a pure (logs, notifs, res) -galleyAccessMock :: Sem (GalleyAccess ': r) a -> Sem r a +galleyAccessMock :: Sem (GalleyAPIAccess ': r) a -> Sem r a galleyAccessMock = interpret $ \case - GetTeamMembers _teamId -> undefined - GetTeamMember _teamId _userId -> undefined - AssertHasPermission _teamId _perm _userId -> pure () - AssertSSOEnabled _teamId -> pure () - IsEmailValidationEnabledTeam _teamId -> undefined - UpdateTeamMember _userId _teamId _role -> undefined - -brigAccessMock :: Maybe User -> Sem (BrigAccess ': r) a -> Sem r ([IdpChangedNotification], a) + Wire.GalleyAPIAccess.GetTeamMember uid _teamId -> pure (Just $ ntmNewTeamMember $ mkNewTeamMember uid (rolePermissions RoleOwner) Nothing) + Wire.GalleyAPIAccess.GetFeatureConfigForTeam _teamId -> pure (def {status = FeatureStatusEnabled}) + _ -> undefined + +brigAccessMock :: Maybe User -> Sem (BrigAPIAccess ': r) a -> Sem r ([IdpChangedNotification], a) brigAccessMock mbAccount = (runState @([IdpChangedNotification]) mempty .) $ reinterpret $ \case - CreateSAML _userRef _userId _teamId _name _managedBy _mHandle _mRichInfo _mLocale _role -> undefined - CreateNoSAML _txt _email _userId _teamId _name _mLocale _role -> undefined - UpdateEmail _userId _email _activation -> undefined - GetAccount _havePendingInvitations _userId -> pure mbAccount - GetByHandle _handle -> undefined - GetByEmail _email -> undefined - SetName _userId _name -> undefined - SetHandle _userId _handle -> undefined - SetManagedBy _userId _managedBy -> undefined - SetSSOId _userId _ssoId -> undefined - SetRichInfo _userId _richInfo -> undefined - SetLocale _userId _mLocale -> undefined - GetRichInfo _userId -> undefined - CheckHandleAvailable _handle -> undefined - DeleteUser _userId -> undefined - EnsureReAuthorised _mUserId _mPassword _mCode _mAction -> undefined - SsoLogin _userId _label -> undefined - GetStatus _userId -> undefined - GetStatusMaybe _userId -> undefined - SetStatus _userId _status -> undefined - GetDefaultUserLocale -> undefined - CheckAdminGetTeamId _userId -> undefined - SendSAMLIdPChangedEmail notif -> modify (notif :) + Wire.BrigAPIAccess.GetAccount _havePendingInvitations _userId -> pure mbAccount + Wire.BrigAPIAccess.SendSAMLIdPChangedEmail notif -> modify (notif :) + _ -> undefined ignoringState :: (Functor f) => (a -> f (c, b)) -> a -> f b ignoringState f = fmap snd . f @@ -561,8 +544,8 @@ ignoringState f = fmap snd . f type Effs = '[ Random, SAMLUserStore, - GalleyAccess, - BrigAccess, + GalleyAPIAccess, + BrigAPIAccess, ScimTokenStore, IdPConfigStore, IdPRawMetadataStore, diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index f28ed144925..5088a8fde7d 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -26,7 +26,6 @@ import Imports import Polysemy import Polysemy.TinyLog import Spar.Scim.User (deleteScimUser) -import Spar.Sem.BrigAccess import Spar.Sem.SAMLUserStore import Spar.Sem.SAMLUserStore.Mem (samlUserStoreToMem) import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore @@ -39,6 +38,7 @@ import Test.QuickCheck import Web.Scim.Schema.Error import Wire.API.User import Wire.API.User.Scim +import Wire.BrigAPIAccess import Wire.IdPConfigStore import Wire.IdPConfigStore.Mem (idPToMem) import Wire.IdPConfigStore.Orphans () @@ -50,32 +50,32 @@ spec = describe "deleteScimUser" $ do tokenInfo <- generate arbitrary acc <- someActiveUser tokenInfo r <- - interpretWithBrigAccessMock - (mockBrig (withActiveUser acc) AccountDeleted) + interpretWithBrigAPIAccessMock + (mockBrig (withActiveUser acc)) (deleteUserAndAssertDeletionInSpar acc tokenInfo) r `shouldBe` Right () it "is idempotent" $ do tokenInfo <- generate arbitrary acc <- someActiveUser tokenInfo r <- - interpretWithBrigAccessMock - (mockBrig (withActiveUser acc) AccountAlreadyDeleted) + interpretWithBrigAPIAccessMock + (mockBrig (withActiveUser acc)) (deleteUserAndAssertDeletionInSpar acc tokenInfo) r `shouldBe` Right () it "works if there never was an account" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary r <- - interpretWithBrigAccessMock - (mockBrig (const Nothing) NoUser) + interpretWithBrigAPIAccessMock + (mockBrig (const Nothing)) (runExceptT $ deleteScimUser tokenInfo uid) r `shouldBe` Right () it "returns no error when there was a partially deleted account" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary r <- - interpretWithBrigAccessMock - (mockBrig (const Nothing) AccountDeleted) + interpretWithBrigAPIAccessMock + (mockBrig (const Nothing)) (runExceptT $ deleteScimUser tokenInfo uid) r `shouldBe` Right () @@ -83,7 +83,7 @@ deleteUserAndAssertDeletionInSpar :: forall (r :: EffectRow). ( Members '[ Logger (Msg -> Msg), - BrigAccess, + BrigAPIAccess, ScimExternalIdStore.ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, @@ -105,7 +105,7 @@ deleteUserAndAssertDeletionInSpar acc tokenInfo = do liftIO $ lr `shouldBe` Nothing pure r -type EffsWithoutBrigAccess = +type EffsWithoutBrigAPIAccess = '[ IdPConfigStore, SAMLUserStore, ScimUserTimesStore, @@ -115,13 +115,13 @@ type EffsWithoutBrigAccess = Final IO ] -interpretWithBrigAccessMock :: - ( Sem (BrigAccess ': EffsWithoutBrigAccess) a -> - Sem EffsWithoutBrigAccess a +interpretWithBrigAPIAccessMock :: + ( Sem (BrigAPIAccess ': EffsWithoutBrigAPIAccess) a -> + Sem EffsWithoutBrigAPIAccess a ) -> - Sem (BrigAccess ': EffsWithoutBrigAccess) a -> + Sem (BrigAPIAccess ': EffsWithoutBrigAPIAccess) a -> IO a -interpretWithBrigAccessMock mock = +interpretWithBrigAPIAccessMock mock = runFinal . embedToFinal @IO . discardTinyLogs @@ -138,12 +138,11 @@ mockBrig :: forall (r :: EffectRow) a. (Member (Embed IO) r) => (UserId -> Maybe User) -> - DeleteUserResult -> - Sem (BrigAccess ': r) a -> + Sem (BrigAPIAccess ': r) a -> Sem r a -mockBrig lookup_user delete_response = interpret $ \case +mockBrig lookup_user = interpret $ \case (GetAccount WithPendingInvitations uid) -> pure $ lookup_user uid - (Spar.Sem.BrigAccess.DeleteUser _) -> pure delete_response + (Wire.BrigAPIAccess.DeleteUser _) -> pure () _ -> do liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Throw error here to avoid implementation of all cases."