From 357b315e9c73a4a1134e515ea2e2b11abbd8ccbd Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 4 Dec 2023 16:39:36 +0100 Subject: [PATCH 1/4] Fix calenter integration setting in backoffice / stern. --- changelog.d/5-internal/WPB-5541 | 1 + tools/stern/src/Stern/API.hs | 5 +++ tools/stern/src/Stern/API/Routes.hs | 11 +++++ tools/stern/src/Stern/Intra.hs | 32 +++++++++++++- tools/stern/test/integration/API.hs | 66 +++++++++++++++++++++++++++++ 5 files changed, 114 insertions(+), 1 deletion(-) create mode 100644 changelog.d/5-internal/WPB-5541 diff --git a/changelog.d/5-internal/WPB-5541 b/changelog.d/5-internal/WPB-5541 new file mode 100644 index 00000000000..028b4c00665 --- /dev/null +++ b/changelog.d/5-internal/WPB-5541 @@ -0,0 +1 @@ +Fix calenter integration setting in backoffice / stern. \ No newline at end of file diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 03832056ac0..f2b5b368d0e 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -157,6 +157,7 @@ sitemap' = :<|> Named @"get-search-visibility" getSearchVisibility :<|> Named @"put-search-visibility" setSearchVisibility :<|> Named @"get-route-outlook-cal-config" (mkFeatureGetRoute @OutlookCalIntegrationConfig) + :<|> Named @"lock-unlock-route-outlook-cal-config" (mkFeatureLockUnlockRouteTrivialConfigNoTTL @OutlookCalIntegrationConfig) :<|> Named @"put-route-outlook-cal-config" (mkFeaturePutRouteTrivialConfigNoTTL @OutlookCalIntegrationConfig) :<|> Named @"get-team-invoice" getTeamInvoice :<|> Named @"get-team-billing-info" getTeamBillingInfo @@ -335,6 +336,10 @@ mkFeaturePutRouteTrivialConfigNoTTL :: forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> FeatureStatus -> Handler NoContent mkFeaturePutRouteTrivialConfigNoTTL tid status = mkFeaturePutRouteTrivialConfig @cfg tid status Nothing +mkFeatureLockUnlockRouteTrivialConfigNoTTL :: + forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> LockStatus -> Handler NoContent +mkFeatureLockUnlockRouteTrivialConfigNoTTL tid lstat = NoContent <$ Intra.setTeamFeatureLockStatus @cfg tid lstat + mkFeaturePutRouteTrivialConfigWithTTL :: forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> FeatureStatus -> FeatureTTLDays -> Handler NoContent mkFeaturePutRouteTrivialConfigWithTTL tid status = mkFeaturePutRouteTrivialConfig @cfg tid status . Just diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index e54540adb94..79fccd55c61 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -320,6 +320,7 @@ type SternAPI = :> Put '[JSON] NoContent ) :<|> Named "get-route-outlook-cal-config" (MkFeatureGetRoute OutlookCalIntegrationConfig) + :<|> Named "lock-unlock-route-outlook-cal-config" (MkFeatureLockUnlockRouteTrivialConfigNoTTL OutlookCalIntegrationConfig) :<|> Named "put-route-outlook-cal-config" (MkFeaturePutRouteTrivialConfigNoTTL OutlookCalIntegrationConfig) :<|> Named "get-team-invoice" @@ -519,6 +520,16 @@ type MkFeaturePutRouteTrivialConfigWithTTL (feature :: Type) = :> QueryParam' [Required, Strict, Description "team feature time to live, given in days, or 'unlimited' (default)."] "ttl" FeatureTTLDays :> Put '[JSON] NoContent +type MkFeatureLockUnlockRouteTrivialConfigNoTTL (feature :: Type) = + Summary "Lock / unlock status for a given feature / team (en-/disable should happen in team settings)" + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> FeatureSymbol feature + :> "lockOrUnlock" + :> QueryParam' [Required, Strict] "lock-status" LockStatus + :> Put '[JSON] NoContent + type MkFeaturePutRoute (feature :: Type) = Summary "Disable / enable feature flag for a given team" :> "teams" diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index b68821eba8c..4d13739d167 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -46,6 +46,7 @@ module Stern.Intra setBlacklistStatus, getTeamFeatureFlag, setTeamFeatureFlag, + setTeamFeatureLockStatus, getTeamData, getSearchVisibility, setSearchVisibility, @@ -86,12 +87,13 @@ import Data.Id import Data.Int import Data.List.Split (chunksOf) import Data.Map qualified as Map +import Data.Proxy (Proxy (Proxy)) import Data.Qualified (qUnqualified) import Data.Text (strip) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Lazy (pack) import Data.Text.Lazy.Encoding qualified as TL -import GHC.TypeLits (KnownSymbol) +import GHC.TypeLits (KnownSymbol, symbolVal) import Imports import Network.HTTP.Types (urlEncode) import Network.HTTP.Types.Method @@ -571,6 +573,34 @@ setTeamFeatureFlag tid status = do where daysLimit = 2000 +setTeamFeatureLockStatus :: + forall cfg. + ( KnownSymbol (Public.FeatureSymbol cfg) + ) => + TeamId -> + LockStatus -> + Handler () +setTeamFeatureLockStatus tid lstat = do + info $ msg ("Setting lock status: " <> show (symbolVal (Proxy @(Public.FeatureSymbol cfg)), lstat)) + gly <- view galley + fromResponseBody <=< catchRpcErrors $ + rpc' + "galley" + gly + ( method PUT + . Bilge.paths + [ "i", + "teams", + toByteString' tid, + "features", + Public.featureNameBS @cfg, + toByteString' lstat + ] + ) + where + fromResponseBody :: Response (Maybe LByteString) -> Handler () + fromResponseBody resp = parseResponse (mkError status502 "bad-upstream") resp + getSearchVisibility :: TeamId -> Handler TeamSearchVisibilityView getSearchVisibility tid = do info $ msg "Getting TeamSearchVisibilityView value" diff --git a/tools/stern/test/integration/API.hs b/tools/stern/test/integration/API.hs index 744481eda6f..657d7359fc5 100644 --- a/tools/stern/test/integration/API.hs +++ b/tools/stern/test/integration/API.hs @@ -92,6 +92,7 @@ tests s = test s "/teams/:tid/features/mls" $ testFeatureConfig @MLSConfig, test s "GET /teams/:tid/features/classifiedDomains" $ testGetFeatureConfig @ClassifiedDomainsConfig (Just FeatureStatusEnabled), test s "GET /teams/:tid/features/outlookCalIntegration" $ testFeatureStatus @OutlookCalIntegrationConfig, + test s "PUT /teams/:tid/features/outlookCalIntegration{,'?lockOrUnlock'}" $ testFeatureStatusWithLock @OutlookCalIntegrationConfig, test s "GET /i/consent" testGetConsentLog, test s "GET /teams/:id" testGetTeamInfo, test s "GET i/user/meta-info?id=..." testGetUserMetaInfo, @@ -337,6 +338,46 @@ testFeatureStatusOptTtl mTtl = do cfg' <- getFeatureConfig @cfg tid liftIO $ wsStatus cfg' @?= newStatus +testFeatureStatusWithLock :: + forall cfg. + ( KnownSymbol (FeatureSymbol cfg), + ToSchema cfg, + Typeable cfg, + IsFeatureConfig cfg, + Eq cfg, + Show cfg + ) => + TestM () +testFeatureStatusWithLock = do + let mTtl = Nothing -- this function can become a variant of `testFeatureStatusOptTtl` if we need one. + (_, tid, _) <- createTeamWithNMembers 10 + getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do + cfg @?= defFeatureStatus @cfg + -- if either of these two lines fails, it's probably because the default is surprising. + -- in that case, make the text more flexible. + wsLockStatus cfg @?= LockStatusLocked + wsStatus cfg @?= FeatureStatusDisabled + + void $ putFeatureStatusLock @cfg tid LockStatusUnlocked mTtl + getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do + wsLockStatus cfg @?= LockStatusUnlocked + wsStatus cfg @?= FeatureStatusDisabled + + void $ putFeatureStatus @cfg tid FeatureStatusEnabled Nothing + getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do + wsLockStatus cfg @?= LockStatusUnlocked + wsStatus cfg @?= FeatureStatusEnabled + + void $ putFeatureStatusLock @cfg tid LockStatusLocked mTtl + getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do + wsLockStatus cfg @?= LockStatusLocked + wsStatus cfg @?= FeatureStatusDisabled + + void $ putFeatureStatusLock @cfg tid LockStatusUnlocked mTtl + getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do + wsLockStatus cfg @?= LockStatusUnlocked + wsStatus cfg @?= FeatureStatusEnabled + testGetConsentLog :: TestM () testGetConsentLog = do (_, email) <- randomEmailUser @@ -619,6 +660,31 @@ putFeatureStatus tid status mTtl = do mkTtlQueryParam :: Maybe FeatureTTL -> Request -> Request mkTtlQueryParam = maybe id (queryItem "ttl" . toByteString') +putFeatureStatusLock :: + forall cfg. + ( KnownSymbol (FeatureSymbol cfg), + ToSchema cfg, + Typeable cfg, + IsFeatureConfig cfg + ) => + TeamId -> + LockStatus -> + Maybe FeatureTTL -> + TestM ResponseLBS +putFeatureStatusLock tid lockStatus mTtl = do + s <- view tsStern + put + ( s + . paths ["teams", toByteString' tid, "features", Public.featureNameBS @cfg, "lockOrUnlock"] + . queryItem "lock-status" (toByteString' lockStatus) + . mkTtlQueryParam mTtl + . contentJson + . expect2xx + ) + where + mkTtlQueryParam :: Maybe FeatureTTL -> Request -> Request + mkTtlQueryParam = maybe id (queryItem "ttl" . toByteString') + putFeatureConfig :: forall cfg. ( KnownSymbol (FeatureSymbol cfg), From 0dbc53cf1c496ce34e183f92bf07a20b13f8ae84 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 4 Dec 2023 17:05:45 +0100 Subject: [PATCH 2/4] Failing attempt at fixing openapi rendering of LockStatus as query param. --- libs/wire-api/src/Wire/API/Team/Feature.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 00a025afdbc..bedd2136aa5 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -494,10 +494,13 @@ invalidTTLErrorString = "Invalid FeatureTTLSeconds: must be a positive integer o -- LockStatus data LockStatus = LockStatusLocked | LockStatusUnlocked - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Generic) deriving (Arbitrary) via (GenericUniform LockStatus) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema LockStatus) +instance Show LockStatus where + show = cs . toByteString' + instance FromHttpApiData LockStatus where parseUrlPiece = maybeToEither "Invalid lock status" . fromByteString . cs @@ -509,7 +512,8 @@ instance ToSchema LockStatus where element "unlocked" LockStatusUnlocked ] -instance S.ToParamSchema LockStatus +instance S.ToParamSchema LockStatus where + toParamSchema _ = mempty & S.type_ ?~ S.OpenApiString & S.enum_ ?~ ["locked", "unlocked"] instance ToByteString LockStatus where builder LockStatusLocked = "locked" From 399bddf59bccfaaa71f0fd981f1e46fe507b1994 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Tue, 5 Dec 2023 09:59:53 +0100 Subject: [PATCH 3/4] Typo --- changelog.d/5-internal/WPB-5541 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.d/5-internal/WPB-5541 b/changelog.d/5-internal/WPB-5541 index 028b4c00665..f8269ccc30e 100644 --- a/changelog.d/5-internal/WPB-5541 +++ b/changelog.d/5-internal/WPB-5541 @@ -1 +1 @@ -Fix calenter integration setting in backoffice / stern. \ No newline at end of file +Fix calendar integration setting in backoffice / stern \ No newline at end of file From 0b99c98d172148cb4b15e195b9b34ad4b306fbaf Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Tue, 5 Dec 2023 10:09:53 +0100 Subject: [PATCH 4/4] Partially revert "Failing attempt at fixing openapi rendering of LockStatus as query param." This reverts commit 0dbc53cf1c496ce34e183f92bf07a20b13f8ae84. --- libs/wire-api/src/Wire/API/Team/Feature.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index bedd2136aa5..7f47a1596f6 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -494,13 +494,10 @@ invalidTTLErrorString = "Invalid FeatureTTLSeconds: must be a positive integer o -- LockStatus data LockStatus = LockStatusLocked | LockStatusUnlocked - deriving stock (Eq, Generic) + deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform LockStatus) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema LockStatus) -instance Show LockStatus where - show = cs . toByteString' - instance FromHttpApiData LockStatus where parseUrlPiece = maybeToEither "Invalid lock status" . fromByteString . cs