Fix calendar integration setting in backoffice / stern

changelog.d/5-internal/WPB-5541

@@ -0,0 +1 @@
+Fix calendar integration setting in backoffice / stern

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"

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

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"

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"

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),