Use new feature flag types and make a generic end-point in stern.

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 flagLegalhold 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

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

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) ..]

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