diff --git a/changelog.d/5-internal/WPB-5541 b/changelog.d/5-internal/WPB-5541 new file mode 100644 index 00000000000..f8269ccc30e --- /dev/null +++ b/changelog.d/5-internal/WPB-5541 @@ -0,0 +1 @@ +Fix calendar integration setting in backoffice / stern \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 00a025afdbc..7f47a1596f6 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -509,7 +509,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" 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),