From 869c7ac59ae62b6cee35aabe7f44ed8c031c946d Mon Sep 17 00:00:00 2001 From: fisx Date: Mon, 8 Jun 2020 16:27:00 +0200 Subject: [PATCH] Simplify team feature database interface; add validate-saml-emails feature to stern/backoffice (#1129) * Simplify team feature database interface. There was one Data.* module per column in the team_features table. That may make sense at some point in the distant future, but as long as all those columns are just booleans, having one haskell module to access any of them in a uniform way saves a lot of boilerplate. * Use new feature flag types and make a generic end-point in stern. * Add FUTUREWORKs. Co-authored-by: Akshay Mankar --- docs/reference/cassandra-schema.cql | 3 +- services/galley/galley.cabal | 5 +- services/galley/src/Galley/API/LegalHold.hs | 3 +- services/galley/src/Galley/API/Teams.hs | 27 ++-- services/galley/src/Galley/Data/LegalHold.hs | 19 +-- services/galley/src/Galley/Data/Queries.hs | 31 ---- services/galley/src/Galley/Data/SSO.hs | 45 ------ .../src/Galley/Data/SearchVisibility.hs | 15 +- .../galley/src/Galley/Data/TeamFeatures.hs | 51 +++++++ .../src/Galley/Data/ValidateSAMLEmails.hs | 42 ------ services/galley/test/integration/API/Teams.hs | 5 + tools/stern/src/Stern/API.hs | 92 ++++-------- tools/stern/src/Stern/Intra.hs | 138 +++--------------- tools/stern/src/Stern/Swagger.hs | 16 -- tools/stern/src/Stern/Types.hs | 18 --- 15 files changed, 121 insertions(+), 389 deletions(-) delete mode 100644 services/galley/src/Galley/Data/SSO.hs create mode 100644 services/galley/src/Galley/Data/TeamFeatures.hs delete mode 100644 services/galley/src/Galley/Data/ValidateSAMLEmails.hs diff --git a/docs/reference/cassandra-schema.cql b/docs/reference/cassandra-schema.cql index 5bbcdd886c5..3a62c2e5288 100644 --- a/docs/reference/cassandra-schema.cql +++ b/docs/reference/cassandra-schema.cql @@ -105,7 +105,8 @@ CREATE TABLE galley_test.team_features ( team_id uuid PRIMARY KEY, legalhold_status int, search_visibility_status int, - sso_status int + sso_status int, + validate_saml_emails int ) WITH bloom_filter_fp_chance = 0.1 AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} AND comment = '' diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index d37aa096ee3..633e053fb66 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ea8a2731dc5ada81ea4a4bfed991318a463ea1bdc8af1b5ae12836565ce2cb19 +-- hash: 92456c44f0413d6ce65ee41f0b151adcc8a84a465cd9b05e3be17b1917c8f551 name: galley version: 0.83.0 @@ -48,10 +48,9 @@ library Galley.Data.Queries Galley.Data.SearchVisibility Galley.Data.Services - Galley.Data.SSO + Galley.Data.TeamFeatures Galley.Data.TeamNotifications Galley.Data.Types - Galley.Data.ValidateSAMLEmails Galley.External Galley.External.LegalHoldService Galley.Intra.Client diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 6ecf802f509..1c32218de16 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -42,6 +42,7 @@ import Galley.API.Util import Galley.App import qualified Galley.Data as Data import qualified Galley.Data.LegalHold as LegalHoldData +import qualified Galley.Data.TeamFeatures as TeamFeatures import qualified Galley.External.LegalHoldService as LHService import qualified Galley.Intra.Client as Client import Galley.Types.Teams as Team @@ -60,7 +61,7 @@ assertLegalHoldEnabled tid = unlessM (isLegalHoldEnabled tid) $ throwM legalHold isLegalHoldEnabled :: TeamId -> Galley Bool isLegalHoldEnabled tid = do - lhConfig <- LegalHoldData.getLegalHoldTeamConfig tid + lhConfig <- TeamFeatures.getFlag tid Public.TeamFeatureLegalHold return $ case lhConfig of Just Public.TeamFeatureEnabled -> True Just Public.TeamFeatureDisabled -> False diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 73eae30ec23..c8ba67affa8 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -77,12 +77,10 @@ import qualified Galley.API.TeamNotifications as APITeamQueue import Galley.API.Util import Galley.App import qualified Galley.Data as Data -import qualified Galley.Data.LegalHold as LegalHoldData -import qualified Galley.Data.SSO as SSOData import qualified Galley.Data.SearchVisibility as SearchVisibilityData import Galley.Data.Services (BotMember) +import qualified Galley.Data.TeamFeatures as TeamFeatures import qualified Galley.Data.Types as Data -import qualified Galley.Data.ValidateSAMLEmails as ValidateSAMLEmailsData import qualified Galley.External as External import qualified Galley.Intra.Journal as Journal import Galley.Intra.Push @@ -896,7 +894,7 @@ getSSOStatusInternal tid = do pure $ case featureSSO of FeatureSSOEnabledByDefault -> Public.TeamFeatureEnabled FeatureSSODisabledByDefault -> Public.TeamFeatureDisabled - ssoTeamConfig <- SSOData.getSSOTeamConfig tid + ssoTeamConfig <- TeamFeatures.getFlag tid Public.TeamFeatureSSO pure . fromMaybe defConfig $ ssoTeamConfig setSSOStatusInternal :: TeamId -> Public.TeamFeatureStatus -> Galley () @@ -904,14 +902,14 @@ setSSOStatusInternal tid ssoTeamConfig = do case ssoTeamConfig of Public.TeamFeatureDisabled -> throwM disableSsoNotImplemented Public.TeamFeatureEnabled -> pure () -- this one is easy to implement :) - SSOData.setSSOTeamConfig tid ssoTeamConfig + TeamFeatures.setFlag tid Public.TeamFeatureSSO ssoTeamConfig getLegalholdStatusInternal :: TeamId -> Galley Public.TeamFeatureStatus getLegalholdStatusInternal tid = do featureLegalHold <- view (options . optSettings . setFeatureFlags . flagLegalHold) case featureLegalHold of FeatureLegalHoldDisabledByDefault -> do - legalHoldTeamConfig <- LegalHoldData.getLegalHoldTeamConfig tid + legalHoldTeamConfig <- TeamFeatures.getFlag tid Public.TeamFeatureLegalHold pure (fromMaybe Public.TeamFeatureDisabled legalHoldTeamConfig) FeatureLegalHoldDisabledPermanently -> do pure Public.TeamFeatureDisabled @@ -929,7 +927,7 @@ setLegalholdStatusInternal tid legalHoldTeamConfig = do Public.TeamFeatureDisabled -> removeSettings' tid -- FUTUREWORK: We cannot enable legalhold on large teams right now Public.TeamFeatureEnabled -> checkTeamSize - LegalHoldData.setLegalHoldTeamConfig tid legalHoldTeamConfig + TeamFeatures.setFlag tid Public.TeamFeatureLegalHold legalHoldTeamConfig where checkTeamSize = do (TeamSize size) <- BrigTeam.getSize tid @@ -945,23 +943,24 @@ getTeamSearchVisibilityAvailableInternal tid = do pure $ case featureTeamSearchVisibility of FeatureTeamSearchVisibilityEnabledByDefault -> Public.TeamFeatureEnabled FeatureTeamSearchVisibilityDisabledByDefault -> Public.TeamFeatureDisabled - fromMaybe defConfig <$> SearchVisibilityData.getTeamSearchVisibilityAvailable tid + fromMaybe defConfig <$> TeamFeatures.getFlag tid Public.TeamFeatureSearchVisibility setTeamSearchVisibilityAvailableInternal :: TeamId -> Public.TeamFeatureStatus -> Galley () setTeamSearchVisibilityAvailableInternal tid isenabled = do case isenabled of Public.TeamFeatureDisabled -> SearchVisibilityData.resetSearchVisibility tid Public.TeamFeatureEnabled -> pure () -- This allows the option to be set at the team level - SearchVisibilityData.setTeamSearchVisibilityAvailable tid isenabled + TeamFeatures.setFlag tid Public.TeamFeatureSearchVisibility isenabled getValidateSAMLEmailsInternal :: TeamId -> Galley Public.TeamFeatureStatus -getValidateSAMLEmailsInternal = - ValidateSAMLEmailsData.getValidateSAMLEmails >=> \case - Nothing -> throwM teamNotFound - Just s -> pure s +getValidateSAMLEmailsInternal tid = + -- FUTUREWORK: we may also want to get a default from the server config file here, like for + -- sso, and team search visibility. + fromMaybe Public.TeamFeatureDisabled + <$> TeamFeatures.getFlag tid Public.TeamFeatureValidateSAMLEmails setValidateSAMLEmailsInternal :: TeamId -> Public.TeamFeatureStatus -> Galley () -setValidateSAMLEmailsInternal = ValidateSAMLEmailsData.setValidateSAMLEmails +setValidateSAMLEmailsInternal tid = TeamFeatures.setFlag tid Public.TeamFeatureValidateSAMLEmails -- | Modify and get visibility type for a team (internal, no user permission checks) getSearchVisibilityInternalH :: TeamId ::: JSON -> Galley Response diff --git a/services/galley/src/Galley/Data/LegalHold.hs b/services/galley/src/Galley/Data/LegalHold.hs index 6036faaa327..857fa9aa499 100644 --- a/services/galley/src/Galley/Data/LegalHold.hs +++ b/services/galley/src/Galley/Data/LegalHold.hs @@ -18,9 +18,7 @@ -- with this program. If not, see . module Galley.Data.LegalHold - ( setLegalHoldTeamConfig, - getLegalHoldTeamConfig, - createSettings, + ( createSettings, getSettings, removeSettings, Galley.Data.LegalHold.insertPendingPrekeys, @@ -40,21 +38,6 @@ import Data.LegalHold import Galley.Data.Instances () import Galley.Data.Queries as Q import Imports -import Wire.API.Team.Feature (TeamFeatureStatus (..)) - --- | Return whether a given team is allowed to enable/disable legalhold --- Defaults to 'TeamFeatureDisabled'. -getLegalHoldTeamConfig :: MonadClient m => TeamId -> m (Maybe TeamFeatureStatus) -getLegalHoldTeamConfig tid = fmap toLegalHoldTeamConfig <$> do - retry x1 $ query1 selectLegalHoldTeamConfig (params Quorum (Identity tid)) - where - toLegalHoldTeamConfig (Identity Nothing) = TeamFeatureDisabled - toLegalHoldTeamConfig (Identity (Just status)) = status - --- | Determines whether a given team is allowed to enable/disable legalhold -setLegalHoldTeamConfig :: MonadClient m => TeamId -> TeamFeatureStatus -> m () -setLegalHoldTeamConfig tid legalHoldTeamConfigStatus = do - retry x5 $ write updateLegalHoldTeamConfig (params Quorum (legalHoldTeamConfigStatus, tid)) -- | Returns 'False' if legal hold is not enabled for this team -- The Caller is responsible for checking whether legal hold is enabled for this team diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index dc097335efb..35193844c2a 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -36,7 +36,6 @@ import Galley.Types.Teams.Intra import Galley.Types.Teams.SearchVisibility import Imports import Text.RawString.QQ -import Wire.API.Team.Feature (TeamFeatureStatus) -- Teams -------------------------------------------------------------------- @@ -321,12 +320,6 @@ insertBot = "insert into member (conv, user, service, provider, status) values ( -- LegalHold ---------------------------------------------------------------- -selectLegalHoldTeamConfig :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatus)) -selectLegalHoldTeamConfig = "select legalhold_status from team_features where team_id = ?" - -updateLegalHoldTeamConfig :: PrepQuery W (TeamFeatureStatus, TeamId) () -updateLegalHoldTeamConfig = "update team_features set legalhold_status = ? where team_id = ?" - insertLegalHoldSettings :: PrepQuery W (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey, TeamId) () insertLegalHoldSettings = [r| @@ -379,22 +372,6 @@ updateUserLegalHoldStatus = where team = ? and user = ? |] -selectSSOTeamConfig :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatus)) -selectSSOTeamConfig = - "select sso_status from team_features where team_id = ?" - -updateSSOTeamConfig :: PrepQuery W (TeamFeatureStatus, TeamId) () -updateSSOTeamConfig = - "update team_features set sso_status = ? where team_id = ?" - -selectTeamSearchVisibilityAvailable :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatus)) -selectTeamSearchVisibilityAvailable = - "select search_visibility_status from team_features where team_id = ?" - -updateTeamSearchVisibilityAvailable :: PrepQuery W (TeamFeatureStatus, TeamId) () -updateTeamSearchVisibilityAvailable = - "update team_features set search_visibility_status = ? where team_id = ?" - selectSearchVisibility :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamSearchVisibility)) selectSearchVisibility = "select search_visibility from team where team = ?" @@ -403,14 +380,6 @@ updateSearchVisibility :: PrepQuery W (TeamSearchVisibility, TeamId) () updateSearchVisibility = "update team set search_visibility = ? where team = ?" -selectValidateSAMLEmails :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatus)) -selectValidateSAMLEmails = - "select validate_saml_emails from team_features where team_id = ?" - -updateValidateSAMLEmails :: PrepQuery W (TeamFeatureStatus, TeamId) () -updateValidateSAMLEmails = - "update team_features set validate_saml_emails = ? where team_id = ?" - selectCustomBackend :: PrepQuery R (Identity Domain) (HttpsUrl, HttpsUrl) selectCustomBackend = "select config_json_url, webapp_welcome_url from custom_backend where domain = ?" diff --git a/services/galley/src/Galley/Data/SSO.hs b/services/galley/src/Galley/Data/SSO.hs deleted file mode 100644 index fd5d484be15..00000000000 --- a/services/galley/src/Galley/Data/SSO.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE ViewPatterns #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Galley.Data.SSO - ( setSSOTeamConfig, - getSSOTeamConfig, - ) -where - -import Cassandra -import Data.Id -import Galley.Data.Instances () -import Galley.Data.Queries -import Imports -import Wire.API.Team.Feature (TeamFeatureStatus (..)) - --- | Return whether a given team is allowed to enable/disable sso. --- Defaults to 'TeamFeatureDisabled' if null in the DB -getSSOTeamConfig :: MonadClient m => TeamId -> m (Maybe TeamFeatureStatus) -getSSOTeamConfig tid = fmap toSSOTeamConfig <$> do - retry x1 $ query1 selectSSOTeamConfig (params Quorum (Identity tid)) - where - toSSOTeamConfig (Identity Nothing) = TeamFeatureDisabled - toSSOTeamConfig (Identity (Just status)) = status - --- | Determines whether a given team is allowed to enable/disable sso -setSSOTeamConfig :: MonadClient m => TeamId -> TeamFeatureStatus -> m () -setSSOTeamConfig tid ssoTeamConfigStatus = do - retry x5 $ write updateSSOTeamConfig (params Quorum (ssoTeamConfigStatus, tid)) diff --git a/services/galley/src/Galley/Data/SearchVisibility.hs b/services/galley/src/Galley/Data/SearchVisibility.hs index 20e2ae7e164..72b3085ec34 100644 --- a/services/galley/src/Galley/Data/SearchVisibility.hs +++ b/services/galley/src/Galley/Data/SearchVisibility.hs @@ -18,9 +18,7 @@ -- with this program. If not, see . module Galley.Data.SearchVisibility - ( setTeamSearchVisibilityAvailable, - getTeamSearchVisibilityAvailable, - setSearchVisibility, + ( setSearchVisibility, getSearchVisibility, resetSearchVisibility, ) @@ -32,17 +30,6 @@ import Galley.Data.Instances () import Galley.Data.Queries import Galley.Types.Teams.SearchVisibility import Imports -import Wire.API.Team.Feature (TeamFeatureStatus) - --- | Return whether a given team is allowed to enable/disable sso -getTeamSearchVisibilityAvailable :: MonadClient m => TeamId -> m (Maybe TeamFeatureStatus) -getTeamSearchVisibilityAvailable tid = join . fmap runIdentity <$> do - retry x1 $ query1 selectTeamSearchVisibilityAvailable (params Quorum (Identity tid)) - --- | Determines whether a given team is allowed to enable/disable sso -setTeamSearchVisibilityAvailable :: MonadClient m => TeamId -> TeamFeatureStatus -> m () -setTeamSearchVisibilityAvailable tid isenabled = do - retry x5 $ write updateTeamSearchVisibilityAvailable (params Quorum (isenabled, tid)) -- | Return whether a given team is allowed to enable/disable sso getSearchVisibility :: MonadClient m => TeamId -> m TeamSearchVisibility diff --git a/services/galley/src/Galley/Data/TeamFeatures.hs b/services/galley/src/Galley/Data/TeamFeatures.hs new file mode 100644 index 00000000000..49072334ee8 --- /dev/null +++ b/services/galley/src/Galley/Data/TeamFeatures.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ViewPatterns #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Galley.Data.TeamFeatures + ( setFlag, + getFlag, + ) +where + +import Cassandra +import Data.Id +import Galley.Data.Instances () +import Imports +import Wire.API.Team.Feature (TeamFeatureName (..), TeamFeatureStatus (..)) + +-- | Is a given feature enabled or disabled? Returns 'Nothing' if team does not exist or the +-- feature flag in Cassandra is null. +getFlag :: MonadClient m => TeamId -> TeamFeatureName -> m (Maybe TeamFeatureStatus) +getFlag tid feature = (>>= runIdentity) <$> retry x1 (query1 (select feature) (params Quorum (Identity tid))) + +-- | Enable or disable feature flag. +setFlag :: MonadClient m => TeamId -> TeamFeatureName -> TeamFeatureStatus -> m () +setFlag tid feature flag = do retry x5 $ write (update feature) (params Quorum (flag, tid)) + +select :: TeamFeatureName -> PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatus)) +select feature = fromString $ "select " <> toCol feature <> " from team_features where team_id = ?" + +update :: TeamFeatureName -> PrepQuery W (TeamFeatureStatus, TeamId) () +update feature = fromString $ "update team_features set " <> toCol feature <> " = ? where team_id = ?" + +toCol :: TeamFeatureName -> String +toCol TeamFeatureLegalHold = "legalhold_status" +toCol TeamFeatureSSO = "sso_status" +toCol TeamFeatureSearchVisibility = "search_visibility_status" +toCol TeamFeatureValidateSAMLEmails = "validate_saml_emails" diff --git a/services/galley/src/Galley/Data/ValidateSAMLEmails.hs b/services/galley/src/Galley/Data/ValidateSAMLEmails.hs deleted file mode 100644 index c81e0d58a8d..00000000000 --- a/services/galley/src/Galley/Data/ValidateSAMLEmails.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE ViewPatterns #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Galley.Data.ValidateSAMLEmails - ( setValidateSAMLEmails, - getValidateSAMLEmails, - ) -where - -import Cassandra -import Data.Id -import Galley.Data.Instances () -import Galley.Data.Queries -import Imports -import Wire.API.Team.Feature (TeamFeatureStatus (..)) - -getValidateSAMLEmails :: MonadClient m => TeamId -> m (Maybe TeamFeatureStatus) -getValidateSAMLEmails tid = fmap toFeatureStatus <$> do - retry x1 $ query1 selectValidateSAMLEmails (params Quorum (Identity tid)) - where - toFeatureStatus (Identity Nothing) = TeamFeatureDisabled - toFeatureStatus (Identity (Just status)) = status - -setValidateSAMLEmails :: MonadClient m => TeamId -> TeamFeatureStatus -> m () -setValidateSAMLEmails tid featureStatus = do - retry x5 $ write updateValidateSAMLEmails (params Quorum (featureStatus, tid)) diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 4267fca0bdd..82cb1f86335 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -1878,6 +1878,11 @@ postCryptoBroadcastMessage100OrMaxConns = do newTeamMember' :: Permissions -> UserId -> TeamMember newTeamMember' perms uid = newTeamMember uid perms Nothing +-- NOTE: all client functions calling @{/i,}/teams/*/features/*@ can be replaced by +-- hypothetical functions 'getTeamFeatureFlag', 'getTeamFeatureFlagInternal', +-- 'putTeamFeatureFlagInternal'. Since these functions all work in slightly different monads +-- and with different kinds of internal checks, it's quite tedious to do so. + getSSOEnabled :: HasCallStack => UserId -> TeamId -> TestM ResponseLBS getSSOEnabled uid tid = do g <- view tsGalley diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 6c7caa598d2..b7d41fa1898 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -66,6 +66,7 @@ import qualified Stern.Swagger as Doc import Stern.Types import System.Logger.Class hiding ((.=), Error, name, trace) import Util.Options +import qualified Wire.API.Team.Feature as Public import qualified Wire.API.Team.SearchVisibility as Public import qualified Wire.Swagger as Doc @@ -326,68 +327,32 @@ routes = do -- feature flags - get "/teams/:tid/features/legalhold" (continue (liftM json . Intra.getLegalholdStatus)) $ + get "/teams/:tid/features/:feature" (continue getTeamFeatureFlagH) $ capture "tid" - document "GET" "getLegalholdStatus" $ do - summary "Shows whether legalhold feature is enabled for team" + .&. capture "feature" + 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.docSetLegalHoldStatus - Doc.response 200 "Legalhold status" Doc.end - Doc.returns Doc.bool' + Doc.parameter Doc.Path "feature" Public.typeTeamFeatureName $ + description "Feature name" + Doc.returns Public.typeTeamFeatureStatus + Doc.response 200 "Team feature flag status" Doc.end - put "/teams/:tid/features/legalhold" (continue setLegalholdStatus) $ - contentType "application" "json" - .&. capture "tid" - .&. jsonRequest @SetLegalHoldStatus - document "PUT" "setLegalholdStatus" $ do - summary "Disable / enable legalhold feature for team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.body Doc.docSetLegalHoldStatus $ - Doc.description "JSON body" - Doc.response 200 "Legalhold status" Doc.end - - get "/teams/:tid/features/sso" (continue (liftM json . Intra.getSSOStatus)) $ + put "/teams/:tid/features/:feature" (continue setTeamFeatureFlagH) $ capture "tid" - document "GET" "getSSOStatus" $ do - summary "Shows whether SSO feature is enabled for team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.returns Doc.docSetSSOStatus - Doc.response 200 "SSO status" Doc.end - - put "/teams/:tid/features/sso" (continue setSSOStatus) $ - contentType "application" "json" - .&. capture "tid" - .&. jsonRequest @SetSSOStatus - document "PUT" "setSSOStatus" $ do - summary "Disable / enable SSO feature for team" + .&. capture "feature" + .&. contentType "application" "json" + .&. jsonRequest @Public.TeamFeatureStatus + 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.docSetSSOStatus $ + Doc.parameter Doc.Path "feature" Public.typeTeamFeatureName $ + description "Feature name" + Doc.body Public.typeTeamFeatureStatus $ Doc.description "JSON body" - Doc.response 200 "SSO status" Doc.end - - get "/teams/:tid/features/search-visibility" (continue (liftM json . Intra.getTeamSearchVisibilityAvailable)) $ - capture "tid" - document "GET" "getTeamSearchVisibilityAvailable" $ do - summary "Shows whether TeamSearchVisibility feature is enabled for team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.returns Doc.docSetTeamSearchVisibilityAvailable - Doc.response 200 "TeamSearchVisibility status" Doc.end - put "/teams/:tid/features/search-visibility" (continue setTeamSearchVisibilityAvailable) $ - contentType "application" "json" - .&. capture "tid" - .&. jsonRequest @SetTeamSearchVisibilityAvailable - document "PUT" "setTeamSearchVisibilityAvailable" $ do - summary "Disable / enable TeamSearchVisibility feature for team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.body Doc.docSetTeamSearchVisibilityAvailable $ - Doc.description "JSON body" - Doc.response 200 "TeamSearchVisibility status" Doc.end + Doc.response 200 "Team feature flag status" Doc.end -- 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 @@ -614,20 +579,13 @@ getTeamInfo = liftM json . Intra.getTeamInfo getTeamAdminInfo :: TeamId -> Handler Response getTeamAdminInfo = liftM (json . toAdminInfo) . Intra.getTeamInfo -setLegalholdStatus :: JSON ::: TeamId ::: JsonRequest SetLegalHoldStatus -> Handler Response -setLegalholdStatus (_ ::: tid ::: req) = do - status <- parseBody req !>> Error status400 "client-error" - liftM json $ Intra.setLegalholdStatus tid status - -setSSOStatus :: JSON ::: TeamId ::: JsonRequest SetSSOStatus -> Handler Response -setSSOStatus (_ ::: tid ::: req) = do - status :: SetSSOStatus <- parseBody req !>> Error status400 "client-error" - liftM json $ Intra.setSSOStatus tid status +getTeamFeatureFlagH :: TeamId ::: Public.TeamFeatureName -> Handler Response +getTeamFeatureFlagH (tid ::: feature) = + json <$> Intra.getTeamFeatureFlag tid feature -setTeamSearchVisibilityAvailable :: JSON ::: TeamId ::: JsonRequest SetTeamSearchVisibilityAvailable -> Handler Response -setTeamSearchVisibilityAvailable (_ ::: tid ::: req) = do - status :: SetTeamSearchVisibilityAvailable <- parseBody req !>> Error status400 "client-error" - liftM json $ Intra.setTeamSearchVisibilityAvailable tid status +setTeamFeatureFlagH :: TeamId ::: Public.TeamFeatureName ::: JSON ::: JsonRequest Public.TeamFeatureStatus -> Handler Response +setTeamFeatureFlagH (tid ::: feature ::: _ ::: req) = + empty <$ (Intra.setTeamFeatureFlag tid feature =<< (parseBody req !>> Error status400 "client-error")) setSearchVisibility :: JSON ::: TeamId ::: JsonRequest Team.TeamSearchVisibility -> Handler Response setSearchVisibility (_ ::: tid ::: req) = do diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 9063ee55cac..95f8e32e7fc 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -40,12 +40,8 @@ module Stern.Intra getUserBindingTeam, isBlacklisted, setBlacklistStatus, - getLegalholdStatus, - setLegalholdStatus, - getSSOStatus, - setSSOStatus, - getTeamSearchVisibilityAvailable, - setTeamSearchVisibilityAvailable, + getTeamFeatureFlag, + setTeamFeatureFlag, getSearchVisibility, setSearchVisibility, getTeamBillingInfo, @@ -96,7 +92,7 @@ import Stern.Types import System.Logger.Class hiding ((.=), Error, name) import qualified System.Logger.Class as Log import UnliftIO.Exception hiding (Handler) -import Wire.API.Team.Feature (TeamFeatureName (..), TeamFeatureStatus (..)) +import qualified Wire.API.Team.Feature as Public ------------------------------------------------------------------------------- @@ -427,125 +423,29 @@ setBlacklistStatus status emailOrPhone = do statusToMethod False = DELETE statusToMethod True = POST -getLegalholdStatus :: TeamId -> Handler SetLegalHoldStatus -getLegalholdStatus tid = do - info $ msg "Getting legalhold status" +getTeamFeatureFlag :: TeamId -> Public.TeamFeatureName -> Handler Public.TeamFeatureStatus +getTeamFeatureFlag tid feature = do + info $ msg "Getting team feature status" gly <- view galley - (>>= fromResponseBody) . catchRpcErrors $ - rpc' - "galley" - gly - ( method GET - . paths ["/i/teams", toByteString' tid, "features", toByteString' TeamFeatureLegalHold] + let req = + method GET + . paths ["/i/teams", toByteString' tid, "features", toByteString' feature] . expect2xx - ) - where - fromResponseBody :: Response (Maybe LByteString) -> Handler SetLegalHoldStatus - fromResponseBody resp = case responseJsonEither resp of - Right TeamFeatureDisabled -> pure SetLegalHoldDisabled - Right TeamFeatureEnabled -> pure SetLegalHoldEnabled - Left errmsg -> throwE (Error status502 "bad-upstream" ("bad response; error message: " <> pack errmsg)) - -setLegalholdStatus :: TeamId -> SetLegalHoldStatus -> Handler () -setLegalholdStatus tid status = do - info $ msg "Setting legalhold status" - gly <- view galley - resp <- - catchRpcErrors $ - rpc' - "galley" - gly - ( method PUT - . paths ["/i/teams", toByteString' tid, "features", "legalhold"] - . lbytes (encode $ toRequestBody status) - . contentJson - ) - case statusCode resp of - 204 -> pure () - _ -> throwE $ responseJsonUnsafe resp - where - toRequestBody SetLegalHoldDisabled = TeamFeatureDisabled - toRequestBody SetLegalHoldEnabled = TeamFeatureEnabled - -getSSOStatus :: TeamId -> Handler SetSSOStatus -getSSOStatus tid = do - info $ msg "Getting SSO status" - gly <- view galley - (>>= fromResponseBody) . catchRpcErrors $ - rpc' - "galley" - gly - ( method GET - . paths ["/i/teams", toByteString' tid, "features", toByteString' TeamFeatureSSO] - . expect2xx - ) - where - fromResponseBody :: Response (Maybe LByteString) -> Handler SetSSOStatus - fromResponseBody resp = case responseJsonEither resp of - Right TeamFeatureEnabled -> pure SetSSOEnabled - Right TeamFeatureDisabled -> pure SetSSODisabled - Left errmsg -> throwE (Error status502 "bad-upstream" ("bad response; error message: " <> pack errmsg)) - -setSSOStatus :: TeamId -> SetSSOStatus -> Handler () -setSSOStatus tid status = do - info $ msg "Setting SSO status" - gly <- view galley - resp <- - catchRpcErrors $ - rpc' - "galley" - gly - ( method PUT - . paths ["/i/teams", toByteString' tid, "features", "sso"] - . lbytes (encode $ toRequestBody status) - . contentJson - ) - case statusCode resp of - 204 -> pure () - _ -> throwE $ responseJsonUnsafe resp - where - toRequestBody SetSSODisabled = TeamFeatureDisabled - toRequestBody SetSSOEnabled = TeamFeatureEnabled + responseJsonUnsafe <$> catchRpcErrors (rpc' "galley" gly req) -getTeamSearchVisibilityAvailable :: TeamId -> Handler SetTeamSearchVisibilityAvailable -getTeamSearchVisibilityAvailable tid = do - info $ msg "Getting TeamSearchVisibility status" +setTeamFeatureFlag :: TeamId -> Public.TeamFeatureName -> Public.TeamFeatureStatus -> Handler () +setTeamFeatureFlag tid feature status = do + info $ msg "Setting team feature status" gly <- view galley - (>>= fromResponseBody) . catchRpcErrors $ - rpc' - "galley" - gly - ( method GET - . paths ["/i/teams", toByteString' tid, "features", toByteString' TeamFeatureSearchVisibility] - . expect2xx - ) - where - fromResponseBody :: Response (Maybe LByteString) -> Handler SetTeamSearchVisibilityAvailable - fromResponseBody resp = case responseJsonEither resp of - Right TeamFeatureEnabled -> pure SetTeamSearchVisibilityEnabled - Right TeamFeatureDisabled -> pure SetTeamSearchVisibilityDisabled - Left errmsg -> throwE (Error status502 "bad-upstream" ("bad response; error message: " <> pack errmsg)) - -setTeamSearchVisibilityAvailable :: TeamId -> SetTeamSearchVisibilityAvailable -> Handler () -setTeamSearchVisibilityAvailable tid status = do - info $ msg "Setting TeamSearchVisibility status" - gly <- view galley - resp <- - catchRpcErrors $ - rpc' - "galley" - gly - ( method PUT - . paths ["/i/teams", toByteString' tid, "features", "search-visibility"] - . lbytes (encode $ toRequestBody status) - . contentJson - ) + let req = + method PUT + . paths ["/i/teams", toByteString' tid, "features", toByteString' feature] + . Bilge.json status + . contentJson + resp <- catchRpcErrors $ rpc' "galley" gly req case statusCode resp of 204 -> pure () _ -> throwE $ responseJsonUnsafe resp - where - toRequestBody SetTeamSearchVisibilityDisabled = TeamFeatureDisabled - toRequestBody SetTeamSearchVisibilityEnabled = TeamFeatureEnabled getSearchVisibility :: TeamId -> Handler TeamSearchVisibilityView getSearchVisibility tid = do diff --git a/tools/stern/src/Stern/Swagger.hs b/tools/stern/src/Stern/Swagger.hs index 452d3a81915..8d1efe8960b 100644 --- a/tools/stern/src/Stern/Swagger.hs +++ b/tools/stern/src/Stern/Swagger.hs @@ -21,7 +21,6 @@ module Stern.Swagger where import Data.Swagger.Build.Api import Imports -import Stern.Types sternModels :: [Model] sternModels = @@ -90,18 +89,3 @@ teamBillingInfoUpdate = defineModel "teamBillingInfoUpdate" $ do property "state" string' $ do description "State of the company address (1 - 256 characters)" optional - -docSetSSOStatus :: DataType -docSetSSOStatus = docBoundedEnum @SetSSOStatus - -docSetLegalHoldStatus :: DataType -docSetLegalHoldStatus = docBoundedEnum @SetLegalHoldStatus - -docSetTeamSearchVisibilityAvailable :: DataType -docSetTeamSearchVisibilityAvailable = docBoundedEnum @SetTeamSearchVisibilityAvailable - --- (the double-call to show is to add extra double-quotes to the string. this is important --- because the json instances also render this into a json string, and json string are wrapped --- in double-quotes.) -docBoundedEnum :: forall a. (Bounded a, Enum a, Show a) => DataType -docBoundedEnum = string . enum $ show . show <$> [(minBound :: a) ..] diff --git a/tools/stern/src/Stern/Types.hs b/tools/stern/src/Stern/Types.hs index 24ceccc6f93..c91bcbd39fa 100644 --- a/tools/stern/src/Stern/Types.hs +++ b/tools/stern/src/Stern/Types.hs @@ -150,21 +150,3 @@ data TeamBillingInfoUpdate = TeamBillingInfoUpdate deriving (Eq, Show) deriveJSON toJSONFieldName ''TeamBillingInfoUpdate - -data SetLegalHoldStatus = SetLegalHoldDisabled | SetLegalHoldEnabled - deriving (Eq, Show, Ord, Enum, Bounded, Generic) - -deriveJSON toJSONFieldName ''SetLegalHoldStatus - -data SetSSOStatus = SetSSODisabled | SetSSOEnabled - deriving (Eq, Show, Ord, Enum, Bounded, Generic) - -deriveJSON toJSONFieldName ''SetSSOStatus - --- | FUTUREWORK: we should probably use --- 'Galley.Types.Teams.SearchVisibility.TeamSearchVisibilityEnabled'. (same for --- 'SetSSOStatus', 'SetLegalHoldStatus'. -data SetTeamSearchVisibilityAvailable = SetTeamSearchVisibilityDisabled | SetTeamSearchVisibilityEnabled - deriving (Eq, Show, Ord, Enum, Bounded, Generic) - -deriveJSON toJSONFieldName ''SetTeamSearchVisibilityAvailable