Feature flag refactoring (part 1)

.gitignore

@@ -60,6 +60,9 @@ stack-dev.yaml
 # HIE db files (e.g. generated for stan)
 *.hie
 
+# dump timings
+*.dump-timings
+
 # generated files under .local
 .local
 

changelog.d/5-internal/feature-flag-refactoring-1

@@ -0,0 +1,7 @@
+Refactor feature flags 
+- Improved naming slightly. Features types are now called `Feature`, `LockableFeature` and `LockableFeaturePatch`
+- Turned `AllFeatures` into an extensible record type
+- Removed `WithStatusBase` barbie.
+- Deleted obsolete `computeFeatureConfigForTeamUser`
+- Abstracted `getFeature` and `setFeature`
+- Abstracted getAllTeamFeatures

integration/test/Test/FeatureFlags.hs

@@ -811,8 +811,7 @@ testConferenceCallingInternal = do
     do
       notif <- awaitMatch isFeatureConfigUpdateNotif ws
       notif %. "payload.0.name" `shouldMatch` "conferenceCalling"
-      -- TODO: the patch event is currently wrong, and does not reflect the update
-      notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {status = "disabled", lockStatus = Just "locked"})
+      notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {status = "enabled", lockStatus = Just "unlocked"})
     checkFeature "conferenceCalling" m tid (confCalling defaultArgs {status = "enabled", lockStatus = Just "unlocked"})
 
     -- just disable
@@ -836,7 +835,7 @@ testConferenceCallingInternal = do
     do
       notif <- awaitMatch isFeatureConfigUpdateNotif ws
       notif %. "payload.0.name" `shouldMatch` "conferenceCalling"
-      notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {lockStatus = Just "unlocked"})
+      notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs)
     checkFeature "conferenceCalling" m tid (confCalling defaultArgs)
 
 _testLockStatusWithConfig ::

libs/galley-types/default.nix

@@ -9,6 +9,7 @@
 , bytestring-conversion
 , containers
 , crypton
+, data-default
 , errors
 , gitignoreSource
 , imports
@@ -34,6 +35,7 @@ mkDerivation {
     bytestring-conversion
     containers
     crypton
+    data-default
     errors
     imports
     lens

libs/galley-types/galley-types.cabal

@@ -75,6 +75,7 @@ library
     , bytestring-conversion
     , containers             >=0.5
     , crypton
+    , data-default
     , errors
     , imports
     , lens                   >=4.12

libs/galley-types/src/Galley/Types/Teams.hs

@@ -64,6 +64,7 @@ import Data.Aeson
 import Data.Aeson.Types qualified as A
 import Data.ByteString (toStrict)
 import Data.ByteString.UTF8 qualified as UTF8
+import Data.Default
 import Data.Id (UserId)
 import Data.Schema qualified as Schema
 import Data.Set qualified as Set
@@ -84,18 +85,18 @@ data FeatureFlags = FeatureFlags
     _flagTeamSearchVisibility :: !FeatureTeamSearchVisibilityAvailability,
     _flagAppLockDefaults :: !(Defaults (ImplicitLockStatus AppLockConfig)),
     _flagClassifiedDomains :: !(ImplicitLockStatus ClassifiedDomainsConfig),
-    _flagFileSharing :: !(Defaults (WithStatus FileSharingConfig)),
-    _flagConferenceCalling :: !(Defaults (WithStatus ConferenceCallingConfig)),
-    _flagSelfDeletingMessages :: !(Defaults (WithStatus SelfDeletingMessagesConfig)),
-    _flagConversationGuestLinks :: !(Defaults (WithStatus GuestLinksConfig)),
+    _flagFileSharing :: !(Defaults (LockableFeature FileSharingConfig)),
+    _flagConferenceCalling :: !(Defaults (LockableFeature ConferenceCallingConfig)),
+    _flagSelfDeletingMessages :: !(Defaults (LockableFeature SelfDeletingMessagesConfig)),
+    _flagConversationGuestLinks :: !(Defaults (LockableFeature GuestLinksConfig)),
     _flagsTeamFeatureValidateSAMLEmailsStatus :: !(Defaults (ImplicitLockStatus ValidateSAMLEmailsConfig)),
-    _flagTeamFeatureSndFactorPasswordChallengeStatus :: !(Defaults (WithStatus SndFactorPasswordChallengeConfig)),
+    _flagTeamFeatureSndFactorPasswordChallengeStatus :: !(Defaults (LockableFeature SndFactorPasswordChallengeConfig)),
     _flagTeamFeatureSearchVisibilityInbound :: !(Defaults (ImplicitLockStatus SearchVisibilityInboundConfig)),
-    _flagMLS :: !(Defaults (WithStatus MLSConfig)),
-    _flagOutlookCalIntegration :: !(Defaults (WithStatus OutlookCalIntegrationConfig)),
-    _flagMlsE2EId :: !(Defaults (WithStatus MlsE2EIdConfig)),
-    _flagMlsMigration :: !(Defaults (WithStatus MlsMigrationConfig)),
-    _flagEnforceFileDownloadLocation :: !(Defaults (WithStatus EnforceFileDownloadLocationConfig)),
+    _flagMLS :: !(Defaults (LockableFeature MLSConfig)),
+    _flagOutlookCalIntegration :: !(Defaults (LockableFeature OutlookCalIntegrationConfig)),
+    _flagMlsE2EId :: !(Defaults (LockableFeature MlsE2EIdConfig)),
+    _flagMlsMigration :: !(Defaults (LockableFeature MlsMigrationConfig)),
+    _flagEnforceFileDownloadLocation :: !(Defaults (LockableFeature EnforceFileDownloadLocationConfig)),
     _flagLimitedEventFanout :: !(Defaults (ImplicitLockStatus LimitedEventFanoutConfig))
   }
   deriving (Eq, Show, Generic)
@@ -137,23 +138,23 @@ instance FromJSON FeatureFlags where
       <*> obj .: "legalhold"
       <*> obj .: "teamSearchVisibility"
       <*> withImplicitLockStatusOrDefault obj "appLock"
-      <*> (fromMaybe (ImplicitLockStatus (defFeatureStatus @ClassifiedDomainsConfig)) <$> (obj .:? "classifiedDomains"))
-      <*> (fromMaybe (Defaults (defFeatureStatus @FileSharingConfig)) <$> (obj .:? "fileSharing"))
-      <*> (fromMaybe (Defaults (defFeatureStatus @ConferenceCallingConfig)) <$> (obj .:? "conferenceCalling"))
-      <*> (fromMaybe (Defaults (defFeatureStatus @SelfDeletingMessagesConfig)) <$> (obj .:? "selfDeletingMessages"))
-      <*> (fromMaybe (Defaults (defFeatureStatus @GuestLinksConfig)) <$> (obj .:? "conversationGuestLinks"))
+      <*> (fromMaybe (ImplicitLockStatus def) <$> (obj .:? "classifiedDomains"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "fileSharing"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "conferenceCalling"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "selfDeletingMessages"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "conversationGuestLinks"))
       <*> withImplicitLockStatusOrDefault obj "validateSAMLEmails"
-      <*> (fromMaybe (Defaults (defFeatureStatus @SndFactorPasswordChallengeConfig)) <$> (obj .:? "sndFactorPasswordChallenge"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "sndFactorPasswordChallenge"))
       <*> withImplicitLockStatusOrDefault obj "searchVisibilityInbound"
-      <*> (fromMaybe (Defaults (defFeatureStatus @MLSConfig)) <$> (obj .:? "mls"))
-      <*> (fromMaybe (Defaults (defFeatureStatus @OutlookCalIntegrationConfig)) <$> (obj .:? "outlookCalIntegration"))
-      <*> (fromMaybe (Defaults (defFeatureStatus @MlsE2EIdConfig)) <$> (obj .:? "mlsE2EId"))
-      <*> (fromMaybe (Defaults (defFeatureStatus @MlsMigrationConfig)) <$> (obj .:? "mlsMigration"))
-      <*> (fromMaybe (Defaults (defFeatureStatus @EnforceFileDownloadLocationConfig)) <$> (obj .:? "enforceFileDownloadLocation"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "mls"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "outlookCalIntegration"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "mlsE2EId"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "mlsMigration"))
+      <*> (fromMaybe (Defaults def) <$> (obj .:? "enforceFileDownloadLocation"))
       <*> withImplicitLockStatusOrDefault obj "limitedEventFanout"
     where
       withImplicitLockStatusOrDefault :: forall cfg. (IsFeatureConfig cfg, Schema.ToSchema cfg) => Object -> Key -> A.Parser (Defaults (ImplicitLockStatus cfg))
-      withImplicitLockStatusOrDefault obj fieldName = fromMaybe (Defaults (ImplicitLockStatus (defFeatureStatus @cfg))) <$> obj .:? fieldName
+      withImplicitLockStatusOrDefault obj fieldName = fromMaybe (Defaults (ImplicitLockStatus def)) <$> obj .:? fieldName
 
 instance FromJSON FeatureSSO where
   parseJSON (String "enabled-by-default") = pure FeatureSSOEnabledByDefault

libs/wire-api/src/Wire/API/Event/FeatureConfig.hs

@@ -30,7 +30,7 @@ import Data.OpenApi qualified as S
 import Data.Schema
 import GHC.TypeLits (KnownSymbol)
 import Imports
-import Test.QuickCheck.Gen (oneof)
+import Test.QuickCheck.Gen
 import Wire.API.Team.Feature
 import Wire.Arbitrary (Arbitrary (..), GenericUniform (..))
 
@@ -42,30 +42,31 @@ data Event = Event
   deriving (Eq, Show, Generic)
   deriving (A.ToJSON, A.FromJSON) via Schema Event
 
+arbitraryFeature :: forall cfg. (IsFeatureConfig cfg, ToSchema cfg, Arbitrary cfg) => Gen A.Value
+arbitraryFeature = toJSON <$> arbitrary @(LockableFeature cfg)
+
+class AllArbitraryFeatures cfgs where
+  allArbitraryFeatures :: [Gen A.Value]
+
+instance AllArbitraryFeatures '[] where
+  allArbitraryFeatures = []
+
+instance
+  ( IsFeatureConfig cfg,
+    ToSchema cfg,
+    Arbitrary cfg,
+    AllArbitraryFeatures cfgs
+  ) =>
+  AllArbitraryFeatures (cfg : cfgs)
+  where
+  allArbitraryFeatures = arbitraryFeature @cfg : allArbitraryFeatures @cfgs
+
 instance Arbitrary Event where
   arbitrary =
-    do
-      let arbConfig =
-            oneof
-              [ arbitrary @(WithStatus SSOConfig) <&> toJSON,
-                arbitrary @(WithStatus SearchVisibilityAvailableConfig) <&> toJSON,
-                arbitrary @(WithStatus ValidateSAMLEmailsConfig) <&> toJSON,
-                arbitrary @(WithStatus DigitalSignaturesConfig) <&> toJSON,
-                arbitrary @(WithStatus AppLockConfig) <&> toJSON,
-                arbitrary @(WithStatus FileSharingConfig) <&> toJSON,
-                arbitrary @(WithStatus ClassifiedDomainsConfig) <&> toJSON,
-                arbitrary @(WithStatus ConferenceCallingConfig) <&> toJSON,
-                arbitrary @(WithStatus SelfDeletingMessagesConfig) <&> toJSON,
-                arbitrary @(WithStatus GuestLinksConfig) <&> toJSON,
-                arbitrary @(WithStatus SndFactorPasswordChallengeConfig) <&> toJSON,
-                arbitrary @(WithStatus SearchVisibilityInboundConfig) <&> toJSON,
-                arbitrary @(WithStatus MLSConfig) <&> toJSON,
-                arbitrary @(WithStatus ExposeInvitationURLsToTeamAdminConfig) <&> toJSON
-              ]
-      Event
-        <$> arbitrary
-        <*> arbitrary
-        <*> arbConfig
+    Event
+      <$> arbitrary
+      <*> arbitrary
+      <*> oneof (allArbitraryFeatures @Features)
 
 data EventType = Update
   deriving (Eq, Show, Generic)
@@ -98,5 +99,5 @@ instance ToJSONObject Event where
 instance S.ToSchema Event where
   declareNamedSchema = schemaToSwagger
 
-mkUpdateEvent :: forall cfg. (IsFeatureConfig cfg, ToSchema cfg, KnownSymbol (FeatureSymbol cfg)) => WithStatus cfg -> Event
+mkUpdateEvent :: forall cfg. (IsFeatureConfig cfg, ToSchema cfg, KnownSymbol (FeatureSymbol cfg)) => LockableFeature cfg -> Event
 mkUpdateEvent ws = Event Update (featureName @cfg) (toJSON ws)

libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs

@@ -55,7 +55,7 @@ import Data.Text qualified as Text
 import GHC.TypeLits
 import Imports hiding (head)
 import Network.HTTP.Client qualified as HTTP
-import Servant hiding (Handler, WithStatus, addHeader, respond)
+import Servant hiding (Handler, addHeader, respond)
 import Servant.Client qualified as Servant
 import Servant.Client.Core qualified as Servant
 import Servant.OpenApi (HasOpenApi (toOpenApi))
@@ -114,7 +114,7 @@ type GetAccountConferenceCallingConfig =
     :> Capture "uid" UserId
     :> "features"
     :> "conferenceCalling"
-    :> Get '[Servant.JSON] (WithStatusNoLock ConferenceCallingConfig)
+    :> Get '[Servant.JSON] (Feature ConferenceCallingConfig)
 
 type PutAccountConferenceCallingConfig =
   Summary
@@ -123,7 +123,7 @@ type PutAccountConferenceCallingConfig =
     :> Capture "uid" UserId
     :> "features"
     :> "conferenceCalling"
-    :> Servant.ReqBody '[Servant.JSON] (WithStatusNoLock ConferenceCallingConfig)
+    :> Servant.ReqBody '[Servant.JSON] (Feature ConferenceCallingConfig)
     :> Put '[Servant.JSON] NoContent
 
 type DeleteAccountConferenceCallingConfig =

libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs

@@ -24,7 +24,7 @@ import Data.OpenApi (OpenApi, info, title)
 import Data.Range
 import GHC.TypeLits (AppendSymbol)
 import Imports hiding (head)
-import Servant hiding (WithStatus)
+import Servant
 import Servant.OpenApi
 import Wire.API.ApplyMods
 import Wire.API.Bot
@@ -410,17 +410,17 @@ type FeatureStatusBasePutInternal errs featureConfig =
     (AppendSymbol "Put config for " (FeatureSymbol featureConfig))
     errs
     featureConfig
-    ( ReqBody '[JSON] (WithStatusNoLock featureConfig)
-        :> Put '[JSON] (WithStatus featureConfig)
+    ( ReqBody '[JSON] (Feature featureConfig)
+        :> Put '[JSON] (LockableFeature featureConfig)
     )
 
 type FeatureStatusBasePatchInternal errs featureConfig =
   FeatureStatusBaseInternal
     (AppendSymbol "Patch config for " (FeatureSymbol featureConfig))
     errs
     featureConfig
-    ( ReqBody '[JSON] (WithStatusPatch featureConfig)
-        :> Patch '[JSON] (WithStatus featureConfig)
+    ( ReqBody '[JSON] (LockableFeaturePatch featureConfig)
+        :> Patch '[JSON] (LockableFeature featureConfig)
     )
 
 type FeatureStatusBaseInternal desc errs featureConfig a =

libs/wire-api/src/Wire/API/Routes/Internal/LegalHold.hs

@@ -23,7 +23,7 @@ import Data.OpenApi (OpenApi)
 import Data.OpenApi.Lens
 import Data.Proxy
 import Imports
-import Servant.API hiding (Header, WithStatus)
+import Servant.API
 import Servant.OpenApi
 import Wire.API.Team.Feature
 
@@ -32,10 +32,10 @@ type InternalLegalHoldAPI =
     :> "teams"
     :> ( Capture "tid" TeamId
            :> "legalhold"
-           :> Get '[JSON] (WithStatus LegalholdConfig)
+           :> Get '[JSON] (LockableFeature LegalholdConfig)
            :<|> Capture "tid" TeamId
              :> "legalhold"
-             :> ReqBody '[JSON] (WithStatusNoLock LegalholdConfig)
+             :> ReqBody '[JSON] (Feature LegalholdConfig)
              :> Put '[] NoContent
        )
 

libs/wire-api/src/Wire/API/Routes/Public/Galley.hs

@@ -20,7 +20,7 @@
 
 module Wire.API.Routes.Public.Galley where
 
-import Servant hiding (WithStatus)
+import Servant
 import Servant.OpenApi.Internal.Orphans ()
 import Wire.API.Routes.API
 import Wire.API.Routes.Public.Galley.Bot

libs/wire-api/src/Wire/API/Routes/Public/Galley/Bot.hs

@@ -17,7 +17,7 @@
 
 module Wire.API.Routes.Public.Galley.Bot where
 
-import Servant hiding (WithStatus)
+import Servant
 import Servant.OpenApi.Internal.Orphans ()
 import Wire.API.Error
 import Wire.API.Error.Galley

libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs

@@ -23,7 +23,7 @@ import Data.Id
 import Data.Range
 import Data.SOP (I (..), NS (..))
 import Imports hiding (head)
-import Servant hiding (WithStatus)
+import Servant
 import Servant.OpenApi.Internal.Orphans ()
 import Wire.API.Conversation
 import Wire.API.Conversation.Code
@@ -884,7 +884,7 @@ type ConversationAPI =
                :> Capture' '[Description "Conversation ID"] "cnv" ConvId
                :> "features"
                :> FeatureSymbol GuestLinksConfig
-               :> Get '[Servant.JSON] (WithStatus GuestLinksConfig)
+               :> Get '[Servant.JSON] (LockableFeature GuestLinksConfig)
            )
     -- This endpoint can lead to the following events being sent:
     -- - ConvCodeDelete event to members

libs/wire-api/src/Wire/API/Routes/Public/Galley/CustomBackend.hs

@@ -18,7 +18,7 @@
 module Wire.API.Routes.Public.Galley.CustomBackend where
 
 import Data.Domain
-import Servant hiding (WithStatus)
+import Servant
 import Servant.OpenApi.Internal.Orphans ()
 import Wire.API.CustomBackend
 import Wire.API.Error

libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs

@@ -19,7 +19,7 @@ module Wire.API.Routes.Public.Galley.Feature where
 
 import Data.Id
 import GHC.TypeLits
-import Servant hiding (WithStatus)
+import Servant
 import Servant.OpenApi.Internal.Orphans ()
 import Wire.API.ApplyMods
 import Wire.API.Conversation.Role
@@ -157,7 +157,7 @@ type FeatureStatusBaseGet featureConfig =
     :> Capture "tid" TeamId
     :> "features"
     :> FeatureSymbol featureConfig
-    :> Get '[Servant.JSON] (WithStatus featureConfig)
+    :> Get '[Servant.JSON] (LockableFeature featureConfig)
 
 type FeatureStatusBasePutPublic errs featureConfig =
   Summary (AppendSymbol "Put config for " (FeatureSymbol featureConfig))
@@ -170,8 +170,8 @@ type FeatureStatusBasePutPublic errs featureConfig =
     :> Capture "tid" TeamId
     :> "features"
     :> FeatureSymbol featureConfig
-    :> ReqBody '[Servant.JSON] (WithStatusNoLock featureConfig)
-    :> Put '[Servant.JSON] (WithStatus featureConfig)
+    :> ReqBody '[Servant.JSON] (Feature featureConfig)
+    :> Put '[Servant.JSON] (LockableFeature featureConfig)
 
 -- | A type for a GET endpoint for a feature with a deprecated path
 type FeatureStatusBaseDeprecatedGet desc featureConfig =
@@ -191,7 +191,7 @@ type FeatureStatusBaseDeprecatedGet desc featureConfig =
       :> Capture "tid" TeamId
       :> "features"
       :> DeprecatedFeatureName featureConfig
-      :> Get '[Servant.JSON] (WithStatus featureConfig)
+      :> Get '[Servant.JSON] (LockableFeature featureConfig)
   )
 
 -- | A type for a PUT endpoint for a feature with a deprecated path
@@ -213,8 +213,8 @@ type FeatureStatusBaseDeprecatedPut desc featureConfig =
     :> Capture "tid" TeamId
     :> "features"
     :> DeprecatedFeatureName featureConfig
-    :> ReqBody '[Servant.JSON] (WithStatusNoLock featureConfig)
-    :> Put '[Servant.JSON] (WithStatus featureConfig)
+    :> ReqBody '[Servant.JSON] (Feature featureConfig)
+    :> Put '[Servant.JSON] (LockableFeature featureConfig)
 
 type FeatureConfigDeprecatedGet desc featureConfig =
   Named
@@ -228,7 +228,7 @@ type FeatureConfigDeprecatedGet desc featureConfig =
         :> CanThrow 'TeamNotFound
         :> "feature-configs"
         :> FeatureSymbol featureConfig
-        :> Get '[Servant.JSON] (WithStatus featureConfig)
+        :> Get '[Servant.JSON] (LockableFeature featureConfig)
     )
 
 type AllFeatureConfigsUserGet =

libs/wire-api/src/Wire/API/Routes/Public/Galley/LegalHold.hs

@@ -20,7 +20,7 @@ module Wire.API.Routes.Public.Galley.LegalHold where
 import Data.Id
 import GHC.Generics
 import Generics.SOP qualified as GSOP
-import Servant hiding (WithStatus)
+import Servant
 import Servant.OpenApi.Internal.Orphans ()
 import Wire.API.Conversation.Role
 import Wire.API.Error