diff --git a/changelog.d/5-internal/pr-2742 b/changelog.d/5-internal/pr-2742 new file mode 100644 index 0000000000..83e99fddea --- /dev/null +++ b/changelog.d/5-internal/pr-2742 @@ -0,0 +1 @@ +Migrate stern to swagger2-ui (remaining backwards compatible with circulating backoffice images) (see also #2742 from last release) (#2744) diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 301b5975a6..7ca1661580 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -84,6 +84,7 @@ library , QuickCheck , schema-profunctor , string-conversions + , swagger2 , tagged , text >=0.11 , time >=1.4 diff --git a/libs/galley-types/src/Galley/Types/Teams/Intra.hs b/libs/galley-types/src/Galley/Types/Teams/Intra.hs index 1df8dd665f..31fee74e25 100644 --- a/libs/galley-types/src/Galley/Types/Teams/Intra.hs +++ b/libs/galley-types/src/Galley/Types/Teams/Intra.hs @@ -1,4 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} -- This file is part of the Wire Server implementation. @@ -31,6 +36,8 @@ import Data.Aeson import Data.Aeson.TH import qualified Data.Currency as Currency import Data.Json.Util +import qualified Data.Schema as S +import qualified Data.Swagger as Swagger hiding (schema) import Data.Time (UTCTime) import Imports import Test.QuickCheck.Arbitrary (Arbitrary) @@ -46,21 +53,18 @@ data TeamStatus | Suspended | PendingActive deriving (Eq, Show, Generic) - -instance ToJSON TeamStatus where - toJSON Active = String "active" - toJSON PendingDelete = String "pending_delete" - toJSON Deleted = String "deleted" - toJSON Suspended = String "suspended" - toJSON PendingActive = String "pending_active" - -instance FromJSON TeamStatus where - parseJSON (String "active") = pure Active - parseJSON (String "pending_delete") = pure PendingDelete - parseJSON (String "deleted") = pure Deleted - parseJSON (String "suspended") = pure Suspended - parseJSON (String "pending_active") = pure PendingActive - parseJSON other = fail $ "Unknown TeamStatus: " <> show other + deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamStatus + +instance S.ToSchema TeamStatus where + schema = + S.enum @Text "Access" $ + mconcat + [ S.element "active" Active, + S.element "pending_delete" PendingDelete, + S.element "deleted" Deleted, + S.element "suspended" Suspended, + S.element "pending_active" PendingActive + ] data TeamData = TeamData { tdTeam :: !Team, @@ -68,20 +72,15 @@ data TeamData = TeamData tdStatusTime :: !(Maybe UTCTime) -- This needs to be a Maybe due to backwards compatibility } deriving (Eq, Show, Generic) - -instance ToJSON TeamData where - toJSON (TeamData t s st) = - object $ - "team" .= t - # "status" .= s - # "status_time" .= (toUTCTimeMillis <$> st) - # [] - -instance FromJSON TeamData where - parseJSON = withObject "team-data" $ \o -> do - TeamData <$> o .: "team" - <*> o .: "status" - <*> o .:? "status_time" + deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamData + +instance S.ToSchema TeamData where + schema = + S.object "TeamData" $ + TeamData + <$> tdTeam S..= S.field "team" S.schema + <*> tdStatus S..= S.field "status" S.schema + <*> tdStatusTime S..= S.maybe_ (S.optField "status_time" utcTimeSchema) data TeamStatusUpdate = TeamStatusUpdate { tuStatus :: !TeamStatus, diff --git a/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal b/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal index 17108388e5..a3f4a2060a 100644 --- a/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal +++ b/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal @@ -13,6 +13,9 @@ build-type: Simple library exposed-modules: Polysemy.TinyLog + Wire.Sem.Concurrency + Wire.Sem.Concurrency.IO + Wire.Sem.Concurrency.Sequential Wire.Sem.FromUTC Wire.Sem.Logger Wire.Sem.Logger.Level @@ -25,9 +28,6 @@ library Wire.Sem.Paging.Cassandra Wire.Sem.Random Wire.Sem.Random.IO - Wire.Sem.Concurrency - Wire.Sem.Concurrency.IO - Wire.Sem.Concurrency.Sequential other-modules: Paths_polysemy_wire_zoo hs-source-dirs: src diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 41eb91997a..a7d74ad034 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -47,6 +47,7 @@ module Wire.API.Team.Feature withLockStatus, withUnlocked, FeatureTTL, + FeatureTTLDays, FeatureTTL' (..), FeatureTTLUnit (..), convertFeatureTTLDaysToSeconds, @@ -971,6 +972,19 @@ data FeatureStatus deriving (Arbitrary) via (GenericUniform FeatureStatus) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema FeatureStatus) +instance S.ToParamSchema FeatureStatus where + toParamSchema _ = + mempty + { S._paramSchemaType = Just S.SwaggerString, + S._paramSchemaEnum = Just (A.String . toQueryParam <$> [(minBound :: FeatureStatus) ..]) + } + +instance FromHttpApiData FeatureStatus where + parseUrlPiece = maybe (Left "must be 'enabled' or 'disabled'") Right . fromByteString' . cs + +instance ToHttpApiData FeatureStatus where + toUrlPiece = cs . toByteString' + typeFeatureStatus :: Doc.DataType typeFeatureStatus = Doc.string $ diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index 3b87022987..5a0f59e4c9 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -31,6 +31,7 @@ module Wire.API.Team.Member teamMemberJson, setOptionalPerms, setOptionalPermsMany, + teamMemberObjectSchema, -- * TeamMemberList TeamMemberList, @@ -133,11 +134,13 @@ mkTeamMember :: mkTeamMember uid perms inv = TeamMember (NewTeamMember uid perms inv) instance ToSchema TeamMember where - schema = - object "TeamMember" $ - TeamMember - <$> _newTeamMember .= newTeamMemberSchema - <*> _legalHoldStatus .= (fromMaybe defUserLegalHoldStatus <$> optFieldWithDocModifier "legalhold_status" (description ?~ lhDesc) schema) + schema = object "TeamMember" teamMemberObjectSchema + +teamMemberObjectSchema :: ObjectSchema SwaggerDoc TeamMember +teamMemberObjectSchema = + TeamMember + <$> _newTeamMember .= newTeamMemberSchema + <*> _legalHoldStatus .= (fromMaybe defUserLegalHoldStatus <$> optFieldWithDocModifier "legalhold_status" (description ?~ lhDesc) schema) instance ToSchema (TeamMember' 'Optional) where schema = diff --git a/libs/wire-api/src/Wire/API/User/Identity.hs b/libs/wire-api/src/Wire/API/User/Identity.hs index 0b7b626d5e..7a3bcecf32 100644 --- a/libs/wire-api/src/Wire/API/User/Identity.hs +++ b/libs/wire-api/src/Wire/API/User/Identity.hs @@ -75,6 +75,7 @@ import SAML2.WebSSO.Test.Arbitrary () import qualified SAML2.WebSSO.Types as SAML import qualified SAML2.WebSSO.Types.Email as SAMLEmail import qualified SAML2.WebSSO.XML as SAML +import qualified Servant.API as S import System.FilePath (()) import qualified Test.QuickCheck as QC import qualified Text.Email.Validate as Email.V @@ -187,6 +188,12 @@ instance ToByteString Email where instance FromByteString Email where parser = parser >>= maybe (fail "Invalid email") pure . parseEmail +instance S.FromHttpApiData Email where + parseUrlPiece = maybe (Left "Invalid email") Right . fromByteString . cs + +instance S.ToHttpApiData Email where + toUrlPiece = cs . toByteString' + instance Arbitrary Email where arbitrary = do localPart <- Text.filter (/= '@') <$> arbitrary @@ -249,6 +256,9 @@ newtype Phone = Phone {fromPhone :: Text} deriving stock (Eq, Ord, Show, Generic) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema Phone) +instance ToParamSchema Phone where + toParamSchema _ = toParamSchema (Proxy @Text) + instance ToSchema Phone where schema = over doc (S.description ?~ "E.164 phone number") $ @@ -260,6 +270,12 @@ instance ToByteString Phone where instance FromByteString Phone where parser = parser >>= maybe (fail "Invalid phone") pure . parsePhone +instance S.FromHttpApiData Phone where + parseUrlPiece = maybe (Left "Invalid phone") Right . fromByteString . cs + +instance S.ToHttpApiData Phone where + toUrlPiece = cs . toByteString' + instance Arbitrary Phone where arbitrary = Phone . Text.pack <$> do diff --git a/tools/stern/README.md b/tools/stern/README.md index ed472388bf..9608649f12 100644 --- a/tools/stern/README.md +++ b/tools/stern/README.md @@ -1,9 +1,9 @@ -Stern - Backoffice facade +Stern - Backoffice Facade ========================= -This tool can be used to create a very basic Backoffice tool to simplify performing operations on users and teams such as visualising their user profiles, suspending or even deleting accounts. It is used internally at Wire to provide customer support the means to respond to certain queries from our customers. +This is a simple web app based on [swagger-ui](https://swagger.io/tools/swagger-ui/) for performing operations on users and teams such as browsing their user profiles, suspending, or deleting accounts. It is used internally at Wire by our customer support team. -Stern provides a swagger interface that accesses multiple other services (mostly using internal endpoints) and is designed to be a simple way to create a basic backoffice functionality. The swagger interface is served at `/stern/api-docs` +Stern is based on a swagger interface that accesses multiple other services (mostly using internal endpoints) and is designed to be a simple way to create a basic backoffice functionality. Point your browser at `http://:/backoffice/api/swagger-ui/`; `` is usually 8091. ## IMPORTANT NOTES @@ -13,6 +13,10 @@ It is intended to be deployed in a private network and accessible only through a Some endpoints (marked as such on the Swagger interface) depend on internal services (named galeb and ibis) that are not relevant for a generic wire server installation as they gather info from other internal systems at Wire (related to billing or other services) and as such will not work properly on installations without them. +### Legacy mode + +stern used to be run together with a separate docker image that carried the swagger-ui frontend, while stern only served the swagger data and the actual rest api. This is not recommended any more, but until all the infrastructure everywhere has caught up with the new mode of operation, stern still delivers the old swagger1.2 data as before under the same path. For details see `./src/Stern/API/RoutesLegacy.hs`. + ## How to run stern together with the rest of wire-server TODO: This section is under construction @@ -20,12 +24,23 @@ TODO: This section is under construction ## How to run stern locally with the `services-demo` Follow the instruction in [`deploy/services-demo/README.md`](../../deploy/services-demo/README.md), -using the `--run-backoffice` option, e.g. `deploy/sevices-demo/demo.sh --run-backoffice` +using the `--run-backoffice` option, e.g. `deploy/sevices-demo/demo.sh --run-backoffice`. -When you now open `localhost:8080/swagger-ui` in a browser, you can switch to the -"Back Office" tab. +Open `http://localhost:8091/backoffice/api/swagger-ui/` in a browser. +(Legacy mode: when you now open `localhost:8080/swagger-ui` in a +browser, you can switch to the "Back Office" tab.) ## Screenshots -![screen shot 1](screenshots/1.png) -![screen shot 2](screenshots/2.png) +![screen shot 1](screenshots/a.png) +![screen shot 2](screenshots/b.png) + +# Legacy mode: + +![screen shot 1](screenshots/legacy/1.png) +![screen shot 2](screenshots/legacy/2.png) + +(one could argue that the old swagger-ui was a little more +end-user-friendly, to which one could respond that neither version is +intended for end-users, but for web-devs, and we should just spend a +week writing an elm app that does this right. :)) diff --git a/tools/stern/screenshots/a.png b/tools/stern/screenshots/a.png new file mode 100644 index 0000000000..fc94394f9c Binary files /dev/null and b/tools/stern/screenshots/a.png differ diff --git a/tools/stern/screenshots/b.png b/tools/stern/screenshots/b.png new file mode 100644 index 0000000000..9d66a13f2e Binary files /dev/null and b/tools/stern/screenshots/b.png differ diff --git a/tools/stern/screenshots/1.png b/tools/stern/screenshots/legacy/1.png similarity index 100% rename from tools/stern/screenshots/1.png rename to tools/stern/screenshots/legacy/1.png diff --git a/tools/stern/screenshots/2.png b/tools/stern/screenshots/legacy/2.png similarity index 100% rename from tools/stern/screenshots/2.png rename to tools/stern/screenshots/legacy/2.png diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 2cdd03873a..335ba729c2 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -3,6 +3,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- This file is part of the Wire Server implementation. -- @@ -33,48 +34,40 @@ import Data.Aeson hiding (Error, json) import qualified Data.Aeson.KeyMap as KeyMap import Data.Aeson.Types (emptyArray) import Data.ByteString.Conversion -import Data.ByteString.Lazy (fromStrict) import Data.Handle (Handle) import Data.Id -import Data.Predicate import Data.Proxy (Proxy (..)) import Data.Range -import qualified Data.Schema as S -import Data.Swagger.Build.Api hiding (Response, def, min, response) -import qualified Data.Swagger.Build.Api as Doc +import Data.Schema hiding ((.=)) +import Data.String.Conversions (cs) import Data.Text (unpack) import qualified Data.Text as T -import Data.Text.Encoding (decodeLatin1) import GHC.TypeLits (KnownSymbol) import qualified Galley.Types.Teams.Intra as Team import Imports hiding (head) import Network.HTTP.Types import Network.Wai -import qualified Network.Wai.Middleware.Gzip as GZip -import Network.Wai.Predicate hiding (Error, reason, setStatus) -import Network.Wai.Routing hiding (trace) import Network.Wai.Utilities import qualified Network.Wai.Utilities.Server as Server -import Network.Wai.Utilities.Swagger (document, mkSwaggerApi) -import Servant (ServerT, (:<|>) (..)) +import Servant (NoContent (NoContent), ServerT, (:<|>) (..)) import qualified Servant -import Stern.API.Predicates +import qualified Servant.Server import Stern.API.Routes +import qualified Stern.API.RoutesLegacy as RoutesLegacy import Stern.App import qualified Stern.Intra as Intra import Stern.Options -import qualified Stern.Swagger as Doc import Stern.Types import System.Logger.Class hiding (Error, name, trace, (.=)) import Util.Options import Wire.API.Connection +import Wire.API.Routes.Internal.Brig.Connection (ConnectionStatus) +import qualified Wire.API.Routes.Internal.Brig.EJPD as EJPD import Wire.API.Routes.Named (Named (Named)) import Wire.API.Team.Feature hiding (setStatus) -import qualified Wire.API.Team.Feature as Public import Wire.API.Team.SearchVisibility -import qualified Wire.API.Team.SearchVisibility as Public import Wire.API.User -import qualified Wire.Swagger as Doc +import Wire.API.User.Search default (ByteString) @@ -87,544 +80,171 @@ start o = do server :: Env -> Server.Server server e = Server.defaultServer (unpack $ stern o ^. epHost) (stern o ^. epPort) (e ^. applog) (e ^. metrics) - pipeline :: Env -> Application - pipeline e = GZip.gzip GZip.def $ serve e - - serve :: Env -> Request -> Continue IO -> IO ResponseReceived - serve e r k = runHandler e r (Server.route (Server.compile sitemap) r k) k - - -- WIP: the servant app wraps the old wai-routes api - -- todo: remove wai-route api and replace with servant api when fully servantified - -- currently the servant app only contains the swagger docs - -- and is served with stern: http://localhost:8091/backoffice/api/swagger-ui/ - -- swagger ui is functional and can execute requests against stern - -- however there is a servant value that implements the servant api and uses the same handlers as the wai-route api - -- to make sure it type checks servantApp :: Env -> Application servantApp e = Servant.serve - (Proxy @(SwaggerDocsAPI :<|> Servant.Raw)) - (swaggerDocsAPI :<|> Servant.Tagged (pipeline e)) - -sitemap :: Routes Doc.ApiBuilder Handler () -sitemap = do - routes - apiDocs + ( Proxy + @( SwaggerDocsAPI + :<|> SternAPIInternal + :<|> SternAPI + ) + ) + ( swaggerDocsAPI + :<|> servantSitemapInternal + :<|> servantSitemap e + ) ------------------------------------------------------------------------------- -- servant API --- | The stern API implemented with servant --- currently not yet in use, replace wai-route api with this, when fully servantified --- primarily used for type checking -_servantSitemap :: ServerT SternAPI Handler -_servantSitemap = Named @"get-users-by-email" usersByEmail - -------------------------------------------------------------------------------- --- wai-routes API - -data SupportsTtl = TtlEnabled | TtlDisabled - -routes :: Routes Doc.ApiBuilder Handler () -routes = do - -- Begin Internal - - get "/i/status" (continue $ const $ pure empty) true - head "/i/status" (continue $ const $ pure empty) true - - -- End Internal - - post "/users/:uid/suspend" (continue suspendUser) $ - capture "uid" - document "POST" "users/:uid/suspend" $ do - Doc.summary "Suspends user with this ID" - Doc.parameter Doc.Path "uid" Doc.bytes' $ - Doc.description "User ID" - Doc.response 200 "User successfully suspended" Doc.end - Doc.response 400 "Bad request" (Doc.model Doc.errorModel) - Doc.response 404 "Account not found" (Doc.model Doc.errorModel) - - post "/users/:uid/unsuspend" (continue unsuspendUser) $ - capture "uid" - document "POST" "users/:uid/unsuspend" $ do - Doc.summary "Unsuspends user with this ID" - Doc.parameter Doc.Path "uid" Doc.bytes' $ - Doc.description "User ID" - Doc.response 200 "User successfully unsuspended" Doc.end - Doc.response 400 "Bad request" (Doc.model Doc.errorModel) - Doc.response 404 "Account not found" (Doc.model Doc.errorModel) - - get "/users" (continue usersByEmail') $ - param "email" - document "GET" "users" $ do - Doc.summary "Displays user's info given an email address" - Doc.parameter Doc.Query "email" Doc.string' $ - Doc.description "Email address" - Doc.response 200 "List of users" Doc.end - - get - "/users" - (continue usersByPhone) - phoneParam - document "GET" "users" $ do - Doc.summary "Displays user's info given a phone number" - Doc.parameter Doc.Query "phone" Doc.string' $ - Doc.description "Phone number" - Doc.response 200 "List of users" Doc.end - - get "/users" (continue usersByIds) $ - param "ids" - document "GET" "users" $ do - Doc.summary "Displays active users info given a list of ids" - Doc.parameter Doc.Query "ids" Doc.string' $ - Doc.description "ID of the user" - Doc.response 200 "List of users" Doc.end - - get "/users" (continue usersByHandles) $ - param "handles" - document "GET" "users" $ do - Doc.summary "Displays active users info given a list of handles" - Doc.parameter Doc.Query "handles" Doc.string' $ - Doc.description "Handle of the user" - Doc.response 200 "List of users" Doc.end - - get "/users/:uid/connections" (continue userConnections) $ - capture "uid" - document "GET" "users/:uid/connections" $ do - Doc.summary "Displays user's connections" - Doc.parameter Doc.Path "uid" Doc.bytes' $ - description "User ID" - Doc.response 200 "List of user's connections" Doc.end - - get "/users/connections" (continue usersConnections) $ - param "ids" - document "GET" "users/connections" $ do - Doc.summary "Displays users connections given a list of ids" - Doc.parameter Doc.Query "ids" Doc.string' $ - Doc.description "IDs of the users" - Doc.response 200 "List of users connections" Doc.end - - get "/users/:uid/search" (continue searchOnBehalf) $ - capture "uid" - .&. def "" (query "q") - .&. def (unsafeRange 10) (query "size") - document "GET" "search" $ do - summary "Search for users on behalf of" - Doc.parameter Doc.Path "uid" Doc.bytes' $ - description "User ID" - Doc.parameter Query "q" string' $ do - description "Search query" - optional - Doc.parameter Query "size" int32' $ do - description "Number of results to return" - optional - Doc.response 200 "List of users" Doc.end - - post "/users/revoke-identity" (continue revokeIdentity) $ - param "email" ||| phoneParam - document "POST" "revokeIdentity" $ do - Doc.summary "Revoke a verified user identity." - Doc.notes - "Forcefully revokes a verified user identity. \ - \WARNING: If the given identity is the only verified \ - \user identity of an account, the account will be \ - \deactivated (\"wireless\") and might thus become inaccessible. \ - \If the given identity is not taken / verified, this is a no-op." - Doc.parameter Doc.Query "email" Doc.string' $ do - Doc.description "A verified email address" - Doc.optional - Doc.parameter Doc.Query "phone" Doc.string' $ do - Doc.description "A verified phone number (E.164 format)." - Doc.optional - Doc.response 200 "Identity revoked or not verified / taken." Doc.end - Doc.response 400 "Bad request" (Doc.model Doc.errorModel) - - put "/users/:uid/email" (continue changeEmail) $ - contentType "application" "json" - .&. capture "uid" - .&. def False (query "validate") - .&. jsonRequest @EmailUpdate - document "PUT" "changeEmail" $ do - Doc.summary "Change a user's email address." - Doc.notes - "The new e-mail address must be verified \ - \before the change takes effect." - Doc.parameter Doc.Path "uid" Doc.bytes' $ - Doc.description "User ID" - Doc.parameter Doc.Query "validate" Doc.bool' $ do - Doc.description "If set to true, a validation email will be sent to the new email address" - Doc.optional - Doc.body (Doc.ref Doc.emailUpdate) $ - Doc.description "JSON body" - Doc.response 200 "Change of email address initiated." Doc.end - Doc.response 400 "Bad request" (Doc.model Doc.errorModel) - - put "/users/:uid/phone" (continue changePhone) $ - contentType "application" "json" - .&. capture "uid" - .&. jsonRequest @PhoneUpdate - document "PUT" "changePhone" $ do - Doc.summary "Change a user's phone number." - Doc.notes - "The new phone number must be verified \ - \before the change takes effect." - Doc.parameter Doc.Path "uid" Doc.bytes' $ - Doc.description "User ID" - Doc.body (Doc.ref Doc.phoneUpdate) $ - Doc.description "JSON body" - Doc.response 200 "Change of phone number initiated." Doc.end - Doc.response 400 "Bad request" (Doc.model Doc.errorModel) - - delete "/users/:uid" (continue deleteUser) $ - capture "uid" - .&. (query "email" ||| phoneParam) - document "DELETE" "deleteUser" $ do - summary "Delete a user (irrevocable!)" - Doc.notes "Email or Phone must match UserId's (to prevent copy/paste mistakes)" - Doc.parameter Doc.Path "uid" Doc.bytes' $ - description "User ID" - Doc.parameter Doc.Query "email" Doc.string' $ do - Doc.description "Matching verified email address" - Doc.optional - Doc.parameter Doc.Query "phone" Doc.string' $ do - Doc.description "Matching verified phone number (E.164 format)." - Doc.optional - Doc.response 200 "Account deleted" Doc.end - Doc.response 400 "Bad request" (Doc.model Doc.errorModel) - - put "/teams/:tid/suspend" (continue (setTeamStatusH Team.Suspended)) $ - capture "tid" - document "PUT" "setTeamStatusH:suspended" $ do - summary "Suspend a team." - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.response 200 mempty Doc.end - - put "/teams/:tid/unsuspend" (continue (setTeamStatusH Team.Active)) $ - capture "tid" - document "PUT" "setTeamStatusH:active" $ do - summary "Set a team status to 'Active', independently on previous status. (Cannot be used to un-delete teams, though.)" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.response 200 mempty Doc.end - - delete "/teams/:tid" (continue deleteTeam) $ - capture "tid" - .&. def False (query "force") - .&. opt (query "email") - document "DELETE" "deleteTeam" $ do - summary "Delete a team (irrevocable!). You can only delete teams with 1 user unless you use the 'force' query flag" - Doc.notes - "The email address of the user must be provided to prevent copy/paste mistakes.\n\ - \The force query flag can be used to delete teams with more than one user. CAUTION: FORCE DELETE WILL PERMANENTLY DELETE ALL TEAM MEMBERS! CHECK TEAM MEMBER LIST (SEE ABOVE OR BELOW) IF YOU ARE UNCERTAIN THAT'S WHAT YOU WANT." - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.parameter Doc.Query "force" Doc.bool' $ do - Doc.description "THIS WILL PERMANENTLY DELETE ALL TEAM MEMBERS! CHECK TEAM MEMBER LIST (SEE ABOVE OR BELOW) IF YOU ARE UNCERTAIN THAT'S WHAT YOU WANT." - optional - Doc.parameter Doc.Query "email" Doc.string' $ do - Doc.description "Matching verified remaining user address" - Doc.optional - Doc.response 202 "Team scheduled for deletion" Doc.end - Doc.response 404 "No such user with that email" (Doc.model Doc.errorModel) - Doc.response 404 "No such binding team" (Doc.model Doc.errorModel) - Doc.response 403 "Only teams with 1 user can be deleted" (Doc.model Doc.errorModel) - Doc.response 404 "Binding team mismatch" (Doc.model Doc.errorModel) - - get "/ejpd-info" (continue ejpdInfoByHandles) $ - param "handles" - .&. def False (query "include_contacts") - document "GET" "ejpd-info" $ do - Doc.summary "internal wire.com process: https://wearezeta.atlassian.net/wiki/spaces/~463749889/pages/256738296/EJPD+official+requests+process" - Doc.parameter Doc.Query "handles" Doc.string' $ - Doc.description "Handles of the user, separated by commas (NB: all chars need to be lower case!)" - Doc.parameter Doc.Query "include_contacts" Doc.bool' $ do - Doc.description "If 'true', this gives you more more exhaustive information about this user (including social network)" - Doc.optional - Doc.response 200 "Required information about the listed users (where found)" Doc.end - - head "/users/blacklist" (continue isUserKeyBlacklisted) $ - (query "email" ||| phoneParam) - document "HEAD" "checkBlacklistStatus" $ do - summary "Fetch blacklist information on a email/phone" - Doc.parameter Doc.Query "email" Doc.string' $ do - Doc.description "An email address to check" - Doc.optional - Doc.parameter Doc.Query "phone" Doc.string' $ do - Doc.description "A phone to check" - Doc.optional - Doc.response 200 "The email/phone IS blacklisted" Doc.end - Doc.response 404 "The email/phone is NOT blacklisted" Doc.end - - post "/users/blacklist" (continue addBlacklist) $ - (query "email" ||| phoneParam) - document "POST" "addToBlacklist" $ do - summary "Add the email/phone to our blacklist" - Doc.parameter Doc.Query "email" Doc.string' $ do - Doc.description "An email address to add" - Doc.optional - Doc.parameter Doc.Query "phone" Doc.string' $ do - Doc.description "A phone to add" - Doc.optional - Doc.response 200 "Operation succeeded" Doc.end - - delete "/users/blacklist" (continue deleteFromBlacklist) $ - (query "email" ||| phoneParam) - document "DELETE" "deleteFromBlacklist" $ do - summary "Remove the email/phone from our blacklist" - Doc.parameter Doc.Query "email" Doc.string' $ do - Doc.description "An email address to remove" - Doc.optional - Doc.parameter Doc.Query "phone" Doc.string' $ do - Doc.description "A phone to remove" - Doc.optional - Doc.response 200 "Operation succeeded" Doc.end - - get "/teams" (continue getTeamInfoByMemberEmail) $ - param "email" - document "GET" "getTeamInfoByMemberEmail" $ do - summary "Fetch a team information given a member's email" - Doc.parameter Doc.Query "email" Doc.string' $ - Doc.description "A verified email address" - Doc.response 200 "Team Information" Doc.end - - get "/teams/:tid" (continue getTeamInfo) $ - capture "tid" - document "GET" "getTeamInfo" $ do - summary "Gets information about a team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.response 200 "Team Information" Doc.end - - get "/teams/:tid/admins" (continue getTeamAdminInfo) $ - capture "tid" - document "GET" "getTeamAdminInfo" $ do - summary "Gets information about a team's owners and admins only" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.response 200 "Team Information about Owners and Admins" Doc.end - - mkFeatureGetRoute @LegalholdConfig - mkFeaturePutRouteTrivialConfig @LegalholdConfig - - mkFeatureGetRoute @SSOConfig - mkFeaturePutRouteTrivialConfig @SSOConfig - - mkFeatureGetRoute @SearchVisibilityAvailableConfig - mkFeaturePutRouteTrivialConfig @SearchVisibilityAvailableConfig - - mkFeatureGetRoute @ValidateSAMLEmailsConfig - mkFeaturePutRouteTrivialConfig @ValidateSAMLEmailsConfig - - mkFeatureGetRoute @DigitalSignaturesConfig - mkFeaturePutRouteTrivialConfig @DigitalSignaturesConfig - - mkFeatureGetRoute @FileSharingConfig - mkFeaturePutRouteTrivialConfig @FileSharingConfig - - mkFeatureGetRoute @ClassifiedDomainsConfig - - mkFeatureGetRoute @ConferenceCallingConfig - mkFeaturePutRouteTrivialConfig' @ConferenceCallingConfig TtlEnabled - - mkFeatureGetRoute @AppLockConfig - mkFeaturePutRoute @AppLockConfig - - mkFeatureGetRoute @MLSConfig - mkFeaturePutRoute @MLSConfig - - -- These endpoints should be part of team settings. Until then, we access them from here - -- for authorized personnel to enable/disable this on the team's behalf - get "/teams/:tid/search-visibility" (continue (fmap json . Intra.getSearchVisibility)) $ - capture "tid" - document "GET" "getSearchVisibility" $ do - summary "Shows the current TeamSearchVisibility value for the given team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.returns (Doc.ref Public.modelTeamSearchVisibility) - Doc.response 200 "TeamSearchVisibility value" Doc.end - put "/teams/:tid/search-visibility" (continue setSearchVisibility) $ - contentType "application" "json" - .&. capture "tid" - .&. jsonRequest @TeamSearchVisibility - document "PUT" "setSearchVisibility" $ do - summary "Set specific search visibility for the team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.body Public.typeSearchVisibility $ - Doc.description "JSON body" - Doc.response 200 "TeamSearchVisibility status set" Doc.end - - -- The following endpoint are only relevant internally at Wire - - get "/teams/:tid/invoices/:inr" (continue getTeamInvoice) $ - capture "tid" - .&. capture "inr" - .&. accept "application" "json" - document "GET" "getTeamInvoice" $ do - summary "Get a specific invoice by Number" - notes "Relevant only internally at Wire" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - Doc.description "Team ID" - Doc.parameter Doc.Path "inr" Doc.string' $ - Doc.description "Invoice Number" - Doc.response 307 "Redirect to PDF download" Doc.end - - get "/teams/:tid/billing" (continue getTeamBillingInfo) $ - capture "tid" - document "GET" "getTeamBillingInfo" $ do - summary "Gets billing information about a team" - notes "Relevant only internally at Wire" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.response 200 "Team Billing Information" Doc.end - Doc.response 404 "No team or no billing info for given team" Doc.end - Doc.returns (Doc.ref Doc.teamBillingInfo) - - put "/teams/:tid/billing" (continue updateTeamBillingInfo) $ - contentType "application" "json" - .&. capture "tid" - .&. jsonRequest @TeamBillingInfoUpdate - document "PUT" "updateTeamBillingInfo" $ do - summary - "Updates billing information about a team. Non \ - \specified fields will NOT be updated" - notes "Relevant only internally at Wire" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.body (Doc.ref Doc.teamBillingInfoUpdate) $ - Doc.description "JSON body" - Doc.response 200 "Updated Team Billing Information" Doc.end - Doc.returns (Doc.ref Doc.teamBillingInfo) - - post "/teams/:tid/billing" (continue setTeamBillingInfo) $ - contentType "application" "json" - .&. capture "tid" - .&. jsonRequest @TeamBillingInfo - document "POST" "setTeamBillingInfo" $ do - summary - "Sets billing information about a team. Can \ - \only be used on teams that do NOT have any \ - \billing information set. To update team billing \ - \info, use the update endpoint" - notes "Relevant only internally at Wire" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.body (Doc.ref Doc.teamBillingInfo) $ - Doc.description "JSON body" - Doc.response 200 "Updated Team Billing Information" Doc.end - Doc.returns (Doc.ref Doc.teamBillingInfo) - - get "/i/consent" (continue getConsentLog) $ - param "email" - document "GET" "getConsentLog" $ do - summary "Fetch the consent log given an email address of a non-user" - notes "Relevant only internally at Wire" - Doc.parameter Doc.Query "email" Doc.string' $ - Doc.description "An email address" - Doc.response 200 "Consent Log" Doc.end - Doc.response 403 "Access denied! There is a user with this email address" Doc.end - - get "/i/user/meta-info" (continue getUserData) $ - param "id" - document "GET" "getUserMetaInfo" $ do - summary "Fetch a user's meta info given a user id: TEMPORARY!" - notes "Relevant only internally at Wire" - Doc.parameter Doc.Query "id" Doc.bytes' $ - Doc.description "A user's ID" - Doc.response 200 "Meta Info" Doc.end - -apiDocs :: Routes a Handler () -apiDocs = do - get - "/stern/api-docs" - ( \(_ ::: url) k -> - let doc = mkSwaggerApi (decodeLatin1 url) Doc.sternModels routes - in k $ json doc - ) - $ accept "application" "json" - .&. query "base_url" +servantSitemap :: Stern.App.Env -> Servant.Server SternAPI +servantSitemap env = Servant.Server.hoistServer (Proxy @SternAPI) nt servantSitemap' + where + nt :: forall x. Stern.App.Handler x -> Servant.Server.Handler x + nt m = Servant.Server.Handler . ExceptT $ do + fmapL renderError <$> Stern.App.runAppT env (runExceptT m) + + renderError :: Error -> Servant.Server.ServerError + renderError (Error code label message _) = + Servant.Server.ServerError (statusCode code) (cs label) (cs message) [("Content-type", "application/json")] + +servantSitemap' :: ServerT SternAPI Handler +servantSitemap' = + Named @"suspend-user" suspendUser + :<|> Named @"unsuspend-user" unsuspendUser + :<|> Named @"get-users-by-email" usersByEmail + :<|> Named @"get-users-by-phone" usersByPhone + :<|> Named @"get-users-by-ids" usersByIds + :<|> Named @"get-users-by-handles" usersByHandles + :<|> Named @"get-user-connections" userConnections + :<|> Named @"get-users-connections" usersConnections + :<|> Named @"search-users" searchOnBehalf + :<|> Named @"revoke-identity" revokeIdentity + :<|> Named @"put-email" changeEmail + :<|> Named @"put-phone" changePhone + :<|> Named @"delete-user" deleteUser + :<|> Named @"suspend-team" (setTeamStatusH Team.Suspended) + :<|> Named @"unsuspend-team" (setTeamStatusH Team.Active) + :<|> Named @"delete-team" deleteTeam + :<|> Named @"ejpd-info" ejpdInfoByHandles + :<|> Named @"head-user-blacklist" isUserKeyBlacklisted + :<|> Named @"post-user-blacklist" addBlacklist + :<|> Named @"delete-user-blacklist" deleteFromBlacklist + :<|> Named @"get-team-info-by-member-email" getTeamInfoByMemberEmail + :<|> Named @"get-team-info" getTeamInfo + :<|> Named @"get-team-admin-info" getTeamAdminInfo + :<|> Named @"get-route-legalhold-config" (mkFeatureGetRoute @LegalholdConfig) + :<|> Named @"put-route-legalhold-config" (mkFeaturePutRouteTrivialConfigNoTTL @LegalholdConfig) + :<|> Named @"get-route-sso-config" (mkFeatureGetRoute @SSOConfig) + :<|> Named @"put-route-sso-config" (mkFeaturePutRouteTrivialConfigNoTTL @SSOConfig) + :<|> Named @"get-route-search-visibility-available-config" (mkFeatureGetRoute @SearchVisibilityAvailableConfig) + :<|> Named @"put-route-search-visibility-available-config" (mkFeaturePutRouteTrivialConfigNoTTL @SearchVisibilityAvailableConfig) + :<|> Named @"get-route-validate-saml-emails-config" (mkFeatureGetRoute @ValidateSAMLEmailsConfig) + :<|> Named @"put-route-validate-saml-emails-config" (mkFeaturePutRouteTrivialConfigNoTTL @ValidateSAMLEmailsConfig) + :<|> Named @"get-route-digital-signatures-config" (mkFeatureGetRoute @DigitalSignaturesConfig) + :<|> Named @"put-route-digital-signatures-config" (mkFeaturePutRouteTrivialConfigNoTTL @DigitalSignaturesConfig) + :<|> Named @"get-route-file-sharing-config" (mkFeatureGetRoute @FileSharingConfig) + :<|> Named @"put-route-file-sharing-config" (mkFeaturePutRouteTrivialConfigNoTTL @FileSharingConfig) + :<|> Named @"get-route-classified-domains-config" (mkFeatureGetRoute @ClassifiedDomainsConfig) + :<|> Named @"get-route-conference-calling-config" (mkFeatureGetRoute @ConferenceCallingConfig) + :<|> Named @"put-route-conference-calling-config" (mkFeaturePutRouteTrivialConfigWithTTL @ConferenceCallingConfig) + :<|> Named @"get-route-applock-config" (mkFeatureGetRoute @AppLockConfig) + :<|> Named @"put-route-applock-config" (mkFeaturePutRoute @AppLockConfig) + :<|> Named @"get-route-mls-config" (mkFeatureGetRoute @MLSConfig) + :<|> Named @"put-route-mls-config" (mkFeaturePutRoute @MLSConfig) + :<|> Named @"get-search-visibility" getSearchVisibility + :<|> Named @"put-search-visibility" setSearchVisibility + :<|> Named @"get-team-invoice" getTeamInvoice + :<|> Named @"get-team-billing-info" getTeamBillingInfo + :<|> Named @"put-team-billing-info" updateTeamBillingInfo + :<|> Named @"post-team-billing-info" setTeamBillingInfo + :<|> Named @"get-consent-log" getConsentLog + :<|> Named @"get-user-meta-info" getUserData + +servantSitemapInternal :: Servant.Server SternAPIInternal +servantSitemapInternal = + Named @"status" (pure Servant.NoContent) + :<|> Named @"legacy-api-docs" serveLegacySwagger + +-- | FUTUREWORK: remove this handler, the servant route, and module Stern.API.RoutesLegacy, +-- once we don't depend on swagger1.2 for stern any more. +serveLegacySwagger :: Text -> Servant.Server.Handler NoContent +serveLegacySwagger url = + Servant.Server.Handler $ + throwE + ( Servant.ServerError + 200 + mempty + (encode $ RoutesLegacy.apiDocs (cs url)) + [("Content-Type", "application/json")] + ) ----------------------------------------------------------------------------- -- Handlers -type JSON = Media "application" "json" - -suspendUser :: UserId -> Handler Response -suspendUser uid = do - Intra.putUserStatus Suspended uid - pure empty +suspendUser :: UserId -> Handler NoContent +suspendUser uid = NoContent <$ Intra.putUserStatus Suspended uid -unsuspendUser :: UserId -> Handler Response -unsuspendUser uid = Intra.putUserStatus Active uid >> pure empty - -usersByEmail' :: Email -> Handler Response -usersByEmail' = fmap json . usersByEmail +unsuspendUser :: UserId -> Handler NoContent +unsuspendUser uid = NoContent <$ Intra.putUserStatus Active uid usersByEmail :: Email -> Handler [UserAccount] usersByEmail = Intra.getUserProfilesByIdentity . Left -usersByPhone :: Phone -> Handler Response -usersByPhone = fmap json . Intra.getUserProfilesByIdentity . Right +usersByPhone :: Phone -> Handler [UserAccount] +usersByPhone = Intra.getUserProfilesByIdentity . Right -usersByIds :: List UserId -> Handler Response -usersByIds = fmap json . Intra.getUserProfiles . Left . fromList +usersByIds :: [UserId] -> Handler [UserAccount] +usersByIds = Intra.getUserProfiles . Left -usersByHandles :: List Handle -> Handler Response -usersByHandles = fmap json . Intra.getUserProfiles . Right . fromList +usersByHandles :: [Handle] -> Handler [UserAccount] +usersByHandles = Intra.getUserProfiles . Right -ejpdInfoByHandles :: (List Handle ::: Bool) -> Handler Response -ejpdInfoByHandles (handles ::: includeContacts) = json <$> Intra.getEjpdInfo (fromList handles) includeContacts +ejpdInfoByHandles :: Maybe Bool -> [Handle] -> Handler EJPD.EJPDResponseBody +ejpdInfoByHandles (fromMaybe False -> includeContacts) handles = Intra.getEjpdInfo handles includeContacts -userConnections :: UserId -> Handler Response -userConnections uid = do - conns <- Intra.getUserConnections uid - pure . json $ groupByStatus conns +userConnections :: UserId -> Handler UserConnectionGroups +userConnections = fmap groupByStatus . Intra.getUserConnections -usersConnections :: List UserId -> Handler Response -usersConnections = fmap json . Intra.getUsersConnections +usersConnections :: [UserId] -> Handler [ConnectionStatus] +usersConnections = Intra.getUsersConnections . List -searchOnBehalf :: UserId ::: T.Text ::: Range 1 100 Int32 -> Handler Response -searchOnBehalf (uid ::: q ::: s) = - json <$> Intra.getContacts uid q (fromRange s) +searchOnBehalf :: UserId -> Maybe T.Text -> Maybe Int32 -> Handler (SearchResult Contact) +searchOnBehalf + uid + (fromMaybe "" -> q) + (fromMaybe (unsafeRange 10) . checked @Int32 @1 @100 . fromMaybe 10 -> s) = + Intra.getContacts uid q (fromRange s) -revokeIdentity :: Either Email Phone -> Handler Response -revokeIdentity emailOrPhone = Intra.revokeIdentity emailOrPhone >> pure empty +revokeIdentity :: Maybe Email -> Maybe Phone -> Handler NoContent +revokeIdentity mbe mbp = NoContent <$ (Intra.revokeIdentity =<< doubleMaybeToEither "email, phone" mbe mbp) -changeEmail :: JSON ::: UserId ::: Bool ::: JsonRequest EmailUpdate -> Handler Response -changeEmail (_ ::: uid ::: validate ::: req) = do - upd <- parseBody req !>> mkError status400 "client-error" - Intra.changeEmail uid upd validate - pure empty +changeEmail :: UserId -> Maybe Bool -> EmailUpdate -> Handler NoContent +changeEmail = undefined -- uid validate upd = NoContent <$ Intra.changeEmail uid (fromMaybe False upd) validate -changePhone :: JSON ::: UserId ::: JsonRequest PhoneUpdate -> Handler Response -changePhone (_ ::: uid ::: req) = do - upd <- parseBody req !>> mkError status400 "client-error" - Intra.changePhone uid upd - pure empty +changePhone :: UserId -> PhoneUpdate -> Handler NoContent +changePhone uid upd = NoContent <$ Intra.changePhone uid upd -deleteUser :: UserId ::: Either Email Phone -> Handler Response -deleteUser (uid ::: emailOrPhone) = do +deleteUser :: UserId -> Maybe Email -> Maybe Phone -> Handler NoContent +deleteUser uid mbEmail mbPhone = do + emailOrPhone <- doubleMaybeToEither "email, phone" mbEmail mbPhone usrs <- Intra.getUserProfilesByIdentity emailOrPhone case usrs of - ((accountUser -> u) : _) -> - if checkUUID u + [accountUser -> u] -> + if userId u == uid then do info $ userMsg uid . msg (val "Deleting account") void $ Intra.deleteAccount uid - pure empty + pure NoContent else throwE $ mkError status400 "match-error" "email or phone did not match UserId" - _ -> pure $ setStatus status404 empty - where - checkUUID u = userId u == uid + (_ : _ : _) -> error "impossible" + _ -> throwE $ mkError status404 "not-found" "not found" -setTeamStatusH :: Team.TeamStatus -> TeamId -> Handler Response -setTeamStatusH status tid = empty <$ Intra.setStatusBindingTeam tid status +setTeamStatusH :: Team.TeamStatus -> TeamId -> Handler NoContent +setTeamStatusH status tid = NoContent <$ Intra.setStatusBindingTeam tid status -deleteTeam :: TeamId ::: Bool ::: Maybe Email -> Handler Response -deleteTeam (_ ::: False ::: Nothing) = - throwE $ mkError status400 "Bad Request" "either email or 'force=true' parameter is required" -deleteTeam (givenTid ::: False ::: Just email) = do +deleteTeam :: TeamId -> Maybe Bool -> Maybe Email -> Handler NoContent +deleteTeam givenTid (fromMaybe False -> False) (Just email) = do acc <- Intra.getUserProfilesByIdentity (Left email) >>= handleNoUser . listToMaybe userTid <- (Intra.getUserBindingTeam . userId . accountUser $ acc) >>= handleNoTeam when (givenTid /= userTid) $ @@ -632,66 +252,122 @@ deleteTeam (givenTid ::: False ::: Just email) = do tInfo <- Intra.getTeamInfo givenTid unless (length (tiMembers tInfo) == 1) $ throwE wrongMemberCount - void $ Intra.deleteBindingTeam givenTid - pure $ setStatus status202 empty + NoContent <$ Intra.deleteBindingTeam givenTid where handleNoUser = ifNothing (mkError status404 "no-user" "No such user with that email") handleNoTeam = ifNothing (mkError status404 "no-binding-team" "No such binding team") wrongMemberCount = mkError status403 "wrong-member-count" "Only teams with 1 user can be deleted" bindingTeamMismatch = mkError status404 "binding-team-mismatch" "Binding team mismatch" -deleteTeam (tid ::: True ::: _) = do +deleteTeam tid (fromMaybe False -> True) _ = do void $ Intra.getTeamData tid -- throws 404 if team does not exist - void $ Intra.deleteBindingTeamForce tid - pure $ setStatus status202 empty + NoContent <$ Intra.deleteBindingTeamForce tid +deleteTeam _ _ _ = + throwE $ mkError status400 "Bad Request" "either email or 'force=true' parameter is required" -isUserKeyBlacklisted :: Either Email Phone -> Handler Response -isUserKeyBlacklisted emailOrPhone = do +isUserKeyBlacklisted :: Maybe Email -> Maybe Phone -> Handler NoContent +isUserKeyBlacklisted mbemail mbphone = do + emailOrPhone <- doubleMaybeToEither "email, phone" mbemail mbphone bl <- Intra.isBlacklisted emailOrPhone if bl - then response status200 "The given user key IS blacklisted" - else response status404 "The given user key is NOT blacklisted" + then throwE $ mkError status200 "blacklisted" "The given user key IS blacklisted" + else throwE $ mkError status404 "not-blacklisted" "The given user key is NOT blacklisted" + +addBlacklist :: Maybe Email -> Maybe Phone -> Handler NoContent +addBlacklist mbemail mbphone = do + emailOrPhone <- doubleMaybeToEither "email, phone" mbemail mbphone + NoContent <$ Intra.setBlacklistStatus True emailOrPhone + +deleteFromBlacklist :: Maybe Email -> Maybe Phone -> Handler NoContent +deleteFromBlacklist mbemail mbphone = do + emailOrPhone <- doubleMaybeToEither "email, phone" mbemail mbphone + NoContent <$ Intra.setBlacklistStatus False emailOrPhone + +getTeamInfoByMemberEmail :: Email -> Handler TeamInfo +getTeamInfoByMemberEmail e = do + acc <- Intra.getUserProfilesByIdentity (Left e) >>= handleUser . listToMaybe + tid <- (Intra.getUserBindingTeam . userId . accountUser $ acc) >>= handleTeam + Intra.getTeamInfo tid where - response st reason = - pure - . setStatus st - . json - $ object ["status" .= (reason :: Text)] - -addBlacklist :: Either Email Phone -> Handler Response -addBlacklist emailOrPhone = do - Intra.setBlacklistStatus True emailOrPhone - pure empty - -deleteFromBlacklist :: Either Email Phone -> Handler Response -deleteFromBlacklist emailOrPhone = do - Intra.setBlacklistStatus False emailOrPhone - pure empty - -getTeamInfo :: TeamId -> Handler Response -getTeamInfo = fmap json . Intra.getTeamInfo - -getTeamAdminInfo :: TeamId -> Handler Response -getTeamAdminInfo = fmap (json . toAdminInfo) . Intra.getTeamInfo - -setSearchVisibility :: JSON ::: TeamId ::: JsonRequest TeamSearchVisibility -> Handler Response -setSearchVisibility (_ ::: tid ::: req) = do - status :: TeamSearchVisibility <- parseBody req !>> mkError status400 "client-error" - json <$> Intra.setSearchVisibility tid status - -getTeamBillingInfo :: TeamId -> Handler Response + handleUser = ifNothing (mkError status404 "no-user" "No such user with that email") + handleTeam = ifNothing (mkError status404 "no-binding-team" "No such binding team") + +getTeamInfo :: TeamId -> Handler TeamInfo +getTeamInfo = Intra.getTeamInfo + +getTeamAdminInfo :: TeamId -> Handler TeamAdminInfo +getTeamAdminInfo = fmap toAdminInfo . Intra.getTeamInfo + +mkFeatureGetRoute :: + forall cfg. + ( IsFeatureConfig cfg, + ToSchema cfg, + KnownSymbol (FeatureSymbol cfg), + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + TeamId -> + Handler (WithStatus cfg) +mkFeatureGetRoute = Intra.getTeamFeatureFlag @cfg + +mkFeaturePutRoute :: + forall cfg. + ( IsFeatureConfig cfg, + ToSchema cfg, + KnownSymbol (FeatureSymbol cfg), + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + TeamId -> + WithStatusNoLock cfg -> + Handler NoContent +mkFeaturePutRoute tid payload = NoContent <$ Intra.setTeamFeatureFlag @cfg tid payload + +type MkFeaturePutConstraints cfg = + ( IsFeatureConfig cfg, + FeatureTrivialConfig cfg, + KnownSymbol (FeatureSymbol cfg), + ToSchema cfg, + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) + +mkFeaturePutRouteTrivialConfigNoTTL :: + forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> FeatureStatus -> Handler NoContent +mkFeaturePutRouteTrivialConfigNoTTL tid status = mkFeaturePutRouteTrivialConfig @cfg tid status Nothing + +mkFeaturePutRouteTrivialConfigWithTTL :: + forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> FeatureStatus -> FeatureTTLDays -> Handler NoContent +mkFeaturePutRouteTrivialConfigWithTTL tid status = mkFeaturePutRouteTrivialConfig @cfg tid status . Just + +mkFeaturePutRouteTrivialConfig :: + forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> FeatureStatus -> Maybe FeatureTTLDays -> Handler NoContent +mkFeaturePutRouteTrivialConfig tid status (maybe FeatureTTLUnlimited convertFeatureTTLDaysToSeconds -> ttl) = do + let fullStatus = WithStatusNoLock status trivialConfig ttl + NoContent <$ Intra.setTeamFeatureFlag @cfg tid fullStatus + +getSearchVisibility :: TeamId -> Handler TeamSearchVisibilityView +getSearchVisibility = Intra.getSearchVisibility + +setSearchVisibility :: TeamId -> TeamSearchVisibility -> Handler NoContent +setSearchVisibility tid status = NoContent <$ Intra.setSearchVisibility tid status + +getTeamInvoice :: TeamId -> InvoiceId -> Handler Text +getTeamInvoice tid iid = cs <$> Intra.getInvoiceUrl tid iid + +getTeamBillingInfo :: TeamId -> Handler TeamBillingInfo getTeamBillingInfo tid = do - ti <- Intra.getTeamBillingInfo tid - case ti of - Just t -> pure $ json t - Nothing -> throwE (mkError status404 "no-team" "No team or no billing info for team") - -updateTeamBillingInfo :: JSON ::: TeamId ::: JsonRequest TeamBillingInfoUpdate -> Handler Response -updateTeamBillingInfo (_ ::: tid ::: req) = do - update <- parseBody req !>> mkError status400 "client-error" + let notfound = throwE (mkError status404 "no-team" "No team or no billing info for team") + Intra.getTeamBillingInfo tid >>= maybe notfound pure + +updateTeamBillingInfo :: TeamId -> TeamBillingInfoUpdate -> Handler TeamBillingInfo +updateTeamBillingInfo tid update = do current <- Intra.getTeamBillingInfo tid >>= handleNoTeam let changes = parse update current Intra.setTeamBillingInfo tid changes - json <$> Intra.getTeamBillingInfo tid + Intra.getTeamBillingInfo tid >>= handleNoTeam where handleNoTeam = ifNothing (mkError status404 "no-team" "No team or no billing info for team") parse :: TeamBillingInfoUpdate -> TeamBillingInfo -> TeamBillingInfo @@ -707,45 +383,25 @@ updateTeamBillingInfo (_ ::: tid ::: req) = do tbiState = fromRange <$> tbiuState <|> tbiState tbi } -setTeamBillingInfo :: JSON ::: TeamId ::: JsonRequest TeamBillingInfo -> Handler Response -setTeamBillingInfo (_ ::: tid ::: req) = do - billingInfo <- parseBody req !>> mkError status400 "client-error" +setTeamBillingInfo :: TeamId -> TeamBillingInfo -> Handler TeamBillingInfo +setTeamBillingInfo tid billingInfo = do current <- Intra.getTeamBillingInfo tid when (isJust current) $ throwE (mkError status403 "existing-team" "Cannot set info on existing team, use update instead") Intra.setTeamBillingInfo tid billingInfo getTeamBillingInfo tid -getTeamInfoByMemberEmail :: Email -> Handler Response -getTeamInfoByMemberEmail e = do - acc <- Intra.getUserProfilesByIdentity (Left e) >>= handleUser . listToMaybe - tid <- (Intra.getUserBindingTeam . userId . accountUser $ acc) >>= handleTeam - json <$> Intra.getTeamInfo tid - where - handleUser = ifNothing (mkError status404 "no-user" "No such user with that email") - handleTeam = ifNothing (mkError status404 "no-binding-team" "No such binding team") - -getTeamInvoice :: TeamId ::: InvoiceId ::: JSON -> Handler Response -getTeamInvoice (tid ::: iid ::: _) = do - url <- Intra.getInvoiceUrl tid iid - pure $ plain (fromStrict url) - -getConsentLog :: Email -> Handler Response +getConsentLog :: Email -> Handler ConsentLogAndMarketo getConsentLog e = do acc <- listToMaybe <$> Intra.getUserProfilesByIdentity (Left e) when (isJust acc) $ throwE $ mkError status403 "user-exists" "Trying to access consent log of existing user!" - consentLog <- Intra.getEmailConsentLog e - marketo <- Intra.getMarketoResult e - pure . json $ - object - [ "consent_log" .= consentLog, - "marketo" .= marketo - ] - --- TODO: This will be removed as soon as this is ported to another tool -getUserData :: UserId -> Handler Response + ConsentLogAndMarketo + <$> Intra.getEmailConsentLog e + <*> Intra.getMarketoResult e + +getUserData :: UserId -> Handler UserMetaInfo getUserData uid = do account <- Intra.getUserProfiles (Left [uid]) >>= noSuchUser . listToMaybe conns <- Intra.getUserConnections uid @@ -758,36 +414,38 @@ getUserData uid = do properties <- Intra.getUserProperties uid -- Get all info from Marketo too let em = userEmail $ accountUser account - marketo <- maybe (pure noEmail) Intra.getMarketoResult em - pure . json $ - object - [ "account" .= account, - "cookies" .= cookies, - "connections" .= conns, - "conversations" .= convs, - "clients" .= clts, - "notifications" .= notfs, - "consent" .= consent, - "consent_log" .= consentLog, - "marketo" .= marketo, - "properties" .= properties - ] - where - noEmail = MarketoResult $ KeyMap.singleton "results" emptyArray + marketo <- do + let noEmail = MarketoResult $ KeyMap.singleton "results" emptyArray + maybe (pure noEmail) Intra.getMarketoResult em + pure . UserMetaInfo . KeyMap.fromList $ + [ "account" .= account, + "cookies" .= cookies, + "connections" .= conns, + "conversations" .= convs, + "clients" .= clts, + "notifications" .= notfs, + "consent" .= consent, + "consent_log" .= consentLog, + "marketo" .= marketo, + "properties" .= properties + ] -- Utilities -groupByStatus :: [UserConnection] -> Value +instance FromByteString a => Servant.FromHttpApiData [a] where + parseUrlPiece = maybe (Left "not a list of a's") (Right . fromList) . fromByteString' . cs + +groupByStatus :: [UserConnection] -> UserConnectionGroups groupByStatus conns = - object - [ "accepted" .= byStatus Accepted conns, - "sent" .= byStatus Sent conns, - "pending" .= byStatus Pending conns, - "blocked" .= byStatus Blocked conns, - "ignored" .= byStatus Ignored conns, - "missing-legalhold-consent" .= byStatus MissingLegalholdConsent conns, - "total" .= length conns - ] + UserConnectionGroups + { ucgAccepted = byStatus Accepted conns, + ucgSent = byStatus Sent conns, + ucgPending = byStatus Pending conns, + ucgBlocked = byStatus Blocked conns, + ucgIgnored = byStatus Ignored conns, + ucgMissingLegalholdConsent = byStatus MissingLegalholdConsent conns, + ucgTotal = length conns + } where byStatus :: Relation -> [UserConnection] -> Int byStatus s = length . filter ((==) s . ucStatus) @@ -797,156 +455,3 @@ ifNothing e = maybe (throwE e) pure noSuchUser :: Maybe a -> Handler a noSuchUser = ifNothing (mkError status404 "no-user" "No such user") - -mkFeatureGetRoute :: - forall cfg. - ( IsFeatureConfig cfg, - S.ToSchema cfg, - KnownSymbol (FeatureSymbol cfg), - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), - Typeable cfg - ) => - Routes Doc.ApiBuilder Handler () -mkFeatureGetRoute = do - get ("/teams/:tid/features/" <> featureNameBS @cfg) (continue (getTeamFeatureFlagH @cfg)) $ - capture "tid" - document "GET" "getTeamFeatureFlag" $ do - summary "Shows whether a feature flag is enabled or not for a given team." - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.returns (Doc.ref (withStatusModel @cfg)) - Doc.response 200 "Team feature flag status" Doc.end - -mkFeaturePutRoute :: - forall cfg. - ( IsFeatureConfig cfg, - S.ToSchema cfg, - KnownSymbol (FeatureSymbol cfg), - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), - Typeable cfg - ) => - Routes Doc.ApiBuilder Handler () -mkFeaturePutRoute = do - put ("/teams/:tid/features/" <> featureNameBS @cfg) (continue (setTeamFeatureFlagH @cfg)) $ - capture "tid" - .&. jsonRequest @(WithStatusNoLock cfg) - .&. accept "application" "json" - document "PUT" "setTeamFeatureFlag" $ do - summary "Disable / enable feature flag for a given team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.body (Doc.ref (withStatusNoLockModel @cfg)) $ - Doc.description "JSON body" - Doc.response 200 "Team feature flag status" Doc.end - -getTeamFeatureFlagH :: - forall cfg. - ( IsFeatureConfig cfg, - S.ToSchema cfg, - KnownSymbol (FeatureSymbol cfg), - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), - Typeable cfg - ) => - TeamId -> - Handler Response -getTeamFeatureFlagH tid = - json <$> Intra.getTeamFeatureFlag @cfg tid - -setTeamFeatureFlagH :: - forall cfg. - ( IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), - Typeable (WithStatusNoLock cfg) - ) => - TeamId ::: JsonRequest (WithStatusNoLock cfg) ::: JSON -> - Handler Response -setTeamFeatureFlagH (tid ::: req ::: _) = do - status :: WithStatusNoLock cfg <- parseBody req !>> mkError status400 "client-error" - empty <$ Intra.setTeamFeatureFlag @cfg tid status - -mkFeaturePutRouteTrivialConfig :: - forall cfg. - ( IsFeatureConfig cfg, - FeatureTrivialConfig cfg, - KnownSymbol (FeatureSymbol cfg), - S.ToSchema cfg, - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), - Typeable cfg - ) => - Routes Doc.ApiBuilder Handler () -mkFeaturePutRouteTrivialConfig = mkFeaturePutRouteTrivialConfig' @cfg TtlDisabled - -mkFeaturePutRouteTrivialConfig' :: - forall cfg. - ( IsFeatureConfig cfg, - FeatureTrivialConfig cfg, - KnownSymbol (FeatureSymbol cfg), - S.ToSchema cfg, - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), - Typeable cfg - ) => - SupportsTtl -> - Routes Doc.ApiBuilder Handler () -mkFeaturePutRouteTrivialConfig' ttlSupport = do - handler - document "PUT" "setTeamFeatureFlag" $ do - summary "Disable / enable feature flag for a given team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.parameter Doc.Query "status" typeFeatureStatus $ do - Doc.description "team feature status (enabled or disabled)" - case ttlSupport of - TtlEnabled -> Doc.parameter Doc.Query "ttl" Public.typeFeatureTTL $ do - Doc.description "team feature time to live, given in days, or 'unlimited' (default). Only applies to conference calling. It's ignored by other features." - TtlDisabled -> pure () - Doc.response 200 "Team feature flag status" Doc.end - where - handler = case ttlSupport of - TtlEnabled -> - put ("/teams/:tid/features/" <> featureNameBS @cfg) (continue (setTeamFeatureFlagTrivialConfigH @cfg)) $ - capture "tid" - .&. param "status" - .&. def Public.FeatureTTLUnlimited (query "ttl") - TtlDisabled -> - put ("/teams/:tid/features/" <> featureNameBS @cfg) (continue (setTeamFeatureFlagTrivialConfigHNoTtl @cfg)) $ - capture "tid" - .&. param "status" - -setTeamFeatureFlagTrivialConfigHNoTtl :: - forall cfg. - ( IsFeatureConfig cfg, - FeatureTrivialConfig cfg, - KnownSymbol (FeatureSymbol cfg), - S.ToSchema cfg, - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), - Typeable cfg - ) => - TeamId ::: FeatureStatus -> - Handler Response -setTeamFeatureFlagTrivialConfigHNoTtl (tid ::: featureStatus) = do - let status = WithStatusNoLock featureStatus trivialConfig FeatureTTLUnlimited - empty <$ Intra.setTeamFeatureFlag @cfg tid status - -setTeamFeatureFlagTrivialConfigH :: - forall cfg. - ( IsFeatureConfig cfg, - FeatureTrivialConfig cfg, - KnownSymbol (FeatureSymbol cfg), - S.ToSchema cfg, - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), - Typeable cfg - ) => - TeamId ::: FeatureStatus ::: FeatureTTL' 'FeatureTTLUnitDays -> - Handler Response -setTeamFeatureFlagTrivialConfigH (tid ::: featureStatus ::: ttl) = do - let status = WithStatusNoLock featureStatus trivialConfig (convertFeatureTTLDaysToSeconds ttl) - empty <$ Intra.setTeamFeatureFlag @cfg tid status diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index f48ca484d2..37fff085d9 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -17,32 +17,373 @@ module Stern.API.Routes ( SternAPI, + SternAPIInternal, SwaggerDocsAPI, swaggerDocsAPI, + UserConnectionGroups (..), + doubleMaybeToEither, ) where import Brig.Types.Intra (UserAccount) import Control.Lens +import Control.Monad.Trans.Except +import qualified Data.Aeson as A +import Data.Handle +import Data.Id +import qualified Data.Schema as Schema import qualified Data.Swagger as S import Imports hiding (head) -import Servant (JSON) -import Servant hiding (Handler, JSON, addHeader, respond) +import Network.HTTP.Types.Status +import Network.Wai.Utilities +import Servant hiding (Handler, WithStatus (..), addHeader, respond) import Servant.Swagger (HasSwagger (toSwagger)) import Servant.Swagger.Internal.Orphans () import Servant.Swagger.UI +import Stern.Types +import Wire.API.Routes.Internal.Brig.Connection (ConnectionStatus) +import qualified Wire.API.Routes.Internal.Brig.EJPD as EJPD import Wire.API.Routes.Named import Wire.API.SwaggerHelper (cleanupSwagger) -import Wire.API.User (Email) +import Wire.API.Team.Feature +import Wire.API.Team.SearchVisibility +import Wire.API.User +import Wire.API.User.Search + +---------------------------------------------------------------------- +-- routing tables + +type SternAPIInternal = + Named + "status" + ( "i" + :> "status" + :> Get '[JSON] NoContent + ) + :<|> Named + "legacy-api-docs" + ( "stern" + :> "api-docs" + :> QueryParam' [Required, Strict, Description "Base URL"] "base_url" Text + -- we throw the old swagger docs as a exception with status 200 so we don't + -- have to implement its type and can give 'NoContent' as the response body + -- type here. + :> Get '[JSON] NoContent + ) type SternAPI = Named - "get-users-by-email" - ( Summary "Displays user's info given an email address" + "suspend-user" + ( Summary "Suspends user with this ID" :> "users" - :> QueryParam' [Required, Strict, Description "Email address"] "email" Email - :> Get '[JSON] [UserAccount] + :> Capture "uid" UserId + :> "suspend" + :> Post '[JSON] NoContent ) + :<|> Named + "unsuspend-user" + ( Summary "Unsuspends user with this ID" + :> "users" + :> Capture "uid" UserId + :> "unsuspend" + :> Post '[JSON] NoContent + ) + :<|> Named + "get-users-by-email" + ( Summary "Displays user's info given an email address" + :> "users" + :> "by-email" + :> QueryParam' [Required, Strict, Description "Email address"] "email" Email + :> Get '[JSON] [UserAccount] + ) + :<|> Named + "get-users-by-phone" + ( Summary "Displays user's info given a phone number" + :> "users" + :> "by-phone" + :> QueryParam' [Required, Strict, Description "Phone number"] "phone" Phone + :> Get '[JSON] [UserAccount] + ) + :<|> Named + "get-users-by-ids" + ( Summary "Displays active users info given a list of ids" + :> "users" + :> "by-ids" + :> QueryParam' [Required, Strict, Description "List of IDs of the users, separated by comma"] "ids" [UserId] + :> Get '[JSON] [UserAccount] + ) + :<|> Named + "get-users-by-handles" + ( Summary "Displays active users info given a list of handles" + :> "users" + :> "by-handles" + :> QueryParam' [Required, Strict, Description "List of Handles of the users, without '@', separated by comma"] "handles" [Handle] + :> Get '[JSON] [UserAccount] + ) + :<|> Named + "get-user-connections" + ( Summary "Displays user's connections" + :> "users" + :> Capture "uid" UserId + :> "connections" + :> Get '[JSON] UserConnectionGroups + ) + :<|> Named + "get-users-connections" + ( Summary "Displays connections of many users given a list of ids" + :> "users" + :> "connections" + :> QueryParam' [Required, Strict, Description "List of IDs of the users, separated by comma"] "ids" [UserId] + :> Get '[JSON] [ConnectionStatus] + ) + :<|> Named + "search-users" + ( Summary "Search for users on behalf of" + :> "users" + :> Capture "uid" UserId + :> "search" + :> QueryParam' [Optional, Strict, Description "Search query (default \"\")"] "q" Text + :> QueryParam' [Optional, Strict, Description "Number of results to return (min 1, max 100, default 10)"] "size" Int32 + :> Get '[JSON] (SearchResult Contact) + ) + :<|> Named + "revoke-identity" + ( Summary "Revoke a verified user identity. Specify exactly one of phone, email." + :> Description + "Forcefully revokes a verified user identity. \ + \WARNING: If the given identity is the only verified \ + \user identity of an account, the account will be \ + \deactivated (\"wireless\") and might thus become inaccessible. \ + \If the given identity is not taken / verified, this is a no-op." + :> "users" + :> "revoke-identity" + :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email + :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> Post '[JSON] NoContent + ) + :<|> Named + "put-email" + ( Summary "Change a user's email address." + :> Description "The new e-mail address must be verified before the change takes effect." + :> "users" + :> Capture "uid" UserId + :> "email" + :> QueryParam' [Optional, Strict, Description "If set to true, a validation email will be sent to the new email address"] "validate" Bool + :> Servant.ReqBody '[JSON] EmailUpdate + :> Put '[JSON] NoContent + ) + :<|> Named + "put-phone" + ( Summary "Change a user's phone number." + :> Description "The new phone number must be verified before the change takes effect." + :> "users" + :> Capture "uid" UserId + :> "phone" + :> Servant.ReqBody '[JSON] PhoneUpdate + :> Put '[JSON] NoContent + ) + :<|> Named + "delete-user" + ( Summary "Delete a user (irrevocable!)" + :> Description + "Email or Phone must match UserId's (to prevent copy/paste mistakes). Use exactly one of the two query params." + :> "users" + :> Capture "uid" UserId + :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email + :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> Delete '[JSON] NoContent + ) + :<|> Named + "suspend-team" + ( Summary "Suspend a team." + :> "teams" + :> Capture "tid" TeamId + :> "suspend" + :> Put '[JSON] NoContent + ) + :<|> Named + "unsuspend-team" + ( Summary "Set a team status to 'Active', independently on previous status. (Cannot be used to un-delete teams, though.)" + :> "teams" + :> Capture "tid" TeamId + :> "unsuspend" + :> Put '[JSON] NoContent + ) + :<|> Named + "delete-team" + ( Summary "Delete a team (irrevocable!). You can only delete teams with 1 user unless you use the 'force' query flag" + :> Description + "The email address of the user must be provided to prevent copy/paste mistakes.\n\ + \The force query flag can be used to delete teams with more than one user. \ + \CAUTION: FORCE DELETE WILL PERMANENTLY DELETE ALL TEAM MEMBERS! \ + \CHECK TEAM MEMBER LIST (SEE ABOVE OR BELOW) IF YOU ARE UNCERTAIN THAT'S WHAT YOU WANT." + :> "teams" + :> Capture "tid" TeamId + :> QueryParam' [Optional, Strict, Description "THIS WILL PERMANENTLY DELETE ALL TEAM MEMBERS! CHECK TEAM MEMBER LIST (SEE ABOVE OR BELOW) IF YOU ARE UNCERTAIN THAT'S WHAT YOU WANT."] "force" Bool + :> QueryParam' [Optional, Strict, Description "Matching verified remaining user address"] "email" Email + :> Delete '[JSON] NoContent + ) + :<|> Named + "ejpd-info" + ( Summary "internal wire.com process: https://wearezeta.atlassian.net/wiki/spaces/~463749889/pages/256738296/EJPD+official+requests+process" + :> "ejpd-info" + :> QueryParam' [Optional, Strict, Description "If 'true', this gives you more more exhaustive information about this user (including social network)"] "include_contacts" Bool + :> QueryParam' [Required, Strict, Description "Handles of the users, separated by commas (NB: all chars need to be lower case!)"] "handles" [Handle] + :> Delete '[JSON] EJPD.EJPDResponseBody + ) + :<|> Named + "head-user-blacklist" + ( Summary "Fetch blacklist information on a email/phone (200: blacklisted; 404: not blacklisted)" + :> "users" + :> "blacklist" + :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email + :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> Verb 'HEAD 200 '[JSON] NoContent + ) + :<|> Named + "post-user-blacklist" + ( Summary "Add the email/phone to our blacklist" + :> "users" + :> "blacklist" + :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email + :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> Post '[JSON] NoContent + ) + :<|> Named + "delete-user-blacklist" + ( Summary "Remove the email/phone from our blacklist" + :> "users" + :> "blacklist" + :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email + :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> Delete '[JSON] NoContent + ) + :<|> Named + "get-team-info-by-member-email" + ( Summary "Fetch a team information given a member's email" + :> "teams" + :> QueryParam' [Required, Strict, Description "A verified email address"] "email" Email + :> Get '[JSON] TeamInfo + ) + :<|> Named + "get-team-info" + ( Summary "Gets information about a team" + :> "teams" + :> Capture "tid" TeamId + :> Get '[JSON] TeamInfo + ) + :<|> Named + "get-team-admin-info" + ( Summary "Gets information about a team's members, owners, and admins" + :> "teams" + :> Capture "tid" TeamId + :> "admins" + :> Get '[JSON] TeamAdminInfo + ) + :<|> Named "get-route-legalhold-config" (MkFeatureGetRoute LegalholdConfig) + :<|> Named "put-route-legalhold-config" (MkFeaturePutRouteTrivialConfigNoTTL LegalholdConfig) + :<|> Named "get-route-sso-config" (MkFeatureGetRoute SSOConfig) + :<|> Named "put-route-sso-config" (MkFeaturePutRouteTrivialConfigNoTTL SSOConfig) + :<|> Named "get-route-search-visibility-available-config" (MkFeatureGetRoute SearchVisibilityAvailableConfig) + :<|> Named "put-route-search-visibility-available-config" (MkFeaturePutRouteTrivialConfigNoTTL SearchVisibilityAvailableConfig) + :<|> Named "get-route-validate-saml-emails-config" (MkFeatureGetRoute ValidateSAMLEmailsConfig) + :<|> Named "put-route-validate-saml-emails-config" (MkFeaturePutRouteTrivialConfigNoTTL ValidateSAMLEmailsConfig) + :<|> Named "get-route-digital-signatures-config" (MkFeatureGetRoute DigitalSignaturesConfig) + :<|> Named "put-route-digital-signatures-config" (MkFeaturePutRouteTrivialConfigNoTTL DigitalSignaturesConfig) + :<|> Named "get-route-file-sharing-config" (MkFeatureGetRoute FileSharingConfig) + :<|> Named "put-route-file-sharing-config" (MkFeaturePutRouteTrivialConfigNoTTL FileSharingConfig) + :<|> Named "get-route-classified-domains-config" (MkFeatureGetRoute ClassifiedDomainsConfig) + :<|> Named "get-route-conference-calling-config" (MkFeatureGetRoute ConferenceCallingConfig) + :<|> Named "put-route-conference-calling-config" (MkFeaturePutRouteTrivialConfigWithTTL ConferenceCallingConfig) + :<|> Named "get-route-applock-config" (MkFeatureGetRoute AppLockConfig) + :<|> Named "put-route-applock-config" (MkFeaturePutRoute AppLockConfig) + :<|> Named "get-route-mls-config" (MkFeatureGetRoute MLSConfig) + :<|> Named "put-route-mls-config" (MkFeaturePutRoute MLSConfig) + :<|> Named + "get-search-visibility" + ( Summary "Shows the current TeamSearchVisibility value for the given team" + :> Description + "These endpoints should be part of team settings. Until that happens, \ + \we access them from here for authorized personnel to enable/disable \ + \this on the team's behalf" + :> "teams" + :> Capture "tid" TeamId + :> "search-visibility" + :> Get '[JSON] TeamSearchVisibilityView + ) + :<|> Named + "put-search-visibility" + ( Summary "Shows the current TeamSearchVisibility value for the given team" + :> Description + "These endpoints should be part of team settings. Until that happens, \ + \we access them from here for authorized personnel to enable/disable \ + \this on the team's behalf" + :> "teams" + :> Capture "tid" TeamId + :> "search-visibility" + :> ReqBody '[JSON] TeamSearchVisibility + :> Get '[JSON] NoContent + ) + :<|> Named + "get-team-invoice" + ( Summary "Get a specific invoice by Number" + :> Description "Relevant only internally at Wire" + :> "teams" + :> Capture "tid" TeamId + :> "invoice" + :> Capture "inr" InvoiceId + :> Get '[JSON] Text + ) + :<|> Named + "get-team-billing-info" + ( Summary "Gets billing information about a team" + :> Description "Relevant only internally at Wire" + :> "teams" + :> Capture "tid" TeamId + :> "billing" + :> Get '[JSON] TeamBillingInfo + ) + :<|> Named + "put-team-billing-info" + ( Summary "Updates billing information about a team. Non specified fields will NOT be updated" + :> Description "Relevant only internally at Wire" + :> "teams" + :> Capture "tid" TeamId + :> "billing" + :> ReqBody '[JSON] TeamBillingInfoUpdate + :> Put '[JSON] TeamBillingInfo + ) + :<|> Named + "post-team-billing-info" + ( Summary + "Sets billing information about a team. Can only be used on teams that do NOT have any \ + \billing information set. To update team billing info, use the update endpoint" + :> Description "Relevant only internally at Wire" + :> "teams" + :> Capture "tid" TeamId + :> "billing" + :> ReqBody '[JSON] TeamBillingInfo + :> Post '[JSON] TeamBillingInfo + ) + :<|> Named + "get-consent-log" + ( Summary "Fetch the consent log given an email address of a non-user" + :> Description "Relevant only internally at Wire" + :> "i" + :> "consent" + :> QueryParam' [Required, Strict, Description "A verified email address"] "email" Email + :> Get '[JSON] ConsentLogAndMarketo + ) + :<|> Named + "get-user-meta-info" + ( Summary "Fetch a user's meta info given a user id: TEMPORARY!" + :> Description "Relevant only internally at Wire" + :> "i" + :> "user" + :> "meta-info" + :> QueryParam' [Required, Strict, Description "A valid UserId"] "id" UserId + :> Post '[JSON] UserMetaInfo + ) ------------------------------------------------------------------------------- -- Swagger @@ -52,6 +393,75 @@ type SwaggerDocsAPI = "backoffice" :> "api" :> SwaggerSchemaUI "swagger-ui" "swa swaggerDocsAPI :: Servant.Server SwaggerDocsAPI swaggerDocsAPI = swaggerSchemaUIServer $ - (toSwagger (Proxy @SternAPI)) + toSwagger (Proxy @SternAPI) & S.info . S.title .~ "Stern API" & cleanupSwagger + +---------------------------------------------------------------------- +-- helpers + +data UserConnectionGroups = UserConnectionGroups + { ucgAccepted :: Int, + ucgSent :: Int, + ucgPending :: Int, + ucgBlocked :: Int, + ucgIgnored :: Int, + ucgMissingLegalholdConsent :: Int, + ucgTotal :: Int + } + deriving (Eq, Show, Generic) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema.Schema UserConnectionGroups + +instance Schema.ToSchema UserConnectionGroups where + schema = + Schema.object "UserConnectionGroups" $ + UserConnectionGroups + <$> ucgAccepted Schema..= Schema.field "ucgAccepted" Schema.schema + <*> ucgSent Schema..= Schema.field "ucgSent" Schema.schema + <*> ucgPending Schema..= Schema.field "ucgPending" Schema.schema + <*> ucgBlocked Schema..= Schema.field "ucgBlocked" Schema.schema + <*> ucgIgnored Schema..= Schema.field "ucgIgnored" Schema.schema + <*> ucgMissingLegalholdConsent Schema..= Schema.field "ucgMissingLegalholdConsent" Schema.schema + <*> ucgTotal Schema..= Schema.field "ucgTotal" Schema.schema + +doubleMaybeToEither :: Monad m => LText -> Maybe a -> Maybe b -> ExceptT Error m (Either a b) +doubleMaybeToEither _ (Just a) Nothing = pure $ Left a +doubleMaybeToEither _ Nothing (Just b) = pure $ Right b +doubleMaybeToEither msg _ _ = throwE $ mkError status400 "either-params" ("Must use exactly one of two query params: " <> msg) + +type MkFeatureGetRoute (feature :: *) = + Summary "Shows whether a feature flag is enabled or not for a given team." + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> FeatureSymbol feature + :> Get '[JSON] (WithStatus feature) + +type MkFeaturePutRouteTrivialConfigNoTTL (feature :: *) = + Summary "Disable / enable status for a given feature / team" + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> FeatureSymbol feature + :> QueryParam' [Required, Strict] "status" FeatureStatus + :> Put '[JSON] NoContent + +type MkFeaturePutRouteTrivialConfigWithTTL (feature :: *) = + Summary "Disable / enable status for a given feature / team" + :> Description "team feature time to live, given in days, or 'unlimited' (default). only available on *some* features!" + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> FeatureSymbol feature + :> QueryParam' [Required, Strict] "status" FeatureStatus + :> QueryParam' [Required, Strict, Description "team feature time to live, given in days, or 'unlimited' (default)."] "ttl" FeatureTTLDays + :> Put '[JSON] NoContent + +type MkFeaturePutRoute (feature :: *) = + Summary "Disable / enable feature flag for a given team" + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> FeatureSymbol feature + :> ReqBody '[JSON] (WithStatusNoLock feature) + :> Put '[JSON] NoContent diff --git a/tools/stern/src/Stern/API/RoutesLegacy.hs b/tools/stern/src/Stern/API/RoutesLegacy.hs new file mode 100644 index 0000000000..e55e164118 --- /dev/null +++ b/tools/stern/src/Stern/API/RoutesLegacy.hs @@ -0,0 +1,700 @@ +-- 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 . + +-- | FUTUREWORK: remove this module once we don't depend on swagger1.2 for stern any more +module Stern.API.RoutesLegacy (apiDocs) where + +import Data.Aeson hiding (Error, json) +import Data.ByteString.Conversion +import Data.Handle +import Data.Id +import Data.Predicate +import Data.Range +import qualified Data.Schema as S +import Data.Swagger.Build.Api hiding (Response, def, min, response) +import qualified Data.Swagger.Build.Api as Doc +import qualified Data.Text as T +import Data.Text.Encoding (decodeLatin1) +import GHC.TypeLits (KnownSymbol) +import qualified Galley.Types.Teams.Intra as Team +import Imports hiding (head) +import Network.HTTP.Types +import Network.Wai +import Network.Wai.Predicate hiding (Error, reason, setStatus) +import Network.Wai.Routing hiding (trace) +import Network.Wai.Utilities +import Network.Wai.Utilities.Swagger (document, mkSwaggerApi) +import Stern.API.Predicates +import Stern.App +import qualified Stern.Intra as Intra +import qualified Stern.Swagger as Doc +import Stern.Types +import Wire.API.Team.Feature hiding (setStatus) +import qualified Wire.API.Team.Feature as Public +import Wire.API.Team.SearchVisibility +import qualified Wire.API.Team.SearchVisibility as Public +import Wire.API.User +import qualified Wire.Swagger as Doc + +apiDocs :: ByteString -> Value +apiDocs url = toJSON $ mkSwaggerApi (decodeLatin1 url) Doc.sternModels routes + +routes :: Routes Doc.ApiBuilder Handler () +routes = do + post "/users/:uid/suspend" (continue suspendUser') $ + capture "uid" + document "POST" "users/:uid/suspend" $ do + Doc.summary "Suspends user with this ID" + Doc.parameter Doc.Path "uid" Doc.bytes' $ + Doc.description "User ID" + Doc.response 200 "User successfully suspended" Doc.end + Doc.response 400 "Bad request" (Doc.model Doc.errorModel) + Doc.response 404 "Account not found" (Doc.model Doc.errorModel) + + post "/users/:uid/unsuspend" (continue unsuspendUser') $ + capture "uid" + document "POST" "users/:uid/unsuspend" $ do + Doc.summary "Unsuspends user with this ID" + Doc.parameter Doc.Path "uid" Doc.bytes' $ + Doc.description "User ID" + Doc.response 200 "User successfully unsuspended" Doc.end + Doc.response 400 "Bad request" (Doc.model Doc.errorModel) + Doc.response 404 "Account not found" (Doc.model Doc.errorModel) + + get "/users" (continue usersByEmail') $ + param "email" + document "GET" "users/by-email" $ do + Doc.summary "Displays user's info given an email address" + Doc.parameter Doc.Query "email" Doc.string' $ + Doc.description "Email address" + Doc.response 200 "List of users" Doc.end + + get + "/users" + (continue usersByPhone') + phoneParam + document "GET" "users/by-phone" $ do + Doc.summary "Displays user's info given a phone number" + Doc.parameter Doc.Query "phone" Doc.string' $ + Doc.description "Phone number" + Doc.response 200 "List of users" Doc.end + + get "/users" (continue usersByIds') $ + param "ids" + document "GET" "users/by-ids" $ do + Doc.summary "Displays active users info given a list of ids" + Doc.parameter Doc.Query "ids" Doc.string' $ + Doc.description "ID of the user" + Doc.response 200 "List of users" Doc.end + + get "/users" (continue usersByHandles') $ + param "handles" + document "GET" "users/by-handles" $ do + Doc.summary "Displays active users info given a list of handles" + Doc.parameter Doc.Query "handles" Doc.string' $ + Doc.description "Handle of the user" + Doc.response 200 "List of users" Doc.end + + get "/users/:uid/connections" (continue userConnections') $ + capture "uid" + document "GET" "users/:uid/connections" $ do + Doc.summary "Displays user's connections" + Doc.parameter Doc.Path "uid" Doc.bytes' $ + description "User ID" + Doc.response 200 "List of user's connections" Doc.end + + get "/users/connections" (continue usersConnections') $ + param "ids" + document "GET" "users/connections" $ do + Doc.summary "Displays users connections given a list of ids" + Doc.parameter Doc.Query "ids" Doc.string' $ + Doc.description "IDs of the users" + Doc.response 200 "List of users connections" Doc.end + + get "/users/:uid/search" (continue searchOnBehalf') $ + capture "uid" + .&. def "" (query "q") + .&. def (unsafeRange 10) (query "size") + document "GET" "search" $ do + summary "Search for users on behalf of" + Doc.parameter Doc.Path "uid" Doc.bytes' $ + description "User ID" + Doc.parameter Query "q" string' $ do + description "Search query" + optional + Doc.parameter Query "size" int32' $ do + description "Number of results to return" + optional + Doc.response 200 "List of users" Doc.end + + post "/users/revoke-identity" (continue revokeIdentity') $ + param "email" ||| phoneParam + document "POST" "revokeIdentity" $ do + Doc.summary "Revoke a verified user identity." + Doc.notes + "Forcefully revokes a verified user identity. \ + \WARNING: If the given identity is the only verified \ + \user identity of an account, the account will be \ + \deactivated (\"wireless\") and might thus become inaccessible. \ + \If the given identity is not taken / verified, this is a no-op." + Doc.parameter Doc.Query "email" Doc.string' $ do + Doc.description "A verified email address" + Doc.optional + Doc.parameter Doc.Query "phone" Doc.string' $ do + Doc.description "A verified phone number (E.164 format)." + Doc.optional + Doc.response 200 "Identity revoked or not verified / taken." Doc.end + Doc.response 400 "Bad request" (Doc.model Doc.errorModel) + + put "/users/:uid/email" (continue changeEmail') $ + contentType "application" "json" + .&. capture "uid" + .&. def False (query "validate") + .&. jsonRequest @EmailUpdate + document "PUT" "changeEmail" $ do + Doc.summary "Change a user's email address." + Doc.notes + "The new e-mail address must be verified \ + \before the change takes effect." + Doc.parameter Doc.Path "uid" Doc.bytes' $ + Doc.description "User ID" + Doc.parameter Doc.Query "validate" Doc.bool' $ do + Doc.description "If set to true, a validation email will be sent to the new email address" + Doc.optional + Doc.body (Doc.ref Doc.emailUpdate) $ + Doc.description "JSON body" + Doc.response 200 "Change of email address initiated." Doc.end + Doc.response 400 "Bad request" (Doc.model Doc.errorModel) + + put "/users/:uid/phone" (continue changePhone') $ + contentType "application" "json" + .&. capture "uid" + .&. jsonRequest @PhoneUpdate + document "PUT" "changePhone" $ do + Doc.summary "Change a user's phone number." + Doc.notes + "The new phone number must be verified \ + \before the change takes effect." + Doc.parameter Doc.Path "uid" Doc.bytes' $ + Doc.description "User ID" + Doc.body (Doc.ref Doc.phoneUpdate) $ + Doc.description "JSON body" + Doc.response 200 "Change of phone number initiated." Doc.end + Doc.response 400 "Bad request" (Doc.model Doc.errorModel) + + delete "/users/:uid" (continue deleteUser') $ + capture "uid" + .&. (query "email" ||| phoneParam) + document "DELETE" "deleteUser" $ do + summary "Delete a user (irrevocable!)" + Doc.notes "Email or Phone must match UserId's (to prevent copy/paste mistakes)" + Doc.parameter Doc.Path "uid" Doc.bytes' $ + description "User ID" + Doc.parameter Doc.Query "email" Doc.string' $ do + Doc.description "Matching verified email address" + Doc.optional + Doc.parameter Doc.Query "phone" Doc.string' $ do + Doc.description "Matching verified phone number (E.164 format)." + Doc.optional + Doc.response 200 "Account deleted" Doc.end + Doc.response 400 "Bad request" (Doc.model Doc.errorModel) + + put "/teams/:tid/suspend" (continue (setTeamStatusH' Team.Suspended)) $ + capture "tid" + document "PUT" "setTeamStatusH:suspended" $ do + summary "Suspend a team." + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.response 200 mempty Doc.end + + put "/teams/:tid/unsuspend" (continue (setTeamStatusH' Team.Active)) $ + capture "tid" + document "PUT" "setTeamStatusH:active" $ do + summary "Set a team status to 'Active', independently on previous status. (Cannot be used to un-delete teams, though.)" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.response 200 mempty Doc.end + + delete "/teams/:tid" (continue deleteTeam') $ + capture "tid" + .&. def False (query "force") + .&. opt (query "email") + document "DELETE" "deleteTeam" $ do + summary "Delete a team (irrevocable!). You can only delete teams with 1 user unless you use the 'force' query flag" + Doc.notes + "The email address of the user must be provided to prevent copy/paste mistakes.\n\ + \The force query flag can be used to delete teams with more than one user. CAUTION: FORCE DELETE WILL PERMANENTLY DELETE ALL TEAM MEMBERS! CHECK TEAM MEMBER LIST (SEE ABOVE OR BELOW) IF YOU ARE UNCERTAIN THAT'S WHAT YOU WANT." + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.parameter Doc.Query "force" Doc.bool' $ do + Doc.description "THIS WILL PERMANENTLY DELETE ALL TEAM MEMBERS! CHECK TEAM MEMBER LIST (SEE ABOVE OR BELOW) IF YOU ARE UNCERTAIN THAT'S WHAT YOU WANT." + optional + Doc.parameter Doc.Query "email" Doc.string' $ do + Doc.description "Matching verified remaining user address" + Doc.optional + Doc.response 202 "Team scheduled for deletion" Doc.end + Doc.response 404 "No such user with that email" (Doc.model Doc.errorModel) + Doc.response 404 "No such binding team" (Doc.model Doc.errorModel) + Doc.response 403 "Only teams with 1 user can be deleted" (Doc.model Doc.errorModel) + Doc.response 404 "Binding team mismatch" (Doc.model Doc.errorModel) + + get "/ejpd-info" (continue ejpdInfoByHandles') $ + param "handles" + .&. def False (query "include_contacts") + document "GET" "ejpd-info" $ do + Doc.summary "internal wire.com process: https://wearezeta.atlassian.net/wiki/spaces/~463749889/pages/256738296/EJPD+official+requests+process" + Doc.parameter Doc.Query "handles" Doc.string' $ + Doc.description "Handles of the user, separated by commas (NB: all chars need to be lower case!)" + Doc.parameter Doc.Query "include_contacts" Doc.bool' $ do + Doc.description "If 'true', this gives you more more exhaustive information about this user (including social network)" + Doc.optional + Doc.response 200 "Required information about the listed users (where found)" Doc.end + + head "/users/blacklist" (continue isUserKeyBlacklisted) $ + (query "email" ||| phoneParam) + document "HEAD" "checkBlacklistStatus" $ do + summary "Fetch blacklist information on a email/phone" + Doc.parameter Doc.Query "email" Doc.string' $ do + Doc.description "An email address to check" + Doc.optional + Doc.parameter Doc.Query "phone" Doc.string' $ do + Doc.description "A phone to check" + Doc.optional + Doc.response 200 "The email/phone IS blacklisted" Doc.end + Doc.response 404 "The email/phone is NOT blacklisted" Doc.end + + post "/users/blacklist" (continue addBlacklist) $ + (query "email" ||| phoneParam) + document "POST" "addToBlacklist" $ do + summary "Add the email/phone to our blacklist" + Doc.parameter Doc.Query "email" Doc.string' $ do + Doc.description "An email address to add" + Doc.optional + Doc.parameter Doc.Query "phone" Doc.string' $ do + Doc.description "A phone to add" + Doc.optional + Doc.response 200 "Operation succeeded" Doc.end + + delete "/users/blacklist" (continue deleteFromBlacklist) $ + (query "email" ||| phoneParam) + document "DELETE" "deleteFromBlacklist" $ do + summary "Remove the email/phone from our blacklist" + Doc.parameter Doc.Query "email" Doc.string' $ do + Doc.description "An email address to remove" + Doc.optional + Doc.parameter Doc.Query "phone" Doc.string' $ do + Doc.description "A phone to remove" + Doc.optional + Doc.response 200 "Operation succeeded" Doc.end + + get "/teams" (continue getTeamInfoByMemberEmail) $ + param "email" + document "GET" "getTeamInfoByMemberEmail" $ do + summary "Fetch a team information given a member's email" + Doc.parameter Doc.Query "email" Doc.string' $ + Doc.description "A verified email address" + Doc.response 200 "Team Information" Doc.end + + get "/teams/:tid" (continue getTeamInfo) $ + capture "tid" + document "GET" "getTeamInfo" $ do + summary "Gets information about a team" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.response 200 "Team Information" Doc.end + + get "/teams/:tid/admins" (continue getTeamAdminInfo) $ + capture "tid" + document "GET" "getTeamAdminInfo" $ do + summary "Gets information about a team's owners and admins only" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.response 200 "Team Information about Owners and Admins" Doc.end + + mkFeatureGetRoute @LegalholdConfig + mkFeaturePutRouteTrivialConfig @LegalholdConfig + + mkFeatureGetRoute @SSOConfig + mkFeaturePutRouteTrivialConfig @SSOConfig + + mkFeatureGetRoute @SearchVisibilityAvailableConfig + mkFeaturePutRouteTrivialConfig @SearchVisibilityAvailableConfig + + mkFeatureGetRoute @ValidateSAMLEmailsConfig + mkFeaturePutRouteTrivialConfig @ValidateSAMLEmailsConfig + + mkFeatureGetRoute @DigitalSignaturesConfig + mkFeaturePutRouteTrivialConfig @DigitalSignaturesConfig + + mkFeatureGetRoute @FileSharingConfig + mkFeaturePutRouteTrivialConfig @FileSharingConfig + + mkFeatureGetRoute @ClassifiedDomainsConfig + + mkFeatureGetRoute @ConferenceCallingConfig + mkFeaturePutRouteTrivialConfig' @ConferenceCallingConfig TtlEnabled + + mkFeatureGetRoute @AppLockConfig + mkFeaturePutRoute @AppLockConfig + + mkFeatureGetRoute @MLSConfig + mkFeaturePutRoute @MLSConfig + + -- These endpoints should be part of team settings. Until then, we access them from here + -- for authorized personnel to enable/disable this on the team's behalf + get "/teams/:tid/search-visibility" (continue (fmap json . Intra.getSearchVisibility)) $ + capture "tid" + document "GET" "getSearchVisibility" $ do + summary "Shows the current TeamSearchVisibility value for the given team" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.returns (Doc.ref Public.modelTeamSearchVisibility) + Doc.response 200 "TeamSearchVisibility value" Doc.end + put "/teams/:tid/search-visibility" (continue setSearchVisibility) $ + contentType "application" "json" + .&. capture "tid" + .&. jsonRequest @TeamSearchVisibility + document "PUT" "setSearchVisibility" $ do + summary "Set specific search visibility for the team" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.body Public.typeSearchVisibility $ + Doc.description "JSON body" + Doc.response 200 "TeamSearchVisibility status set" Doc.end + + -- The following endpoint are only relevant internally at Wire + + get "/teams/:tid/invoices/:inr" (continue getTeamInvoice) $ + capture "tid" + .&. capture "inr" + .&. accept "application" "json" + document "GET" "getTeamInvoice" $ do + summary "Get a specific invoice by Number" + notes "Relevant only internally at Wire" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + Doc.description "Team ID" + Doc.parameter Doc.Path "inr" Doc.string' $ + Doc.description "Invoice Number" + Doc.response 307 "Redirect to PDF download" Doc.end + + get "/teams/:tid/billing" (continue getTeamBillingInfo) $ + capture "tid" + document "GET" "getTeamBillingInfo" $ do + summary "Gets billing information about a team" + notes "Relevant only internally at Wire" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.response 200 "Team Billing Information" Doc.end + Doc.response 404 "No team or no billing info for given team" Doc.end + Doc.returns (Doc.ref Doc.teamBillingInfo) + + put "/teams/:tid/billing" (continue updateTeamBillingInfo) $ + contentType "application" "json" + .&. capture "tid" + .&. jsonRequest @TeamBillingInfoUpdate + document "PUT" "updateTeamBillingInfo" $ do + summary + "Updates billing information about a team. Non \ + \specified fields will NOT be updated" + notes "Relevant only internally at Wire" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.body (Doc.ref Doc.teamBillingInfoUpdate) $ + Doc.description "JSON body" + Doc.response 200 "Updated Team Billing Information" Doc.end + Doc.returns (Doc.ref Doc.teamBillingInfo) + + post "/teams/:tid/billing" (continue setTeamBillingInfo) $ + contentType "application" "json" + .&. capture "tid" + .&. jsonRequest @TeamBillingInfo + document "POST" "setTeamBillingInfo" $ do + summary + "Sets billing information about a team. Can \ + \only be used on teams that do NOT have any \ + \billing information set. To update team billing \ + \info, use the update endpoint" + notes "Relevant only internally at Wire" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.body (Doc.ref Doc.teamBillingInfo) $ + Doc.description "JSON body" + Doc.response 200 "Updated Team Billing Information" Doc.end + Doc.returns (Doc.ref Doc.teamBillingInfo) + + get "/i/consent" (continue getConsentLog) $ + param "email" + document "GET" "getConsentLog" $ do + summary "Fetch the consent log given an email address of a non-user" + notes "Relevant only internally at Wire" + Doc.parameter Doc.Query "email" Doc.string' $ + Doc.description "An email address" + Doc.response 200 "Consent Log" Doc.end + Doc.response 403 "Access denied! There is a user with this email address" Doc.end + + get "/i/user/meta-info" (continue getUserData) $ + param "id" + document "GET" "getUserMetaInfo" $ do + summary "Fetch a user's meta info given a user id: TEMPORARY!" + notes "Relevant only internally at Wire" + Doc.parameter Doc.Query "id" Doc.bytes' $ + Doc.description "A user's ID" + Doc.response 200 "Meta Info" Doc.end + +suspendUser' :: UserId -> Handler Response +suspendUser' = undefined + +unsuspendUser' :: UserId -> Handler Response +unsuspendUser' = undefined + +usersByEmail' :: Email -> Handler Response +usersByEmail' = undefined + +usersByPhone' :: Phone -> Handler Response +usersByPhone' = undefined + +usersByIds' :: List UserId -> Handler Response +usersByIds' = undefined + +usersByHandles' :: List Handle -> Handler Response +usersByHandles' = undefined + +ejpdInfoByHandles' :: (List Handle ::: Bool) -> Handler Response +ejpdInfoByHandles' = undefined + +userConnections' :: UserId -> Handler Response +userConnections' = undefined + +usersConnections' :: List UserId -> Handler Response +usersConnections' = undefined + +searchOnBehalf' :: UserId ::: T.Text ::: Range 1 100 Int32 -> Handler Response +searchOnBehalf' = undefined + +revokeIdentity' :: Either Email Phone -> Handler Response +revokeIdentity' = undefined + +changeEmail' :: JSON ::: UserId ::: Bool ::: JsonRequest EmailUpdate -> Handler Response +changeEmail' = undefined + +changePhone' :: JSON ::: UserId ::: JsonRequest PhoneUpdate -> Handler Response +changePhone' = undefined + +deleteUser' :: UserId ::: Either Email Phone -> Handler Response +deleteUser' = undefined + +setTeamStatusH' :: Team.TeamStatus -> TeamId -> Handler Response +setTeamStatusH' = undefined + +deleteTeam' :: TeamId ::: Bool ::: Maybe Email -> Handler Response +deleteTeam' = undefined + +isUserKeyBlacklisted :: Either Email Phone -> Handler Response +isUserKeyBlacklisted = undefined + +addBlacklist :: Either Email Phone -> Handler Response +addBlacklist = undefined + +deleteFromBlacklist :: Either Email Phone -> Handler Response +deleteFromBlacklist = undefined + +getTeamInfo :: TeamId -> Handler Response +getTeamInfo = undefined + +getTeamAdminInfo :: TeamId -> Handler Response +getTeamAdminInfo = undefined + +setSearchVisibility :: JSON ::: TeamId ::: JsonRequest TeamSearchVisibility -> Handler Response +setSearchVisibility = undefined + +getTeamBillingInfo :: TeamId -> Handler Response +getTeamBillingInfo = undefined + +updateTeamBillingInfo :: JSON ::: TeamId ::: JsonRequest TeamBillingInfoUpdate -> Handler Response +updateTeamBillingInfo = undefined + +setTeamBillingInfo :: JSON ::: TeamId ::: JsonRequest TeamBillingInfo -> Handler Response +setTeamBillingInfo = undefined + +getTeamInfoByMemberEmail :: Email -> Handler Response +getTeamInfoByMemberEmail = undefined + +getTeamInvoice :: TeamId ::: InvoiceId ::: JSON -> Handler Response +getTeamInvoice = undefined + +getConsentLog :: Email -> Handler Response +getConsentLog = undefined + +getUserData :: UserId -> Handler Response +getUserData = undefined + +data SupportsTtl = TtlEnabled | TtlDisabled + +type JSON = Media "application" "json" + +mkFeatureGetRoute :: + forall cfg. + ( IsFeatureConfig cfg, + S.ToSchema cfg, + KnownSymbol (FeatureSymbol cfg), + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + Routes Doc.ApiBuilder Handler () +mkFeatureGetRoute = do + get ("/teams/:tid/features/" <> featureNameBS @cfg) (continue (getTeamFeatureFlagH @cfg)) $ + capture "tid" + document "GET" "getTeamFeatureFlag" $ do + summary "Shows whether a feature flag is enabled or not for a given team." + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.returns (Doc.ref (withStatusModel @cfg)) + Doc.response 200 "Team feature flag status" Doc.end + +mkFeaturePutRoute :: + forall cfg. + ( IsFeatureConfig cfg, + S.ToSchema cfg, + KnownSymbol (FeatureSymbol cfg), + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + Routes Doc.ApiBuilder Handler () +mkFeaturePutRoute = do + put ("/teams/:tid/features/" <> featureNameBS @cfg) (continue (setTeamFeatureFlagH @cfg)) $ + capture "tid" + .&. jsonRequest @(WithStatusNoLock cfg) + .&. accept "application" "json" + document "PUT" "setTeamFeatureFlag" $ do + summary "Disable / enable feature flag for a given team" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.body (Doc.ref (withStatusNoLockModel @cfg)) $ + Doc.description "JSON body" + Doc.response 200 "Team feature flag status" Doc.end + +getTeamFeatureFlagH :: + forall cfg. + ( IsFeatureConfig cfg, + S.ToSchema cfg, + KnownSymbol (FeatureSymbol cfg), + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + TeamId -> + Handler Response +getTeamFeatureFlagH tid = + json <$> Intra.getTeamFeatureFlag @cfg tid + +setTeamFeatureFlagH :: + forall cfg. + ( IsFeatureConfig cfg, + KnownSymbol (FeatureSymbol cfg), + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable (WithStatusNoLock cfg) + ) => + TeamId ::: JsonRequest (WithStatusNoLock cfg) ::: JSON -> + Handler Response +setTeamFeatureFlagH (tid ::: req ::: _) = do + status :: WithStatusNoLock cfg <- parseBody req !>> mkError status400 "client-error" + empty <$ Intra.setTeamFeatureFlag @cfg tid status + +mkFeaturePutRouteTrivialConfig :: + forall cfg. + ( IsFeatureConfig cfg, + FeatureTrivialConfig cfg, + KnownSymbol (FeatureSymbol cfg), + S.ToSchema cfg, + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + Routes Doc.ApiBuilder Handler () +mkFeaturePutRouteTrivialConfig = mkFeaturePutRouteTrivialConfig' @cfg TtlDisabled + +mkFeaturePutRouteTrivialConfig' :: + forall cfg. + ( IsFeatureConfig cfg, + FeatureTrivialConfig cfg, + KnownSymbol (FeatureSymbol cfg), + S.ToSchema cfg, + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + SupportsTtl -> + Routes Doc.ApiBuilder Handler () +mkFeaturePutRouteTrivialConfig' ttlSupport = do + handler + document "PUT" "setTeamFeatureFlag" $ do + summary "Disable / enable feature flag for a given team" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.parameter Doc.Query "status" typeFeatureStatus $ do + Doc.description "team feature status (enabled or disabled)" + case ttlSupport of + TtlEnabled -> Doc.parameter Doc.Query "ttl" Public.typeFeatureTTL $ do + Doc.description "team feature time to live, given in days, or 'unlimited' (default). Only applies to conference calling. It's ignored by other features." + TtlDisabled -> pure () + Doc.response 200 "Team feature flag status" Doc.end + where + handler = case ttlSupport of + TtlEnabled -> + put ("/teams/:tid/features/" <> featureNameBS @cfg) (continue (setTeamFeatureFlagTrivialConfigH @cfg)) $ + capture "tid" + .&. param "status" + .&. def Public.FeatureTTLUnlimited (query "ttl") + TtlDisabled -> + put ("/teams/:tid/features/" <> featureNameBS @cfg) (continue (setTeamFeatureFlagTrivialConfigHNoTtl @cfg)) $ + capture "tid" + .&. param "status" + +setTeamFeatureFlagTrivialConfigHNoTtl :: + forall cfg. + ( IsFeatureConfig cfg, + FeatureTrivialConfig cfg, + KnownSymbol (FeatureSymbol cfg), + S.ToSchema cfg, + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + TeamId ::: FeatureStatus -> + Handler Response +setTeamFeatureFlagTrivialConfigHNoTtl (tid ::: featureStatus) = do + let status = WithStatusNoLock featureStatus trivialConfig FeatureTTLUnlimited + empty <$ Intra.setTeamFeatureFlag @cfg tid status + +setTeamFeatureFlagTrivialConfigH :: + forall cfg. + ( IsFeatureConfig cfg, + FeatureTrivialConfig cfg, + KnownSymbol (FeatureSymbol cfg), + S.ToSchema cfg, + FromJSON (WithStatusNoLock cfg), + ToJSON (WithStatusNoLock cfg), + Typeable cfg + ) => + TeamId ::: FeatureStatus ::: FeatureTTL' 'FeatureTTLUnitDays -> + Handler Response +setTeamFeatureFlagTrivialConfigH (tid ::: featureStatus ::: ttl) = do + let status = WithStatusNoLock featureStatus trivialConfig (convertFeatureTTLDaysToSeconds ttl) + empty <$ Intra.setTeamFeatureFlag @cfg tid status diff --git a/tools/stern/src/Stern/Types.hs b/tools/stern/src/Stern/Types.hs index f51c98dd0c..b4300b1889 100644 --- a/tools/stern/src/Stern/Types.hs +++ b/tools/stern/src/Stern/Types.hs @@ -25,36 +25,48 @@ module Stern.Types where +import Control.Lens ((?~)) import Data.Aeson -import qualified Data.Aeson.KeyMap as KeyMap import Data.Aeson.TH import Data.ByteString.Conversion import Data.Json.Util +import Data.Proxy import Data.Range +import qualified Data.Schema as S +import qualified Data.Swagger as Swagger import Galley.Types.Teams import Galley.Types.Teams.Intra (TeamData) import Imports +import Servant.API import Wire.API.Properties import Wire.API.Team.Member import Wire.API.Team.Permission newtype TeamMemberInfo = TeamMemberInfo {tm :: TeamMember} + deriving (Eq, Show, Generic) + deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamMemberInfo -instance ToJSON TeamMemberInfo where - toJSON (TeamMemberInfo m) = - case teamMemberJson (const True) m of - Object o -> - Object $ - KeyMap.insert "can_update_billing" (Bool (hasPermission m SetBilling)) $ - KeyMap.insert "can_view_billing" (Bool (hasPermission m GetBilling)) $ - o - other -> - error $ "toJSON TeamMemberInfo: not an object: " <> show (encode other) +instance S.ToSchema TeamMemberInfo where + schema = + S.object "TeamMemberInfo" $ + TeamMemberInfo + <$> tm S..= teamMemberObjectSchema + <* ((`hasPermission` SetBilling) . tm) S..= S.field "can_update_billing" S.schema + <* ((`hasPermission` GetBilling) . tm) S..= S.field "can_view_billing" S.schema data TeamInfo = TeamInfo { tiData :: TeamData, tiMembers :: [TeamMemberInfo] } + deriving (Eq, Show, Generic) + deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamInfo + +instance S.ToSchema TeamInfo where + schema = + S.object "TeamInfo" $ + TeamInfo + <$> tiData S..= S.field "info" S.schema + <*> tiMembers S..= S.field "members" (S.array S.schema) data TeamAdminInfo = TeamAdminInfo { taData :: TeamData, @@ -62,6 +74,17 @@ data TeamAdminInfo = TeamAdminInfo taAdmins :: [TeamMemberInfo], taMembers :: Int } + deriving (Eq, Show, Generic) + deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamAdminInfo + +instance S.ToSchema TeamAdminInfo where + schema = + S.object "TeamAdminInfo" $ + TeamAdminInfo + <$> taData S..= S.field "data" S.schema + <*> taOwners S..= S.field "owners" (S.array S.schema) + <*> taAdmins S..= S.field "admins" (S.array S.schema) + <*> taMembers S..= S.field "total_members" S.schema toAdminInfo :: TeamInfo -> TeamAdminInfo toAdminInfo (TeamInfo d members) = @@ -79,22 +102,6 @@ isOwner m = hasPermission m SetBilling isAdmin :: TeamMember -> Bool isAdmin m = hasPermission m AddTeamMember && not (hasPermission m SetBilling) -instance ToJSON TeamInfo where - toJSON (TeamInfo d m) = - object - [ "info" .= d, - "members" .= m - ] - -instance ToJSON TeamAdminInfo where - toJSON (TeamAdminInfo d o a m) = - object - [ "info" .= d, - "owners" .= o, - "admins" .= a, - "total_members" .= m - ] - newtype UserProperties = UserProperties { unUserProperties :: Map PropertyKey Value } @@ -116,6 +123,13 @@ newtype ConsentLog = ConsentLog } deriving (Eq, Show, ToJSON, FromJSON) +instance Swagger.ToSchema ConsentLog where + declareNamedSchema _ = + pure . Swagger.NamedSchema (Just "ConsentLog") $ + mempty + & Swagger.type_ ?~ Swagger.SwaggerObject + & Swagger.description ?~ "(object structure is not specified in this schema)" + newtype ConsentValue = ConsentValue { unConsentValue :: Object } @@ -126,9 +140,45 @@ newtype MarketoResult = MarketoResult } deriving (Eq, Show, ToJSON, FromJSON) +data ConsentLogAndMarketo = ConsentLogAndMarketo + { clamConsentLog :: ConsentLog, + clamMarketo :: MarketoResult + } + deriving (Eq, Show) + +deriveJSON toJSONFieldName ''ConsentLogAndMarketo + +instance Swagger.ToSchema ConsentLogAndMarketo where + declareNamedSchema _ = + pure . Swagger.NamedSchema (Just "ConsentLogAndMarketo") $ + mempty + & Swagger.type_ ?~ Swagger.SwaggerObject + & Swagger.description ?~ "(object structure is not specified in this schema)" + +newtype UserMetaInfo = UserMetaInfo + { unUserMetaInfo :: Object + } + deriving (Eq, Show, ToJSON, FromJSON) + +instance Swagger.ToSchema UserMetaInfo where + declareNamedSchema _ = + pure . Swagger.NamedSchema (Just "UserMetaInfo") $ + mempty + & Swagger.type_ ?~ Swagger.SwaggerObject + & Swagger.description ?~ "(object structure is not specified in this schema)" + newtype InvoiceId = InvoiceId {unInvoiceId :: Text} deriving (Eq, Show, ToByteString, FromByteString, ToJSON, FromJSON) +instance Swagger.ToParamSchema InvoiceId where + toParamSchema _ = Swagger.toParamSchema (Proxy @Text) + +instance FromHttpApiData InvoiceId where + parseUrlPiece = fmap InvoiceId . parseUrlPiece + +instance ToHttpApiData InvoiceId where + toUrlPiece (InvoiceId t) = toUrlPiece t + data TeamBillingInfo = TeamBillingInfo { tbiFirstname :: Text, tbiLastname :: Text, @@ -140,8 +190,20 @@ data TeamBillingInfo = TeamBillingInfo tbiState :: Maybe Text } deriving (Eq, Show) - -deriveJSON toJSONFieldName ''TeamBillingInfo + deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamBillingInfo + +instance S.ToSchema TeamBillingInfo where + schema = + S.object "TeamBillingInfo" $ + TeamBillingInfo + <$> tbiFirstname S..= S.field "firstname" S.schema + <*> tbiLastname S..= S.field "lastname" S.schema + <*> tbiStreet S..= S.field "street" S.schema + <*> tbiZip S..= S.field "zip" S.schema + <*> tbiCity S..= S.field "city" S.schema + <*> tbiCountry S..= S.field "country" S.schema + <*> tbiCompany S..= S.maybe_ (S.optField "company" S.schema) + <*> tbiState S..= S.maybe_ (S.optField "state" S.schema) data TeamBillingInfoUpdate = TeamBillingInfoUpdate { tbiuFirstname :: Maybe (Range 1 256 Text), @@ -154,5 +216,19 @@ data TeamBillingInfoUpdate = TeamBillingInfoUpdate tbiuState :: Maybe (Range 1 256 Text) } deriving (Eq, Show) - -deriveJSON toJSONFieldName ''TeamBillingInfoUpdate + deriving (ToJSON, FromJSON, Swagger.ToSchema) via S.Schema TeamBillingInfoUpdate + +instance S.ToSchema TeamBillingInfoUpdate where + schema = + S.object "TeamBillingInfoUpdate" $ + TeamBillingInfoUpdate + <$> tbiuFirstname S..= tbiuField "firstname" + <*> tbiuLastname S..= tbiuField "lastname" + <*> tbiuStreet S..= tbiuField "street" + <*> tbiuZip S..= tbiuField "zip" + <*> tbiuCity S..= tbiuField "city" + <*> tbiuCountry S..= tbiuField "country" + <*> tbiuCompany S..= tbiuField "company" + <*> tbiuState S..= tbiuField "state" + where + tbiuField fnm = S.maybe_ (S.optField fnm S.schema) diff --git a/tools/stern/stern.cabal b/tools/stern/stern.cabal index 3ba2ef6abd..304d91e9dc 100644 --- a/tools/stern/stern.cabal +++ b/tools/stern/stern.cabal @@ -20,6 +20,7 @@ library Stern.API Stern.API.Predicates Stern.API.Routes + Stern.API.RoutesLegacy Stern.App Stern.Intra Stern.Options