diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 9c4ccb34d34..7e593bec127 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -301,7 +301,6 @@ library , brig-types >=0.73.1 , bytestring >=0.9 , bytestring-conversion >=0.2 - , case-insensitive , cassandra-util >=0.16.2 , cassava >=0.5.2 , comonad @@ -342,7 +341,6 @@ library , resourcet >=1.1 , retry >=0.5 , safe-exceptions >=0.1 - , saml2-web-sso >=0.20 , servant , servant-client , servant-server diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 124945508f6..e51070d5f5a 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -31,7 +31,6 @@ module Galley.API.Teams addTeamMember, getTeamConversationRoles, getTeamMembers, - getTeamMembersCSV, bulkGetTeamMembers, getTeamMember, deleteTeamMember, @@ -61,13 +60,9 @@ import Brig.Types.Team (TeamSize (..)) import Cassandra (PageWithState (pwsResults), pwsHasMore) import Cassandra qualified as C import Control.Lens -import Data.ByteString.Builder (lazyByteString) import Data.ByteString.Conversion (List, toByteString) import Data.ByteString.Conversion qualified import Data.ByteString.Lazy qualified as LBS -import Data.CaseInsensitive qualified as CI -import Data.Csv (EncodeOptions (..), Quoting (QuoteAll), encodeDefaultOrderedByNameWith) -import Data.Handle qualified as Handle import Data.Id import Data.Json.Util import Data.LegalHold qualified as LH @@ -75,8 +70,6 @@ import Data.List.Extra qualified as List import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 (list1) import Data.Map qualified as Map -import Data.Map.Strict qualified as M -import Data.Misc (HttpsUrl, mkHttpsUrl) import Data.Proxy import Data.Qualified import Data.Range as Range @@ -114,11 +107,8 @@ import Galley.Types.UserList import Imports hiding (forkIO) import Polysemy import Polysemy.Error -import Polysemy.Final import Polysemy.Input -import Polysemy.Output import Polysemy.TinyLog qualified as P -import SAML2.WebSSO qualified as SAML import System.Logger qualified as Log import Wire.API.Conversation (ConversationRemoveMembers (..)) import Wire.API.Conversation.Role (wireConvRoles) @@ -129,16 +119,13 @@ import Wire.API.Event.Conversation qualified as Conv import Wire.API.Event.LeaveReason import Wire.API.Event.Team import Wire.API.Federation.Error -import Wire.API.Message qualified as Conv import Wire.API.Routes.Internal.Galley.TeamsIntra -import Wire.API.Routes.LowLevelStream import Wire.API.Routes.MultiTablePaging (MultiTablePage (MultiTablePage), MultiTablePagingState (mtpsState)) import Wire.API.Routes.Public.Galley.TeamMember import Wire.API.Team import Wire.API.Team qualified as Public import Wire.API.Team.Conversation import Wire.API.Team.Conversation qualified as Public -import Wire.API.Team.Export (TeamExportUser (..)) import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member qualified as M @@ -147,12 +134,8 @@ import Wire.API.Team.Permission (Perm (..), Permissions (..), SPerm (..), copy, import Wire.API.Team.Role import Wire.API.Team.SearchVisibility import Wire.API.Team.SearchVisibility qualified as Public -import Wire.API.User (ScimUserInfo (..), User, UserIdList, UserSSOId (UserScimExternalId), userSCIMExternalId, userSSOId) import Wire.API.User qualified as U -import Wire.API.User.Identity (UserSSOId (UserSSOId)) -import Wire.API.User.RichInfo (RichInfo) import Wire.NotificationSubsystem -import Wire.Sem.Paging qualified as E import Wire.Sem.Paging.Cassandra getTeamH :: @@ -500,133 +483,6 @@ getTeamMembers lzusr tid mbMaxResults mbPagingState = do (pwsHasMore p) (teamMemberPagingState p) -outputToStreamingBody :: - (Member (Final IO) r) => - Sem (Output LByteString ': r) () -> - Sem r LowLevelStreamingBody -outputToStreamingBody action = withWeavingToFinal @IO $ \state weave _inspect -> - pure . (<$ state) $ pure $ \write flush -> do - let writeChunk c = embedFinal $ do - write (lazyByteString c) - flush - void . weave . (<$ state) $ runOutputSem writeChunk action - -getTeamMembersCSV :: - ( Member BrigAccess r, - Member (ErrorS 'AccessDenied) r, - Member (TeamMemberStore InternalPaging) r, - Member TeamStore r, - Member (Final IO) r, - Member SparAccess r - ) => - Local UserId -> - TeamId -> - Sem r LowLevelStreamingBody -getTeamMembersCSV lusr tid = do - E.getTeamMember tid (tUnqualified lusr) >>= \case - Nothing -> throwS @'AccessDenied - Just member -> unless (member `hasPermission` DownloadTeamMembersCsv) $ throwS @'AccessDenied - - -- In case an exception is thrown inside the StreamingBody of responseStream - -- the response will not contain a correct error message, but rather be an - -- http error such as 'InvalidChunkHeaders'. The exception however still - -- reaches the middleware and is being tracked in logging and metrics. - outputToStreamingBody $ do - output headerLine - E.withChunks (\mps -> E.listTeamMembers @InternalPaging tid mps maxBound) $ - \members -> do - let uids = fmap (view userId) members - teamExportUser <- - mkTeamExportUser - <$> (lookupUser <$> E.lookupActivatedUsers uids) - <*> lookupInviterHandle members - <*> (lookupRichInfo <$> E.getRichInfoMultiUser uids) - <*> (lookupClients <$> E.lookupClients uids) - <*> (lookupScimUserInfo <$> Spar.lookupScimUserInfos uids) - output @LByteString - ( encodeDefaultOrderedByNameWith - defaultEncodeOptions - (mapMaybe teamExportUser members) - ) - where - headerLine :: LByteString - headerLine = encodeDefaultOrderedByNameWith (defaultEncodeOptions {encIncludeHeader = True}) ([] :: [TeamExportUser]) - - defaultEncodeOptions :: EncodeOptions - defaultEncodeOptions = - EncodeOptions - { encDelimiter = fromIntegral (ord ','), - encUseCrLf = True, -- to be compatible with Mac and Windows - encIncludeHeader = False, -- (so we can flush when the header is on the wire) - encQuoting = QuoteAll - } - - mkTeamExportUser :: - (UserId -> Maybe User) -> - (UserId -> Maybe Handle.Handle) -> - (UserId -> Maybe RichInfo) -> - (UserId -> Int) -> - (UserId -> Maybe ScimUserInfo) -> - TeamMember -> - Maybe TeamExportUser - mkTeamExportUser users inviters richInfos numClients scimUserInfo member = do - let uid = member ^. userId - user <- users uid - pure $ - TeamExportUser - { tExportDisplayName = U.userDisplayName user, - tExportHandle = U.userHandle user, - tExportEmail = U.userIdentity user >>= U.emailIdentity, - tExportRole = permissionsRole . view permissions $ member, - tExportCreatedOn = maybe (scimUserInfo uid >>= suiCreatedOn) (Just . snd) (view invitation member), - tExportInvitedBy = inviters . fst =<< member ^. invitation, - tExportIdpIssuer = userToIdPIssuer user, - tExportManagedBy = U.userManagedBy user, - tExportSAMLNamedId = fromMaybe "" (samlNamedId user), - tExportSCIMExternalId = fromMaybe "" (userSCIMExternalId user), - tExportSCIMRichInfo = richInfos uid, - tExportUserId = U.userId user, - tExportNumDevices = numClients uid - } - - lookupInviterHandle :: (Member BrigAccess r) => [TeamMember] -> Sem r (UserId -> Maybe Handle.Handle) - lookupInviterHandle members = do - let inviterIds :: [UserId] - inviterIds = nub $ mapMaybe (fmap fst . view invitation) members - - userList <- E.getUsers inviterIds - - let userMap :: M.Map UserId Handle.Handle - userMap = M.fromList (mapMaybe extract userList) - where - extract u = (U.userId u,) <$> U.userHandle u - - pure (`M.lookup` userMap) - - userToIdPIssuer :: U.User -> Maybe HttpsUrl - userToIdPIssuer usr = case (U.userIdentity >=> U.ssoIdentity) usr of - Just (U.UserSSOId (SAML.UserRef issuer _)) -> either (const Nothing) Just . mkHttpsUrl $ issuer ^. SAML.fromIssuer - Just _ -> Nothing - Nothing -> Nothing - - lookupScimUserInfo :: [ScimUserInfo] -> (UserId -> Maybe ScimUserInfo) - lookupScimUserInfo infos = (`M.lookup` M.fromList (infos <&> (\sui -> (suiUserId sui, sui)))) - - lookupUser :: [U.User] -> (UserId -> Maybe U.User) - lookupUser users = (`M.lookup` M.fromList (users <&> \user -> (U.userId user, user))) - - lookupRichInfo :: [(UserId, RichInfo)] -> (UserId -> Maybe RichInfo) - lookupRichInfo pairs = (`M.lookup` M.fromList pairs) - - lookupClients :: Conv.UserClients -> UserId -> Int - lookupClients userClients uid = maybe 0 length (M.lookup uid (Conv.userClients userClients)) - - samlNamedId :: User -> Maybe Text - samlNamedId = - userSSOId >=> \case - (UserSSOId (SAML.UserRef _idp nameId)) -> Just . CI.original . SAML.unsafeShowNameID $ nameId - (UserScimExternalId _) -> Nothing - -- | like 'getTeamMembers', but with an explicit list of users we are to return. bulkGetTeamMembers :: ( Member (ErrorS 'BulkGetMemberLimitExceeded) r, @@ -636,7 +492,7 @@ bulkGetTeamMembers :: Local UserId -> TeamId -> Maybe (Range 1 HardTruncationLimit Int32) -> - UserIdList -> + U.UserIdList -> Sem r TeamMemberListOptPerms bulkGetTeamMembers lzusr tid mbMaxResults uids = do unless (length (U.mUsers uids) <= fromIntegral (fromRange (fromMaybe (unsafeRange Public.hardTruncationLimit) mbMaxResults))) $