diff --git a/changelog.d/5-internal/servantify-csv b/changelog.d/5-internal/servantify-csv new file mode 100644 index 00000000000..fa1464e7d85 --- /dev/null +++ b/changelog.d/5-internal/servantify-csv @@ -0,0 +1 @@ +Convert Team CSV endpoint to Servant diff --git a/libs/wire-api/src/Wire/API/Routes/CSV.hs b/libs/wire-api/src/Wire/API/Routes/CSV.hs new file mode 100644 index 00000000000..0d09941545c --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/CSV.hs @@ -0,0 +1,26 @@ +-- 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 Wire.API.Routes.CSV where + +import Network.HTTP.Media.MediaType +import Servant.API + +data CSV + +instance Accept CSV where + contentType _ = "text" // "csv" diff --git a/libs/wire-api/src/Wire/API/Routes/LowLevelStream.hs b/libs/wire-api/src/Wire/API/Routes/LowLevelStream.hs new file mode 100644 index 00000000000..ef2ec8bbe7d --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/LowLevelStream.hs @@ -0,0 +1,110 @@ +-- 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 Wire.API.Routes.LowLevelStream where + +import Control.Lens (at, (.~), (?~)) +import Data.ByteString.Char8 as B8 +import qualified Data.CaseInsensitive as CI +import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap +import Data.Metrics.Servant +import Data.Proxy +import qualified Data.Swagger as S +import qualified Data.Text as Text +import GHC.TypeLits +import Imports +import qualified Network.HTTP.Media as HTTP +import Network.HTTP.Types +import Network.Wai +import Servant.API +import Servant.API.ContentTypes +import Servant.API.Status +import Servant.Server hiding (respond) +import Servant.Server.Internal +import Servant.Swagger as S +import Servant.Swagger.Internal as S + +-- FUTUREWORK: make it possible to generate headers at runtime +data LowLevelStream method status (headers :: [(Symbol, Symbol)]) desc ctype + +class RenderHeaders (headers :: [(Symbol, Symbol)]) where + renderHeaders :: [(HeaderName, ByteString)] + +instance RenderHeaders '[] where + renderHeaders = [] + +instance + (KnownSymbol name, KnownSymbol value, RenderHeaders headers) => + RenderHeaders ('(name, value) ': headers) + where + renderHeaders = (name, value) : renderHeaders @headers + where + name :: HeaderName + name = CI.mk (B8.pack (symbolVal (Proxy @name))) + value :: ByteString + value = B8.pack (symbolVal (Proxy @value)) + +instance + (ReflectMethod method, KnownNat status, RenderHeaders headers, Accept ctype) => + HasServer (LowLevelStream method status headers desc ctype) context + where + type ServerT (LowLevelStream method status headers desc ctype) m = m StreamingBody + hoistServerWithContext _ _ nt s = nt s + + route Proxy _ action = leafRouter $ \env request respond -> + let AcceptHeader accH = getAcceptHeader request + cmediatype = HTTP.matchAccept [contentType (Proxy @ctype)] accH + accCheck = when (isNothing cmediatype) $ delayedFail err406 + contentHeader = (hContentType, HTTP.renderHeader . maybeToList $ cmediatype) + in runAction + ( action `addMethodCheck` methodCheck method request + `addAcceptCheck` accCheck + ) + env + request + respond + $ Route . responseStream status (contentHeader : extraHeaders) + where + method = reflectMethod (Proxy :: Proxy method) + status = statusFromNat (Proxy :: Proxy status) + extraHeaders = renderHeaders @headers + +instance + (Accept ctype, KnownNat status, KnownSymbol desc, SwaggerMethod method) => + HasSwagger (LowLevelStream method status headers desc ctype) + where + toSwagger _ = + mempty + & S.paths + . at "/" + ?~ ( mempty + & method + ?~ ( mempty + & S.produces ?~ S.MimeList [contentType (Proxy @ctype)] + & S.responses . S.responses .~ fmap S.Inline responses + ) + ) + where + method = S.swaggerMethod (Proxy @method) + responses = + InsOrdHashMap.singleton + (fromIntegral (natVal (Proxy @status))) + $ mempty + & S.description .~ Text.pack (symbolVal (Proxy @desc)) + +instance RoutesToPaths (LowLevelStream method status headers desc ctype) where + getRoutes = [] diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 2dcd3df2daf..1a19df810f7 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -46,6 +46,8 @@ import Wire.API.MLS.Serialisation import Wire.API.MLS.Servant import Wire.API.MLS.Welcome import Wire.API.Message +import Wire.API.Routes.CSV +import Wire.API.Routes.LowLevelStream import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named import Wire.API.Routes.Public @@ -1653,6 +1655,29 @@ type TeamMemberAPI = '[JSON] (RespondEmpty 200 "") ) + :<|> Named + "get-team-members-csv" + ( Summary "Get all members of the team as a CSV file" + :> CanThrow 'AccessDenied + :> Description + "The endpoint returns data in chunked transfer encoding.\ + \ Internal server errors might result in a failed transfer\ + \ instead of a 500 response." + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> "csv" + :> LowLevelStream + 'GET + 200 + '[ '( "Content-Disposition", + "attachment; filename=\"wire_team_members.csv\"" + ) + ] + "CSV of team members" + CSV + ) type TeamMemberDeleteResultResponseType = '[ RespondEmpty 202 "Team member scheduled for deletion", diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index b1c15d5eb03..a0909e3097e 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -69,6 +69,7 @@ library Wire.API.Routes.API Wire.API.Routes.AssetBody Wire.API.Routes.ClientAlgebra + Wire.API.Routes.CSV Wire.API.Routes.Internal.Brig Wire.API.Routes.Internal.Brig.Connection Wire.API.Routes.Internal.Brig.EJPD @@ -76,6 +77,7 @@ library Wire.API.Routes.Internal.Cargohold Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti Wire.API.Routes.Internal.LegalHold + Wire.API.Routes.LowLevelStream Wire.API.Routes.MultiTablePaging Wire.API.Routes.MultiTablePaging.State Wire.API.Routes.MultiVerb diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 4fe677e653a..1a120160008 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -110,24 +110,6 @@ errorSResponse = errorResponse (toWai (dynError @(MapError e))) sitemap :: Routes ApiBuilder (Sem GalleyEffects) () sitemap = do - -- Team Member API ----------------------------------------------------- - - get "/teams/:tid/members/csv" (continueE Teams.getTeamMembersCSVH) $ - -- we could discriminate based on accept header only, but having two paths makes building - -- nginz metrics dashboards easier. - zauthUserId - .&. capture "tid" - .&. accept "text" "csv" - document "GET" "getTeamMembersCSV" $ do - summary "Get all members of the team as a CSV file" - notes - "The endpoint returns data in chunked transfer encoding.\ - \ Internal server errors might result in a failed transfer instead of a 500 response." - parameter Path "tid" bytes' $ - description "Team ID" - response 200 "Team members CSV file" end - errorSResponse @'AccessDenied - get "/teams/notifications" (continueE Teams.getTeamNotificationsH) $ zauthUserId .&. opt (query "since") diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index 24b47ed5f09..ca4e5c0d7b1 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -307,3 +307,4 @@ servantSitemap = <@> mkNamedAPI @"delete-team-member" deleteTeamMember <@> mkNamedAPI @"delete-non-binding-team-member" deleteNonBindingTeamMember <@> mkNamedAPI @"update-team-member" updateTeamMember + <@> mkNamedAPI @"get-team-members-csv" getTeamMembersCSV diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 283279c6d38..a0794ccccdf 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -32,7 +32,7 @@ module Galley.API.Teams getTeamNotificationsH, getTeamConversationRoles, getTeamMembers, - getTeamMembersCSVH, + getTeamMembersCSV, bulkGetTeamMembers, getTeamMember, deleteTeamMember, @@ -114,7 +114,6 @@ import Galley.Types.Teams.Intra import Galley.Types.Teams.SearchVisibility import Galley.Types.UserList import Imports hiding (forkIO) -import Network.HTTP.Types import Network.Wai import Network.Wai.Predicate hiding (Error, or, result, setStatus) import Network.Wai.Utilities hiding (Error) @@ -497,12 +496,13 @@ outputToStreamingBody action = withWeavingToFinal @IO $ \state weave _inspect -> flush void . weave . (<$ state) $ runOutputSem writeChunk action -getTeamMembersCSVH :: +getTeamMembersCSV :: (Members '[BrigAccess, ErrorS 'AccessDenied, TeamMemberStore InternalPaging, TeamStore, Final IO] r) => - UserId ::: TeamId ::: JSON -> - Sem r Response -getTeamMembersCSVH (zusr ::: tid ::: _) = do - E.getTeamMember tid zusr >>= \case + Local UserId -> + TeamId -> + Sem r StreamingBody +getTeamMembersCSV lusr tid = do + E.getTeamMember tid (tUnqualified lusr) >>= \case Nothing -> throwS @'AccessDenied Just member -> unless (member `hasPermission` DownloadTeamMembersCsv) $ throwS @'AccessDenied @@ -510,7 +510,7 @@ getTeamMembersCSVH (zusr ::: tid ::: _) = do -- 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. - body <- outputToStreamingBody $ do + outputToStreamingBody $ do output headerLine E.withChunks (\mps -> E.listTeamMembers @InternalPaging tid mps maxBound) $ \members -> do @@ -524,13 +524,6 @@ getTeamMembersCSVH (zusr ::: tid ::: _) = do defaultEncodeOptions (mapMaybe (teamExportUser users inviters richInfos) members) ) - pure $ - responseStream - status200 - [ (hContentType, "text/csv"), - ("Content-Disposition", "attachment; filename=\"wire_team_members.csv\"") - ] - body where headerLine :: LByteString headerLine = encodeDefaultOrderedByNameWith (defaultEncodeOptions {encIncludeHeader = True}) ([] :: [TeamExportUser])