diff --git a/.gitignore b/.gitignore index a6318e378e3..c5be8f38512 100644 --- a/.gitignore +++ b/.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 diff --git a/changelog.d/5-internal/feature-flag-refactoring-1 b/changelog.d/5-internal/feature-flag-refactoring-1 new file mode 100644 index 00000000000..92f0a33d35a --- /dev/null +++ b/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 diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index a0d274b9a2e..4b285e6bef2 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/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 :: diff --git a/libs/galley-types/default.nix b/libs/galley-types/default.nix index c67ae7c7cb1..f977e3444c9 100644 --- a/libs/galley-types/default.nix +++ b/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 diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index f1fae8db830..7a07066d2e3 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -75,6 +75,7 @@ library , bytestring-conversion , containers >=0.5 , crypton + , data-default , errors , imports , lens >=4.12 diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 47ae6d8a516..23300b55c27 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs b/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs index 32e67dcfaf6..ca1e3fc7534 100644 --- a/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs +++ b/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) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index a143f9e3e33..6c14cbd6916 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/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 = diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index 44afc4e627a..b8f6b73b324 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/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,8 +410,8 @@ 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 = @@ -419,8 +419,8 @@ type FeatureStatusBasePatchInternal errs featureConfig = (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 = diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/LegalHold.hs b/libs/wire-api/src/Wire/API/Routes/Internal/LegalHold.hs index ffde2e561c3..73087b78ea3 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/LegalHold.hs +++ b/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 ) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 52ec0ee5022..e7610068772 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Bot.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Bot.hs index 6d4359b545c..06b1df74de1 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Bot.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs index 064dd35f673..c228a3c2621 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/CustomBackend.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/CustomBackend.hs index 607a6e62573..c91dd758fdd 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/CustomBackend.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs index 4aba788fcf5..5e69d130941 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs +++ b/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 = diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/LegalHold.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/LegalHold.hs index f04ad6c3e70..a9d7ebe219d 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/LegalHold.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs index 6c53e5e3398..41d5dbf27a6 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs @@ -17,7 +17,7 @@ module Wire.API.Routes.Public.Galley.MLS where -import Servant hiding (WithStatus) +import Servant import Servant.OpenApi.Internal.Orphans () import Wire.API.Error import Wire.API.Error.Galley diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs index d4b81661b79..c862d5863d0 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs @@ -23,7 +23,7 @@ import Data.OpenApi qualified as S import Data.SOP import Generics.SOP qualified as GSOP import Imports -import Servant hiding (WithStatus) +import Servant import Servant.OpenApi.Internal.Orphans () import Wire.API.Error import Wire.API.Error.Brig qualified as BrigError diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs index fd3fd392a4a..4c0c61751d4 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs @@ -19,7 +19,7 @@ module Wire.API.Routes.Public.Galley.Team where import Data.Id import Imports -import Servant hiding (WithStatus) +import Servant import Servant.OpenApi.Internal.Orphans () import Wire.API.Error import Wire.API.Error.Galley diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs index 0f45c2ac92c..98573abb02e 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs @@ -18,7 +18,7 @@ module Wire.API.Routes.Public.Galley.TeamConversation where import Data.Id -import Servant hiding (WithStatus) +import Servant import Servant.OpenApi.Internal.Orphans () import Wire.API.Conversation.Role import Wire.API.Error diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs index 4c71df03e49..ef66057baa3 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs @@ -22,7 +22,7 @@ import Data.Int import Data.Range import GHC.Generics import Generics.SOP qualified as GSOP -import Servant hiding (WithStatus) +import Servant import Servant.OpenApi.Internal.Orphans () import Wire.API.Error import Wire.API.Error.Galley diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index f5083f5c87f..095c2fe5f9b 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -3,6 +3,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} -- This file is part of the Wire Server implementation. -- @@ -26,33 +27,16 @@ module Wire.API.Team.Feature featureName, featureNameBS, LockStatus (..), - WithStatusBase (..), DbFeature (..), - DbFeatureWithLock (..), + dbFeatureLockStatus, dbFeatureStatus, - dbFeatureTTL, dbFeatureConfig, dbFeatureModConfig, - WithStatus, - withStatus, - withStatus', - wsStatus, - wsLockStatus, - wsConfig, - wsTTL, - setStatus, - setLockStatus, - setConfig, - setConfig', - setTTL, - setWsTTL, - WithStatusPatch, - wsPatch, - wspStatus, - wspLockStatus, - wspConfig, - wspTTL, - WithStatusNoLock (..), + LockableFeature (..), + defUnlockedFeature, + defLockedFeature, + LockableFeaturePatch (..), + Feature (..), forgetLock, withLockStatus, withUnlocked, @@ -62,9 +46,7 @@ module Wire.API.Team.Feature FeatureTTLUnit (..), convertFeatureTTLDaysToSeconds, EnforceAppLock (..), - defFeatureStatusNoLock, genericComputeFeature, - computeFeatureConfigForTeamUser, IsFeatureConfig (..), FeatureSingleton (..), HasDeprecatedFeatureName (..), @@ -91,7 +73,12 @@ module Wire.API.Team.Feature MlsMigrationConfig (..), EnforceFileDownloadLocationConfig (..), LimitedEventFanoutConfig (..), - AllFeatures (..), + Features, + AllFeatures, + NpProject (..), + npProject, + NpUpdate (..), + npUpdate, AllFeatureConfigs, unImplicitLockStatus, ImplicitLockStatus (..), @@ -113,8 +100,10 @@ import Data.Id import Data.Json.Util import Data.Kind import Data.Misc (HttpsUrl) +import Data.Monoid import Data.OpenApi qualified as S import Data.Proxy +import Data.SOP import Data.Schema import Data.Scientific (toBoundedInteger) import Data.Text qualified as T @@ -189,9 +178,8 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -- 12. Add a section to the documentation at an appropriate place -- (e.g. 'docs/src/developer/reference/config-options.md' (if applicable) or -- 'docs/src/understand/team-feature-settings.md') -class IsFeatureConfig cfg where +class (Default cfg, Default (LockableFeature cfg)) => IsFeatureConfig cfg where type FeatureSymbol cfg :: Symbol - defFeatureStatus :: WithStatus cfg featureSingleton :: FeatureSingleton cfg objectSchema :: @@ -218,10 +206,7 @@ data FeatureSingleton cfg where FeatureSingletonExposeInvitationURLsToTeamAdminConfig :: FeatureSingleton ExposeInvitationURLsToTeamAdminConfig FeatureSingletonOutlookCalIntegrationConfig :: FeatureSingleton OutlookCalIntegrationConfig FeatureSingletonMlsE2EIdConfig :: FeatureSingleton MlsE2EIdConfig - FeatureSingletonMlsMigration :: - -- FUTUREWORK: rename to `FeatureSingletonMlsMigrationConfig` (or drop the `Config` from - -- all other constructors) - FeatureSingleton MlsMigrationConfig + FeatureSingletonMlsMigrationConfig :: FeatureSingleton MlsMigrationConfig FeatureSingletonEnforceFileDownloadLocationConfig :: FeatureSingleton EnforceFileDownloadLocationConfig FeatureSingletonLimitedEventFanoutConfig :: FeatureSingleton LimitedEventFanoutConfig @@ -234,49 +219,28 @@ featureName = T.pack $ symbolVal (Proxy @(FeatureSymbol cfg)) featureNameBS :: forall cfg. (KnownSymbol (FeatureSymbol cfg)) => ByteString featureNameBS = UTF8.fromString $ symbolVal (Proxy @(FeatureSymbol cfg)) ----------------------------------------------------------------------- --- WithStatusBase - -data WithStatusBase (m :: Type -> Type) (cfg :: Type) = WithStatusBase - { wsbStatus :: m FeatureStatus, - wsbLockStatus :: m LockStatus, - wsbConfig :: m cfg, - wsbTTL :: m FeatureTTL - } - deriving stock (Generic, Typeable, Functor) - -------------------------------------------------------------------------------- -- DbFeature -- | Feature data stored in the database, as a function of its default values. newtype DbFeature cfg = DbFeature - {unDbFeature :: WithStatusNoLock cfg -> WithStatusNoLock cfg} + {applyDbFeature :: LockableFeature cfg -> LockableFeature cfg} + deriving (Semigroup, Monoid) via Endo (LockableFeature cfg) -instance Semigroup (DbFeature cfg) where - DbFeature f <> DbFeature g = DbFeature (f . g) - -instance Monoid (DbFeature cfg) where - mempty = DbFeature id +dbFeatureLockStatus :: LockStatus -> DbFeature cfg +dbFeatureLockStatus s = DbFeature $ \w -> w {lockStatus = s} dbFeatureStatus :: FeatureStatus -> DbFeature cfg -dbFeatureStatus s = DbFeature $ \w -> w {wssStatus = s} - -dbFeatureTTL :: FeatureTTL -> DbFeature cfg -dbFeatureTTL ttl = DbFeature $ \w -> w {wssTTL = ttl} +dbFeatureStatus s = DbFeature $ \w -> w {status = s} dbFeatureConfig :: cfg -> DbFeature cfg -dbFeatureConfig c = DbFeature $ \w -> w {wssConfig = c} +dbFeatureConfig c = DbFeature $ \w -> w {config = c} dbFeatureModConfig :: (cfg -> cfg) -> DbFeature cfg -dbFeatureModConfig f = DbFeature $ \w -> w {wssConfig = f (wssConfig w)} - -data DbFeatureWithLock cfg = DbFeatureWithLock - { lockStatus :: Maybe LockStatus, - feature :: DbFeature cfg - } +dbFeatureModConfig f = DbFeature $ \w -> w {config = f w.config} ---------------------------------------------------------------------- --- WithStatus +-- LockableFeature -- [Note: unsettable features] -- @@ -296,153 +260,119 @@ data DbFeatureWithLock cfg = DbFeatureWithLock -- See the implementation of 'computeFeature' for 'ConferenceCallingConfig' for -- an example of this mechanism in practice. --- FUTUREWORK: use lenses, maybe? -wsStatus :: WithStatus cfg -> FeatureStatus -wsStatus = runIdentity . wsbStatus - -wsLockStatus :: WithStatus cfg -> LockStatus -wsLockStatus = runIdentity . wsbLockStatus - -wsConfig :: WithStatus cfg -> cfg -wsConfig = runIdentity . wsbConfig - -wsTTL :: WithStatus cfg -> FeatureTTL -wsTTL = runIdentity . wsbTTL - -withStatus :: FeatureStatus -> LockStatus -> cfg -> FeatureTTL -> WithStatus cfg -withStatus s ls c ttl = WithStatusBase (Identity s) (Identity ls) (Identity c) (Identity ttl) - -setStatus :: FeatureStatus -> WithStatus cfg -> WithStatus cfg -setStatus s (WithStatusBase _ ls c ttl) = WithStatusBase (Identity s) ls c ttl - -setLockStatus :: LockStatus -> WithStatus cfg -> WithStatus cfg -setLockStatus ls (WithStatusBase s _ c ttl) = WithStatusBase s (Identity ls) c ttl - -setConfig :: cfg -> WithStatus cfg -> WithStatus cfg -setConfig = setConfig' - -setConfig' :: forall (m :: Type -> Type) (cfg :: Type). (Applicative m) => cfg -> WithStatusBase m cfg -> WithStatusBase m cfg -setConfig' c (WithStatusBase s ls _ ttl) = WithStatusBase s ls (pure c) ttl - -setTTL :: forall (m :: Type -> Type) (cfg :: Type). (Applicative m) => FeatureTTL -> WithStatusBase m cfg -> WithStatusBase m cfg -setTTL ttl (WithStatusBase s ls c _) = WithStatusBase s ls c (pure ttl) - -setWsTTL :: FeatureTTL -> WithStatus cfg -> WithStatus cfg -setWsTTL = setTTL - -type WithStatus = WithStatusBase Identity - -deriving instance (Eq cfg) => Eq (WithStatus cfg) - -deriving instance (Show cfg) => Show (WithStatus cfg) - -deriving via (Schema (WithStatus cfg)) instance (ToSchema (WithStatus cfg)) => ToJSON (WithStatus cfg) - -deriving via (Schema (WithStatus cfg)) instance (ToSchema (WithStatus cfg)) => FromJSON (WithStatus cfg) - -deriving via (Schema (WithStatus cfg)) instance (ToSchema (WithStatus cfg), Typeable cfg) => S.ToSchema (WithStatus cfg) - -instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (WithStatus cfg) where +data LockableFeature cfg = LockableFeature + { status :: FeatureStatus, + lockStatus :: LockStatus, + config :: cfg + } + deriving stock (Eq, Show) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema (LockableFeature cfg) + +instance (Default (LockableFeature cfg)) => Default (Feature cfg) where + def = forgetLock def + +-- | A feature that is disabled and locked. +defLockedFeature :: (Default cfg) => LockableFeature cfg +defLockedFeature = + LockableFeature + { status = FeatureStatusDisabled, + lockStatus = LockStatusLocked, + config = def + } + +-- | A feature that is enabled and unlocked. +defUnlockedFeature :: (Default cfg) => LockableFeature cfg +defUnlockedFeature = + LockableFeature + { status = FeatureStatusEnabled, + lockStatus = LockStatusUnlocked, + config = def + } + +instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where schema = object name $ - WithStatusBase - <$> (runIdentity . wsbStatus) .= (Identity <$> field "status" schema) - <*> (runIdentity . wsbLockStatus) .= (Identity <$> field "lockStatus" schema) - <*> (runIdentity . wsbConfig) .= (Identity <$> objectSchema @cfg) - <*> (runIdentity . wsbTTL) .= (Identity . fromMaybe FeatureTTLUnlimited <$> optField "ttl" schema) + LockableFeature + <$> (.status) .= field "status" schema + <*> (.lockStatus) .= field "lockStatus" schema + <*> (.config) .= objectSchema @cfg + <* const FeatureTTLUnlimited + .= optField + "ttl" + (schema :: ValueSchema NamedSwaggerDoc FeatureTTL) where inner = schema @cfg - name = fromMaybe "" (getName (schemaDoc inner)) <> ".WithStatus" + name = fromMaybe "" (getName (schemaDoc inner)) <> ".LockableFeature" -instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (WithStatus cfg) where - arbitrary = WithStatusBase <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (LockableFeature cfg) where + arbitrary = LockableFeature <$> arbitrary <*> arbitrary <*> arbitrary ---------------------------------------------------------------------- --- WithStatusPatch - -type WithStatusPatch (cfg :: Type) = WithStatusBase Maybe cfg - -deriving instance (Eq cfg) => Eq (WithStatusPatch cfg) - -deriving instance (Show cfg) => Show (WithStatusPatch cfg) - -deriving via (Schema (WithStatusPatch cfg)) instance (ToSchema (WithStatusPatch cfg)) => ToJSON (WithStatusPatch cfg) - -deriving via (Schema (WithStatusPatch cfg)) instance (ToSchema (WithStatusPatch cfg)) => FromJSON (WithStatusPatch cfg) +-- LockableFeaturePatch -deriving via (Schema (WithStatusPatch cfg)) instance (ToSchema (WithStatusPatch cfg), Typeable cfg) => S.ToSchema (WithStatusPatch cfg) - -wsPatch :: Maybe FeatureStatus -> Maybe LockStatus -> Maybe cfg -> Maybe FeatureTTL -> WithStatusPatch cfg -wsPatch = WithStatusBase - -wspStatus :: WithStatusPatch cfg -> Maybe FeatureStatus -wspStatus = wsbStatus - -wspLockStatus :: WithStatusPatch cfg -> Maybe LockStatus -wspLockStatus = wsbLockStatus - -wspConfig :: WithStatusPatch cfg -> Maybe cfg -wspConfig = wsbConfig - -wspTTL :: WithStatusPatch cfg -> Maybe FeatureTTL -wspTTL = wsbTTL - -withStatus' :: Maybe FeatureStatus -> Maybe LockStatus -> Maybe cfg -> Maybe FeatureTTL -> WithStatusPatch cfg -withStatus' = WithStatusBase +data LockableFeaturePatch (cfg :: Type) = LockableFeaturePatch + { status :: Maybe FeatureStatus, + lockStatus :: Maybe LockStatus, + config :: Maybe cfg + } + deriving stock (Eq, Show) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema (LockableFeaturePatch cfg)) --- | The ToJSON implementation of `WithStatusPatch` will encode the trivial config as `"config": {}` +-- | The ToJSON implementation of `LockableFeaturePatch` will encode the trivial config as `"config": {}` -- when the value is a `Just`, if it's `Nothing` it will be omitted, which is the important part. -instance (ToSchema cfg) => ToSchema (WithStatusPatch cfg) where +instance (ToSchema cfg) => ToSchema (LockableFeaturePatch cfg) where schema = object name $ - WithStatusBase - <$> wsbStatus .= maybe_ (optField "status" schema) - <*> wsbLockStatus .= maybe_ (optField "lockStatus" schema) - <*> wsbConfig .= maybe_ (optField "config" schema) - <*> wsbTTL .= maybe_ (optField "ttl" schema) + LockableFeaturePatch + <$> (.status) .= maybe_ (optField "status" schema) + <*> (.lockStatus) .= maybe_ (optField "lockStatus" schema) + <*> (.config) .= maybe_ (optField "config" schema) + <* const FeatureTTLUnlimited + .= optField + "ttl" + (schema :: ValueSchema NamedSwaggerDoc FeatureTTL) where inner = schema @cfg - name = fromMaybe "" (getName (schemaDoc inner)) <> ".WithStatusPatch" + name = fromMaybe "" (getName (schemaDoc inner)) <> ".LockableFeaturePatch" -instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (WithStatusPatch cfg) where - arbitrary = WithStatusBase <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (LockableFeaturePatch cfg) where + arbitrary = LockableFeaturePatch <$> arbitrary <*> arbitrary <*> arbitrary ---------------------------------------------------------------------- --- WithStatusNoLock +-- Feature -data WithStatusNoLock (cfg :: Type) = WithStatusNoLock - { wssStatus :: FeatureStatus, - wssConfig :: cfg, - wssTTL :: FeatureTTL +data Feature (cfg :: Type) = Feature + { status :: FeatureStatus, + config :: cfg } deriving stock (Eq, Show, Generic, Typeable, Functor) - deriving (ToJSON, FromJSON, S.ToSchema) via (Schema (WithStatusNoLock cfg)) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema (Feature cfg)) -instance (Arbitrary cfg) => Arbitrary (WithStatusNoLock cfg) where - arbitrary = WithStatusNoLock <$> arbitrary <*> arbitrary <*> arbitrary +instance (Arbitrary cfg) => Arbitrary (Feature cfg) where + arbitrary = Feature <$> arbitrary <*> arbitrary -forgetLock :: WithStatus a -> WithStatusNoLock a -forgetLock ws = WithStatusNoLock (wsStatus ws) (wsConfig ws) (wsTTL ws) +forgetLock :: LockableFeature a -> Feature a +forgetLock ws = Feature ws.status ws.config -withLockStatus :: LockStatus -> WithStatusNoLock a -> WithStatus a -withLockStatus ls (WithStatusNoLock s c ttl) = withStatus s ls c ttl +withLockStatus :: LockStatus -> Feature a -> LockableFeature a +withLockStatus ls (Feature s c) = LockableFeature s ls c -withUnlocked :: WithStatusNoLock a -> WithStatus a +withUnlocked :: Feature a -> LockableFeature a withUnlocked = withLockStatus LockStatusUnlocked -withLocked :: WithStatusNoLock a -> WithStatus a -withLocked = withLockStatus LockStatusLocked - -instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (WithStatusNoLock cfg) where +instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (Feature cfg) where schema = object name $ - WithStatusNoLock - <$> wssStatus .= field "status" schema - <*> wssConfig .= objectSchema @cfg - <*> wssTTL .= (fromMaybe FeatureTTLUnlimited <$> optField "ttl" schema) + Feature + <$> (.status) .= field "status" schema + <*> (.config) .= objectSchema @cfg + <* const FeatureTTLUnlimited + .= optField + "ttl" + (schema :: ValueSchema NamedSwaggerDoc FeatureTTL) where inner = schema @cfg - name = fromMaybe "" (getName (schemaDoc inner)) <> ".WithStatusNoLock" + name = fromMaybe "" (getName (schemaDoc inner)) <> ".Feature" ---------------------------------------------------------------------- -- FeatureTTL @@ -602,40 +532,24 @@ instance ToSchema LockStatusResponse where LockStatusResponse <$> _unlockStatus .= field "lockStatus" schema -newtype ImplicitLockStatus (cfg :: Type) = ImplicitLockStatus {_unImplicitLockStatus :: WithStatus cfg} +newtype ImplicitLockStatus (cfg :: Type) = ImplicitLockStatus {_unImplicitLockStatus :: LockableFeature cfg} deriving newtype (Eq, Show, Arbitrary) instance (IsFeatureConfig a, ToSchema a) => ToJSON (ImplicitLockStatus a) where toJSON (ImplicitLockStatus a) = A.toJSON $ forgetLock a instance (IsFeatureConfig a, ToSchema a) => FromJSON (ImplicitLockStatus a) where - parseJSON v = ImplicitLockStatus . withLockStatus (wsLockStatus $ defFeatureStatus @a) <$> A.parseJSON v + parseJSON v = ImplicitLockStatus . withLockStatus ((def @(LockableFeature a)).lockStatus) <$> A.parseJSON v -- | Convert a feature coming from the database to its public form. This can be -- overridden on a feature basis by implementing the `computeFeature` method of -- the `GetFeatureConfig` class. -genericComputeFeature :: - WithStatus cfg -> - Maybe LockStatus -> - DbFeature cfg -> - WithStatus cfg -genericComputeFeature defFeature lockStatus dbFeature = - case fromMaybe (wsLockStatus defFeature) lockStatus of - LockStatusLocked -> setLockStatus LockStatusLocked defFeature - LockStatusUnlocked -> withUnlocked $ unDbFeature dbFeature (forgetLock defFeature) - --- | This contains the pure business logic for users from teams -computeFeatureConfigForTeamUser :: Maybe (WithStatusNoLock cfg) -> Maybe LockStatus -> WithStatus cfg -> WithStatus cfg -computeFeatureConfigForTeamUser mStatusDb mLockStatusDb defStatus = - case lockStatus of - LockStatusLocked -> - withLocked (forgetLock defStatus) - LockStatusUnlocked -> - withUnlocked $ case mStatusDb of - Nothing -> forgetLock defStatus - Just fs -> fs - where - lockStatus = fromMaybe (wsLockStatus defStatus) mLockStatusDb +genericComputeFeature :: forall cfg. LockableFeature cfg -> DbFeature cfg -> LockableFeature cfg +genericComputeFeature defFeature dbFeature = + let feat = applyDbFeature dbFeature defFeature + in case feat.lockStatus of + LockStatusLocked -> defFeature {lockStatus = LockStatusLocked} + LockStatusUnlocked -> feat -------------------------------------------------------------------------------- -- GuestLinks feature @@ -644,15 +558,20 @@ data GuestLinksConfig = GuestLinksConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform GuestLinksConfig) +instance Default GuestLinksConfig where + def = GuestLinksConfig + instance RenderableSymbol GuestLinksConfig where renderSymbol = "GuestLinksConfig" instance ToSchema GuestLinksConfig where schema = object "GuestLinksConfig" objectSchema +instance Default (LockableFeature GuestLinksConfig) where + def = defUnlockedFeature + instance IsFeatureConfig GuestLinksConfig where type FeatureSymbol GuestLinksConfig = "conversationGuestLinks" - defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonGuestLinksConfig objectSchema = pure GuestLinksConfig @@ -664,12 +583,17 @@ data LegalholdConfig = LegalholdConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform LegalholdConfig) +instance Default LegalholdConfig where + def = LegalholdConfig + instance RenderableSymbol LegalholdConfig where renderSymbol = "LegalholdConfig" +instance Default (LockableFeature LegalholdConfig) where + def = defUnlockedFeature {status = FeatureStatusDisabled} + instance IsFeatureConfig LegalholdConfig where type FeatureSymbol LegalholdConfig = "legalhold" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonLegalholdConfig objectSchema = pure LegalholdConfig @@ -684,12 +608,17 @@ data SSOConfig = SSOConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform SSOConfig) +instance Default SSOConfig where + def = SSOConfig + instance RenderableSymbol SSOConfig where renderSymbol = "SSOConfig" +instance Default (LockableFeature SSOConfig) where + def = defUnlockedFeature {status = FeatureStatusDisabled} + instance IsFeatureConfig SSOConfig where type FeatureSymbol SSOConfig = "sso" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonSSOConfig objectSchema = pure SSOConfig @@ -705,12 +634,17 @@ data SearchVisibilityAvailableConfig = SearchVisibilityAvailableConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform SearchVisibilityAvailableConfig) +instance Default SearchVisibilityAvailableConfig where + def = SearchVisibilityAvailableConfig + instance RenderableSymbol SearchVisibilityAvailableConfig where renderSymbol = "SearchVisibilityAvailableConfig" +instance Default (LockableFeature SearchVisibilityAvailableConfig) where + def = defUnlockedFeature {status = FeatureStatusDisabled} + instance IsFeatureConfig SearchVisibilityAvailableConfig where type FeatureSymbol SearchVisibilityAvailableConfig = "searchVisibility" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonSearchVisibilityAvailableConfig objectSchema = pure SearchVisibilityAvailableConfig @@ -728,15 +662,20 @@ data ValidateSAMLEmailsConfig = ValidateSAMLEmailsConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ValidateSAMLEmailsConfig) +instance Default ValidateSAMLEmailsConfig where + def = ValidateSAMLEmailsConfig + instance RenderableSymbol ValidateSAMLEmailsConfig where renderSymbol = "ValidateSAMLEmailsConfig" instance ToSchema ValidateSAMLEmailsConfig where schema = object "ValidateSAMLEmailsConfig" objectSchema +instance Default (LockableFeature ValidateSAMLEmailsConfig) where + def = defUnlockedFeature + instance IsFeatureConfig ValidateSAMLEmailsConfig where type FeatureSymbol ValidateSAMLEmailsConfig = "validateSAMLemails" - defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked ValidateSAMLEmailsConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonValidateSAMLEmailsConfig objectSchema = pure ValidateSAMLEmailsConfig @@ -751,12 +690,17 @@ data DigitalSignaturesConfig = DigitalSignaturesConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform DigitalSignaturesConfig) +instance Default DigitalSignaturesConfig where + def = DigitalSignaturesConfig + instance RenderableSymbol DigitalSignaturesConfig where renderSymbol = "DigitalSignaturesConfig" +instance Default (LockableFeature DigitalSignaturesConfig) where + def = defUnlockedFeature {status = FeatureStatusDisabled} + instance IsFeatureConfig DigitalSignaturesConfig where type FeatureSymbol DigitalSignaturesConfig = "digitalSignatures" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked DigitalSignaturesConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonDigitalSignaturesConfig objectSchema = pure DigitalSignaturesConfig @@ -804,9 +748,11 @@ instance Default ConferenceCallingConfig where instance RenderableSymbol ConferenceCallingConfig where renderSymbol = "ConferenceCallingConfig" +instance Default (LockableFeature ConferenceCallingConfig) where + def = defLockedFeature {status = FeatureStatusEnabled} + instance IsFeatureConfig ConferenceCallingConfig where type FeatureSymbol ConferenceCallingConfig = "conferenceCalling" - defFeatureStatus = withStatus FeatureStatusEnabled LockStatusLocked def FeatureTTLUnlimited featureSingleton = FeatureSingletonConferenceCallingConfig objectSchema = fromMaybe def <$> optField "config" schema @@ -826,15 +772,20 @@ data SndFactorPasswordChallengeConfig = SndFactorPasswordChallengeConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform SndFactorPasswordChallengeConfig) +instance Default SndFactorPasswordChallengeConfig where + def = SndFactorPasswordChallengeConfig + instance RenderableSymbol SndFactorPasswordChallengeConfig where renderSymbol = "SndFactorPasswordChallengeConfig" instance ToSchema SndFactorPasswordChallengeConfig where schema = object "SndFactorPasswordChallengeConfig" objectSchema +instance Default (LockableFeature SndFactorPasswordChallengeConfig) where + def = defLockedFeature + instance IsFeatureConfig SndFactorPasswordChallengeConfig where type FeatureSymbol SndFactorPasswordChallengeConfig = "sndFactorPasswordChallenge" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked SndFactorPasswordChallengeConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonSndFactorPasswordChallengeConfig objectSchema = pure SndFactorPasswordChallengeConfig @@ -846,12 +797,17 @@ data SearchVisibilityInboundConfig = SearchVisibilityInboundConfig deriving (Arbitrary) via (GenericUniform SearchVisibilityInboundConfig) deriving (S.ToSchema) via Schema SearchVisibilityInboundConfig +instance Default SearchVisibilityInboundConfig where + def = SearchVisibilityInboundConfig + instance RenderableSymbol SearchVisibilityInboundConfig where renderSymbol = "SearchVisibilityInboundConfig" +instance Default (LockableFeature SearchVisibilityInboundConfig) where + def = defUnlockedFeature {status = FeatureStatusDisabled} + instance IsFeatureConfig SearchVisibilityInboundConfig where type FeatureSymbol SearchVisibilityInboundConfig = "searchVisibilityInbound" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityInboundConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonSearchVisibilityInboundConfig objectSchema = pure SearchVisibilityInboundConfig @@ -870,6 +826,9 @@ data ClassifiedDomainsConfig = ClassifiedDomainsConfig deriving stock (Show, Eq, Generic) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ClassifiedDomainsConfig) +instance Default ClassifiedDomainsConfig where + def = ClassifiedDomainsConfig [] + instance RenderableSymbol ClassifiedDomainsConfig where renderSymbol = "ClassifiedDomainsConfig" @@ -881,15 +840,12 @@ instance ToSchema ClassifiedDomainsConfig where ClassifiedDomainsConfig <$> classifiedDomainsDomains .= field "domains" (array schema) +instance Default (LockableFeature ClassifiedDomainsConfig) where + def = defUnlockedFeature {status = FeatureStatusDisabled} + instance IsFeatureConfig ClassifiedDomainsConfig where type FeatureSymbol ClassifiedDomainsConfig = "classifiedDomains" - defFeatureStatus = - withStatus - FeatureStatusDisabled - LockStatusUnlocked - (ClassifiedDomainsConfig []) - FeatureTTLUnlimited featureSingleton = FeatureSingletonClassifiedDomainsConfig objectSchema = field "config" schema @@ -904,6 +860,9 @@ data AppLockConfig = AppLockConfig deriving (FromJSON, ToJSON, S.ToSchema) via (Schema AppLockConfig) deriving (Arbitrary) via (GenericUniform AppLockConfig) +instance Default AppLockConfig where + def = AppLockConfig (EnforceAppLock False) 60 + instance RenderableSymbol AppLockConfig where renderSymbol = "AppLockConfig" @@ -914,15 +873,12 @@ instance ToSchema AppLockConfig where <$> applockEnforceAppLock .= field "enforceAppLock" schema <*> applockInactivityTimeoutSecs .= field "inactivityTimeoutSecs" schema +instance Default (LockableFeature AppLockConfig) where + def = defUnlockedFeature + instance IsFeatureConfig AppLockConfig where type FeatureSymbol AppLockConfig = "appLock" - defFeatureStatus = - withStatus - FeatureStatusEnabled - LockStatusUnlocked - (AppLockConfig (EnforceAppLock False) 60) - FeatureTTLUnlimited featureSingleton = FeatureSingletonAppLockConfig objectSchema = field "config" schema @@ -941,12 +897,17 @@ data FileSharingConfig = FileSharingConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform FileSharingConfig) +instance Default FileSharingConfig where + def = FileSharingConfig + instance RenderableSymbol FileSharingConfig where renderSymbol = "FileSharingConfig" +instance Default (LockableFeature FileSharingConfig) where + def = defUnlockedFeature + instance IsFeatureConfig FileSharingConfig where type FeatureSymbol FileSharingConfig = "fileSharing" - defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked FileSharingConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonFileSharingConfig objectSchema = pure FileSharingConfig @@ -963,6 +924,9 @@ newtype SelfDeletingMessagesConfig = SelfDeletingMessagesConfig deriving (FromJSON, ToJSON, S.ToSchema) via (Schema SelfDeletingMessagesConfig) deriving (Arbitrary) via (GenericUniform SelfDeletingMessagesConfig) +instance Default SelfDeletingMessagesConfig where + def = SelfDeletingMessagesConfig 0 + instance RenderableSymbol SelfDeletingMessagesConfig where renderSymbol = "SelfDeletingMessagesConfig" @@ -972,14 +936,11 @@ instance ToSchema SelfDeletingMessagesConfig where SelfDeletingMessagesConfig <$> sdmEnforcedTimeoutSeconds .= field "enforcedTimeoutSeconds" schema +instance Default (LockableFeature SelfDeletingMessagesConfig) where + def = defUnlockedFeature + instance IsFeatureConfig SelfDeletingMessagesConfig where type FeatureSymbol SelfDeletingMessagesConfig = "selfDeletingMessages" - defFeatureStatus = - withStatus - FeatureStatusEnabled - LockStatusUnlocked - (SelfDeletingMessagesConfig 0) - FeatureTTLUnlimited featureSingleton = FeatureSingletonSelfDeletingMessagesConfig objectSchema = field "config" schema @@ -996,6 +957,15 @@ data MLSConfig = MLSConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform MLSConfig) +instance Default MLSConfig where + def = + MLSConfig + [] + ProtocolProteusTag + [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] + MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 + [ProtocolProteusTag, ProtocolMLSTag] + instance RenderableSymbol MLSConfig where renderSymbol = "MLSConfig" @@ -1009,17 +979,11 @@ instance ToSchema MLSConfig where <*> mlsDefaultCipherSuite .= field "defaultCipherSuite" schema <*> mlsSupportedProtocols .= field "supportedProtocols" (array schema) +instance Default (LockableFeature MLSConfig) where + def = defUnlockedFeature {status = FeatureStatusDisabled} + instance IsFeatureConfig MLSConfig where type FeatureSymbol MLSConfig = "mls" - defFeatureStatus = - let config = - MLSConfig - [] - ProtocolProteusTag - [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] - MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - [ProtocolProteusTag, ProtocolMLSTag] - in withStatus FeatureStatusDisabled LockStatusUnlocked config FeatureTTLUnlimited featureSingleton = FeatureSingletonMLSConfig objectSchema = field "config" schema @@ -1030,12 +994,17 @@ data ExposeInvitationURLsToTeamAdminConfig = ExposeInvitationURLsToTeamAdminConf deriving stock (Show, Eq, Generic) deriving (Arbitrary) via (GenericUniform ExposeInvitationURLsToTeamAdminConfig) +instance Default ExposeInvitationURLsToTeamAdminConfig where + def = ExposeInvitationURLsToTeamAdminConfig + instance RenderableSymbol ExposeInvitationURLsToTeamAdminConfig where renderSymbol = "ExposeInvitationURLsToTeamAdminConfig" +instance Default (LockableFeature ExposeInvitationURLsToTeamAdminConfig) where + def = defLockedFeature + instance IsFeatureConfig ExposeInvitationURLsToTeamAdminConfig where type FeatureSymbol ExposeInvitationURLsToTeamAdminConfig = "exposeInvitationURLsToTeamAdmin" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonExposeInvitationURLsToTeamAdminConfig objectSchema = pure ExposeInvitationURLsToTeamAdminConfig @@ -1051,12 +1020,17 @@ data OutlookCalIntegrationConfig = OutlookCalIntegrationConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform OutlookCalIntegrationConfig) +instance Default OutlookCalIntegrationConfig where + def = OutlookCalIntegrationConfig + instance RenderableSymbol OutlookCalIntegrationConfig where renderSymbol = "OutlookCalIntegrationConfig" +instance Default (LockableFeature OutlookCalIntegrationConfig) where + def = defLockedFeature + instance IsFeatureConfig OutlookCalIntegrationConfig where type FeatureSymbol OutlookCalIntegrationConfig = "outlookCalIntegration" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked OutlookCalIntegrationConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonOutlookCalIntegrationConfig objectSchema = pure OutlookCalIntegrationConfig @@ -1074,6 +1048,9 @@ data MlsE2EIdConfig = MlsE2EIdConfig } deriving stock (Eq, Show, Generic) +instance Default MlsE2EIdConfig where + def = MlsE2EIdConfig (fromIntegral @Int (60 * 60 * 24)) Nothing Nothing False + instance RenderableSymbol MlsE2EIdConfig where renderSymbol = "MlsE2EIdConfig" @@ -1116,11 +1093,11 @@ instance ToSchema MlsE2EIdConfig where \this team. It is of the form \"https://acme.{backendDomain}/acme/{provisionerName}/discovery\". For example: \ \`https://acme.example.com/acme/provisioner1/discovery`." +instance Default (LockableFeature MlsE2EIdConfig) where + def = defLockedFeature + instance IsFeatureConfig MlsE2EIdConfig where type FeatureSymbol MlsE2EIdConfig = "mlsE2EId" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked defValue FeatureTTLUnlimited - where - defValue = MlsE2EIdConfig (fromIntegral @Int (60 * 60 * 24)) Nothing Nothing False featureSingleton = FeatureSingletonMlsE2EIdConfig objectSchema = field "config" schema @@ -1133,6 +1110,9 @@ data MlsMigrationConfig = MlsMigrationConfig } deriving stock (Eq, Show, Generic) +instance Default MlsMigrationConfig where + def = MlsMigrationConfig Nothing Nothing + instance RenderableSymbol MlsMigrationConfig where renderSymbol = "MlsMigrationConfig" @@ -1153,12 +1133,12 @@ instance ToSchema MlsMigrationConfig where <$> startTime .= maybe_ (optField "startTime" utcTimeSchema) <*> finaliseRegardlessAfter .= maybe_ (optField "finaliseRegardlessAfter" utcTimeSchema) +instance Default (LockableFeature MlsMigrationConfig) where + def = defLockedFeature + instance IsFeatureConfig MlsMigrationConfig where type FeatureSymbol MlsMigrationConfig = "mlsMigration" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked defValue FeatureTTLUnlimited - where - defValue = MlsMigrationConfig Nothing Nothing - featureSingleton = FeatureSingletonMlsMigration + featureSingleton = FeatureSingletonMlsMigrationConfig objectSchema = field "config" schema ---------------------------------------------------------------------- @@ -1169,6 +1149,9 @@ data EnforceFileDownloadLocationConfig = EnforceFileDownloadLocationConfig } deriving stock (Eq, Show, Generic) +instance Default EnforceFileDownloadLocationConfig where + def = EnforceFileDownloadLocationConfig Nothing + instance RenderableSymbol EnforceFileDownloadLocationConfig where renderSymbol = "EnforceFileDownloadLocationConfig" @@ -1181,9 +1164,11 @@ instance ToSchema EnforceFileDownloadLocationConfig where EnforceFileDownloadLocationConfig <$> enforcedDownloadLocation .= maybe_ (optField "enforcedDownloadLocation" schema) +instance Default (LockableFeature EnforceFileDownloadLocationConfig) where + def = defLockedFeature + instance IsFeatureConfig EnforceFileDownloadLocationConfig where type FeatureSymbol EnforceFileDownloadLocationConfig = "enforceFileDownloadLocation" - defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked (EnforceFileDownloadLocationConfig Nothing) FeatureTTLUnlimited featureSingleton = FeatureSingletonEnforceFileDownloadLocationConfig objectSchema = field "config" schema @@ -1199,12 +1184,17 @@ data LimitedEventFanoutConfig = LimitedEventFanoutConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform LimitedEventFanoutConfig) +instance Default LimitedEventFanoutConfig where + def = LimitedEventFanoutConfig + instance RenderableSymbol LimitedEventFanoutConfig where renderSymbol = "LimitedEventFanoutConfig" +instance Default (LockableFeature LimitedEventFanoutConfig) where + def = defUnlockedFeature + instance IsFeatureConfig LimitedEventFanoutConfig where type FeatureSymbol LimitedEventFanoutConfig = "limitedEventFanout" - defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked LimitedEventFanoutConfig FeatureTTLUnlimited featureSingleton = FeatureSingletonLimitedEventFanoutConfig objectSchema = pure LimitedEventFanoutConfig @@ -1271,120 +1261,108 @@ instance Cass.Cql FeatureStatus where toCql FeatureStatusDisabled = Cass.CqlInt 0 toCql FeatureStatusEnabled = Cass.CqlInt 1 -defFeatureStatusNoLock :: (IsFeatureConfig cfg) => WithStatusNoLock cfg -defFeatureStatusNoLock = forgetLock defFeatureStatus - --- FUTUREWORK: rewrite using SOP -data AllFeatures f = AllFeatures - { afcLegalholdStatus :: f LegalholdConfig, - afcSSOStatus :: f SSOConfig, - afcTeamSearchVisibilityAvailable :: f SearchVisibilityAvailableConfig, - afcSearchVisibilityInboundConfig :: f SearchVisibilityInboundConfig, - afcValidateSAMLEmails :: f ValidateSAMLEmailsConfig, - afcDigitalSignatures :: f DigitalSignaturesConfig, - afcAppLock :: f AppLockConfig, - afcFileSharing :: f FileSharingConfig, - afcClassifiedDomains :: f ClassifiedDomainsConfig, - afcConferenceCalling :: f ConferenceCallingConfig, - afcSelfDeletingMessages :: f SelfDeletingMessagesConfig, - afcGuestLink :: f GuestLinksConfig, - afcSndFactorPasswordChallenge :: f SndFactorPasswordChallengeConfig, - afcMLS :: f MLSConfig, - afcExposeInvitationURLsToTeamAdmin :: f ExposeInvitationURLsToTeamAdminConfig, - afcOutlookCalIntegration :: f OutlookCalIntegrationConfig, - afcMlsE2EId :: f MlsE2EIdConfig, - afcMlsMigration :: f MlsMigrationConfig, - afcEnforceFileDownloadLocation :: f EnforceFileDownloadLocationConfig, - afcLimitedEventFanout :: f LimitedEventFanoutConfig - } - -type AllFeatureConfigs = AllFeatures WithStatus +-- | list of available features config types +type Features :: [Type] +type Features = + [ LegalholdConfig, + SSOConfig, + SearchVisibilityAvailableConfig, + SearchVisibilityInboundConfig, + ValidateSAMLEmailsConfig, + DigitalSignaturesConfig, + AppLockConfig, + FileSharingConfig, + ClassifiedDomainsConfig, + ConferenceCallingConfig, + SelfDeletingMessagesConfig, + GuestLinksConfig, + SndFactorPasswordChallengeConfig, + MLSConfig, + ExposeInvitationURLsToTeamAdminConfig, + OutlookCalIntegrationConfig, + MlsE2EIdConfig, + MlsMigrationConfig, + EnforceFileDownloadLocationConfig, + LimitedEventFanoutConfig + ] + +-- | list of available features as a record +type AllFeatures f = NP f Features + +-- | 'AllFeatures' specialised to the 'LockableFeature' functor +type AllFeatureConfigs = AllFeatures LockableFeature + +class (Default (LockableFeature cfg)) => LockableFeatureDefault cfg + +instance (Default (LockableFeature cfg)) => LockableFeatureDefault cfg instance Default AllFeatureConfigs where - def = - AllFeatures - { afcLegalholdStatus = defFeatureStatus, - afcSSOStatus = defFeatureStatus, - afcTeamSearchVisibilityAvailable = defFeatureStatus, - afcSearchVisibilityInboundConfig = defFeatureStatus, - afcValidateSAMLEmails = defFeatureStatus, - afcDigitalSignatures = defFeatureStatus, - afcAppLock = defFeatureStatus, - afcFileSharing = defFeatureStatus, - afcClassifiedDomains = defFeatureStatus, - afcConferenceCalling = defFeatureStatus, - afcSelfDeletingMessages = defFeatureStatus, - afcGuestLink = defFeatureStatus, - afcSndFactorPasswordChallenge = defFeatureStatus, - afcMLS = defFeatureStatus, - afcExposeInvitationURLsToTeamAdmin = defFeatureStatus, - afcOutlookCalIntegration = defFeatureStatus, - afcMlsE2EId = defFeatureStatus, - afcMlsMigration = defFeatureStatus, - afcEnforceFileDownloadLocation = defFeatureStatus, - afcLimitedEventFanout = defFeatureStatus - } + def = hcpure (Proxy @LockableFeatureDefault) def + +-- | object schema for nary products +class HObjectSchema c xs where + hobjectSchema :: (forall cfg. (c cfg) => ObjectSchema SwaggerDoc (f cfg)) -> ObjectSchema SwaggerDoc (NP f xs) + +instance HObjectSchema c '[] where + hobjectSchema _ = pure Nil + +instance (HObjectSchema c xs, c x) => HObjectSchema c ((x :: Type) : xs) where + hobjectSchema f = (:*) <$> hd .= f <*> tl .= hobjectSchema @c @xs f + +-- | constraint synonym for 'ToSchema' 'AllFeatureConfigs' +class (IsFeatureConfig cfg, ToSchema cfg, KnownSymbol (FeatureSymbol cfg)) => FeatureFieldConstraints cfg + +instance (IsFeatureConfig cfg, ToSchema cfg, KnownSymbol (FeatureSymbol cfg)) => FeatureFieldConstraints cfg instance ToSchema AllFeatureConfigs where schema = - object "AllFeatureConfigs" $ - AllFeatures - <$> afcLegalholdStatus .= featureField - <*> afcSSOStatus .= featureField - <*> afcTeamSearchVisibilityAvailable .= featureField - <*> afcSearchVisibilityInboundConfig .= featureField - <*> afcValidateSAMLEmails .= featureField - <*> afcDigitalSignatures .= featureField - <*> afcAppLock .= featureField - <*> afcFileSharing .= featureField - <*> afcClassifiedDomains .= featureField - <*> afcConferenceCalling .= featureField - <*> afcSelfDeletingMessages .= featureField - <*> afcGuestLink .= featureField - <*> afcSndFactorPasswordChallenge .= featureField - <*> afcMLS .= featureField - <*> afcExposeInvitationURLsToTeamAdmin .= featureField - <*> afcOutlookCalIntegration .= featureField - <*> afcMlsE2EId .= featureField - <*> afcMlsMigration .= featureField - <*> afcEnforceFileDownloadLocation .= featureField - <*> afcLimitedEventFanout .= featureField + object "AllFeatureConfigs" $ hobjectSchema @FeatureFieldConstraints featureField where - featureField :: - forall cfg. - (IsFeatureConfig cfg, ToSchema cfg, KnownSymbol (FeatureSymbol cfg)) => - ObjectSchema SwaggerDoc (WithStatus cfg) + featureField :: forall cfg. (FeatureFieldConstraints cfg) => ObjectSchema SwaggerDoc (LockableFeature cfg) featureField = field (T.pack (symbolVal (Proxy @(FeatureSymbol cfg)))) schema +class (Arbitrary cfg, IsFeatureConfig cfg) => ArbitraryFeatureConfig cfg + +instance (Arbitrary cfg, IsFeatureConfig cfg) => ArbitraryFeatureConfig cfg + instance Arbitrary AllFeatureConfigs where - arbitrary = - AllFeatures - <$> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary + arbitrary = hsequence' $ hcpure (Proxy @ArbitraryFeatureConfig) (Comp arbitrary) -makeLenses ''ImplicitLockStatus +-- | FUTUREWORK: 'NpProject' and 'NpUpdate' can be useful for more than +-- features. Maybe they should be moved somewhere else. +class NpProject x xs where + npProject' :: Proxy x -> NP f xs -> f x + +instance {-# OVERLAPPING #-} NpProject x (x : xs) where + npProject' _ (x :* _) = x + +instance (NpProject x xs) => NpProject x (y : xs) where + npProject' p (_ :* xs) = npProject' p xs -deriving instance Show AllFeatureConfigs +instance (TypeError ('ShowType x :<>: 'Text " not found")) => NpProject x '[] where + npProject' = error "npProject': someone naughty removed the type error constraint" -deriving instance Eq AllFeatureConfigs +-- | Get the first field of a given type out of an @'NP' f xs@. +npProject :: forall x f xs. (NpProject x xs) => NP f xs -> f x +npProject = npProject' (Proxy @x) + +class NpUpdate x xs where + npUpdate' :: Proxy x -> f x -> NP f xs -> NP f xs + +instance {-# OVERLAPPING #-} NpUpdate x (x : xs) where + npUpdate' _ x (_ :* xs) = x :* xs + +instance (NpUpdate x xs) => NpUpdate x (y : xs) where + npUpdate' p x (y :* xs) = y :* npUpdate' p x xs + +instance (TypeError ('ShowType x :<>: 'Text " not found")) => NpUpdate x '[] where + npUpdate' = error "npUpdate': someone naughty removed the type error constraint" + +-- | Update the first field of a given type in an @'NP' f xs@. +npUpdate :: forall x f xs. (NpUpdate x xs) => f x -> NP f xs -> NP f xs +npUpdate = npUpdate' (Proxy @x) + +makeLenses ''ImplicitLockStatus deriving via (Schema AllFeatureConfigs) instance (FromJSON AllFeatureConfigs) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs index e999ab389a2..9aece18a8cb 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs @@ -21,11 +21,11 @@ import Imports import Test.Tasty import Test.Tasty.HUnit import Test.Wire.API.Golden.Generated.Invite_user (testObject_Invite_user_2) +import Test.Wire.API.Golden.Generated.LockableFeature_team import Test.Wire.API.Golden.Generated.MemberUpdateData_user import Test.Wire.API.Golden.Generated.NewOtrMessage_user import Test.Wire.API.Golden.Generated.RmClient_user import Test.Wire.API.Golden.Generated.SimpleMember_user -import Test.Wire.API.Golden.Generated.WithStatus_team import Test.Wire.API.Golden.Runner import Wire.API.Conversation (Conversation, MemberUpdate, OtherMemberUpdate) import Wire.API.User (NewUser, NewUserPublic) @@ -90,6 +90,6 @@ tests = (Just "only managed-by-Wire users can be created here.") "testObject_NewUserPublic_user_1-3.json" ], - testCase "WithStatus_ConferenceCallingConfig" $ - testFromJSONObject testObject_WithStatus_team_14 "testObject_WithStatus_team_14.json" + testCase "LockableFeature_ConferenceCallingConfig" $ + testFromJSONObject testObject_LockableFeature_team_14 "testObject_LockableFeature_team_14.json" ] diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs index cf0a3e20eaf..36af8c92ec1 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs @@ -86,6 +86,7 @@ import Test.Wire.API.Golden.Generated.Event_conversation qualified import Test.Wire.API.Golden.Generated.Event_featureConfig qualified import Test.Wire.API.Golden.Generated.Event_team qualified import Test.Wire.API.Golden.Generated.Event_user qualified +import Test.Wire.API.Golden.Generated.Feature_team qualified import Test.Wire.API.Golden.Generated.HandleUpdate_user qualified import Test.Wire.API.Golden.Generated.InvitationCode_user qualified import Test.Wire.API.Golden.Generated.InvitationList_team qualified @@ -99,6 +100,8 @@ import Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_user qualified import Test.Wire.API.Golden.Generated.ListType_team qualified import Test.Wire.API.Golden.Generated.LocaleUpdate_user qualified import Test.Wire.API.Golden.Generated.Locale_user qualified +import Test.Wire.API.Golden.Generated.LockableFeaturePatch_team qualified +import Test.Wire.API.Golden.Generated.LockableFeature_team qualified import Test.Wire.API.Golden.Generated.LoginCodeTimeout_user qualified import Test.Wire.API.Golden.Generated.LoginCode_user qualified import Test.Wire.API.Golden.Generated.ManagedBy_user qualified @@ -227,9 +230,6 @@ import Test.Wire.API.Golden.Generated.VerificationAction_user qualified import Test.Wire.API.Golden.Generated.VerifyDeleteUser_user qualified import Test.Wire.API.Golden.Generated.ViewLegalHoldServiceInfo_team qualified import Test.Wire.API.Golden.Generated.ViewLegalHoldService_team qualified -import Test.Wire.API.Golden.Generated.WithStatusNoLock_team qualified -import Test.Wire.API.Golden.Generated.WithStatusPatch_team qualified -import Test.Wire.API.Golden.Generated.WithStatus_team qualified import Test.Wire.API.Golden.Generated.Wrapped_20_22some_5fint_22_20Int_user qualified import Test.Wire.API.Golden.Runner import Wire.API.Routes.Version @@ -1181,110 +1181,110 @@ tests = "testObject_TeamConversationList_team_2.json" ) ], - testGroup "Golden: WithStatusNoLock_team 1" $ + testGroup "Golden: Feature_team 1" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_1, "testObject_WithStatusNoLock_team_1.json"), - (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_2, "testObject_WithStatusNoLock_team_2.json"), - (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_3, "testObject_WithStatusNoLock_team_3.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_1, "testObject_Feature_team_1.json"), + (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_2, "testObject_Feature_team_2.json"), + (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_3, "testObject_Feature_team_3.json") ], - testGroup "Golden: WithStatusNoLock_team 2" $ + testGroup "Golden: Feature_team 2" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_4, "testObject_WithStatusNoLock_team_4.json"), - (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_5, "testObject_WithStatusNoLock_team_5.json"), - (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_6, "testObject_WithStatusNoLock_team_6.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_4, "testObject_Feature_team_4.json"), + (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_5, "testObject_Feature_team_5.json"), + (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_6, "testObject_Feature_team_6.json") ], - testGroup "Golden: WithStatusNoLock_team 3" $ + testGroup "Golden: Feature_team 3" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_7, "testObject_WithStatusNoLock_team_7.json"), - (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_8, "testObject_WithStatusNoLock_team_8.json"), - (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_9, "testObject_WithStatusNoLock_team_9.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_7, "testObject_Feature_team_7.json"), + (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_8, "testObject_Feature_team_8.json"), + (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_9, "testObject_Feature_team_9.json") ], - testGroup "Golden: WithStatusNoLock_team 4" $ + testGroup "Golden: Feature_team 4" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_10, "testObject_WithStatusNoLock_team_10.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_10, "testObject_Feature_team_10.json") ], - testGroup "Golden: WithStatusNoLock_team 5" $ + testGroup "Golden: Feature_team 5" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_11, "testObject_WithStatusNoLock_team_11.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_11, "testObject_Feature_team_11.json") ], - testGroup "Golden: WithStatusNoLock_team 6" $ + testGroup "Golden: Feature_team 6" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_12, "testObject_WithStatusNoLock_team_12.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_12, "testObject_Feature_team_12.json") ], - testGroup "Golden: WithStatusNoLock_team 7" $ + testGroup "Golden: Feature_team 7" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_13, "testObject_WithStatusNoLock_team_13.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_13, "testObject_Feature_team_13.json") ], - testGroup "Golden: WithStatusNoLock_team 8" $ + testGroup "Golden: Feature_team 8" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_14, "testObject_WithStatusNoLock_team_14.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_14, "testObject_Feature_team_14.json") ], - testGroup "Golden: WithStatusNoLock_team 9" $ + testGroup "Golden: Feature_team 9" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_15, "testObject_WithStatusNoLock_team_15.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_15, "testObject_Feature_team_15.json") ], - testGroup "Golden: WithStatusNoLock_team 10" $ + testGroup "Golden: Feature_team 10" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_16, "testObject_WithStatusNoLock_team_16.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_16, "testObject_Feature_team_16.json") ], - testGroup "Golden: WithStatusNoLock_team 11" $ + testGroup "Golden: Feature_team 11" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_17, "testObject_WithStatusNoLock_team_17.json") + [ (Test.Wire.API.Golden.Generated.Feature_team.testObject_Feature_team_17, "testObject_Feature_team_17.json") ], - testGroup "Golden: WithStatus_team 1" $ + testGroup "Golden: LockableFeature_team 1" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_1, "testObject_WithStatus_team_1.json"), - (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_2, "testObject_WithStatus_team_2.json"), - (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_3, "testObject_WithStatus_team_3.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_1, "testObject_LockableFeature_team_1.json"), + (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_2, "testObject_LockableFeature_team_2.json"), + (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_3, "testObject_LockableFeature_team_3.json") ], - testGroup "Golden: WithStatus_team 2" $ + testGroup "Golden: LockableFeature_team 2" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_4, "testObject_WithStatus_team_4.json"), - (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_5, "testObject_WithStatus_team_5.json"), - (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_6, "testObject_WithStatus_team_6.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_4, "testObject_LockableFeature_team_4.json"), + (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_5, "testObject_LockableFeature_team_5.json"), + (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_6, "testObject_LockableFeature_team_6.json") ], - testGroup "Golden: WithStatus_team 3" $ + testGroup "Golden: LockableFeature_team 3" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_7, "testObject_WithStatus_team_7.json"), - (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_8, "testObject_WithStatus_team_8.json"), - (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_9, "testObject_WithStatus_team_9.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_7, "testObject_LockableFeature_team_7.json"), + (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_8, "testObject_LockableFeature_team_8.json"), + (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_9, "testObject_LockableFeature_team_9.json") ], - testGroup "Golden: WithStatus_team 4" $ + testGroup "Golden: LockableFeature_team 4" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_10, "testObject_WithStatus_team_10.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_10, "testObject_LockableFeature_team_10.json") ], - testGroup "Golden: WithStatus_team 5" $ + testGroup "Golden: LockableFeature_team 5" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_11, "testObject_WithStatus_team_11.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_11, "testObject_LockableFeature_team_11.json") ], - testGroup "Golden: WithStatus_team 6" $ + testGroup "Golden: LockableFeature_team 6" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_12, "testObject_WithStatus_team_12.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_12, "testObject_LockableFeature_team_12.json") ], - testGroup "Golden: WithStatus_team 7" $ + testGroup "Golden: LockableFeature_team 7" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_13, "testObject_WithStatus_team_13.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_13, "testObject_LockableFeature_team_13.json") ], - testGroup "Golden: WithStatus_team 8" $ + testGroup "Golden: LockableFeature_team 8" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_14, "testObject_WithStatus_team_14.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_14, "testObject_LockableFeature_team_14.json") ], - testGroup "Golden: WithStatus_team 9" $ + testGroup "Golden: LockableFeature_team 9" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_15, "testObject_WithStatus_team_15.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_15, "testObject_LockableFeature_team_15.json") ], - testGroup "Golden: WithStatus_team 10" $ + testGroup "Golden: LockableFeature_team 10" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_16, "testObject_WithStatus_team_16.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_16, "testObject_LockableFeature_team_16.json") ], - testGroup "Golden: WithStatus_team 11" $ + testGroup "Golden: LockableFeature_team 11" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_17, "testObject_WithStatus_team_17.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_17, "testObject_LockableFeature_team_17.json") ], - testGroup "Golden: WithStatus_team 12" $ + testGroup "Golden: LockableFeature_team 12" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_18, "testObject_WithStatus_team_18.json"), - (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_19, "testObject_WithStatus_team_19.json") + [ (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_18, "testObject_LockableFeature_team_18.json"), + (Test.Wire.API.Golden.Generated.LockableFeature_team.testObject_LockableFeature_team_19, "testObject_LockableFeature_team_19.json") ], testGroup "Golden: InvitationRequest_team" $ testObjects [(Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_1, "testObject_InvitationRequest_team_1.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_2, "testObject_InvitationRequest_team_2.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_3, "testObject_InvitationRequest_team_3.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_4, "testObject_InvitationRequest_team_4.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_5, "testObject_InvitationRequest_team_5.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_6, "testObject_InvitationRequest_team_6.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_7, "testObject_InvitationRequest_team_7.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_8, "testObject_InvitationRequest_team_8.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_9, "testObject_InvitationRequest_team_9.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_10, "testObject_InvitationRequest_team_10.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_11, "testObject_InvitationRequest_team_11.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_12, "testObject_InvitationRequest_team_12.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_13, "testObject_InvitationRequest_team_13.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_14, "testObject_InvitationRequest_team_14.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_15, "testObject_InvitationRequest_team_15.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_16, "testObject_InvitationRequest_team_16.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_17, "testObject_InvitationRequest_team_17.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_18, "testObject_InvitationRequest_team_18.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_19, "testObject_InvitationRequest_team_19.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_20, "testObject_InvitationRequest_team_20.json")], @@ -1339,81 +1339,81 @@ tests = (Test.Wire.API.Golden.Generated.VerificationAction_user.testObject_VerificationAction_user_3, "testObject_VerificationAction_user_3") ], testGroup - "Golden: WithStatusPatch_team 1" + "Golden: LockableFeaturePatch_team 1" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_1, "testObject_WithStatusPatch_team_1.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_1, "testObject_LockableFeaturePatch_team_1.json")], testGroup - "Golden: WithStatusPatch_team 2" + "Golden: LockableFeaturePatch_team 2" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_2, "testObject_WithStatusPatch_team_2.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_2, "testObject_LockableFeaturePatch_team_2.json")], testGroup - "Golden: WithStatusPatch_team 3" + "Golden: LockableFeaturePatch_team 3" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_3, "testObject_WithStatusPatch_team_3.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_3, "testObject_LockableFeaturePatch_team_3.json")], testGroup - "Golden: WithStatusPatch_team 4" + "Golden: LockableFeaturePatch_team 4" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_4, "testObject_WithStatusPatch_team_4.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_4, "testObject_LockableFeaturePatch_team_4.json")], testGroup - "Golden: WithStatusPatch_team 5" + "Golden: LockableFeaturePatch_team 5" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_5, "testObject_WithStatusPatch_team_5.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_5, "testObject_LockableFeaturePatch_team_5.json")], testGroup - "Golden: WithStatusPatch_team 6" + "Golden: LockableFeaturePatch_team 6" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_6, "testObject_WithStatusPatch_team_6.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_6, "testObject_LockableFeaturePatch_team_6.json")], testGroup - "Golden: WithStatusPatch_team 7" + "Golden: LockableFeaturePatch_team 7" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_7, "testObject_WithStatusPatch_team_7.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_7, "testObject_LockableFeaturePatch_team_7.json")], testGroup - "Golden: WithStatusPatch_team 8" + "Golden: LockableFeaturePatch_team 8" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_8, "testObject_WithStatusPatch_team_8.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_8, "testObject_LockableFeaturePatch_team_8.json")], testGroup - "Golden: WithStatusPatch_team 9" + "Golden: LockableFeaturePatch_team 9" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_9, "testObject_WithStatusPatch_team_9.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_9, "testObject_LockableFeaturePatch_team_9.json")], testGroup - "Golden: WithStatusPatch_team 10" + "Golden: LockableFeaturePatch_team 10" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_10, "testObject_WithStatusPatch_team_10.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_10, "testObject_LockableFeaturePatch_team_10.json")], testGroup - "Golden: WithStatusPatch_team 11" + "Golden: LockableFeaturePatch_team 11" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_11, "testObject_WithStatusPatch_team_11.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_11, "testObject_LockableFeaturePatch_team_11.json")], testGroup - "Golden: WithStatusPatch_team 12" + "Golden: LockableFeaturePatch_team 12" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_12, "testObject_WithStatusPatch_team_12.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_12, "testObject_LockableFeaturePatch_team_12.json")], testGroup - "Golden: WithStatusPatch_team 13" + "Golden: LockableFeaturePatch_team 13" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_13, "testObject_WithStatusPatch_team_13.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_13, "testObject_LockableFeaturePatch_team_13.json")], testGroup - "Golden: WithStatusPatch_team 14" + "Golden: LockableFeaturePatch_team 14" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_14, "testObject_WithStatusPatch_team_14.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_14, "testObject_LockableFeaturePatch_team_14.json")], testGroup - "Golden: WithStatusPatch_team 15" + "Golden: LockableFeaturePatch_team 15" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_15, "testObject_WithStatusPatch_team_15.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_15, "testObject_LockableFeaturePatch_team_15.json")], testGroup - "Golden: WithStatusPatch_team 16" + "Golden: LockableFeaturePatch_team 16" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_16, "testObject_WithStatusPatch_team_16.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_16, "testObject_LockableFeaturePatch_team_16.json")], testGroup - "Golden: WithStatusPatch_team 17" + "Golden: LockableFeaturePatch_team 17" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_17, "testObject_WithStatusPatch_team_17.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_17, "testObject_LockableFeaturePatch_team_17.json")], testGroup - "Golden: WithStatusPatch_team 18" + "Golden: LockableFeaturePatch_team 18" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_18, "testObject_WithStatusPatch_team_18.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_18, "testObject_LockableFeaturePatch_team_18.json")], testGroup - "Golden: WithStatusPatch_team 19" + "Golden: LockableFeaturePatch_team 19" $ testObjects - [(Test.Wire.API.Golden.Generated.WithStatusPatch_team.testObject_WithStatusPatch_team_19, "testObject_WithStatusPatch_team_19.json")], + [(Test.Wire.API.Golden.Generated.LockableFeaturePatch_team.testObject_LockableFeaturePatch_team_19, "testObject_LockableFeaturePatch_team_19.json")], testGroup "Golden: Event_FeatureConfig" $ testObjects diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Feature_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Feature_team.hs new file mode 100644 index 00000000000..540fa355c3f --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Feature_team.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedLists #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Wire.API.Golden.Generated.Feature_team where + +import Data.Domain +import Imports +import Wire.API.Team.Feature + +testObject_Feature_team_1 :: Feature AppLockConfig +testObject_Feature_team_1 = Feature FeatureStatusEnabled (AppLockConfig (EnforceAppLock False) (-98)) + +testObject_Feature_team_2 :: Feature AppLockConfig +testObject_Feature_team_2 = Feature FeatureStatusEnabled (AppLockConfig (EnforceAppLock True) 0) + +testObject_Feature_team_3 :: Feature AppLockConfig +testObject_Feature_team_3 = Feature FeatureStatusEnabled (AppLockConfig (EnforceAppLock True) 111) + +testObject_Feature_team_4 :: Feature SelfDeletingMessagesConfig +testObject_Feature_team_4 = Feature FeatureStatusEnabled (SelfDeletingMessagesConfig (-97)) + +testObject_Feature_team_5 :: Feature SelfDeletingMessagesConfig +testObject_Feature_team_5 = Feature FeatureStatusEnabled (SelfDeletingMessagesConfig 0) + +testObject_Feature_team_6 :: Feature SelfDeletingMessagesConfig +testObject_Feature_team_6 = Feature FeatureStatusEnabled (SelfDeletingMessagesConfig 77) + +testObject_Feature_team_7 :: Feature ClassifiedDomainsConfig +testObject_Feature_team_7 = Feature FeatureStatusEnabled (ClassifiedDomainsConfig []) + +testObject_Feature_team_8 :: Feature ClassifiedDomainsConfig +testObject_Feature_team_8 = Feature FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "example.com", Domain "test.foobar"]) + +testObject_Feature_team_9 :: Feature ClassifiedDomainsConfig +testObject_Feature_team_9 = Feature FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "test.foobar"]) + +testObject_Feature_team_10 :: Feature SSOConfig +testObject_Feature_team_10 = Feature FeatureStatusDisabled SSOConfig + +testObject_Feature_team_11 :: Feature SearchVisibilityAvailableConfig +testObject_Feature_team_11 = Feature FeatureStatusEnabled SearchVisibilityAvailableConfig + +testObject_Feature_team_12 :: Feature ValidateSAMLEmailsConfig +testObject_Feature_team_12 = Feature FeatureStatusDisabled ValidateSAMLEmailsConfig + +testObject_Feature_team_13 :: Feature DigitalSignaturesConfig +testObject_Feature_team_13 = Feature FeatureStatusEnabled DigitalSignaturesConfig + +testObject_Feature_team_14 :: Feature ConferenceCallingConfig +testObject_Feature_team_14 = Feature FeatureStatusDisabled (ConferenceCallingConfig One2OneCallsSft) + +testObject_Feature_team_15 :: Feature GuestLinksConfig +testObject_Feature_team_15 = Feature FeatureStatusEnabled GuestLinksConfig + +testObject_Feature_team_16 :: Feature SndFactorPasswordChallengeConfig +testObject_Feature_team_16 = Feature FeatureStatusDisabled SndFactorPasswordChallengeConfig + +testObject_Feature_team_17 :: Feature SearchVisibilityInboundConfig +testObject_Feature_team_17 = Feature FeatureStatusEnabled SearchVisibilityInboundConfig diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LockableFeaturePatch_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LockableFeaturePatch_team.hs new file mode 100644 index 00000000000..478398eb383 --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LockableFeaturePatch_team.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedLists #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Wire.API.Golden.Generated.LockableFeaturePatch_team where + +import Data.Domain +import Imports +import Wire.API.Team.Feature + +testObject_LockableFeaturePatch_team_1 :: LockableFeaturePatch AppLockConfig +testObject_LockableFeaturePatch_team_1 = LockableFeaturePatch (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just (AppLockConfig (EnforceAppLock False) (-98))) + +testObject_LockableFeaturePatch_team_2 :: LockableFeaturePatch AppLockConfig +testObject_LockableFeaturePatch_team_2 = LockableFeaturePatch Nothing Nothing (Just (AppLockConfig (EnforceAppLock True) 0)) + +testObject_LockableFeaturePatch_team_3 :: LockableFeaturePatch AppLockConfig +testObject_LockableFeaturePatch_team_3 = LockableFeaturePatch (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just (AppLockConfig (EnforceAppLock True) 111)) + +testObject_LockableFeaturePatch_team_4 :: LockableFeaturePatch SelfDeletingMessagesConfig +testObject_LockableFeaturePatch_team_4 = LockableFeaturePatch (Just FeatureStatusEnabled) Nothing (Just (SelfDeletingMessagesConfig (-97))) + +testObject_LockableFeaturePatch_team_5 :: LockableFeaturePatch SelfDeletingMessagesConfig +testObject_LockableFeaturePatch_team_5 = LockableFeaturePatch (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just (SelfDeletingMessagesConfig 0)) + +testObject_LockableFeaturePatch_team_6 :: LockableFeaturePatch SelfDeletingMessagesConfig +testObject_LockableFeaturePatch_team_6 = LockableFeaturePatch (Just FeatureStatusEnabled) Nothing (Just (SelfDeletingMessagesConfig 77)) + +testObject_LockableFeaturePatch_team_7 :: LockableFeaturePatch ClassifiedDomainsConfig +testObject_LockableFeaturePatch_team_7 = LockableFeaturePatch (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just (ClassifiedDomainsConfig [])) + +testObject_LockableFeaturePatch_team_8 :: LockableFeaturePatch ClassifiedDomainsConfig +testObject_LockableFeaturePatch_team_8 = LockableFeaturePatch Nothing (Just LockStatusLocked) (Just (ClassifiedDomainsConfig [Domain "example.com", Domain "test.foobar"])) + +testObject_LockableFeaturePatch_team_9 :: LockableFeaturePatch ClassifiedDomainsConfig +testObject_LockableFeaturePatch_team_9 = LockableFeaturePatch (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just (ClassifiedDomainsConfig [Domain "test.foobar"])) + +testObject_LockableFeaturePatch_team_10 :: LockableFeaturePatch SSOConfig +testObject_LockableFeaturePatch_team_10 = LockableFeaturePatch (Just FeatureStatusDisabled) (Just LockStatusLocked) (Just SSOConfig) + +testObject_LockableFeaturePatch_team_11 :: LockableFeaturePatch SearchVisibilityAvailableConfig +testObject_LockableFeaturePatch_team_11 = LockableFeaturePatch (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just SearchVisibilityAvailableConfig) + +testObject_LockableFeaturePatch_team_12 :: LockableFeaturePatch ValidateSAMLEmailsConfig +testObject_LockableFeaturePatch_team_12 = LockableFeaturePatch (Just FeatureStatusDisabled) Nothing (Just ValidateSAMLEmailsConfig) + +testObject_LockableFeaturePatch_team_13 :: LockableFeaturePatch DigitalSignaturesConfig +testObject_LockableFeaturePatch_team_13 = LockableFeaturePatch (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just DigitalSignaturesConfig) + +testObject_LockableFeaturePatch_team_14 :: LockableFeaturePatch ConferenceCallingConfig +testObject_LockableFeaturePatch_team_14 = LockableFeaturePatch Nothing (Just LockStatusUnlocked) (Just (ConferenceCallingConfig One2OneCallsSft)) + +testObject_LockableFeaturePatch_team_15 :: LockableFeaturePatch GuestLinksConfig +testObject_LockableFeaturePatch_team_15 = LockableFeaturePatch (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just GuestLinksConfig) + +testObject_LockableFeaturePatch_team_16 :: LockableFeaturePatch SndFactorPasswordChallengeConfig +testObject_LockableFeaturePatch_team_16 = LockableFeaturePatch (Just FeatureStatusDisabled) (Just LockStatusUnlocked) (Just SndFactorPasswordChallengeConfig) + +testObject_LockableFeaturePatch_team_17 :: LockableFeaturePatch SearchVisibilityInboundConfig +testObject_LockableFeaturePatch_team_17 = LockableFeaturePatch (Just FeatureStatusEnabled) Nothing (Just SearchVisibilityInboundConfig) + +testObject_LockableFeaturePatch_team_18 :: LockableFeaturePatch GuestLinksConfig +testObject_LockableFeaturePatch_team_18 = LockableFeaturePatch (Just FeatureStatusEnabled) Nothing Nothing + +testObject_LockableFeaturePatch_team_19 :: LockableFeaturePatch SelfDeletingMessagesConfig +testObject_LockableFeaturePatch_team_19 = LockableFeaturePatch Nothing (Just LockStatusUnlocked) Nothing diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LockableFeature_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LockableFeature_team.hs new file mode 100644 index 00000000000..8c4f9562f39 --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LockableFeature_team.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE OverloadedLists #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Wire.API.Golden.Generated.LockableFeature_team where + +import Data.ByteString.Conversion (parser, runParser) +import Data.Domain +import Data.Misc +import Imports +import Wire.API.Team.Feature + +testObject_LockableFeature_team_1 :: LockableFeature AppLockConfig +testObject_LockableFeature_team_1 = LockableFeature FeatureStatusEnabled LockStatusUnlocked (AppLockConfig (EnforceAppLock False) (-98)) + +testObject_LockableFeature_team_2 :: LockableFeature AppLockConfig +testObject_LockableFeature_team_2 = LockableFeature FeatureStatusEnabled LockStatusUnlocked (AppLockConfig (EnforceAppLock True) 0) + +testObject_LockableFeature_team_3 :: LockableFeature AppLockConfig +testObject_LockableFeature_team_3 = LockableFeature FeatureStatusEnabled LockStatusLocked (AppLockConfig (EnforceAppLock True) 111) + +testObject_LockableFeature_team_4 :: LockableFeature SelfDeletingMessagesConfig +testObject_LockableFeature_team_4 = LockableFeature FeatureStatusEnabled LockStatusUnlocked (SelfDeletingMessagesConfig (-97)) + +testObject_LockableFeature_team_5 :: LockableFeature SelfDeletingMessagesConfig +testObject_LockableFeature_team_5 = LockableFeature FeatureStatusEnabled LockStatusUnlocked (SelfDeletingMessagesConfig 0) + +testObject_LockableFeature_team_6 :: LockableFeature SelfDeletingMessagesConfig +testObject_LockableFeature_team_6 = LockableFeature FeatureStatusEnabled LockStatusLocked (SelfDeletingMessagesConfig 77) + +testObject_LockableFeature_team_7 :: LockableFeature ClassifiedDomainsConfig +testObject_LockableFeature_team_7 = LockableFeature FeatureStatusEnabled LockStatusLocked (ClassifiedDomainsConfig []) + +testObject_LockableFeature_team_8 :: LockableFeature ClassifiedDomainsConfig +testObject_LockableFeature_team_8 = LockableFeature FeatureStatusEnabled LockStatusLocked (ClassifiedDomainsConfig [Domain "example.com", Domain "test.foobar"]) + +testObject_LockableFeature_team_9 :: LockableFeature ClassifiedDomainsConfig +testObject_LockableFeature_team_9 = LockableFeature FeatureStatusEnabled LockStatusUnlocked (ClassifiedDomainsConfig [Domain "test.foobar"]) + +testObject_LockableFeature_team_10 :: LockableFeature SSOConfig +testObject_LockableFeature_team_10 = LockableFeature FeatureStatusDisabled LockStatusLocked SSOConfig + +testObject_LockableFeature_team_11 :: LockableFeature SearchVisibilityAvailableConfig +testObject_LockableFeature_team_11 = LockableFeature FeatureStatusEnabled LockStatusLocked SearchVisibilityAvailableConfig + +testObject_LockableFeature_team_12 :: LockableFeature ValidateSAMLEmailsConfig +testObject_LockableFeature_team_12 = LockableFeature FeatureStatusDisabled LockStatusLocked ValidateSAMLEmailsConfig + +testObject_LockableFeature_team_13 :: LockableFeature DigitalSignaturesConfig +testObject_LockableFeature_team_13 = LockableFeature FeatureStatusEnabled LockStatusLocked DigitalSignaturesConfig + +testObject_LockableFeature_team_14 :: LockableFeature ConferenceCallingConfig +testObject_LockableFeature_team_14 = LockableFeature FeatureStatusDisabled LockStatusUnlocked (ConferenceCallingConfig One2OneCallsTurn) + +testObject_LockableFeature_team_15 :: LockableFeature GuestLinksConfig +testObject_LockableFeature_team_15 = LockableFeature FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig + +testObject_LockableFeature_team_16 :: LockableFeature SndFactorPasswordChallengeConfig +testObject_LockableFeature_team_16 = LockableFeature FeatureStatusDisabled LockStatusUnlocked SndFactorPasswordChallengeConfig + +testObject_LockableFeature_team_17 :: LockableFeature SearchVisibilityInboundConfig +testObject_LockableFeature_team_17 = LockableFeature FeatureStatusEnabled LockStatusUnlocked SearchVisibilityInboundConfig + +testObject_LockableFeature_team_18 :: LockableFeature MlsE2EIdConfig +testObject_LockableFeature_team_18 = + LockableFeature + FeatureStatusEnabled + LockStatusLocked + ( MlsE2EIdConfig + (fromIntegral @Int (60 * 60 * 24)) + Nothing + (either (\e -> error (show e)) Just $ parseHttpsUrl "https://example.com") + False + ) + +parseHttpsUrl :: ByteString -> Either String HttpsUrl +parseHttpsUrl url = runParser parser url + +testObject_LockableFeature_team_19 :: LockableFeature MlsE2EIdConfig +testObject_LockableFeature_team_19 = + LockableFeature + FeatureStatusEnabled + LockStatusLocked + ( MlsE2EIdConfig + (fromIntegral @Int (60 * 60 * 24)) + (either (\e -> error (show e)) Just $ parseHttpsUrl "https://example.com") + Nothing + True + ) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs deleted file mode 100644 index efc0c52b7d5..00000000000 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE OverloadedLists #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Wire.API.Golden.Generated.WithStatusNoLock_team where - -import Data.Domain -import Imports -import Wire.API.Team.Feature - -testObject_WithStatusNoLock_team_1 :: WithStatusNoLock AppLockConfig -testObject_WithStatusNoLock_team_1 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock False) (-98)) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_2 :: WithStatusNoLock AppLockConfig -testObject_WithStatusNoLock_team_2 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock True) 0) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_3 :: WithStatusNoLock AppLockConfig -testObject_WithStatusNoLock_team_3 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock True) 111) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_4 :: WithStatusNoLock SelfDeletingMessagesConfig -testObject_WithStatusNoLock_team_4 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig (-97)) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_5 :: WithStatusNoLock SelfDeletingMessagesConfig -testObject_WithStatusNoLock_team_5 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig 0) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_6 :: WithStatusNoLock SelfDeletingMessagesConfig -testObject_WithStatusNoLock_team_6 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig 77) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_7 :: WithStatusNoLock ClassifiedDomainsConfig -testObject_WithStatusNoLock_team_7 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig []) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_8 :: WithStatusNoLock ClassifiedDomainsConfig -testObject_WithStatusNoLock_team_8 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "example.com", Domain "test.foobar"]) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_9 :: WithStatusNoLock ClassifiedDomainsConfig -testObject_WithStatusNoLock_team_9 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "test.foobar"]) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_10 :: WithStatusNoLock SSOConfig -testObject_WithStatusNoLock_team_10 = WithStatusNoLock FeatureStatusDisabled SSOConfig FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_11 :: WithStatusNoLock SearchVisibilityAvailableConfig -testObject_WithStatusNoLock_team_11 = WithStatusNoLock FeatureStatusEnabled SearchVisibilityAvailableConfig FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_12 :: WithStatusNoLock ValidateSAMLEmailsConfig -testObject_WithStatusNoLock_team_12 = WithStatusNoLock FeatureStatusDisabled ValidateSAMLEmailsConfig FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_13 :: WithStatusNoLock DigitalSignaturesConfig -testObject_WithStatusNoLock_team_13 = WithStatusNoLock FeatureStatusEnabled DigitalSignaturesConfig FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_14 :: WithStatusNoLock ConferenceCallingConfig -testObject_WithStatusNoLock_team_14 = WithStatusNoLock FeatureStatusDisabled (ConferenceCallingConfig One2OneCallsSft) FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_15 :: WithStatusNoLock GuestLinksConfig -testObject_WithStatusNoLock_team_15 = WithStatusNoLock FeatureStatusEnabled GuestLinksConfig FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_16 :: WithStatusNoLock SndFactorPasswordChallengeConfig -testObject_WithStatusNoLock_team_16 = WithStatusNoLock FeatureStatusDisabled SndFactorPasswordChallengeConfig FeatureTTLUnlimited - -testObject_WithStatusNoLock_team_17 :: WithStatusNoLock SearchVisibilityInboundConfig -testObject_WithStatusNoLock_team_17 = WithStatusNoLock FeatureStatusEnabled SearchVisibilityInboundConfig FeatureTTLUnlimited diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs deleted file mode 100644 index a5dd2c94955..00000000000 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# LANGUAGE OverloadedLists #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Wire.API.Golden.Generated.WithStatusPatch_team where - -import Data.Domain -import Imports -import Wire.API.Team.Feature hiding (withStatus) - -testObject_WithStatusPatch_team_1 :: WithStatusPatch AppLockConfig -testObject_WithStatusPatch_team_1 = withStatus (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just (AppLockConfig (EnforceAppLock False) (-98))) - -testObject_WithStatusPatch_team_2 :: WithStatusPatch AppLockConfig -testObject_WithStatusPatch_team_2 = withStatus Nothing Nothing (Just (AppLockConfig (EnforceAppLock True) 0)) - -testObject_WithStatusPatch_team_3 :: WithStatusPatch AppLockConfig -testObject_WithStatusPatch_team_3 = withStatus (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just (AppLockConfig (EnforceAppLock True) 111)) - -testObject_WithStatusPatch_team_4 :: WithStatusPatch SelfDeletingMessagesConfig -testObject_WithStatusPatch_team_4 = withStatus (Just FeatureStatusEnabled) Nothing (Just (SelfDeletingMessagesConfig (-97))) - -testObject_WithStatusPatch_team_5 :: WithStatusPatch SelfDeletingMessagesConfig -testObject_WithStatusPatch_team_5 = withStatus (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just (SelfDeletingMessagesConfig 0)) - -testObject_WithStatusPatch_team_6 :: WithStatusPatch SelfDeletingMessagesConfig -testObject_WithStatusPatch_team_6 = withStatus (Just FeatureStatusEnabled) Nothing (Just (SelfDeletingMessagesConfig 77)) - -testObject_WithStatusPatch_team_7 :: WithStatusPatch ClassifiedDomainsConfig -testObject_WithStatusPatch_team_7 = withStatus (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just (ClassifiedDomainsConfig [])) - -testObject_WithStatusPatch_team_8 :: WithStatusPatch ClassifiedDomainsConfig -testObject_WithStatusPatch_team_8 = withStatus Nothing (Just LockStatusLocked) (Just (ClassifiedDomainsConfig [Domain "example.com", Domain "test.foobar"])) - -testObject_WithStatusPatch_team_9 :: WithStatusPatch ClassifiedDomainsConfig -testObject_WithStatusPatch_team_9 = withStatus (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just (ClassifiedDomainsConfig [Domain "test.foobar"])) - -testObject_WithStatusPatch_team_10 :: WithStatusPatch SSOConfig -testObject_WithStatusPatch_team_10 = withStatus (Just FeatureStatusDisabled) (Just LockStatusLocked) (Just SSOConfig) - -testObject_WithStatusPatch_team_11 :: WithStatusPatch SearchVisibilityAvailableConfig -testObject_WithStatusPatch_team_11 = withStatus (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just SearchVisibilityAvailableConfig) - -testObject_WithStatusPatch_team_12 :: WithStatusPatch ValidateSAMLEmailsConfig -testObject_WithStatusPatch_team_12 = withStatus (Just FeatureStatusDisabled) Nothing (Just ValidateSAMLEmailsConfig) - -testObject_WithStatusPatch_team_13 :: WithStatusPatch DigitalSignaturesConfig -testObject_WithStatusPatch_team_13 = withStatus (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just DigitalSignaturesConfig) - -testObject_WithStatusPatch_team_14 :: WithStatusPatch ConferenceCallingConfig -testObject_WithStatusPatch_team_14 = withStatus Nothing (Just LockStatusUnlocked) (Just (ConferenceCallingConfig One2OneCallsSft)) - -testObject_WithStatusPatch_team_15 :: WithStatusPatch GuestLinksConfig -testObject_WithStatusPatch_team_15 = withStatus (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just GuestLinksConfig) - -testObject_WithStatusPatch_team_16 :: WithStatusPatch SndFactorPasswordChallengeConfig -testObject_WithStatusPatch_team_16 = withStatus (Just FeatureStatusDisabled) (Just LockStatusUnlocked) (Just SndFactorPasswordChallengeConfig) - -testObject_WithStatusPatch_team_17 :: WithStatusPatch SearchVisibilityInboundConfig -testObject_WithStatusPatch_team_17 = withStatus (Just FeatureStatusEnabled) Nothing (Just SearchVisibilityInboundConfig) - -testObject_WithStatusPatch_team_18 :: WithStatusPatch GuestLinksConfig -testObject_WithStatusPatch_team_18 = withStatus (Just FeatureStatusEnabled) Nothing Nothing - -testObject_WithStatusPatch_team_19 :: WithStatusPatch SelfDeletingMessagesConfig -testObject_WithStatusPatch_team_19 = withStatus Nothing (Just LockStatusUnlocked) Nothing - -withStatus :: Maybe FeatureStatus -> Maybe LockStatus -> Maybe cfg -> WithStatusPatch cfg -withStatus fs ls cfg = withStatus' fs ls cfg (Just FeatureTTLUnlimited) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs deleted file mode 100644 index 6acd1c8f634..00000000000 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE OverloadedLists #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Wire.API.Golden.Generated.WithStatus_team where - -import Data.ByteString.Conversion (parser, runParser) -import Data.Domain -import Data.Misc -import Imports -import Wire.API.Team.Feature hiding (withStatus) -import Wire.API.Team.Feature qualified as F - -testObject_WithStatus_team_1 :: WithStatus AppLockConfig -testObject_WithStatus_team_1 = withStatus FeatureStatusEnabled LockStatusUnlocked (AppLockConfig (EnforceAppLock False) (-98)) - -testObject_WithStatus_team_2 :: WithStatus AppLockConfig -testObject_WithStatus_team_2 = withStatus FeatureStatusEnabled LockStatusUnlocked (AppLockConfig (EnforceAppLock True) 0) - -testObject_WithStatus_team_3 :: WithStatus AppLockConfig -testObject_WithStatus_team_3 = withStatus FeatureStatusEnabled LockStatusLocked (AppLockConfig (EnforceAppLock True) 111) - -testObject_WithStatus_team_4 :: WithStatus SelfDeletingMessagesConfig -testObject_WithStatus_team_4 = withStatus FeatureStatusEnabled LockStatusUnlocked (SelfDeletingMessagesConfig (-97)) - -testObject_WithStatus_team_5 :: WithStatus SelfDeletingMessagesConfig -testObject_WithStatus_team_5 = withStatus FeatureStatusEnabled LockStatusUnlocked (SelfDeletingMessagesConfig 0) - -testObject_WithStatus_team_6 :: WithStatus SelfDeletingMessagesConfig -testObject_WithStatus_team_6 = withStatus FeatureStatusEnabled LockStatusLocked (SelfDeletingMessagesConfig 77) - -testObject_WithStatus_team_7 :: WithStatus ClassifiedDomainsConfig -testObject_WithStatus_team_7 = withStatus FeatureStatusEnabled LockStatusLocked (ClassifiedDomainsConfig []) - -testObject_WithStatus_team_8 :: WithStatus ClassifiedDomainsConfig -testObject_WithStatus_team_8 = withStatus FeatureStatusEnabled LockStatusLocked (ClassifiedDomainsConfig [Domain "example.com", Domain "test.foobar"]) - -testObject_WithStatus_team_9 :: WithStatus ClassifiedDomainsConfig -testObject_WithStatus_team_9 = withStatus FeatureStatusEnabled LockStatusUnlocked (ClassifiedDomainsConfig [Domain "test.foobar"]) - -testObject_WithStatus_team_10 :: WithStatus SSOConfig -testObject_WithStatus_team_10 = withStatus FeatureStatusDisabled LockStatusLocked SSOConfig - -testObject_WithStatus_team_11 :: WithStatus SearchVisibilityAvailableConfig -testObject_WithStatus_team_11 = withStatus FeatureStatusEnabled LockStatusLocked SearchVisibilityAvailableConfig - -testObject_WithStatus_team_12 :: WithStatus ValidateSAMLEmailsConfig -testObject_WithStatus_team_12 = withStatus FeatureStatusDisabled LockStatusLocked ValidateSAMLEmailsConfig - -testObject_WithStatus_team_13 :: WithStatus DigitalSignaturesConfig -testObject_WithStatus_team_13 = withStatus FeatureStatusEnabled LockStatusLocked DigitalSignaturesConfig - -testObject_WithStatus_team_14 :: WithStatus ConferenceCallingConfig -testObject_WithStatus_team_14 = withStatus FeatureStatusDisabled LockStatusUnlocked (ConferenceCallingConfig One2OneCallsTurn) - -testObject_WithStatus_team_15 :: WithStatus GuestLinksConfig -testObject_WithStatus_team_15 = withStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig - -testObject_WithStatus_team_16 :: WithStatus SndFactorPasswordChallengeConfig -testObject_WithStatus_team_16 = withStatus FeatureStatusDisabled LockStatusUnlocked SndFactorPasswordChallengeConfig - -testObject_WithStatus_team_17 :: WithStatus SearchVisibilityInboundConfig -testObject_WithStatus_team_17 = withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityInboundConfig - -testObject_WithStatus_team_18 :: WithStatus MlsE2EIdConfig -testObject_WithStatus_team_18 = - withStatus - FeatureStatusEnabled - LockStatusLocked - ( MlsE2EIdConfig - (fromIntegral @Int (60 * 60 * 24)) - Nothing - (either (\e -> error (show e)) Just $ parseHttpsUrl "https://example.com") - False - ) - -parseHttpsUrl :: ByteString -> Either String HttpsUrl -parseHttpsUrl url = runParser parser url - -testObject_WithStatus_team_19 :: WithStatus MlsE2EIdConfig -testObject_WithStatus_team_19 = - withStatus - FeatureStatusEnabled - LockStatusLocked - ( MlsE2EIdConfig - (fromIntegral @Int (60 * 60 * 24)) - (either (\e -> error (show e)) Just $ parseHttpsUrl "https://example.com") - Nothing - True - ) - -withStatus :: FeatureStatus -> LockStatus -> cfg -> WithStatus cfg -withStatus fs ls cfg = F.withStatus fs ls cfg FeatureTTLUnlimited diff --git a/libs/wire-api/test/golden/fromJSON/testObject_WithStatus_team_14.json b/libs/wire-api/test/golden/fromJSON/testObject_LockableFeature_team_14.json similarity index 100% rename from libs/wire-api/test/golden/fromJSON/testObject_WithStatus_team_14.json rename to libs/wire-api/test/golden/fromJSON/testObject_LockableFeature_team_14.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_1.json b/libs/wire-api/test/golden/testObject_Feature_team_1.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_1.json rename to libs/wire-api/test/golden/testObject_Feature_team_1.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_10.json b/libs/wire-api/test/golden/testObject_Feature_team_10.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_10.json rename to libs/wire-api/test/golden/testObject_Feature_team_10.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_11.json b/libs/wire-api/test/golden/testObject_Feature_team_11.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_11.json rename to libs/wire-api/test/golden/testObject_Feature_team_11.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_12.json b/libs/wire-api/test/golden/testObject_Feature_team_12.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_12.json rename to libs/wire-api/test/golden/testObject_Feature_team_12.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_13.json b/libs/wire-api/test/golden/testObject_Feature_team_13.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_13.json rename to libs/wire-api/test/golden/testObject_Feature_team_13.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json b/libs/wire-api/test/golden/testObject_Feature_team_14.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json rename to libs/wire-api/test/golden/testObject_Feature_team_14.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_15.json b/libs/wire-api/test/golden/testObject_Feature_team_15.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_15.json rename to libs/wire-api/test/golden/testObject_Feature_team_15.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_16.json b/libs/wire-api/test/golden/testObject_Feature_team_16.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_16.json rename to libs/wire-api/test/golden/testObject_Feature_team_16.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_17.json b/libs/wire-api/test/golden/testObject_Feature_team_17.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_17.json rename to libs/wire-api/test/golden/testObject_Feature_team_17.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_2.json b/libs/wire-api/test/golden/testObject_Feature_team_2.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_2.json rename to libs/wire-api/test/golden/testObject_Feature_team_2.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_3.json b/libs/wire-api/test/golden/testObject_Feature_team_3.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_3.json rename to libs/wire-api/test/golden/testObject_Feature_team_3.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_4.json b/libs/wire-api/test/golden/testObject_Feature_team_4.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_4.json rename to libs/wire-api/test/golden/testObject_Feature_team_4.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_5.json b/libs/wire-api/test/golden/testObject_Feature_team_5.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_5.json rename to libs/wire-api/test/golden/testObject_Feature_team_5.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_6.json b/libs/wire-api/test/golden/testObject_Feature_team_6.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_6.json rename to libs/wire-api/test/golden/testObject_Feature_team_6.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_7.json b/libs/wire-api/test/golden/testObject_Feature_team_7.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_7.json rename to libs/wire-api/test/golden/testObject_Feature_team_7.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_8.json b/libs/wire-api/test/golden/testObject_Feature_team_8.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_8.json rename to libs/wire-api/test/golden/testObject_Feature_team_8.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_9.json b/libs/wire-api/test/golden/testObject_Feature_team_9.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusNoLock_team_9.json rename to libs/wire-api/test/golden/testObject_Feature_team_9.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_1.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_1.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_1.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_1.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_10.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_10.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_10.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_10.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_11.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_11.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_11.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_11.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_12.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_12.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_12.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_12.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_13.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_13.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_13.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_13.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_14.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_14.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_14.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_14.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_15.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_15.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_15.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_15.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_16.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_16.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_16.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_16.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_17.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_17.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_17.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_17.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_18.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_18.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_18.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_18.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_19.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_19.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_19.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_19.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_2.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_2.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_2.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_2.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_3.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_3.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_3.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_3.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_4.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_4.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_4.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_4.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_5.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_5.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_5.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_5.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_6.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_6.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_6.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_6.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_7.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_7.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_7.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_7.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_8.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_8.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_8.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_8.json diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_9.json b/libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_9.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatusPatch_team_9.json rename to libs/wire-api/test/golden/testObject_LockableFeaturePatch_team_9.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_1.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_1.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_1.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_1.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_10.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_10.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_10.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_10.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_11.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_11.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_11.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_11.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_12.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_12.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_12.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_12.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_13.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_13.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_13.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_13.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_14.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_14.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_14.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_14.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_15.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_15.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_15.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_15.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_16.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_16.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_16.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_16.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_17.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_17.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_17.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_17.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_18.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_18.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_18.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_18.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_19.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_19.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_19.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_19.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_2.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_2.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_2.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_2.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_3.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_3.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_3.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_3.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_4.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_4.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_4.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_4.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_5.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_5.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_5.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_5.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_6.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_6.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_6.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_6.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_7.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_7.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_7.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_7.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_8.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_8.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_8.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_8.json diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_9.json b/libs/wire-api/test/golden/testObject_LockableFeature_team_9.json similarity index 100% rename from libs/wire-api/test/golden/testObject_WithStatus_team_9.json rename to libs/wire-api/test/golden/testObject_LockableFeature_team_9.json diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index bec9d3c96f1..a4d3b841fa5 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -214,10 +214,10 @@ tests = testRoundTrip @Team.TeamDeleteData, testRoundTrip @Team.Conversation.TeamConversation, testRoundTrip @Team.Conversation.TeamConversationList, - testRoundTrip @(Team.Feature.WithStatus Team.Feature.LegalholdConfig), - testRoundTrip @(Team.Feature.WithStatusPatch Team.Feature.LegalholdConfig), - testRoundTrip @(Team.Feature.WithStatusPatch Team.Feature.SelfDeletingMessagesConfig), - testRoundTrip @(Team.Feature.WithStatusNoLock Team.Feature.LegalholdConfig), + testRoundTrip @(Team.Feature.LockableFeature Team.Feature.LegalholdConfig), + testRoundTrip @(Team.Feature.LockableFeaturePatch Team.Feature.LegalholdConfig), + testRoundTrip @(Team.Feature.LockableFeaturePatch Team.Feature.SelfDeletingMessagesConfig), + testRoundTrip @(Team.Feature.Feature Team.Feature.LegalholdConfig), testRoundTrip @Team.Feature.AllFeatureConfigs, testRoundTrip @Team.Feature.FeatureStatus, testRoundTrip @Team.Feature.LockStatus, diff --git a/libs/wire-api/test/unit/Test/Wire/API/Run.hs b/libs/wire-api/test/unit/Test/Wire/API/Run.hs index 417d543e0e4..5301f44cdc9 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Run.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Run.hs @@ -37,7 +37,6 @@ import Test.Wire.API.Routes.Version qualified as Routes.Version import Test.Wire.API.Routes.Version.Wai qualified as Routes.Version.Wai import Test.Wire.API.Swagger qualified as Swagger import Test.Wire.API.Team.Export qualified as Team.Export -import Test.Wire.API.Team.Feature qualified as Team.Feature import Test.Wire.API.Team.Member qualified as Team.Member import Test.Wire.API.User qualified as User import Test.Wire.API.User.Auth qualified as User.Auth @@ -70,6 +69,5 @@ main = unsafePerformIO Routes.Version.Wai.tests, RawJson.tests, OAuth.tests, - Password.tests, - Team.Feature.tests + Password.tests ] diff --git a/libs/wire-api/test/unit/Test/Wire/API/Team/Feature.hs b/libs/wire-api/test/unit/Test/Wire/API/Team/Feature.hs deleted file mode 100644 index 60b634c9d17..00000000000 --- a/libs/wire-api/test/unit/Test/Wire/API/Team/Feature.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2024 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Wire.API.Team.Feature (tests) where - -import Imports -import Test.Tasty -import Test.Tasty.HUnit -import Wire.API.Team.Feature - -tests :: TestTree -tests = - testGroup - "Wire.API.Team.Feature" - [ testCase "no lock status in DB" testComputeFeatureConfigForTeamUserLsIsNothing, - testCase "feature is locked in DB" testComputeFeatureConfigForTeamUserLocked, - testCase "feature is unlocked in DB but has no feature status" testComputeFeatureConfigForTeamUserUnlocked, - testCase "feature is unlocked in DB and has feature status" testComputeFeatureConfigForTeamWithDbStatus - ] - -testComputeFeatureConfigForTeamUserLsIsNothing :: Assertion -testComputeFeatureConfigForTeamUserLsIsNothing = do - let mStatusDb = undefined - let mLockStatusDb = Nothing - let defStatus = - withStatus - FeatureStatusEnabled - LockStatusLocked - ExposeInvitationURLsToTeamAdminConfig - FeatureTTLUnlimited - let expected = defStatus - let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus - actual @?= expected - -testComputeFeatureConfigForTeamUserLocked :: Assertion -testComputeFeatureConfigForTeamUserLocked = do - let mStatusDb = undefined - let mLockStatusDb = Just LockStatusLocked - let defStatus = - withStatus - FeatureStatusEnabled - LockStatusLocked - ExposeInvitationURLsToTeamAdminConfig - FeatureTTLUnlimited - let expected = defStatus - let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus - actual @?= expected - -testComputeFeatureConfigForTeamUserUnlocked :: Assertion -testComputeFeatureConfigForTeamUserUnlocked = do - let mStatusDb = Nothing - let mLockStatusDb = Just LockStatusUnlocked - let defStatus = - withStatus - FeatureStatusEnabled - LockStatusLocked - ExposeInvitationURLsToTeamAdminConfig - FeatureTTLUnlimited - let expected = defStatus & setLockStatus LockStatusUnlocked - let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus - actual @?= expected - -testComputeFeatureConfigForTeamWithDbStatus :: Assertion -testComputeFeatureConfigForTeamWithDbStatus = do - let mStatusDb = - Just . forgetLock $ - withStatus - FeatureStatusDisabled - LockStatusUnlocked - ExposeInvitationURLsToTeamAdminConfig - FeatureTTLUnlimited - let mLockStatusDb = Just LockStatusUnlocked - let defStatus = undefined - let (Just expected) = withUnlocked <$> mStatusDb - let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus - actual @?= expected diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 5f1a6b8bdc0..e875f415f6c 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -420,6 +420,7 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Generated.Event_user Test.Wire.API.Golden.Generated.EventType_team Test.Wire.API.Golden.Generated.EventType_user + Test.Wire.API.Golden.Generated.Feature_team Test.Wire.API.Golden.Generated.HandleUpdate_user Test.Wire.API.Golden.Generated.Invitation_team Test.Wire.API.Golden.Generated.InvitationCode_user @@ -433,6 +434,8 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Generated.ListType_team Test.Wire.API.Golden.Generated.Locale_user Test.Wire.API.Golden.Generated.LocaleUpdate_user + Test.Wire.API.Golden.Generated.LockableFeature_team + Test.Wire.API.Golden.Generated.LockableFeaturePatch_team Test.Wire.API.Golden.Generated.LoginCode_user Test.Wire.API.Golden.Generated.LoginCodeTimeout_user Test.Wire.API.Golden.Generated.ManagedBy_user @@ -562,9 +565,6 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Generated.VerifyDeleteUser_user Test.Wire.API.Golden.Generated.ViewLegalHoldService_team Test.Wire.API.Golden.Generated.ViewLegalHoldServiceInfo_team - Test.Wire.API.Golden.Generated.WithStatus_team - Test.Wire.API.Golden.Generated.WithStatusNoLock_team - Test.Wire.API.Golden.Generated.WithStatusPatch_team Test.Wire.API.Golden.Generated.Wrapped_20_22some_5fint_22_20Int_user Test.Wire.API.Golden.Manual Test.Wire.API.Golden.Manual.Activate_user @@ -660,7 +660,6 @@ test-suite wire-api-tests Test.Wire.API.Run Test.Wire.API.Swagger Test.Wire.API.Team.Export - Test.Wire.API.Team.Feature Test.Wire.API.Team.Member Test.Wire.API.User Test.Wire.API.User.Auth diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs index b039bff1303..3ef3d01a3bb 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs @@ -92,7 +92,7 @@ data GalleyAPIAccess m a where GalleyAPIAccess m Team.TeamName GetTeamLegalHoldStatus :: TeamId -> - GalleyAPIAccess m (WithStatus LegalholdConfig) + GalleyAPIAccess m (LockableFeature LegalholdConfig) GetTeamSearchVisibility :: TeamId -> GalleyAPIAccess m TeamSearchVisibility diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs index e05584e9a36..7f451bad632 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs @@ -403,7 +403,7 @@ getTeamLegalHoldStatus :: Member TinyLog r ) => TeamId -> - Sem r (WithStatus LegalholdConfig) + Sem r (LockableFeature LegalholdConfig) getTeamLegalHoldStatus tid = do debug $ remote "galley" . msg (val "Get legalhold settings") galleyRequest req >>= decodeBodyOrThrow "galley" @@ -443,7 +443,7 @@ getVerificationCodeEnabled :: getVerificationCodeEnabled tid = do debug $ remote "galley" . msg (val "Get snd factor password challenge settings") response <- galleyRequest req - status <- wsStatus <$> decodeBodyOrThrow @(WithStatus SndFactorPasswordChallengeConfig) "galley" response + status <- (.status) <$> decodeBodyOrThrow @(LockableFeature SndFactorPasswordChallengeConfig) "galley" response case status of FeatureStatusEnabled -> pure True FeatureStatusDisabled -> pure False @@ -500,7 +500,7 @@ getTeamExposeInvitationURLsToTeamAdmin :: getTeamExposeInvitationURLsToTeamAdmin tid = do debug $ remote "galley" . msg (val "Get expose invitation URLs to team admin settings") response <- galleyRequest req - status <- wsStatus <$> decodeBodyOrThrow @(WithStatus ExposeInvitationURLsToTeamAdminConfig) "galley" response + status <- (.status) <$> decodeBodyOrThrow @(LockableFeature ExposeInvitationURLsToTeamAdminConfig) "galley" response case status of FeatureStatusEnabled -> pure ShowInvitationUrl FeatureStatusDisabled -> pure HideInvitationUrl diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 7daba81f6d8..7b0edcee302 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -472,7 +472,8 @@ checkHandleImpl uhandle = do hasE2EId :: (Member GalleyAPIAccess r) => StoredUser -> Sem r Bool hasE2EId user = - wsStatus . afcMlsE2EId + -- FUTUREWORK(mangoiv): we should use a function 'getSingleFeatureConfigForUser' + (.status) . npProject @MlsE2EIdConfig <$> getAllFeatureConfigsForUser (Just user.id) <&> \case FeatureStatusEnabled -> True FeatureStatusDisabled -> False diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index 1c0e673fa88..84f870e01b2 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + module Wire.MiniBackend ( -- * Mini backends MiniBackend (..), diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index 03fb0a2cda5..096e740c642 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -221,9 +221,12 @@ spec = describe "UserSubsystem.Interpreter" do getSelfProfile (toLocalUnsafe domain selfId) in retrievedProfile === Nothing - prop "should mark user as managed by scim if E2EId is enabled for the user and they have a handle" \storedSelf domain susbsystemConfig mlsE2EIdConfig -> + prop "should mark user as managed by scim if E2EId is enabled for the user and they have a handle" \storedSelf domain susbsystemConfig (mlsE2EIdConfig :: MlsE2EIdConfig) -> let localBackend = def {users = [storedSelf]} - allFeatureConfigs = def {afcMlsE2EId = withStatus FeatureStatusEnabled LockStatusUnlocked mlsE2EIdConfig FeatureTTLUnlimited} + allFeatureConfigs = + npUpdate + (LockableFeature FeatureStatusEnabled LockStatusUnlocked mlsE2EIdConfig) + def SelfProfile retrievedUser = fromJust . runAllErrorsUnsafe @@ -326,9 +329,21 @@ spec = describe "UserSubsystem.Interpreter" do run . runErrorUnsafe . runError - $ interpretNoFederationStack localBackend Nothing def {afcMlsE2EId = setStatus FeatureStatusEnabled defFeatureStatus} config do - updateUserProfile lusr Nothing UpdateOriginScim (def {name = Just newName}) - getUserProfile lusr (tUntagged lusr) + $ interpretNoFederationStack + localBackend + Nothing + ( npUpdate + ( def + { status = FeatureStatusEnabled + } :: + LockableFeature MlsE2EIdConfig + ) + def + ) + config + do + updateUserProfile lusr Nothing UpdateOriginScim (def {name = Just newName}) + getUserProfile lusr (tUntagged lusr) in profileErr === Left UserSubsystemDisplayNameManagedByScim prop diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 85d5342bc0b..ab43f085d49 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -350,12 +350,12 @@ updateFederationRemote dom fedcfg = do \do that, removing or updating items listed in the config file is not allowed." -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. -getAccountConferenceCallingConfig :: UserId -> (Handler r) (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) +getAccountConferenceCallingConfig :: UserId -> (Handler r) (ApiFt.Feature ApiFt.ConferenceCallingConfig) getAccountConferenceCallingConfig uid = lift (wrapClient $ Data.lookupFeatureConferenceCalling uid) >>= maybe (ApiFt.forgetLock <$> view (settings . getAfcConferenceCallingDefNull)) pure -putAccountConferenceCallingConfig :: UserId -> ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig -> (Handler r) NoContent +putAccountConferenceCallingConfig :: UserId -> ApiFt.Feature ApiFt.ConferenceCallingConfig -> (Handler r) NoContent putAccountConferenceCallingConfig uid status = lift $ wrapClient $ Data.updateFeatureConferenceCalling uid (Just status) $> NoContent diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index e1e71eb74d0..9b58b382ff9 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -83,7 +83,7 @@ getCallsConfigV2 uid _ limit = do sftFederation <- view enableSFTFederation discoveredServers <- turnServersV2 (env ^. turnServers) shared <- do - ccStatus <- lift $ liftSem $ (wsStatus . afcConferenceCalling <$> getAllFeatureConfigsForUser (Just uid)) + ccStatus <- lift $ liftSem $ ((.status) . npProject @ConferenceCallingConfig <$> getAllFeatureConfigsForUser (Just uid)) pure $ case ccStatus of FeatureStatusEnabled -> True FeatureStatusDisabled -> False @@ -118,7 +118,7 @@ getCallsConfig uid _ = do env <- view turnEnv discoveredServers <- turnServersV1 (env ^. turnServers) shared <- do - ccStatus <- lift $ liftSem $ (wsStatus . afcConferenceCalling <$> getAllFeatureConfigsForUser (Just uid)) + ccStatus <- lift $ liftSem $ ((.status) . npProject @ConferenceCallingConfig <$> getAllFeatureConfigsForUser (Just uid)) pure $ case ccStatus of FeatureStatusEnabled -> True FeatureStatusDisabled -> False diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 147fd666c7a..900301853c2 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- This file is part of the Wire Server implementation. -- @@ -70,6 +71,7 @@ import Cassandra hiding (Set) import Control.Error import Control.Lens hiding (from) import Data.Conduit (ConduitM) +import Data.Default import Data.Domain import Data.Handle (Handle) import Data.Id @@ -299,9 +301,9 @@ updateManagedBy u h = retry x5 $ write userManagedByUpdate (params LocalQuorum ( updateRichInfo :: (MonadClient m) => UserId -> RichInfoAssocList -> m () updateRichInfo u ri = retry x5 $ write userRichInfoUpdate (params LocalQuorum (ri, u)) -updateFeatureConferenceCalling :: (MonadClient m) => UserId -> Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) -> m (Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig)) +updateFeatureConferenceCalling :: (MonadClient m) => UserId -> Maybe (ApiFt.Feature ApiFt.ConferenceCallingConfig) -> m (Maybe (ApiFt.Feature ApiFt.ConferenceCallingConfig)) updateFeatureConferenceCalling uid mbStatus = do - let flag = ApiFt.wssStatus <$> mbStatus + let flag = (.status) <$> mbStatus retry x5 $ write update (params LocalQuorum (flag, uid)) pure mbStatus where @@ -436,13 +438,13 @@ lookupServiceUsersForTeam pid sid tid = "SELECT user, conv FROM service_team \ \WHERE provider = ? AND service = ? AND team = ?" -lookupFeatureConferenceCalling :: (MonadClient m) => UserId -> m (Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig)) +lookupFeatureConferenceCalling :: (MonadClient m) => UserId -> m (Maybe (ApiFt.Feature ApiFt.ConferenceCallingConfig)) lookupFeatureConferenceCalling uid = do let q = query1 select (params LocalQuorum (Identity uid)) mStatusValue <- (>>= runIdentity) <$> retry x1 q case mStatusValue of Nothing -> pure Nothing - Just status -> pure $ Just $ ApiFt.defFeatureStatusNoLock {ApiFt.wssStatus = status} + Just status -> pure $ Just $ def {ApiFt.status = status} where select :: PrepQuery R (Identity UserId) (Identity (Maybe ApiFt.FeatureStatus)) select = fromString "select feature_conference_calling from user where id = ?" diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 36ddf319be2..45c72d9b0f5 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} -- Disabling to stop errors on Getters {-# OPTIONS_GHC -Wno-redundant-constraints #-} @@ -34,6 +35,7 @@ import Data.Aeson qualified as Aeson import Data.Aeson.Types (typeMismatch) import Data.Char qualified as Char import Data.Code qualified as Code +import Data.Default import Data.Domain (Domain (..)) import Data.Id import Data.LanguageCodes (ISO639_1 (EN)) @@ -708,7 +710,11 @@ instance Arbitrary AccountFeatureConfigs where arbitrary = AccountFeatureConfigs <$> fmap locked arbitrary <*> fmap locked arbitrary where locked :: Public.ImplicitLockStatus a -> Public.ImplicitLockStatus a - locked = Public.ImplicitLockStatus . Public.setLockStatus Public.LockStatusLocked . Public._unImplicitLockStatus + locked impl = + Public.ImplicitLockStatus $ + (Public._unImplicitLockStatus impl) + { Public.lockStatus = Public.LockStatusLocked + } instance FromJSON AccountFeatureConfigs where parseJSON = @@ -740,17 +746,17 @@ instance ToJSON AccountFeatureConfigs where ] ] -getAfcConferenceCallingDefNewMaybe :: Lens.Getter Settings (Maybe (Public.WithStatus Public.ConferenceCallingConfig)) +getAfcConferenceCallingDefNewMaybe :: Lens.Getter Settings (Maybe (Public.LockableFeature Public.ConferenceCallingConfig)) getAfcConferenceCallingDefNewMaybe = Lens.to (Lens.^? (Lens.to setFeatureFlags . Lens._Just . Lens.to afcConferenceCallingDefNew . unImplicitLockStatus)) -getAfcConferenceCallingDefNull :: Lens.Getter Settings (Public.WithStatus Public.ConferenceCallingConfig) +getAfcConferenceCallingDefNull :: Lens.Getter Settings (Public.LockableFeature Public.ConferenceCallingConfig) getAfcConferenceCallingDefNull = Lens.to (Public._unImplicitLockStatus . afcConferenceCallingDefNull . fromMaybe defAccountFeatureConfigs . setFeatureFlags) defAccountFeatureConfigs :: AccountFeatureConfigs defAccountFeatureConfigs = AccountFeatureConfigs - { afcConferenceCallingDefNew = Public.ImplicitLockStatus Public.defFeatureStatus, - afcConferenceCallingDefNull = Public.ImplicitLockStatus Public.defFeatureStatus + { afcConferenceCallingDefNew = Public.ImplicitLockStatus def, + afcConferenceCallingDefNull = Public.ImplicitLockStatus def } -- | Customer extensions naturally are covered by the AGPL like everything else, but use them diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index f87e181648d..f55928f4fb1 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -804,8 +804,12 @@ guardSecondFactorDisabled :: Maybe UserId -> ExceptT HttpError (AppT r) () guardSecondFactorDisabled mbUserId = do - enabled <- lift $ liftSem $ (==) Feature.FeatureStatusEnabled . Feature.wsStatus . Feature.afcSndFactorPasswordChallenge <$> GalleyAPIAccess.getAllFeatureConfigsForUser mbUserId - when enabled $ (throwStd (errorToWai @'E.AccessDenied)) + feat <- lift $ liftSem $ GalleyAPIAccess.getAllFeatureConfigsForUser mbUserId + let enabled = + (Feature.npProject @Feature.SndFactorPasswordChallengeConfig feat).status + == Feature.FeatureStatusEnabled + when enabled do + throwStd $ errorToWai @'E.AccessDenied minRsaKeySize :: Int minRsaKeySize = 256 -- Bytes (= 2048 bits) diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 8f5fbe0392e..e79955c528f 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -51,6 +51,7 @@ import Control.Error hiding (bool) import Control.Lens (to, view) import Data.ByteString.Conversion (toByteString) import Data.Code qualified as Code +import Data.Default import Data.Handle (Handle) import Data.Id import Data.List.NonEmpty qualified as NE @@ -134,7 +135,7 @@ verifyCode mbCode action uid = do (mbEmail, mbTeamId) <- getEmailAndTeamId uid featureEnabled <- lift $ do mbFeatureEnabled <- liftSem $ GalleyAPIAccess.getVerificationCodeEnabled `traverse` mbTeamId - pure $ fromMaybe (Public.wsStatus (Public.defFeatureStatus @Public.SndFactorPasswordChallengeConfig) == Public.FeatureStatusEnabled) mbFeatureEnabled + pure $ fromMaybe ((def @(Feature Public.SndFactorPasswordChallengeConfig)).status == Public.FeatureStatusEnabled) mbFeatureEnabled isSsoUser <- wrapHttpClientE $ Data.isSamlUser uid when (featureEnabled && not isSsoUser) $ do case (mbCode, mbEmail) of @@ -421,8 +422,8 @@ assertLegalHoldEnabled :: TeamId -> ExceptT LegalHoldLoginError (AppT r) () assertLegalHoldEnabled tid = do - stat <- lift $ liftSem $ GalleyAPIAccess.getTeamLegalHoldStatus tid - case wsStatus stat of + feat <- lift $ liftSem $ GalleyAPIAccess.getTeamLegalHoldStatus tid + case feat.status of FeatureStatusDisabled -> throwE LegalHoldLoginLegalHoldNotEnabled FeatureStatusEnabled -> pure () diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 0d2aad8a5db..f803d6a988a 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -1580,7 +1580,7 @@ enabled2ndFaForTeamInternal galley tid = do ( galley . paths ["i", "teams", toByteString' tid, "features", featureNameBS @Public.SndFactorPasswordChallengeConfig] . contentJson - . Bilge.json (Public.WithStatusNoLock Public.FeatureStatusEnabled Public.SndFactorPasswordChallengeConfig Public.FeatureTTLUnlimited) + . Bilge.json (Public.Feature Public.FeatureStatusEnabled Public.SndFactorPasswordChallengeConfig) ) !!! const 200 === statusCode diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 3e829d00d25..72ff959ab9f 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -274,11 +274,10 @@ invitationUrlGalleyMock featureStatus tid inviter (ReceivedRequest mth pth body_ && pth == ["i", "teams", Text.pack (show tid), "features", "exposeInvitationURLsToTeamAdmin"] = pure . Wai.responseLBS HTTP.status200 mempty $ encode - ( withStatus + ( LockableFeature featureStatus LockStatusUnlocked ExposeInvitationURLsToTeamAdminConfig - FeatureTTLUnlimited ) | mth == "GET" && pth == ["i", "teams", Text.pack (show tid), "members", Text.pack (show inviter)] = diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs index 331309043cf..9a862fba44a 100644 --- a/services/brig/test/integration/API/Team/Util.hs +++ b/services/brig/test/integration/API/Team/Util.hs @@ -266,7 +266,7 @@ putLegalHoldEnabled tid enabled g = do g . paths ["i", "teams", toByteString' tid, "features", "legalhold"] . contentJson - . lbytes (encode (Public.WithStatusNoLock enabled Public.LegalholdConfig Public.FeatureTTLUnlimited)) + . lbytes (encode (Public.Feature enabled Public.LegalholdConfig)) . expect2xx putLHWhitelistTeam :: (HasCallStack) => Galley -> TeamId -> Http ResponseLBS @@ -436,7 +436,7 @@ setTeamTeamSearchVisibilityAvailable galley tid status = ( galley . paths ["i/teams", toByteString' tid, "features/searchVisibility"] . contentJson - . body (RequestBodyLBS . encode $ Public.WithStatusNoLock status Public.SearchVisibilityAvailableConfig Public.FeatureTTLUnlimited) + . body (RequestBodyLBS . encode $ Public.Feature status Public.SearchVisibilityAvailableConfig) ) !!! do const 200 === statusCode @@ -458,7 +458,7 @@ setTeamSearchVisibilityInboundAvailable galley tid status = ( galley . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @Public.SearchVisibilityInboundConfig] . contentJson - . body (RequestBodyLBS . encode $ Public.WithStatusNoLock status Public.SearchVisibilityInboundConfig Public.FeatureTTLUnlimited) + . body (RequestBodyLBS . encode $ Public.Feature status Public.SearchVisibilityInboundConfig) ) !!! do const 200 === statusCode diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index b041300dca0..3c378e4f4ae 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -86,7 +86,7 @@ import Wire.API.Asset qualified as Asset import Wire.API.Connection import Wire.API.Conversation import Wire.API.Routes.MultiTablePaging -import Wire.API.Team.Feature (ExposeInvitationURLsToTeamAdminConfig (..), FeatureStatus (..), FeatureTTL' (..), LockStatus (LockStatusLocked), withStatus) +import Wire.API.Team.Feature import Wire.API.Team.Invitation (Invitation (inInvitation)) import Wire.API.Team.Permission hiding (self) import Wire.API.User @@ -1408,11 +1408,10 @@ testTooManyMembersForLegalhold opts brig = do && pth == ["i", "teams", Text.pack (show tid), "features", "exposeInvitationURLsToTeamAdmin"] = pure . Wai.responseLBS HTTP.status200 mempty $ encode - ( withStatus + ( LockableFeature FeatureStatusDisabled LockStatusLocked ExposeInvitationURLsToTeamAdminConfig - FeatureTTLUnlimited ) | otherwise = pure $ Wai.responseLBS HTTP.status500 mempty "Unexpected request to mocked galley" diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 8627d78c989..8a1c1004ad9 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -441,7 +441,7 @@ generateVerificationCode' brig req = do setTeamSndFactorPasswordChallenge :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Galley -> TeamId -> Public.FeatureStatus -> m () setTeamSndFactorPasswordChallenge galley tid status = do - let js = RequestBodyLBS $ encode $ Public.WithStatusNoLock status Public.SndFactorPasswordChallengeConfig Public.FeatureTTLUnlimited + let js = RequestBodyLBS $ encode $ Public.Feature status Public.SndFactorPasswordChallengeConfig put (galley . paths ["i", "teams", toByteString' tid, "features", featureNameBS @Public.SndFactorPasswordChallengeConfig] . contentJson . body js) !!! const 200 === statusCode setTeamFeatureLockStatus :: diff --git a/services/galley/default.nix b/services/galley/default.nix index 362e174d34a..c3ef5ddd9e3 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -27,7 +27,6 @@ , conduit , containers , cookie -, cql , crypton , crypton-x509 , currency-codes @@ -42,6 +41,7 @@ , federator , filepath , galley-types +, generics-sop , gitignoreSource , gundeck-types , hex @@ -86,6 +86,7 @@ , servant-client-core , servant-server , singletons +, singletons-base , sop-core , split , ssl-util @@ -98,6 +99,7 @@ , tasty-cannon , tasty-hunit , tasty-quickcheck +, template-haskell , temporary , text , time @@ -152,10 +154,10 @@ mkDerivation { cassava comonad containers - cql crypton crypton-x509 currency-codes + data-default data-timeout either enclosed-exceptions @@ -164,6 +166,7 @@ mkDerivation { extended extra galley-types + generics-sop gundeck-types hex HsOpenSSL @@ -193,10 +196,13 @@ mkDerivation { servant-client servant-server singletons + singletons-base + sop-core split ssl-util stm tagged + template-haskell text time tinylog diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 58f9f6c9fab..3437caf3795 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -136,9 +136,12 @@ library Galley.Cassandra.Conversation.MLS Galley.Cassandra.ConversationList Galley.Cassandra.CustomBackend + Galley.Cassandra.FeatureTH Galley.Cassandra.GetAllTeamFeatureConfigs Galley.Cassandra.Instances Galley.Cassandra.LegalHold + Galley.Cassandra.MakeFeature + Galley.Cassandra.Orphans Galley.Cassandra.Proposal Galley.Cassandra.Queries Galley.Cassandra.SearchVisibility @@ -300,10 +303,10 @@ library , cassava >=0.5.2 , comonad , containers >=0.5 - , cql , crypton , crypton-x509 , currency-codes >=2.0 + , data-default , data-timeout , either , enclosed-exceptions >=1.0 @@ -312,6 +315,7 @@ library , extended , extra >=1.3 , galley-types >=0.65.0 + , generics-sop , gundeck-types >=1.35.2 , hex , HsOpenSSL >=0.11 @@ -341,10 +345,13 @@ library , servant-client , servant-server , singletons + , singletons-base + , sop-core , split >=0.2 , ssl-util >=0.1 , stm >=2.4 , tagged + , template-haskell , text >=0.11 , time >=1.4 , tinylog >=0.10 diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 92a176a4dea..7dc40d9c289 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -72,7 +72,7 @@ import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog qualified as P -import Servant hiding (JSON, WithStatus) +import Servant import System.Logger.Class hiding (Path, name) import System.Logger.Class qualified as Log import Wire.API.Conversation hiding (Member) @@ -90,7 +90,7 @@ import Wire.API.Routes.Internal.Galley import Wire.API.Routes.Internal.Galley.TeamsIntra import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) import Wire.API.Routes.MultiTablePaging qualified as MTP -import Wire.API.Team.Feature hiding (setStatus) +import Wire.API.Team.Feature import Wire.API.User.Client import Wire.NotificationSubsystem import Wire.Sem.Paging @@ -364,7 +364,7 @@ rmUser lusr conn = do FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid ) - . wsStatus + . (.status) uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound leaveTeams page' diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index c7052c2d8bc..c62137f4e1a 100644 --- a/services/galley/src/Galley/API/LegalHold/Team.hs +++ b/services/galley/src/Galley/API/LegalHold/Team.hs @@ -24,6 +24,7 @@ module Galley.API.LegalHold.Team ) where +import Data.Default import Data.Id import Data.Range import Galley.Effects @@ -63,8 +64,7 @@ computeLegalHoldFeatureStatus tid dbFeature = getLegalHoldFlag >>= \case FeatureLegalHoldDisabledPermanently -> pure FeatureStatusDisabled FeatureLegalHoldDisabledByDefault -> - pure . wssStatus $ - unDbFeature dbFeature defFeatureStatusNoLock + pure (applyDbFeature dbFeature def).status FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do wl <- LegalHoldData.isTeamLegalholdWhitelisted tid pure $ if wl then FeatureStatusEnabled else FeatureStatusDisabled diff --git a/services/galley/src/Galley/API/MLS/Migration.hs b/services/galley/src/Galley/API/MLS/Migration.hs index 747de458cd4..4cb5c35d8a6 100644 --- a/services/galley/src/Galley/API/MLS/Migration.hs +++ b/services/galley/src/Galley/API/MLS/Migration.hs @@ -52,15 +52,14 @@ checkMigrationCriteria :: ) => UTCTime -> MLSConversation -> - WithStatus MlsMigrationConfig -> + LockableFeature MlsMigrationConfig -> Sem r Bool checkMigrationCriteria now conv ws - | wsStatus ws == FeatureStatusDisabled = pure False + | ws.status == FeatureStatusDisabled = pure False | afterDeadline = pure True | otherwise = unApAll $ mconcat [localUsersMigrated, remoteUsersMigrated] where - mig = wsConfig ws - afterDeadline = maybe False (now >=) mig.finaliseRegardlessAfter + afterDeadline = maybe False (now >=) ws.config.finaliseRegardlessAfter containsMLS = Set.member BaseProtocolMLSTag diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 29073e71bbc..87457e2ccab 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -97,7 +97,7 @@ import Wire.API.Federation.Client (FederatorClient) import Wire.API.Federation.Error import Wire.API.Provider.Bot qualified as Public import Wire.API.Routes.MultiTablePaging qualified as Public -import Wire.API.Team.Feature as Public hiding (setStatus) +import Wire.API.Team.Feature as Public import Wire.API.User import Wire.Sem.Paging.Cassandra @@ -653,7 +653,7 @@ ensureGuestLinksEnabled :: Maybe TeamId -> Sem r () ensureGuestLinksEnabled mbTid = - getConversationGuestLinksFeatureStatus mbTid >>= \ws -> case wsStatus ws of + getConversationGuestLinksFeatureStatus mbTid >>= \ws -> case ws.status of FeatureStatusEnabled -> pure () FeatureStatusDisabled -> throwS @'GuestLinksDisabled @@ -667,7 +667,7 @@ getConversationGuestLinksStatus :: ) => UserId -> ConvId -> - Sem r (WithStatus GuestLinksConfig) + Sem r (LockableFeature GuestLinksConfig) getConversationGuestLinksStatus uid convId = do conv <- E.getConversation convId >>= noteS @'ConvNotFound ensureConvAdmin (Data.convLocalMembers conv) uid @@ -679,7 +679,7 @@ getConversationGuestLinksFeatureStatus :: Member (Input Opts) r ) => Maybe TeamId -> - Sem r (WithStatus GuestLinksConfig) + Sem r (LockableFeature GuestLinksConfig) getConversationGuestLinksFeatureStatus Nothing = getConfigForServer @GuestLinksConfig getConversationGuestLinksFeatureStatus (Just tid) = getConfigForTeam @GuestLinksConfig tid diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index e3aed8fbd4c..c489516322b 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1000,7 +1000,7 @@ deleteTeamMember' lusr zcon tid remove mBody = do mems <- getTeamMembersForFanout tid uncheckedDeleteTeamMember lusr (Just zcon) tid remove (Right mems) ) - . wsStatus + . (.status) pure TeamMemberDeleteCompleted -- This function is "unchecked" because it does not validate that the user has the `RemoveTeamMember` permission. diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 7fb0e456069..38d16da2f45 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -90,24 +92,22 @@ patchFeatureStatusInternal :: Member NotificationSubsystem r ) => TeamId -> - WithStatusPatch cfg -> - Sem r (WithStatus cfg) + LockableFeaturePatch cfg -> + Sem r (LockableFeature cfg) patchFeatureStatusInternal tid patch = do assertTeamExists tid currentFeatureStatus <- getFeatureStatus @cfg DontDoAuth tid let newFeatureStatus = applyPatch currentFeatureStatus - -- setting the config can fail, so we need to do it first - void $ setConfigForTeam @cfg tid (forgetLock newFeatureStatus) - when (isJust $ wspLockStatus patch) $ void $ updateLockStatus @cfg tid (wsLockStatus newFeatureStatus) + void $ setConfigForTeam @cfg tid newFeatureStatus getFeatureStatus @cfg DontDoAuth tid where - applyPatch :: WithStatus cfg -> WithStatus cfg + applyPatch :: LockableFeature cfg -> LockableFeature cfg applyPatch current = current - & setStatus (fromMaybe (wsStatus current) (wspStatus patch)) - & setLockStatus (fromMaybe (wsLockStatus current) (wspLockStatus patch)) - & setConfig (fromMaybe (wsConfig current) (wspConfig patch)) - & setWsTTL (fromMaybe (wsTTL current) (wspTTL patch)) + { status = fromMaybe current.status patch.status, + lockStatus = fromMaybe current.lockStatus patch.lockStatus, + config = fromMaybe current.config patch.config + } setFeatureStatus :: forall cfg r. @@ -126,17 +126,18 @@ setFeatureStatus :: ) => DoAuth -> TeamId -> - WithStatusNoLock cfg -> - Sem r (WithStatus cfg) -setFeatureStatus doauth tid wsnl = do + Feature cfg -> + Sem r (LockableFeature cfg) +setFeatureStatus doauth tid feat = do case doauth of DoAuth uid -> do zusrMembership <- getTeamMember tid uid void $ permissionCheck ChangeTeamFeature zusrMembership DontDoAuth -> assertTeamExists tid - guardLockStatus . wsLockStatus =<< getConfigForTeam @cfg tid - setConfigForTeam @cfg tid wsnl + feat0 <- getConfigForTeam @cfg tid + guardLockStatus feat0.lockStatus + setConfigForTeam @cfg tid (withLockStatus feat0.lockStatus feat) setFeatureStatusInternal :: forall cfg r. @@ -154,8 +155,8 @@ setFeatureStatusInternal :: Member NotificationSubsystem r ) => TeamId -> - WithStatusNoLock cfg -> - Sem r (WithStatus cfg) + Feature cfg -> + Sem r (LockableFeature cfg) setFeatureStatusInternal = setFeatureStatus @cfg DontDoAuth updateLockStatus :: @@ -186,10 +187,10 @@ persistAndPushEvent :: Member TeamStore r ) => TeamId -> - WithStatusNoLock cfg -> - Sem r (WithStatus cfg) -persistAndPushEvent tid wsnl = do - setFeatureConfig (featureSingleton @cfg) tid wsnl + LockableFeature cfg -> + Sem r (LockableFeature cfg) +persistAndPushEvent tid feat = do + setFeatureConfig (featureSingleton @cfg) tid feat fs <- getConfigForTeam @cfg tid pushFeatureConfigEvent tid (Event.mkUpdateEvent fs) pure fs @@ -247,8 +248,8 @@ class (GetFeatureConfig cfg) => SetFeatureConfig cfg where Member TeamStore r ) => TeamId -> - WithStatusNoLock cfg -> - Sem r (WithStatus cfg) + LockableFeature cfg -> + Sem r (LockableFeature cfg) default setConfigForTeam :: ( ComputeFeatureConstraints cfg r, KnownSymbol (FeatureSymbol cfg), @@ -260,9 +261,9 @@ class (GetFeatureConfig cfg) => SetFeatureConfig cfg where Member TeamStore r ) => TeamId -> - WithStatusNoLock cfg -> - Sem r (WithStatus cfg) - setConfigForTeam tid wsnl = persistAndPushEvent tid wsnl + LockableFeature cfg -> + Sem r (LockableFeature cfg) + setConfigForTeam tid feat = persistAndPushEvent tid feat instance SetFeatureConfig SSOConfig where type @@ -271,11 +272,11 @@ instance SetFeatureConfig SSOConfig where Member (Error TeamFeatureError) r ) - setConfigForTeam tid wsnl = do - case wssStatus wsnl of + setConfigForTeam tid feat = do + case feat.status of FeatureStatusEnabled -> pure () FeatureStatusDisabled -> throw DisableSsoNotImplemented - persistAndPushEvent tid wsnl + persistAndPushEvent tid feat instance SetFeatureConfig SearchVisibilityAvailableConfig where type @@ -284,11 +285,11 @@ instance SetFeatureConfig SearchVisibilityAvailableConfig where Member (Input Opts) r ) - setConfigForTeam tid wsnl = do - case wssStatus wsnl of + setConfigForTeam tid feat = do + case feat.status of FeatureStatusEnabled -> pure () FeatureStatusDisabled -> SearchVisibilityData.resetSearchVisibility tid - persistAndPushEvent tid wsnl + persistAndPushEvent tid feat instance SetFeatureConfig ValidateSAMLEmailsConfig @@ -335,7 +336,7 @@ instance SetFeatureConfig LegalholdConfig where ) -- we're good to update the status now. - setConfigForTeam tid wsnl = do + setConfigForTeam tid feat = do -- this extra do is to encapsulate the assertions running before the actual operation. -- enabling LH for teams is only allowed in normal operation; disabled-permanently and -- whitelist-teams have no or their own way to do that, resp. @@ -348,20 +349,20 @@ instance SetFeatureConfig LegalholdConfig where FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do throw LegalHoldWhitelistedOnly - case wssStatus wsnl of + case feat.status of FeatureStatusDisabled -> LegalHold.removeSettings' @InternalPaging tid FeatureStatusEnabled -> ensureNotTooLargeToActivateLegalHold tid - persistAndPushEvent tid wsnl + persistAndPushEvent tid feat instance SetFeatureConfig FileSharingConfig instance SetFeatureConfig AppLockConfig where type SetConfigForTeamConstraints AppLockConfig r = Member (Error TeamFeatureError) r - setConfigForTeam tid wsnl = do - when ((applockInactivityTimeoutSecs . wssConfig $ wsnl) < 30) $ + setConfigForTeam tid feat = do + when ((applockInactivityTimeoutSecs feat.config) < 30) $ throw AppLockInactivityTimeoutTooLow - persistAndPushEvent tid wsnl + persistAndPushEvent tid feat instance SetFeatureConfig ConferenceCallingConfig @@ -373,22 +374,22 @@ instance SetFeatureConfig SndFactorPasswordChallengeConfig instance SetFeatureConfig SearchVisibilityInboundConfig where type SetConfigForTeamConstraints SearchVisibilityInboundConfig (r :: EffectRow) = (Member BrigAccess r) - setConfigForTeam tid wsnl = do - updateSearchVisibilityInbound $ toTeamStatus tid wsnl - persistAndPushEvent tid wsnl + setConfigForTeam tid feat = do + updateSearchVisibilityInbound $ toTeamStatus tid feat + persistAndPushEvent tid feat instance SetFeatureConfig MLSConfig where type SetConfigForTeamConstraints MLSConfig (r :: EffectRow) = (Member (Error TeamFeatureError) r) - setConfigForTeam tid wsnl = do + setConfigForTeam tid feat = do mlsMigrationConfig <- getConfigForTeam @MlsMigrationConfig tid unless ( -- default protocol needs to be included in supported protocols - mlsDefaultProtocol (wssConfig wsnl) `elem` mlsSupportedProtocols (wssConfig wsnl) + feat.config.mlsDefaultProtocol `elem` feat.config.mlsSupportedProtocols -- when MLS migration is enabled, MLS needs to be enabled as well - && (wsStatus mlsMigrationConfig == FeatureStatusDisabled || wssStatus wsnl == FeatureStatusEnabled) + && (mlsMigrationConfig.status == FeatureStatusDisabled || feat.status == FeatureStatusEnabled) ) $ throw MLSProtocolMismatch - persistAndPushEvent tid wsnl + persistAndPushEvent tid feat instance SetFeatureConfig ExposeInvitationURLsToTeamAdminConfig @@ -399,25 +400,25 @@ instance SetFeatureConfig MlsE2EIdConfig guardMlsE2EIdConfig :: forall r a. (Member (Error TeamFeatureError) r) => - (UserId -> TeamId -> WithStatusNoLock MlsE2EIdConfig -> Sem r a) -> + (UserId -> TeamId -> Feature MlsE2EIdConfig -> Sem r a) -> UserId -> TeamId -> - WithStatusNoLock MlsE2EIdConfig -> + Feature MlsE2EIdConfig -> Sem r a -guardMlsE2EIdConfig handler uid tid conf = do - when (isNothing . crlProxy . wssConfig $ conf) $ throw MLSE2EIDMissingCrlProxy - handler uid tid conf +guardMlsE2EIdConfig handler uid tid feat = do + when (isNothing feat.config.crlProxy) $ throw MLSE2EIDMissingCrlProxy + handler uid tid feat instance SetFeatureConfig MlsMigrationConfig where type SetConfigForTeamConstraints MlsMigrationConfig (r :: EffectRow) = (Member (Error TeamFeatureError) r) - setConfigForTeam tid wsnl = do + setConfigForTeam tid feat = do mlsConfig <- getConfigForTeam @MLSConfig tid unless ( -- when MLS migration is enabled, MLS needs to be enabled as well - wssStatus wsnl == FeatureStatusDisabled || wsStatus mlsConfig == FeatureStatusEnabled + feat.status == FeatureStatusDisabled || mlsConfig.status == FeatureStatusEnabled ) $ throw MLSProtocolMismatch - persistAndPushEvent tid wsnl + persistAndPushEvent tid feat instance SetFeatureConfig EnforceFileDownloadLocationConfig diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index a83d1bad4f7..842403e7960 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableSuperClasses #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} -- This file is part of the Wire Server implementation. -- @@ -35,10 +36,11 @@ where import Control.Error (hush) import Control.Lens -import Data.Bifunctor (second) +import Data.Default import Data.Id import Data.Kind import Data.Qualified (Local, tUnqualified) +import Data.SOP import Data.Tagged import Galley.API.LegalHold.Team import Galley.API.Util @@ -79,39 +81,37 @@ class (IsFeatureConfig cfg) => GetFeatureConfig cfg where getConfigForServer :: (Member (Input Opts) r) => - Sem r (WithStatus cfg) + Sem r (LockableFeature cfg) -- only override if there is additional business logic for getting the feature config -- and/or if the feature flag is configured for the backend in 'FeatureFlags' for galley in 'Galley.Types.Teams' -- otherwise this will return the default config from wire-api - default getConfigForServer :: Sem r (WithStatus cfg) - getConfigForServer = pure defFeatureStatus + default getConfigForServer :: Sem r (LockableFeature cfg) + getConfigForServer = pure def getConfigForUser :: (GetConfigForUserConstraints cfg r) => UserId -> - Sem r (WithStatus cfg) + Sem r (LockableFeature cfg) default getConfigForUser :: (DefaultGetConfigForUserConstraints cfg r) => UserId -> - Sem r (WithStatus cfg) + Sem r (LockableFeature cfg) getConfigForUser _ = getConfigForServer computeFeature :: (ComputeFeatureConstraints cfg r) => TeamId -> - WithStatus cfg -> - Maybe LockStatus -> + LockableFeature cfg -> DbFeature cfg -> - Sem r (WithStatus cfg) + Sem r (LockableFeature cfg) default computeFeature :: TeamId -> - WithStatus cfg -> - Maybe LockStatus -> + LockableFeature cfg -> DbFeature cfg -> - Sem r (WithStatus cfg) - computeFeature _tid defFeature lockStatus dbFeature = + Sem r (LockableFeature cfg) + computeFeature _tid defFeature dbFeature = pure $ - genericComputeFeature @cfg defFeature lockStatus dbFeature + genericComputeFeature @cfg defFeature dbFeature getFeatureStatus :: forall cfg r. @@ -125,7 +125,7 @@ getFeatureStatus :: ) => DoAuth -> TeamId -> - Sem r (WithStatus cfg) + Sem r (LockableFeature cfg) getFeatureStatus doauth tid = do case doauth of DoAuth uid -> @@ -145,11 +145,11 @@ getFeatureStatusMulti :: Sem r (Multi.TeamFeatureNoConfigMultiResponse cfg) getFeatureStatusMulti (Multi.TeamFeatureNoConfigMultiRequest tids) = do cfgs <- getConfigForMultiTeam @cfg tids - let xs = uncurry toTeamStatus . second forgetLock <$> cfgs + let xs = uncurry toTeamStatus <$> cfgs pure $ Multi.TeamFeatureNoConfigMultiResponse xs -toTeamStatus :: TeamId -> WithStatusNoLock cfg -> Multi.TeamStatus cfg -toTeamStatus tid ws = Multi.TeamStatus tid (wssStatus ws) +toTeamStatus :: TeamId -> LockableFeature cfg -> Multi.TeamStatus cfg +toTeamStatus tid feat = Multi.TeamStatus tid feat.status getTeamAndCheckMembership :: ( Member TeamStore r, @@ -181,7 +181,18 @@ getAllFeatureConfigsForTeam luid tid = do void $ getTeamMember tid (tUnqualified luid) >>= noteS @'NotATeamMember getAllFeatureConfigs tid +class (GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => GetAllFeatureConfigsForServerConstraints r cfg + +instance (GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => GetAllFeatureConfigsForServerConstraints r cfg + +getAllFeatureConfigsForServer :: + forall r. + (Member (Input Opts) r) => + Sem r AllFeatureConfigs +getAllFeatureConfigsForServer = hsequence' $ hcpure (Proxy @GetFeatureConfig) $ Comp getConfigForServer + getAllFeatureConfigs :: + forall r. ( Member (Input Opts) r, Member LegalHoldStore r, Member TeamFeatureStore r, @@ -192,80 +203,18 @@ getAllFeatureConfigs :: getAllFeatureConfigs tid = do features <- TeamFeatures.getAllFeatureConfigs tid defFeatures <- getAllFeatureConfigsForServer - biTraverseAllFeatures (computeFeatureWithLock tid) defFeatures features + hsequence' $ hcliftA2 (Proxy @(GetAllFeatureConfigsForServerConstraints r)) compute defFeatures features + where + compute :: + (ComputeFeatureConstraints p r, GetFeatureConfig p) => + LockableFeature p -> + DbFeature p -> + (Sem r :.: LockableFeature) p + compute defFeature feat = Comp $ computeFeature tid defFeature feat -computeFeatureWithLock :: - forall cfg r. - (GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => - TeamId -> - WithStatus cfg -> - DbFeatureWithLock cfg -> - Sem r (WithStatus cfg) -computeFeatureWithLock tid defFeature feat = - computeFeature @cfg tid defFeature feat.lockStatus feat.feature - --- | One of a number of possible combinators. This is the only one we happen to need. -biTraverseAllFeatures :: - ( Member (Input Opts) r, - Member TeamStore r, - Member LegalHoldStore r - ) => - ( forall cfg. - (GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => - f cfg -> - g cfg -> - Sem r (h cfg) - ) -> - (AllFeatures f -> AllFeatures g -> Sem r (AllFeatures h)) -biTraverseAllFeatures phi features1 features2 = do - afcLegalholdStatus <- phi (afcLegalholdStatus features1) (afcLegalholdStatus features2) - afcSSOStatus <- phi (afcSSOStatus features1) (afcSSOStatus features2) - afcTeamSearchVisibilityAvailable <- phi (afcTeamSearchVisibilityAvailable features1) (afcTeamSearchVisibilityAvailable features2) - afcSearchVisibilityInboundConfig <- phi (afcSearchVisibilityInboundConfig features1) (afcSearchVisibilityInboundConfig features2) - afcValidateSAMLEmails <- phi (afcValidateSAMLEmails features1) (afcValidateSAMLEmails features2) - afcDigitalSignatures <- phi (afcDigitalSignatures features1) (afcDigitalSignatures features2) - afcAppLock <- phi (afcAppLock features1) (afcAppLock features2) - afcFileSharing <- phi (afcFileSharing features1) (afcFileSharing features2) - afcClassifiedDomains <- phi (afcClassifiedDomains features1) (afcClassifiedDomains features2) - afcConferenceCalling <- phi (afcConferenceCalling features1) (afcConferenceCalling features2) - afcSelfDeletingMessages <- phi (afcSelfDeletingMessages features1) (afcSelfDeletingMessages features2) - afcGuestLink <- phi (afcGuestLink features1) (afcGuestLink features2) - afcSndFactorPasswordChallenge <- phi (afcSndFactorPasswordChallenge features1) (afcSndFactorPasswordChallenge features2) - afcMLS <- phi (afcMLS features1) (afcMLS features2) - afcExposeInvitationURLsToTeamAdmin <- phi (afcExposeInvitationURLsToTeamAdmin features1) (afcExposeInvitationURLsToTeamAdmin features2) - afcOutlookCalIntegration <- phi (afcOutlookCalIntegration features1) (afcOutlookCalIntegration features2) - afcMlsE2EId <- phi (afcMlsE2EId features1) (afcMlsE2EId features2) - afcMlsMigration <- phi (afcMlsMigration features1) (afcMlsMigration features2) - afcEnforceFileDownloadLocation <- phi (afcEnforceFileDownloadLocation features1) (afcEnforceFileDownloadLocation features2) - afcLimitedEventFanout <- phi (afcLimitedEventFanout features1) (afcLimitedEventFanout features2) - pure AllFeatures {..} +class (GetConfigForUserConstraints cfg r, GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => GetAllFeatureConfigsForUserConstraints r cfg -getAllFeatureConfigsForServer :: - forall r. - (Member (Input Opts) r) => - Sem r AllFeatureConfigs -getAllFeatureConfigsForServer = - AllFeatures - <$> getConfigForServer @LegalholdConfig - <*> getConfigForServer @SSOConfig - <*> getConfigForServer @SearchVisibilityAvailableConfig - <*> getConfigForServer @SearchVisibilityInboundConfig - <*> getConfigForServer @ValidateSAMLEmailsConfig - <*> getConfigForServer @DigitalSignaturesConfig - <*> getConfigForServer @AppLockConfig - <*> getConfigForServer @FileSharingConfig - <*> getConfigForServer @ClassifiedDomainsConfig - <*> getConfigForServer @ConferenceCallingConfig - <*> getConfigForServer @SelfDeletingMessagesConfig - <*> getConfigForServer @GuestLinksConfig - <*> getConfigForServer @SndFactorPasswordChallengeConfig - <*> getConfigForServer @MLSConfig - <*> getConfigForServer @ExposeInvitationURLsToTeamAdminConfig - <*> getConfigForServer @OutlookCalIntegrationConfig - <*> getConfigForServer @MlsE2EIdConfig - <*> getConfigForServer @MlsMigrationConfig - <*> getConfigForServer @EnforceFileDownloadLocationConfig - <*> getConfigForServer @LimitedEventFanoutConfig +instance (GetConfigForUserConstraints cfg r, GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => GetAllFeatureConfigsForUserConstraints r cfg getAllFeatureConfigsForUser :: forall r. @@ -282,27 +231,7 @@ getAllFeatureConfigsForUser :: Sem r AllFeatureConfigs getAllFeatureConfigsForUser uid = do mTid <- getTeamAndCheckMembership uid - AllFeatures - <$> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid - <*> getConfigForTeamUser uid mTid + hsequence' $ hcpure (Proxy @(GetAllFeatureConfigsForUserConstraints r)) $ Comp $ getConfigForTeamUser uid mTid getSingleFeatureConfigForUser :: forall cfg r. @@ -316,7 +245,7 @@ getSingleFeatureConfigForUser :: ComputeFeatureConstraints cfg r ) => UserId -> - Sem r (WithStatus cfg) + Sem r (LockableFeature cfg) getSingleFeatureConfigForUser uid = do mTid <- getTeamAndCheckMembership uid getConfigForTeamUser @cfg uid mTid @@ -329,18 +258,15 @@ getConfigForTeam :: Member TeamFeatureStore r ) => TeamId -> - Sem r (WithStatus cfg) + Sem r (LockableFeature cfg) getConfigForTeam tid = do dbFeature <- TeamFeatures.getFeatureConfig (featureSingleton @cfg) tid - lockStatus <- TeamFeatures.getFeatureLockStatus (featureSingleton @cfg) tid defFeature <- getConfigForServer computeFeature @cfg tid defFeature - lockStatus dbFeature --- Note: this function assumes the feature cannot be locked getConfigForMultiTeam :: forall cfg r. ( GetFeatureConfig cfg, @@ -349,12 +275,12 @@ getConfigForMultiTeam :: Member (Input Opts) r ) => [TeamId] -> - Sem r [(TeamId, WithStatus cfg)] + Sem r [(TeamId, LockableFeature cfg)] getConfigForMultiTeam tids = do defFeature <- getConfigForServer features <- TeamFeatures.getFeatureConfigMulti (featureSingleton @cfg) tids for features $ \(tid, dbFeature) -> do - feat <- computeFeature @cfg tid defFeature (Just LockStatusUnlocked) dbFeature + feat <- computeFeature @cfg tid defFeature dbFeature pure (tid, feat) getConfigForTeamUser :: @@ -367,7 +293,7 @@ getConfigForTeamUser :: ) => UserId -> Maybe TeamId -> - Sem r (WithStatus cfg) + Sem r (LockableFeature cfg) getConfigForTeamUser uid Nothing = getConfigForUser uid getConfigForTeamUser _ (Just tid) = getConfigForTeam @cfg tid @@ -380,7 +306,7 @@ instance GetFeatureConfig SSOConfig where inputs (view (settings . featureFlags . flagSSO)) <&> \case FeatureSSOEnabledByDefault -> FeatureStatusEnabled FeatureSSODisabledByDefault -> FeatureStatusDisabled - pure $ setStatus status defFeatureStatus + pure $ def {status = status} instance GetFeatureConfig SearchVisibilityAvailableConfig where getConfigForServer = do @@ -388,7 +314,7 @@ instance GetFeatureConfig SearchVisibilityAvailableConfig where inputs (view (settings . featureFlags . flagTeamSearchVisibility)) <&> \case FeatureTeamSearchVisibilityAvailableByDefault -> FeatureStatusEnabled FeatureTeamSearchVisibilityUnavailableByDefault -> FeatureStatusDisabled - pure $ setStatus status defFeatureStatus + pure $ def {status = status} instance GetFeatureConfig ValidateSAMLEmailsConfig where getConfigForServer = @@ -411,9 +337,9 @@ instance GetFeatureConfig LegalholdConfig where ComputeFeatureConstraints LegalholdConfig r = (Member TeamStore r, Member LegalHoldStore r) - computeFeature tid defFeature _lockStatus dbFeature = do + computeFeature tid defFeature dbFeature = do status <- computeLegalHoldFeatureStatus tid dbFeature - pure $ setStatus status defFeature + pure $ defFeature {status = status} instance GetFeatureConfig FileSharingConfig where getConfigForServer = @@ -453,18 +379,15 @@ instance GetFeatureConfig ConferenceCallingConfig where input <&> view (settings . featureFlags . flagConferenceCalling . unDefaults) getConfigForUser uid = do - wsnl <- getAccountConferenceCallingConfigClient uid - pure $ withLockStatus (wsLockStatus (defFeatureStatus @ConferenceCallingConfig)) wsnl - - computeFeature _tid defFeature lockStatus dbFeature = - pure $ case fromMaybe (wsLockStatus defFeature) lockStatus of - LockStatusLocked -> setLockStatus LockStatusLocked defFeature - LockStatusUnlocked -> - withUnlocked $ - (unDbFeature dbFeature) - (forgetLock defFeature) - { wssStatus = FeatureStatusEnabled - } + feat <- getAccountConferenceCallingConfigClient uid + pure $ withLockStatus (def @(LockableFeature ConferenceCallingConfig)).lockStatus feat + + computeFeature _tid defFeature dbFeature = + pure $ + let feat = applyDbFeature dbFeature defFeature {status = FeatureStatusEnabled} + in case feat.lockStatus of + LockStatusLocked -> defFeature {lockStatus = LockStatusLocked} + LockStatusUnlocked -> feat instance GetFeatureConfig SelfDeletingMessagesConfig where getConfigForServer = @@ -492,11 +415,11 @@ instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where (Member (Input Opts) r) -- the lock status of this feature is calculated from the allow list, not the database - computeFeature tid defFeature _lockStatus dbFeature = do + computeFeature tid defFeature dbFeature = do allowList <- input <&> view (settings . exposeInvitationURLsTeamAllowlist . to (fromMaybe [])) let teamAllowed = tid `elem` allowList lockStatus = if teamAllowed then LockStatusUnlocked else LockStatusLocked - pure $ genericComputeFeature defFeature (Just lockStatus) dbFeature + pure $ genericComputeFeature defFeature (dbFeatureLockStatus lockStatus <> dbFeature) instance GetFeatureConfig OutlookCalIntegrationConfig where getConfigForServer = @@ -542,7 +465,7 @@ guardSecondFactorDisabled uid cid = do pure tid tf <- getConfigForTeamUser @SndFactorPasswordChallengeConfig uid mTid - case wsStatus tf of + case tf.status of FeatureStatusDisabled -> pure () FeatureStatusEnabled -> throwS @'AccessDenied @@ -560,5 +483,5 @@ featureEnabledForTeam :: Sem r Bool featureEnabledForTeam tid = (==) FeatureStatusEnabled - . wsStatus + . (.status) <$> getFeatureStatus @cfg DontDoAuth tid diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 0eab89da5c7..1e87befbc8d 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -147,8 +147,8 @@ validateOptions o = do (Just _, Nothing) -> error "Federator is specified and RabbitMQ config is not, please specify both or none" _ -> pure () let mlsFlag = settings' ^. featureFlags . Teams.flagMLS . Teams.unDefaults - mlsConfig = wsConfig mlsFlag - migrationStatus = wsStatus $ settings' ^. featureFlags . Teams.flagMlsMigration . Teams.unDefaults + mlsConfig = mlsFlag.config + migrationStatus = (.status) $ settings' ^. featureFlags . Teams.flagMlsMigration . Teams.unDefaults when (migrationStatus == FeatureStatusEnabled && ProtocolMLSTag `notElem` mlsSupportedProtocols mlsConfig) $ error "For starting MLS migration, MLS must be included in the supportedProtocol list" unless (mlsDefaultProtocol mlsConfig `elem` mlsSupportedProtocols mlsConfig) $ diff --git a/services/galley/src/Galley/Cassandra/FeatureTH.hs b/services/galley/src/Galley/Cassandra/FeatureTH.hs new file mode 100644 index 00000000000..cf52cdc6caf --- /dev/null +++ b/services/galley/src/Galley/Cassandra/FeatureTH.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskellQuotes #-} + +module Galley.Cassandra.FeatureTH where + +import Data.Kind +import Generics.SOP.TH +import Imports +import Language.Haskell.TH hiding (Type) +import Wire.API.Team.Feature + +featureCases :: ExpQ -> Q Exp +featureCases rhsQ = do + rhs <- rhsQ + TyConI (DataD _ _ _ _ constructors _) <- reify ''FeatureSingleton + pure $ + LamCaseE + [ Match (ConP c [] []) (NormalB rhs) [] + | GadtC [c] _ _ <- constructors + ] + +generateTupleP :: Q [Dec] +generateTupleP = do + let maxSize = 64 :: Int + tylist <- [t|[Type]|] + let vars = [VarT (mkName ("a" <> show i)) | i <- [0 .. maxSize - 1]] + pure + [ ClosedTypeFamilyD + (TypeFamilyHead (mkName "TupleP") [KindedTV (mkName "xs") () tylist] NoSig Nothing) + [ TySynEqn + Nothing + ( ConT (mkName "TupleP") + `AppT` mkPattern (take n vars) + ) + (mkTuple (take n vars)) + | n <- [0 .. maxSize] + ] + ] + where + mkPattern = foldr (\x y -> PromotedConsT `AppT` x `AppT` y) PromotedNilT + + mkTuple [] = ConT ''() + mkTuple [v] = ConT ''Identity `AppT` v + mkTuple vs = + let n = length vs + in foldl' AppT (TupleT n) vs + +-- | generates some of the remaining @SOP.Generic@ instances as orphans +-- it is cut off at 50 on purpose to reduce compilation times +-- you may increase up to 64 which is the number at which you +-- you should probably start fixing cql instead. +generateSOPInstances :: Q [Dec] +generateSOPInstances = concat <$> traverse (deriveGeneric . tupleTypeName) [31 .. 50] diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index c55808c7823..6fd27b9e107 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -1,400 +1,86 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} -module Galley.Cassandra.GetAllTeamFeatureConfigs where +module Galley.Cassandra.GetAllTeamFeatureConfigs (getAllFeatureConfigs) where import Cassandra -import Cassandra qualified as C import Data.Id -import Data.Misc (HttpsUrl) -import Data.Time -import Database.CQL.Protocol import Galley.Cassandra.Instances () -import Imports -import Wire.API.Conversation.Protocol (ProtocolTag) -import Wire.API.MLS.CipherSuite +import Galley.Cassandra.MakeFeature +import Galley.Cassandra.Orphans () +import Generics.SOP +import Imports hiding (Map) +import Polysemy.Internal import Wire.API.Team.Feature -data AllTeamFeatureConfigsRow = AllTeamFeatureConfigsRow - { -- legalhold - legalhold :: Maybe FeatureStatus, - -- sso - sso :: Maybe FeatureStatus, - -- search visibility - searchVisibility :: Maybe FeatureStatus, - -- validate saml emails - validateSamlEmails :: Maybe FeatureStatus, - -- digital signatures - digitalSignatures :: Maybe FeatureStatus, - -- app lock - appLock :: Maybe FeatureStatus, - appLockEnforce :: Maybe EnforceAppLock, - appLockInactivityTimeoutSecs :: Maybe Int32, - -- file sharing - fileSharing :: Maybe FeatureStatus, - fileSharingLock :: Maybe LockStatus, - -- self deleting messages - selfDeletingMessages :: Maybe FeatureStatus, - selfDeletingMessagesTtl :: Maybe Int32, - selfDeletingMessagesLock :: Maybe LockStatus, - -- conference calling - conferenceCalling :: Maybe FeatureStatus, - conferenceCallingTtl :: Maybe FeatureTTL, - conferenceCallingOne2One :: Maybe One2OneCalls, - conferenceCallingLock :: Maybe LockStatus, - -- guest links - guestLinks :: Maybe FeatureStatus, - guestLinksLock :: Maybe LockStatus, - -- snd factor - sndFactor :: Maybe FeatureStatus, - sndFactorLock :: Maybe LockStatus, - -- mls - mls :: Maybe FeatureStatus, - mlsDefaultProtocol :: Maybe ProtocolTag, - mlsToggleUsers :: Maybe (C.Set UserId), - mlsAllowedCipherSuites :: Maybe (C.Set CipherSuiteTag), - mlsDefaultCipherSuite :: Maybe CipherSuiteTag, - mlsSupportedProtocols :: Maybe (C.Set ProtocolTag), - mlsLock :: Maybe LockStatus, - -- mls e2eid - mlsE2eid :: Maybe FeatureStatus, - mlsE2eidGracePeriod :: Maybe Int32, - mlsE2eidAcmeDiscoverUrl :: Maybe HttpsUrl, - mlsE2eidMaybeCrlProxy :: Maybe HttpsUrl, - mlsE2eidMaybeUseProxyOnMobile :: Maybe Bool, - mlsE2eidLock :: Maybe LockStatus, - -- mls migration - mlsMigration :: Maybe FeatureStatus, - mlsMigrationStartTime :: Maybe UTCTime, - mlsMigrationFinalizeRegardlessAfter :: Maybe UTCTime, - mlsMigrationLock :: Maybe LockStatus, - -- expose invitation urls - exposeInvitationUrls :: Maybe FeatureStatus, - -- outlook calendar integration - outlookCalIntegration :: Maybe FeatureStatus, - outlookCalIntegrationLock :: Maybe LockStatus, - -- enforce download location - enforceDownloadLocation :: Maybe FeatureStatus, - enforceDownloadLocation_Location :: Maybe Text, - enforceDownloadLocationLock :: Maybe LockStatus, - -- limit event fanout - limitEventFanout :: Maybe FeatureStatus - } - deriving (Generic, Show) +type family ConcatFeatureRow xs where + ConcatFeatureRow '[] = '[] + ConcatFeatureRow (x : xs) = Append (FeatureRow x) (ConcatFeatureRow xs) -recordInstance ''AllTeamFeatureConfigsRow +type AllFeatureRow = ConcatFeatureRow Features -emptyRow :: AllTeamFeatureConfigsRow -emptyRow = - AllTeamFeatureConfigsRow - { legalhold = Nothing, - sso = Nothing, - searchVisibility = Nothing, - validateSamlEmails = Nothing, - digitalSignatures = Nothing, - appLock = Nothing, - appLockEnforce = Nothing, - appLockInactivityTimeoutSecs = Nothing, - fileSharing = Nothing, - fileSharingLock = Nothing, - selfDeletingMessages = Nothing, - selfDeletingMessagesTtl = Nothing, - selfDeletingMessagesLock = Nothing, - conferenceCalling = Nothing, - conferenceCallingTtl = Nothing, - conferenceCallingOne2One = Nothing, - conferenceCallingLock = Nothing, - guestLinks = Nothing, - guestLinksLock = Nothing, - sndFactor = Nothing, - sndFactorLock = Nothing, - mls = Nothing, - mlsDefaultProtocol = Nothing, - mlsToggleUsers = Nothing, - mlsAllowedCipherSuites = Nothing, - mlsDefaultCipherSuite = Nothing, - mlsSupportedProtocols = Nothing, - mlsLock = Nothing, - mlsE2eid = Nothing, - mlsE2eidGracePeriod = Nothing, - mlsE2eidAcmeDiscoverUrl = Nothing, - mlsE2eidMaybeCrlProxy = Nothing, - mlsE2eidMaybeUseProxyOnMobile = Nothing, - mlsE2eidLock = Nothing, - mlsMigration = Nothing, - mlsMigrationStartTime = Nothing, - mlsMigrationFinalizeRegardlessAfter = Nothing, - mlsMigrationLock = Nothing, - exposeInvitationUrls = Nothing, - outlookCalIntegration = Nothing, - outlookCalIntegrationLock = Nothing, - enforceDownloadLocation = Nothing, - enforceDownloadLocation_Location = Nothing, - enforceDownloadLocationLock = Nothing, - limitEventFanout = Nothing - } +emptyRow :: NP Maybe AllFeatureRow +emptyRow = hpure Nothing -allFeatureConfigsFromRow :: AllTeamFeatureConfigsRow -> AllFeatures DbFeatureWithLock -allFeatureConfigsFromRow row = - AllFeatures - { afcLegalholdStatus = mkFeatureWithLock Nothing row.legalhold, - afcSSOStatus = mkFeatureWithLock Nothing row.sso, - afcTeamSearchVisibilityAvailable = mkFeatureWithLock Nothing row.searchVisibility, - afcSearchVisibilityInboundConfig = mkFeatureWithLock Nothing row.searchVisibility, - afcValidateSAMLEmails = mkFeatureWithLock Nothing row.validateSamlEmails, - afcDigitalSignatures = mkFeatureWithLock Nothing row.digitalSignatures, - afcAppLock = - mkFeatureWithLock - Nothing - (row.appLock, row.appLockEnforce, row.appLockInactivityTimeoutSecs), - afcFileSharing = mkFeatureWithLock row.fileSharingLock row.fileSharing, - afcClassifiedDomains = mkFeatureWithLock Nothing Nothing, - afcConferenceCalling = - mkFeatureWithLock - row.conferenceCallingLock - ( row.conferenceCalling, - row.conferenceCallingTtl, - row.conferenceCallingOne2One - ), - afcSelfDeletingMessages = - mkFeatureWithLock - row.selfDeletingMessagesLock - ( row.selfDeletingMessages, - row.selfDeletingMessagesTtl - ), - afcGuestLink = mkFeatureWithLock row.guestLinksLock row.guestLinks, - afcSndFactorPasswordChallenge = mkFeatureWithLock row.sndFactorLock row.sndFactor, - afcMLS = - mkFeatureWithLock - row.mlsLock - ( row.mls, - row.mlsDefaultProtocol, - row.mlsToggleUsers, - row.mlsAllowedCipherSuites, - row.mlsDefaultCipherSuite, - row.mlsSupportedProtocols - ), - afcExposeInvitationURLsToTeamAdmin = mkFeatureWithLock Nothing row.exposeInvitationUrls, - afcOutlookCalIntegration = - mkFeatureWithLock - row.outlookCalIntegrationLock - row.outlookCalIntegration, - afcMlsE2EId = - mkFeatureWithLock - row.mlsE2eidLock - ( row.mlsE2eid, - row.mlsE2eidGracePeriod, - row.mlsE2eidAcmeDiscoverUrl, - row.mlsE2eidMaybeCrlProxy, - row.mlsE2eidMaybeUseProxyOnMobile - ), - afcMlsMigration = - mkFeatureWithLock - row.mlsMigrationLock - ( row.mlsMigration, - row.mlsMigrationStartTime, - row.mlsMigrationFinalizeRegardlessAfter - ), - afcEnforceFileDownloadLocation = - mkFeatureWithLock - row.enforceDownloadLocationLock - ( row.enforceDownloadLocation, - row.enforceDownloadLocation_Location - ), - afcLimitedEventFanout = mkFeatureWithLock Nothing row.limitEventFanout - } +class ConcatFeatures cfgs where + rowToAllFeatures :: NP Maybe (ConcatFeatureRow cfgs) -> NP DbFeature cfgs -getAllFeatureConfigs :: (MonadClient m) => TeamId -> m (AllFeatures DbFeatureWithLock) -getAllFeatureConfigs tid = do - mRow <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) - pure $ allFeatureConfigsFromRow $ maybe emptyRow asRecord mRow - where - select :: - PrepQuery - R - (Identity TeamId) - (TupleType AllTeamFeatureConfigsRow) - select = - "select \ - \legalhold_status, \ - \sso_status, \ - \search_visibility_status, \ - \validate_saml_emails, \ - \digital_signatures, \ - \app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs, \ - \file_sharing, file_sharing_lock_status, \ - \self_deleting_messages_status, self_deleting_messages_ttl, self_deleting_messages_lock_status, \ - \conference_calling_status, ttl(conference_calling_status), conference_calling_one_to_one, conference_calling, \ - \guest_links_status, guest_links_lock_status, \ - \snd_factor_password_challenge_status, snd_factor_password_challenge_lock_status, \ - \\ - \mls_status, mls_default_protocol, mls_protocol_toggle_users, mls_allowed_ciphersuites, \ - \mls_default_ciphersuite, mls_supported_protocols, mls_lock_status, \ - \\ - \mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile, mls_e2eid_lock_status, \ - \\ - \mls_migration_status, mls_migration_start_time, mls_migration_finalise_regardless_after, \ - \mls_migration_lock_status, \ - \\ - \expose_invitation_urls_to_team_admin, \ - \outlook_cal_integration_status, outlook_cal_integration_lock_status, \ - \enforce_file_download_location_status, enforce_file_download_location, enforce_file_download_location_lock_status, \ - \limited_event_fanout_status \ - \from team_features where team_id = ?" - -class (Tuple (FeatureRow cfg), HasRowType (FeatureRow cfg)) => MakeFeature cfg where - type FeatureRow cfg - type FeatureRow cfg = Identity (Maybe FeatureStatus) - - mkFeature :: RowType (FeatureRow cfg) -> DbFeature cfg - default mkFeature :: - (FeatureRow cfg ~ Identity (Maybe FeatureStatus)) => - RowType (FeatureRow cfg) -> - DbFeature cfg - mkFeature = foldMap dbFeatureStatus - -mkFeatureWithLock :: - (MakeFeature cfg) => - Maybe LockStatus -> - RowType (FeatureRow cfg) -> - DbFeatureWithLock cfg -mkFeatureWithLock lockStatus row = DbFeatureWithLock lockStatus (mkFeature row) - --- | Used to remove the annoying Identity wrapper around single-element rows. -type family RowType a where - RowType (Identity a) = a - RowType tuple = tuple - -class HasRowType a where - fromRowType :: RowType a -> a - default fromRowType :: (RowType a ~ a) => RowType a -> a - fromRowType = id - - toRowType :: a -> RowType a - default toRowType :: (RowType a ~ a) => a -> RowType a - toRowType = id - -instance HasRowType (a, b) - -instance HasRowType (a, b, c) - -instance HasRowType (a, b, c, d) - -instance HasRowType (a, b, c, d, e) - -instance HasRowType (a, b, c, d, e, f) - -instance HasRowType (Identity a) where - fromRowType = Identity - toRowType = runIdentity - -instance MakeFeature LegalholdConfig - -instance MakeFeature SSOConfig - -instance MakeFeature SearchVisibilityAvailableConfig +instance ConcatFeatures '[] where + rowToAllFeatures Nil = Nil -instance MakeFeature SearchVisibilityInboundConfig - -instance MakeFeature ValidateSAMLEmailsConfig - -instance MakeFeature DigitalSignaturesConfig - -instance MakeFeature AppLockConfig where - type FeatureRow AppLockConfig = (Maybe FeatureStatus, Maybe EnforceAppLock, Maybe Int32) - - mkFeature (status, enforce, timeout) = - foldMap dbFeatureStatus status - <> foldMap dbFeatureConfig (AppLockConfig <$> enforce <*> timeout) - -instance MakeFeature FileSharingConfig - -instance MakeFeature ClassifiedDomainsConfig - -instance MakeFeature ConferenceCallingConfig where - type FeatureRow ConferenceCallingConfig = (Maybe FeatureStatus, Maybe FeatureTTL, Maybe One2OneCalls) - - mkFeature (status, ttl, sftForOneToOne) = - foldMap dbFeatureStatus status - <> foldMap dbFeatureTTL ttl - <> foldMap (dbFeatureConfig . ConferenceCallingConfig) sftForOneToOne - -instance MakeFeature SelfDeletingMessagesConfig where - type FeatureRow SelfDeletingMessagesConfig = (Maybe FeatureStatus, Maybe Int32) - - mkFeature (status, ttl) = - foldMap dbFeatureStatus status - <> foldMap (dbFeatureConfig . SelfDeletingMessagesConfig) ttl - -instance MakeFeature GuestLinksConfig - -instance MakeFeature SndFactorPasswordChallengeConfig - -instance MakeFeature ExposeInvitationURLsToTeamAdminConfig - -instance MakeFeature OutlookCalIntegrationConfig +instance + ( SplitNP (FeatureRow cfg) (ConcatFeatureRow cfgs), + ConcatFeatures cfgs, + MakeFeature cfg + ) => + ConcatFeatures (cfg : cfgs) + where + rowToAllFeatures row = case splitNP @(FeatureRow cfg) @(ConcatFeatureRow cfgs) row of + (row0, row1) -> rowToFeature row0 :* rowToAllFeatures row1 -instance MakeFeature MLSConfig where - type - FeatureRow MLSConfig = - ( Maybe FeatureStatus, - Maybe ProtocolTag, - Maybe (C.Set UserId), - Maybe (C.Set CipherSuiteTag), - Maybe CipherSuiteTag, - Maybe (C.Set ProtocolTag) - ) +class SplitNP xs ys where + splitNP :: NP f (Append xs ys) -> (NP f xs, NP f ys) - mkFeature (status, defProto, toggleUsers, ciphersuites, defCiphersuite, supportedProtos) = - foldMap dbFeatureStatus status - <> foldMap - dbFeatureConfig - ( MLSConfig (foldMap C.fromSet toggleUsers) - <$> defProto - <*> pure (foldMap C.fromSet ciphersuites) - <*> defCiphersuite - <*> pure (foldMap C.fromSet supportedProtos) - ) +instance SplitNP '[] ys where + splitNP ys = (Nil, ys) -instance MakeFeature MlsE2EIdConfig where - type - FeatureRow MlsE2EIdConfig = - ( Maybe FeatureStatus, - Maybe Int32, - Maybe HttpsUrl, - Maybe HttpsUrl, - Maybe Bool - ) +instance (SplitNP xs ys) => SplitNP (x ': xs) ys where + splitNP (z :* zs) = case splitNP zs of + (xs, ys) -> (z :* xs, ys) - mkFeature (status, gracePeriod, acmeDiscoveryUrl, crlProxy, useProxyOnMobile) = - foldMap dbFeatureStatus status - <> dbFeatureModConfig - ( \defCfg -> - defCfg - { verificationExpiration = - maybe defCfg.verificationExpiration fromIntegral gracePeriod, - acmeDiscoveryUrl = acmeDiscoveryUrl, - crlProxy = crlProxy, - useProxyOnMobile = fromMaybe defCfg.useProxyOnMobile useProxyOnMobile - } - ) +class AppendNP xs ys where + appendNP :: NP f xs -> NP f ys -> NP f (Append xs ys) -instance MakeFeature MlsMigrationConfig where - type - FeatureRow MlsMigrationConfig = - ( Maybe FeatureStatus, - Maybe UTCTime, - Maybe UTCTime - ) +instance AppendNP '[] ys where + appendNP Nil ys = ys - mkFeature (status, startTime, finalizeAfter) = - foldMap dbFeatureStatus status - <> dbFeatureConfig (MlsMigrationConfig startTime finalizeAfter) +instance (AppendNP xs ys) => AppendNP (x : xs) ys where + appendNP (x :* xs) ys = x :* appendNP xs ys -instance MakeFeature EnforceFileDownloadLocationConfig where - type FeatureRow EnforceFileDownloadLocationConfig = (Maybe FeatureStatus, Maybe Text) +class ConcatColumns cfgs where + concatColumns :: NP (K String) (ConcatFeatureRow cfgs) - mkFeature (status, location) = - foldMap dbFeatureStatus status - <> dbFeatureConfig (EnforceFileDownloadLocationConfig location) +instance ConcatColumns '[] where + concatColumns = Nil -instance MakeFeature LimitedEventFanoutConfig +instance + ( AppendNP (FeatureRow cfg) (ConcatFeatureRow cfgs), + MakeFeature cfg, + ConcatColumns cfgs + ) => + ConcatColumns (cfg : cfgs) + where + concatColumns = featureColumns @cfg `appendNP` concatColumns @cfgs + +getAllFeatureConfigs :: + forall row mrow m. + ( MonadClient m, + row ~ AllFeatureRow, + Tuple (TupleP mrow), + IsProductType (TupleP mrow) mrow, + AllZip (IsF Maybe) row mrow + ) => + TeamId -> + m (AllFeatures DbFeature) +getAllFeatureConfigs tid = do + mRow <- fetchFeatureRow @row @mrow tid (concatColumns @Features) + pure . rowToAllFeatures $ fromMaybe emptyRow mRow diff --git a/services/galley/src/Galley/Cassandra/MakeFeature.hs b/services/galley/src/Galley/Cassandra/MakeFeature.hs new file mode 100644 index 00000000000..2db777f2521 --- /dev/null +++ b/services/galley/src/Galley/Cassandra/MakeFeature.hs @@ -0,0 +1,463 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | Abstraction to fetch and store feature values from and to the database. +module Galley.Cassandra.MakeFeature where + +import Cassandra +import Cassandra qualified as C +import Data.Functor +import Data.Functor.Identity +import Data.Id +import Data.Kind +import Data.List.Singletons (Length) +import Data.Misc (HttpsUrl) +import Data.Singletons (demote) +import Data.Time +import GHC.TypeNats +import Galley.Cassandra.FeatureTH +import Galley.Cassandra.Instances () +import Generics.SOP +import Imports hiding (Generic, Map) +import Wire.API.Conversation.Protocol (ProtocolTag) +import Wire.API.MLS.CipherSuite +import Wire.API.Team.Feature + +-- | This is necessary in order to convert an @NP f xs@ type to something that +-- CQL can understand. +-- +-- The generated code looks like: +-- @@ +-- instance TupleP xs where +-- TupleP '[] = () +-- TupleP '[a] = Identity a +-- TupleP '[a, b] = (a, b) +-- ... +-- @@ +$generateTupleP + +class MakeFeature cfg where + type FeatureRow cfg :: [Type] + type FeatureRow cfg = '[FeatureStatus] + + featureColumns :: NP (K String) (FeatureRow cfg) + + rowToFeature :: NP Maybe (FeatureRow cfg) -> DbFeature cfg + default rowToFeature :: + (FeatureRow cfg ~ '[FeatureStatus]) => + NP Maybe (FeatureRow cfg) -> + DbFeature cfg + rowToFeature = foldMap dbFeatureStatus . hd + + featureToRow :: LockableFeature cfg -> NP Maybe (FeatureRow cfg) + default featureToRow :: + (FeatureRow cfg ~ '[FeatureStatus]) => + LockableFeature cfg -> + NP Maybe (FeatureRow cfg) + featureToRow feat = Just feat.status :* Nil + +instance MakeFeature LegalholdConfig where + featureColumns = K "legalhold_status" :* Nil + +instance MakeFeature SSOConfig where + featureColumns = K "sso_status" :* Nil + +instance MakeFeature SearchVisibilityAvailableConfig where + featureColumns = K "search_visibility_status" :* Nil + +-- | This feature shares its status column with +-- 'SearchVisibilityAvailableConfig'. This means that when fetching all +-- features, this column is repeated in the query, i.e. the query looks like: +-- @@ +-- select ..., search_visibility_status, search_visibility_status, ... from team_features ... +-- @@ +instance MakeFeature SearchVisibilityInboundConfig where + featureColumns = K "search_visibility_status" :* Nil + +instance MakeFeature ValidateSAMLEmailsConfig where + featureColumns = K "validate_saml_emails" :* Nil + +instance MakeFeature DigitalSignaturesConfig where + featureColumns = K "digital_signatures" :* Nil + +instance MakeFeature AppLockConfig where + type FeatureRow AppLockConfig = '[FeatureStatus, EnforceAppLock, Int32] + featureColumns = + K "app_lock_status" + :* K "app_lock_enforce" + :* K "app_lock_inactivity_timeout_secs" + :* Nil + + rowToFeature (status :* enforce :* timeout :* Nil) = + foldMap dbFeatureStatus status + <> foldMap dbFeatureConfig (AppLockConfig <$> enforce <*> timeout) + + featureToRow feat = + Just feat.status + :* Just feat.config.applockEnforceAppLock + :* Just feat.config.applockInactivityTimeoutSecs + :* Nil + +instance MakeFeature ClassifiedDomainsConfig where + type FeatureRow ClassifiedDomainsConfig = '[] + featureColumns = Nil + + rowToFeature Nil = mempty + featureToRow _ = Nil + +instance MakeFeature FileSharingConfig where + type FeatureRow FileSharingConfig = '[LockStatus, FeatureStatus] + featureColumns = K "file_sharing_lock_status" :* K "file_sharing" :* Nil + + rowToFeature (lockStatus :* status :* Nil) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + + featureToRow feat = Just feat.lockStatus :* Just feat.status :* Nil + +instance MakeFeature ConferenceCallingConfig where + type FeatureRow ConferenceCallingConfig = '[LockStatus, FeatureStatus, One2OneCalls] + featureColumns = + K "conference_calling" + :* K "conference_calling_status" + :* K "conference_calling_one_to_one" + :* Nil + + rowToFeature (lockStatus :* status :* calls :* Nil) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + <> foldMap (dbFeatureConfig . ConferenceCallingConfig) calls + + featureToRow feat = + Just feat.lockStatus + :* Just feat.status + :* Just feat.config.one2OneCalls + :* Nil + +instance MakeFeature SelfDeletingMessagesConfig where + type FeatureRow SelfDeletingMessagesConfig = '[LockStatus, FeatureStatus, Int32] + featureColumns = + K "self_deleting_messages_lock_status" + :* K "self_deleting_messages_status" + :* K "self_deleting_messages_ttl" + :* Nil + + rowToFeature (lockStatus :* status :* ttl :* Nil) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + <> foldMap (dbFeatureConfig . SelfDeletingMessagesConfig) ttl + + featureToRow feat = + Just feat.lockStatus + :* Just feat.status + :* Just feat.config.sdmEnforcedTimeoutSeconds + :* Nil + +instance MakeFeature GuestLinksConfig where + type FeatureRow GuestLinksConfig = '[LockStatus, FeatureStatus] + featureColumns = K "guest_links_lock_status" :* K "guest_links_status" :* Nil + + rowToFeature (lockStatus :* status :* Nil) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + + featureToRow feat = Just feat.lockStatus :* Just feat.status :* Nil + +instance MakeFeature SndFactorPasswordChallengeConfig where + type FeatureRow SndFactorPasswordChallengeConfig = '[LockStatus, FeatureStatus] + featureColumns = + K "snd_factor_password_challenge_lock_status" + :* K "snd_factor_password_challenge_status" + :* Nil + + rowToFeature (lockStatus :* status :* Nil) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + + featureToRow feat = Just feat.lockStatus :* Just feat.status :* Nil + +instance MakeFeature ExposeInvitationURLsToTeamAdminConfig where + featureColumns = K "expose_invitation_urls_to_team_admin" :* Nil + +instance MakeFeature OutlookCalIntegrationConfig where + type FeatureRow OutlookCalIntegrationConfig = '[LockStatus, FeatureStatus] + + featureColumns = + K "outlook_cal_integration_lock_status" + :* K "outlook_cal_integration_status" + :* Nil + + rowToFeature (lockStatus :* status :* Nil) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + + featureToRow feat = Just feat.lockStatus :* Just feat.status :* Nil + +instance MakeFeature MLSConfig where + type + FeatureRow MLSConfig = + '[ LockStatus, + FeatureStatus, + ProtocolTag, + (C.Set UserId), + (C.Set CipherSuiteTag), + CipherSuiteTag, + (C.Set ProtocolTag) + ] + featureColumns = + K "mls_lock_status" + :* K "mls_status" + :* K "mls_default_protocol" + :* K "mls_protocol_toggle_users" + :* K "mls_allowed_ciphersuites" + :* K "mls_default_ciphersuite" + :* K "mls_supported_protocols" + :* Nil + + rowToFeature + ( lockStatus + :* status + :* defProto + :* toggleUsers + :* ciphersuites + :* defCiphersuite + :* supportedProtos + :* Nil + ) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + <> foldMap + dbFeatureConfig + ( MLSConfig (foldMap C.fromSet toggleUsers) + <$> defProto + <*> pure (foldMap C.fromSet ciphersuites) + <*> defCiphersuite + <*> pure (foldMap C.fromSet supportedProtos) + ) + + featureToRow feat = + Just feat.lockStatus + :* Just feat.status + :* Just feat.config.mlsDefaultProtocol + :* Just (C.Set feat.config.mlsProtocolToggleUsers) + :* Just (C.Set feat.config.mlsAllowedCipherSuites) + :* Just feat.config.mlsDefaultCipherSuite + :* Just (C.Set feat.config.mlsSupportedProtocols) + :* Nil + +instance MakeFeature MlsE2EIdConfig where + type + FeatureRow MlsE2EIdConfig = + '[ LockStatus, + FeatureStatus, + Int32, + HttpsUrl, + HttpsUrl, + Bool + ] + featureColumns = + K "mls_e2eid_lock_status" + :* K "mls_e2eid_status" + :* K "mls_e2eid_grace_period" + :* K "mls_e2eid_acme_discovery_url" + :* K "mls_e2eid_crl_proxy" + :* K "mls_e2eid_use_proxy_on_mobile" + :* Nil + + rowToFeature + ( lockStatus + :* status + :* gracePeriod + :* acmeDiscoveryUrl + :* crlProxy + :* useProxyOnMobile + :* Nil + ) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + <> dbFeatureModConfig + ( \defCfg -> + defCfg + { verificationExpiration = + maybe defCfg.verificationExpiration fromIntegral gracePeriod, + acmeDiscoveryUrl = acmeDiscoveryUrl, + crlProxy = crlProxy, + useProxyOnMobile = fromMaybe defCfg.useProxyOnMobile useProxyOnMobile + } + ) + + featureToRow feat = + Just feat.lockStatus + :* Just feat.status + :* Just (truncate feat.config.verificationExpiration) + :* feat.config.acmeDiscoveryUrl + :* feat.config.crlProxy + :* Just feat.config.useProxyOnMobile + :* Nil + +instance MakeFeature MlsMigrationConfig where + type + FeatureRow MlsMigrationConfig = + '[LockStatus, FeatureStatus, UTCTime, UTCTime] + + featureColumns = + K "mls_migration_lock_status" + :* K "mls_migration_status" + :* K "mls_migration_start_time" + :* K "mls_migration_finalise_regardless_after" + :* Nil + + rowToFeature (lockStatus :* status :* startTime :* finalizeAfter :* Nil) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + <> dbFeatureConfig (MlsMigrationConfig startTime finalizeAfter) + + featureToRow feat = + Just feat.lockStatus + :* Just feat.status + :* feat.config.startTime + :* feat.config.finaliseRegardlessAfter + :* Nil + +instance MakeFeature EnforceFileDownloadLocationConfig where + type FeatureRow EnforceFileDownloadLocationConfig = '[LockStatus, FeatureStatus, Text] + + featureColumns = + K "enforce_file_download_location_lock_status" + :* K "enforce_file_download_location_status" + :* K "enforce_file_download_location" + :* Nil + + rowToFeature (lockStatus :* status :* location :* Nil) = + foldMap dbFeatureLockStatus lockStatus + <> foldMap dbFeatureStatus status + <> dbFeatureConfig (EnforceFileDownloadLocationConfig location) + featureToRow feat = + Just feat.lockStatus + :* Just feat.status + :* feat.config.enforcedDownloadLocation + :* Nil + +instance MakeFeature LimitedEventFanoutConfig where + featureColumns = K "limited_event_fanout_status" :* Nil + +fetchFeature :: + forall cfg m row mrow. + ( MonadClient m, + row ~ FeatureRow cfg, + MakeFeature cfg, + IsProductType (TupleP mrow) mrow, + AllZip (IsF Maybe) row mrow, + Tuple (TupleP mrow) + ) => + TeamId -> + m (DbFeature cfg) +fetchFeature tid = do + case featureColumns @cfg of + Nil -> pure (rowToFeature Nil) + cols -> do + mRow <- fetchFeatureRow @row @mrow tid cols + pure $ foldMap rowToFeature mRow + +fetchFeatureRow :: + forall row mrow m. + ( MonadClient m, + IsProductType (TupleP mrow) mrow, + AllZip (IsF Maybe) row mrow, + Tuple (TupleP mrow) + ) => + TeamId -> + NP (K String) row -> + m (Maybe (NP Maybe row)) +fetchFeatureRow tid cols = do + let select :: PrepQuery R (Identity TeamId) (TupleP mrow) + select = + fromString $ + "select " + <> intercalate ", " (hcollapse cols) + <> " from team_features where team_id = ?" + row <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) + pure $ fmap (unfactorI . productTypeFrom) row + +storeFeature :: + forall cfg m row mrow. + ( MonadClient m, + row ~ FeatureRow cfg, + MakeFeature cfg, + IsProductType (TupleP (TeamId : mrow)) (TeamId : mrow), + AllZip (IsF Maybe) row mrow, + Tuple (TupleP (TeamId : mrow)), + KnownNat (Length row) + ) => + TeamId -> + LockableFeature cfg -> + m () +storeFeature tid feat = do + if n == 0 + then pure () + else + retry x5 $ + write + insert + ( params LocalQuorum (productTypeTo (I tid :* factorI (featureToRow feat))) + ) + where + n :: Int + n = fromIntegral (demote @(Length row)) + + insert :: PrepQuery W (TupleP (TeamId ': mrow)) () + insert = + fromString $ + "insert into team_features (team_id, " + <> intercalate ", " (hcollapse (featureColumns @cfg)) + <> ") values (" + <> intercalate "," (replicate (succ n) "?") + <> ")" + +class (FeatureRow cfg ~ row) => StoreFeatureLockStatus (row :: [Type]) cfg where + storeFeatureLockStatus' :: (MonadClient m) => TeamId -> Tagged cfg LockStatus -> m () + +instance + {-# OVERLAPPING #-} + ( FeatureRow cfg ~ (LockStatus ': row), + MakeFeature cfg + ) => + StoreFeatureLockStatus (LockStatus ': row) cfg + where + storeFeatureLockStatus' tid lock = do + let col = unK (hd (featureColumns @cfg)) + insert :: PrepQuery W (TeamId, LockStatus) () + insert = + fromString $ + "insert into team_features (team_id, " <> col <> ") values (?, ?)" + retry x5 $ write insert (params LocalQuorum (tid, (untag lock))) + +instance (FeatureRow cfg ~ row) => StoreFeatureLockStatus row cfg where + storeFeatureLockStatus' _ _ = pure () + +storeFeatureLockStatus :: + forall cfg m. + (MonadClient m, StoreFeatureLockStatus (FeatureRow cfg) cfg) => + TeamId -> + Tagged cfg LockStatus -> + m () +storeFeatureLockStatus = storeFeatureLockStatus' @(FeatureRow cfg) + +-- | Convert @NP f [x1, ..., xn]@ to @NP I [f x1, ..., f xn]@. +-- +-- This works because @I . f = f@. +factorI :: forall f xs ys. (AllZip (IsF f) xs ys) => NP f xs -> NP I ys +factorI Nil = Nil +factorI (x :* xs) = I x :* factorI xs + +-- | Convert @NP I [f x1, ..., f xn]@ to @NP f [x1, ..., xn]@. +-- +-- See 'factorI'. +unfactorI :: forall f xs ys. (AllZip (IsF f) xs ys) => NP I ys -> NP f xs +unfactorI Nil = Nil +unfactorI (I x :* xs) = x :* unfactorI xs + +-- | This is to emulate a constraint-level lambda. +class (f x ~ y) => IsF f x y | y -> x + +instance (f x ~ y) => IsF f x y diff --git a/services/galley/src/Galley/Cassandra/Orphans.hs b/services/galley/src/Galley/Cassandra/Orphans.hs new file mode 100644 index 00000000000..d939cdafdb0 --- /dev/null +++ b/services/galley/src/Galley/Cassandra/Orphans.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Galley.Cassandra.Orphans where + +import Galley.Cassandra.FeatureTH + +$generateSOPInstances diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index a751060e668..f1db0f1a5c6 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -23,13 +25,12 @@ module Galley.Cassandra.TeamFeatures where import Cassandra -import Cassandra qualified as C import Data.Id -import Data.Misc (HttpsUrl) -import Data.Time import Galley.API.Teams.Features.Get +import Galley.Cassandra.FeatureTH import Galley.Cassandra.GetAllTeamFeatureConfigs import Galley.Cassandra.Instances () +import Galley.Cassandra.MakeFeature import Galley.Cassandra.Store import Galley.Cassandra.Util import Galley.Effects.TeamFeatureStore qualified as TFS @@ -38,8 +39,6 @@ import Polysemy import Polysemy.Input import Polysemy.TinyLog import UnliftIO.Async (pooledMapConcurrentlyN) -import Wire.API.Conversation.Protocol (ProtocolTag) -import Wire.API.MLS.CipherSuite import Wire.API.Team.Feature interpretTeamFeatureStoreToCassandra :: @@ -56,256 +55,16 @@ interpretTeamFeatureStoreToCassandra = interpret $ \case TFS.GetFeatureConfigMulti sing tids -> do logEffect "TeamFeatureStore.GetFeatureConfigMulti" embedClient $ getFeatureConfigMulti sing tids - TFS.SetFeatureConfig sing tid wsnl -> do + TFS.SetFeatureConfig sing tid feat -> do logEffect "TeamFeatureStore.SetFeatureConfig" - embedClient $ setFeatureConfig sing tid wsnl - TFS.GetFeatureLockStatus sing tid -> do - logEffect "TeamFeatureStore.GetFeatureLockStatus" - embedClient $ getFeatureLockStatus sing tid - TFS.SetFeatureLockStatus sing tid ls -> do + embedClient $ setFeatureConfig sing tid feat + TFS.SetFeatureLockStatus sing tid lock -> do logEffect "TeamFeatureStore.SetFeatureLockStatus" - embedClient $ setFeatureLockStatus sing tid ls + embedClient $ setFeatureLockStatus sing tid (Tagged lock) TFS.GetAllFeatureConfigs tid -> do logEffect "TeamFeatureStore.GetAllFeatureConfigs" embedClient $ getAllFeatureConfigs tid -getFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (DbFeature cfg) -getFeatureConfig FeatureSingletonLegalholdConfig tid = getFeature "legalhold_status" tid -getFeatureConfig FeatureSingletonSSOConfig tid = getFeature "sso_status" tid -getFeatureConfig FeatureSingletonSearchVisibilityAvailableConfig tid = getFeature "search_visibility_status" tid -getFeatureConfig FeatureSingletonValidateSAMLEmailsConfig tid = getFeature "validate_saml_emails" tid -getFeatureConfig FeatureSingletonClassifiedDomainsConfig _tid = pure mempty -getFeatureConfig FeatureSingletonDigitalSignaturesConfig tid = getFeature "digital_signatures" tid -getFeatureConfig FeatureSingletonAppLockConfig tid = - getFeature - "app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs" - tid -getFeatureConfig FeatureSingletonFileSharingConfig tid = getFeature "file_sharing" tid -getFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid = - getFeature - "self_deleting_messages_status, self_deleting_messages_ttl" - tid -getFeatureConfig FeatureSingletonConferenceCallingConfig tid = - getFeature - "conference_calling_status, ttl(conference_calling_status), conference_calling_one_to_one" - tid -getFeatureConfig FeatureSingletonGuestLinksConfig tid = getFeature "guest_links_status" tid -getFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid = getFeature "snd_factor_password_challenge_status" tid -getFeatureConfig FeatureSingletonSearchVisibilityInboundConfig tid = getFeature "search_visibility_status" tid -getFeatureConfig FeatureSingletonMLSConfig tid = - getFeature - "mls_status, mls_default_protocol, mls_protocol_toggle_users, \ - \mls_allowed_ciphersuites, mls_default_ciphersuite, mls_supported_protocols" - tid -getFeatureConfig FeatureSingletonMlsE2EIdConfig tid = - getFeature - "mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, \ - \mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile" - tid -getFeatureConfig FeatureSingletonMlsMigration tid = - getFeature - "mls_migration_status, mls_migration_start_time, \ - \mls_migration_finalise_regardless_after" - tid -getFeatureConfig FeatureSingletonExposeInvitationURLsToTeamAdminConfig tid = - getFeature "expose_invitation_urls_to_team_admin" tid -getFeatureConfig FeatureSingletonOutlookCalIntegrationConfig tid = - getFeature "outlook_cal_integration_status" tid -getFeatureConfig FeatureSingletonEnforceFileDownloadLocationConfig tid = - getFeature - "enforce_file_download_location_status, enforce_file_download_location" - tid -getFeatureConfig FeatureSingletonLimitedEventFanoutConfig tid = - getFeature "limited_event_fanout_status" tid - -setFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> WithStatusNoLock cfg -> m () -setFeatureConfig FeatureSingletonLegalholdConfig tid statusNoLock = setFeatureStatusC "legalhold_status" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonSSOConfig tid statusNoLock = setFeatureStatusC "sso_status" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonSearchVisibilityAvailableConfig tid statusNoLock = setFeatureStatusC "search_visibility_status" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonValidateSAMLEmailsConfig tid statusNoLock = setFeatureStatusC "validate_saml_emails" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonClassifiedDomainsConfig _tid _statusNoLock = pure () -setFeatureConfig FeatureSingletonDigitalSignaturesConfig tid statusNoLock = setFeatureStatusC "digital_signatures" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonAppLockConfig tid status = do - let enforce = applockEnforceAppLock (wssConfig status) - timeout = applockInactivityTimeoutSecs (wssConfig status) - - retry x5 $ write insert (params LocalQuorum (tid, wssStatus status, enforce, timeout)) - where - insert :: PrepQuery W (TeamId, FeatureStatus, EnforceAppLock, Int32) () - insert = - fromString $ - "insert into team_features (team_id, app_lock_status, app_lock_enforce,\ - \ app_lock_inactivity_timeout_secs) values (?, ?, ?, ?)" -setFeatureConfig FeatureSingletonFileSharingConfig tid statusNoLock = setFeatureStatusC "file_sharing" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid status = do - let statusValue = wssStatus status - timeout = sdmEnforcedTimeoutSeconds . wssConfig $ status - retry x5 $ write insert (params LocalQuorum (tid, statusValue, timeout)) - where - insert :: PrepQuery W (TeamId, FeatureStatus, Int32) () - insert = - "insert into team_features (team_id, self_deleting_messages_status,\ - \ self_deleting_messages_ttl) values (?, ?, ?)" -setFeatureConfig FeatureSingletonConferenceCallingConfig tid statusNoLock = do - retry x5 . batch $ do - setType BatchLogged - setConsistency LocalQuorum - addPrepQuery insertStatus (tid, statusNoLock.wssStatus) - addPrepQuery insertConfig (tid, statusNoLock.wssConfig.one2OneCalls) - where - insertStatus :: PrepQuery W (TeamId, FeatureStatus) () - insertStatus = "insert into team_features (team_id, conference_calling_status) values (?, ?)" - insertConfig :: PrepQuery W (TeamId, One2OneCalls) () - insertConfig = "insert into team_features (team_id, conference_calling_one_to_one) values (?, ?)" -setFeatureConfig FeatureSingletonGuestLinksConfig tid statusNoLock = setFeatureStatusC "guest_links_status" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid statusNoLock = - setFeatureStatusC "snd_factor_password_challenge_status" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonSearchVisibilityInboundConfig tid statusNoLock = setFeatureStatusC "search_visibility_status" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonMLSConfig tid statusNoLock = do - let status = wssStatus statusNoLock - let MLSConfig protocolToggleUsers defaultProtocol allowedCipherSuites defaultCipherSuite supportedProtocols = wssConfig statusNoLock - retry x5 $ - write - insert - ( params - LocalQuorum - ( tid, - status, - defaultProtocol, - C.Set protocolToggleUsers, - C.Set allowedCipherSuites, - defaultCipherSuite, - C.Set supportedProtocols - ) - ) - where - insert :: PrepQuery W (TeamId, FeatureStatus, ProtocolTag, C.Set UserId, C.Set CipherSuiteTag, CipherSuiteTag, C.Set ProtocolTag) () - insert = - "insert into team_features (team_id, mls_status, mls_default_protocol, \ - \mls_protocol_toggle_users, mls_allowed_ciphersuites, mls_default_ciphersuite, mls_supported_protocols) values (?, ?, ?, ?, ?, ?, ?)" -setFeatureConfig FeatureSingletonMlsE2EIdConfig tid status = do - let statusValue = wssStatus status - vex = verificationExpiration . wssConfig $ status - mUrl = acmeDiscoveryUrl . wssConfig $ status - mCrlProxy = crlProxy . wssConfig $ status - useProxy = useProxyOnMobile . wssConfig $ status - retry x5 $ write insert (params LocalQuorum (tid, statusValue, truncate vex, mUrl, mCrlProxy, useProxy)) - where - insert :: PrepQuery W (TeamId, FeatureStatus, Int32, Maybe HttpsUrl, Maybe HttpsUrl, Bool) () - insert = - "insert into team_features (team_id, mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile) values (?, ?, ?, ?, ?, ?)" -setFeatureConfig FeatureSingletonMlsMigration tid status = do - let statusValue = wssStatus status - config = wssConfig status - - retry x5 $ write insert (params LocalQuorum (tid, statusValue, config.startTime, config.finaliseRegardlessAfter)) - where - insert :: PrepQuery W (TeamId, FeatureStatus, Maybe UTCTime, Maybe UTCTime) () - insert = - "insert into team_features (team_id, mls_migration_status, mls_migration_start_time, mls_migration_finalise_regardless_after) values (?, ?, ?, ?)" -setFeatureConfig FeatureSingletonExposeInvitationURLsToTeamAdminConfig tid statusNoLock = setFeatureStatusC "expose_invitation_urls_to_team_admin" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonOutlookCalIntegrationConfig tid statusNoLock = setFeatureStatusC "outlook_cal_integration_status" tid (wssStatus statusNoLock) -setFeatureConfig FeatureSingletonEnforceFileDownloadLocationConfig tid status = do - let statusValue = wssStatus status - config = wssConfig status - - retry x5 $ write insert (params LocalQuorum (tid, statusValue, config.enforcedDownloadLocation)) - where - insert :: PrepQuery W (TeamId, FeatureStatus, Maybe Text) () - insert = - "insert into team_features (team_id, enforce_file_download_location_status, enforce_file_download_location) values (?, ?, ?)" -setFeatureConfig FeatureSingletonLimitedEventFanoutConfig tid statusNoLock = - setFeatureStatusC "limited_event_fanout_status" tid (wssStatus statusNoLock) - -getFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (Maybe LockStatus) -getFeatureLockStatus FeatureSingletonFileSharingConfig tid = getLockStatusC "file_sharing_lock_status" tid -getFeatureLockStatus FeatureSingletonSelfDeletingMessagesConfig tid = getLockStatusC "self_deleting_messages_lock_status" tid -getFeatureLockStatus FeatureSingletonGuestLinksConfig tid = getLockStatusC "guest_links_lock_status" tid -getFeatureLockStatus FeatureSingletonSndFactorPasswordChallengeConfig tid = getLockStatusC "snd_factor_password_challenge_lock_status" tid -getFeatureLockStatus FeatureSingletonMlsE2EIdConfig tid = getLockStatusC "mls_e2eid_lock_status" tid -getFeatureLockStatus FeatureSingletonMlsMigration tid = getLockStatusC "mls_migration_lock_status" tid -getFeatureLockStatus FeatureSingletonOutlookCalIntegrationConfig tid = getLockStatusC "outlook_cal_integration_lock_status" tid -getFeatureLockStatus FeatureSingletonMLSConfig tid = getLockStatusC "mls_lock_status" tid -getFeatureLockStatus FeatureSingletonEnforceFileDownloadLocationConfig tid = getLockStatusC "enforce_file_download_location_lock_status" tid -getFeatureLockStatus FeatureSingletonConferenceCallingConfig tid = getLockStatusC "conference_calling" tid -getFeatureLockStatus _ _ = pure Nothing - -setFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> LockStatus -> m () -setFeatureLockStatus FeatureSingletonFileSharingConfig tid status = setLockStatusC "file_sharing_lock_status" tid status -setFeatureLockStatus FeatureSingletonSelfDeletingMessagesConfig tid status = setLockStatusC "self_deleting_messages_lock_status" tid status -setFeatureLockStatus FeatureSingletonGuestLinksConfig tid status = setLockStatusC "guest_links_lock_status" tid status -setFeatureLockStatus FeatureSingletonSndFactorPasswordChallengeConfig tid status = setLockStatusC "snd_factor_password_challenge_lock_status" tid status -setFeatureLockStatus FeatureSingletonMlsE2EIdConfig tid status = setLockStatusC "mls_e2eid_lock_status" tid status -setFeatureLockStatus FeatureSingletonMlsMigration tid status = setLockStatusC "mls_migration_lock_status" tid status -setFeatureLockStatus FeatureSingletonOutlookCalIntegrationConfig tid status = setLockStatusC "outlook_cal_integration_lock_status" tid status -setFeatureLockStatus FeatureSingletonMLSConfig tid status = setLockStatusC "mls_lock_status" tid status -setFeatureLockStatus FeatureSingletonEnforceFileDownloadLocationConfig tid status = setLockStatusC "enforce_file_download_location_lock_status" tid status -setFeatureLockStatus FeatureSingletonConferenceCallingConfig tid status = setLockStatusC "conference_calling" tid status -setFeatureLockStatus _ _tid _status = pure () - -getFeature :: - forall m cfg. - (MonadClient m, MakeFeature cfg) => - String -> - TeamId -> - m (DbFeature cfg) -getFeature columns tid = do - row <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) - pure $ foldMap (mkFeature . toRowType) row - where - select :: PrepQuery R (Identity TeamId) (FeatureRow cfg) - select = - fromString $ - "select " - <> columns - <> " from team_features where team_id = ?" - -setFeatureStatusC :: - forall m. - (MonadClient m) => - String -> - TeamId -> - FeatureStatus -> - m () -setFeatureStatusC statusCol tid status = do - retry x5 $ write insert (params LocalQuorum (tid, status)) - where - insert :: PrepQuery W (TeamId, FeatureStatus) () - insert = - fromString $ - "insert into team_features (team_id, " <> statusCol <> ") values (?, ?)" - -getLockStatusC :: - forall m. - (MonadClient m) => - String -> - TeamId -> - m (Maybe LockStatus) -getLockStatusC lockStatusCol tid = do - let q = query1 select (params LocalQuorum (Identity tid)) - (>>= runIdentity) <$> retry x1 q - where - select :: PrepQuery R (Identity TeamId) (Identity (Maybe LockStatus)) - select = - fromString $ - "select " - <> lockStatusCol - <> " from team_features where team_id = ?" - -setLockStatusC :: - (MonadClient m) => - String -> - TeamId -> - LockStatus -> - m () -setLockStatusC col tid status = do - retry x5 $ write insert (params LocalQuorum (tid, status)) - where - insert :: PrepQuery W (TeamId, LockStatus) () - insert = - fromString $ - "insert into team_features (team_id, " <> col <> ") values (?, ?)" - getFeatureConfigMulti :: forall cfg m. (MonadClient m, MonadUnliftIO m) => @@ -314,3 +73,12 @@ getFeatureConfigMulti :: m [(TeamId, DbFeature cfg)] getFeatureConfigMulti proxy = pooledMapConcurrentlyN 8 (\tid -> getFeatureConfig proxy tid <&> (tid,)) + +getFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (DbFeature cfg) +getFeatureConfig = $(featureCases [|fetchFeature|]) + +setFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> LockableFeature cfg -> m () +setFeatureConfig = $(featureCases [|storeFeature|]) + +setFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> Tagged cfg LockStatus -> m () +setFeatureLockStatus = $(featureCases [|storeFeatureLockStatus|]) diff --git a/services/galley/src/Galley/Effects/BrigAccess.hs b/services/galley/src/Galley/Effects/BrigAccess.hs index c825a3e7129..2e14a25c104 100644 --- a/services/galley/src/Galley/Effects/BrigAccess.hs +++ b/services/galley/src/Galley/Effects/BrigAccess.hs @@ -122,7 +122,7 @@ data BrigAccess m a where LastPrekey -> BrigAccess m (Either AuthenticationError ClientId) RemoveLegalHoldClientFromUser :: UserId -> BrigAccess m () - GetAccountConferenceCallingConfigClient :: UserId -> BrigAccess m (WithStatusNoLock ConferenceCallingConfig) + GetAccountConferenceCallingConfigClient :: UserId -> BrigAccess m (Feature ConferenceCallingConfig) GetLocalMLSClients :: Local UserId -> CipherSuiteTag -> BrigAccess m (Set ClientInfo) UpdateSearchVisibilityInbound :: Multi.TeamStatus SearchVisibilityInboundConfig -> diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/services/galley/src/Galley/Effects/TeamFeatureStore.hs index 0d24a1821af..d319d3515da 100644 --- a/services/galley/src/Galley/Effects/TeamFeatureStore.hs +++ b/services/galley/src/Galley/Effects/TeamFeatureStore.hs @@ -20,7 +20,6 @@ module Galley.Effects.TeamFeatureStore where import Data.Id -import Imports import Polysemy import Wire.API.Team.Feature @@ -37,12 +36,8 @@ data TeamFeatureStore m a where SetFeatureConfig :: FeatureSingleton cfg -> TeamId -> - WithStatusNoLock cfg -> + LockableFeature cfg -> TeamFeatureStore m () - GetFeatureLockStatus :: - FeatureSingleton cfg -> - TeamId -> - TeamFeatureStore m (Maybe LockStatus) SetFeatureLockStatus :: FeatureSingleton cfg -> TeamId -> @@ -50,6 +45,6 @@ data TeamFeatureStore m a where TeamFeatureStore m () GetAllFeatureConfigs :: TeamId -> - TeamFeatureStore m (AllFeatures DbFeatureWithLock) + TeamFeatureStore m (AllFeatures DbFeature) makeSem ''TeamFeatureStore diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 5419b68ecea..6e6ef60859e 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -238,7 +238,7 @@ getRichInfoMultiUser = chunkify $ \uids -> do . expect2xx parseResponse (mkError status502 "server-error: could not parse response to `GET brig:/i/users/rich-info`") resp -getAccountConferenceCallingConfigClient :: (HasCallStack) => UserId -> App (WithStatusNoLock ConferenceCallingConfig) +getAccountConferenceCallingConfigClient :: (HasCallStack) => UserId -> App (Feature ConferenceCallingConfig) getAccountConferenceCallingConfigClient uid = runHereClientM (namedClient @IAPI.API @"get-account-conference-calling-config" uid) >>= handleServantResp diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index f05541d3a76..16fa23d97be 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedRecordDot #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-unused-local-binds #-} @@ -1176,7 +1177,7 @@ testGetCodeRejectedIfGuestLinksDisabled = do convId <- createConvWithGuestLink let checkGetCode expectedStatus = getConvCode owner convId !!! const expectedStatus === statusCode let setStatus tfStatus = - TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId (Public.Feature tfStatus Public.GuestLinksConfig) !!! do const 200 === statusCode checkGetCode 200 @@ -1192,7 +1193,7 @@ testPostCodeRejectedIfGuestLinksDisabled = do convId <- decodeConvId <$> postTeamConv teamId owner [] (Just "testConversation") [CodeAccess] (Just noGuestsAccess) Nothing let checkPostCode expectedStatus = postConvCode owner convId !!! statusCode === const expectedStatus let setStatus tfStatus = - TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId (Public.Feature tfStatus Public.GuestLinksConfig) !!! do const 200 === statusCode checkPostCode 201 @@ -1216,7 +1217,16 @@ testJoinTeamConvGuestLinksDisabled = do let checkFeatureStatus fstatus = Util.getTeamFeature @Public.GuestLinksConfig owner teamId !!! do const 200 === statusCode - const (Right (Public.withStatus fstatus Public.LockStatusUnlocked Public.GuestLinksConfig Public.FeatureTTLUnlimited)) === responseJsonEither + const + ( Right + ( Public.LockableFeature + { Public.status = fstatus, + Public.lockStatus = Public.LockStatusUnlocked, + Public.config = Public.GuestLinksConfig + } + ) + ) + === responseJsonEither -- guest can join if guest link feature is enabled checkFeatureStatus Public.FeatureStatusEnabled @@ -1229,7 +1239,7 @@ testJoinTeamConvGuestLinksDisabled = do postJoinCodeConv bob cCode !!! const 200 === statusCode -- disabled guest links feature - let disabled = Public.WithStatusNoLock Public.FeatureStatusDisabled Public.GuestLinksConfig Public.FeatureTTLUnlimited + let disabled = Public.Feature Public.FeatureStatusDisabled Public.GuestLinksConfig TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId disabled !!! do const 200 === statusCode @@ -1248,7 +1258,7 @@ testJoinTeamConvGuestLinksDisabled = do checkFeatureStatus Public.FeatureStatusDisabled -- after re-enabling, the old link is still valid - let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled Public.GuestLinksConfig Public.FeatureTTLUnlimited + let enabled = Public.Feature Public.FeatureStatusEnabled Public.GuestLinksConfig TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId enabled !!! do const 200 === statusCode getJoinCodeConv eve' (conversationKey cCode) (conversationCode cCode) !!! do @@ -1276,7 +1286,7 @@ testJoinNonTeamConvGuestLinksDisabled = do const 200 === statusCode -- for non-team conversations it still works if status is disabled for the team but not server wide - let tfStatus = Public.WithStatusNoLock Public.FeatureStatusDisabled Public.GuestLinksConfig Public.FeatureTTLUnlimited + let tfStatus = Public.Feature Public.FeatureStatusDisabled Public.GuestLinksConfig TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId tfStatus !!! do const 200 === statusCode @@ -1516,12 +1526,12 @@ getGuestLinksStatusFromForeignTeamConv = do localDomain <- viewFederationDomain galley <- viewGalley let setTeamStatus u tid tfStatus = - TeamFeatures.putTeamFeature @Public.GuestLinksConfig u tid (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig u tid (Public.Feature tfStatus Public.GuestLinksConfig) !!! do const 200 === statusCode let checkGuestLinksStatus u c s = getGuestLinkStatus galley u c !!! do const 200 === statusCode - const s === (Public.wsStatus . (responseJsonUnsafe @(Public.WithStatus Public.GuestLinksConfig))) + const s === ((.status) . (responseJsonUnsafe @(Public.LockableFeature Public.GuestLinksConfig))) let checkGetGuestLinksStatus s u c = getGuestLinkStatus galley u c !!! do const s === statusCode diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 8aca27809c2..72bd68fa8e5 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -398,9 +398,8 @@ testEnableSSOPerTeam = do assertTeamActivate "create team" tid let check :: (HasCallStack) => String -> Public.FeatureStatus -> TestM () check msg enabledness = do - status :: Public.WithStatusNoLock Public.SSOConfig <- responseJsonUnsafe <$> (getSSOEnabledInternal tid (getSSOEnabledInternal tid TestM () putSSOEnabledInternalCheckNotImplemented = do g <- viewGalley @@ -409,7 +408,7 @@ testEnableSSOPerTeam = do <$> put ( g . paths ["i", "teams", toByteString' tid, "features", "sso"] - . json (Public.WithStatusNoLock Public.FeatureStatusDisabled Public.SSOConfig Public.FeatureTTLUnlimited) + . json (Public.Feature Public.FeatureStatusDisabled Public.SSOConfig) ) liftIO $ do assertEqual "bad status" status403 (Wai.code waierr) @@ -427,10 +426,9 @@ testEnableTeamSearchVisibilityPerTeam = do (tid, owner, member : _) <- Util.createBindingTeamWithMembers 2 let check :: String -> Public.FeatureStatus -> TestM () check msg enabledness = do - status :: Public.WithStatusNoLock Public.SearchVisibilityAvailableConfig <- responseJsonUnsafe <$> (Util.getTeamFeatureInternal @Public.SearchVisibilityAvailableConfig tid (Util.getTeamFeatureInternal @Public.SearchVisibilityAvailableConfig tid Public.FeatureStatus -> TestM () setTeamSndFactorPasswordChallenge tid status = do g <- viewGalley - let js = RequestBodyLBS $ encode $ Public.WithStatusNoLock status Public.SndFactorPasswordChallengeConfig Public.FeatureTTLUnlimited + let js = RequestBodyLBS $ encode $ Public.Feature status Public.SndFactorPasswordChallengeConfig put (g . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @Public.SndFactorPasswordChallengeConfig] . contentJson . body js) !!! const 200 === statusCode getVerificationCode :: UserId -> Public.VerificationAction -> TestM Code.Value @@ -1745,7 +1743,7 @@ getSSOEnabledInternal = Util.getTeamFeatureInternal @Public.SSOConfig putSSOEnabledInternal :: (HasCallStack) => TeamId -> Public.FeatureStatus -> TestM () putSSOEnabledInternal tid statusValue = - void $ Util.putTeamFeatureInternal @Public.SSOConfig expect2xx tid (Public.WithStatusNoLock statusValue Public.SSOConfig Public.FeatureTTLUnlimited) + void $ Util.putTeamFeatureInternal @Public.SSOConfig expect2xx tid (Public.Feature statusValue Public.SSOConfig) getSearchVisibility :: (HasCallStack) => (Request -> Request) -> UserId -> TeamId -> (MonadHttp m) => m ResponseLBS getSearchVisibility g uid tid = do diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs index 0ed8319d99e..923a25b92e7 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs @@ -502,14 +502,12 @@ testEnablePerTeam = do member <- randomUser addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing do - status :: Public.WithStatusNoLock Public.LegalholdConfig <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid do grantConsent tid member requestLegalHoldDevice owner member tid !!! const 201 === statusCode @@ -519,9 +517,8 @@ testEnablePerTeam = do liftIO $ assertEqual "User legal hold status should be enabled" UserLegalHoldEnabled status do putEnabled tid Public.FeatureStatusDisabled -- disable again - status :: Public.WithStatusNoLock Public.LegalholdConfig <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid UserId -> TeamId -> NewLegalHoldService -> TestM ResponseLBS diff --git a/services/galley/test/integration/API/Util/TeamFeature.hs b/services/galley/test/integration/API/Util/TeamFeature.hs index 630f030e3f2..873eb4e51ea 100644 --- a/services/galley/test/integration/API/Util/TeamFeature.hs +++ b/services/galley/test/integration/API/Util/TeamFeature.hs @@ -50,7 +50,7 @@ putTeamSearchVisibilityAvailableInternal tid statusValue = @Public.SearchVisibilityAvailableConfig expect2xx tid - (Public.WithStatusNoLock statusValue Public.SearchVisibilityAvailableConfig Public.FeatureTTLUnlimited) + (Public.Feature statusValue Public.SearchVisibilityAvailableConfig) putTeamFeatureInternal :: forall cfg m. @@ -59,11 +59,11 @@ putTeamFeatureInternal :: MonadHttp m, HasCallStack, KnownSymbol (Public.FeatureSymbol cfg), - ToJSON (Public.WithStatusNoLock cfg) + ToJSON (Public.Feature cfg) ) => (Request -> Request) -> TeamId -> - Public.WithStatusNoLock cfg -> + Public.Feature cfg -> m ResponseLBS putTeamFeatureInternal reqmod tid status = do galley <- viewGalley @@ -77,11 +77,11 @@ putTeamFeature :: forall cfg. ( HasCallStack, KnownSymbol (Public.FeatureSymbol cfg), - ToJSON (Public.WithStatusNoLock cfg) + ToJSON (Public.Feature cfg) ) => UserId -> TeamId -> - Public.WithStatusNoLock cfg -> + Public.Feature cfg -> TestM ResponseLBS putTeamFeature uid tid status = do galley <- viewGalley diff --git a/services/spar/src/Spar/Intra/Galley.hs b/services/spar/src/Spar/Intra/Galley.hs index 03dc835df67..8e9b508c947 100644 --- a/services/spar/src/Spar/Intra/Galley.hs +++ b/services/spar/src/Spar/Intra/Galley.hs @@ -99,8 +99,8 @@ assertSSOEnabled tid = do . paths ["i", "teams", toByteString' tid, "features", "sso"] unless (statusCode resp == 200) $ rethrow "galley" resp - ws :: WithStatus SSOConfig <- parseResponse "galley" resp - unless (wsStatus ws == FeatureStatusEnabled) $ + ws :: LockableFeature SSOConfig <- parseResponse "galley" resp + unless (ws.status == FeatureStatusEnabled) $ throwSpar SparSSODisabled isEmailValidationEnabledTeam :: (HasCallStack, MonadSparToGalley m) => TeamId -> m Bool @@ -108,7 +108,7 @@ isEmailValidationEnabledTeam tid = do resp <- call $ method GET . paths ["i", "teams", toByteString' tid, "features", "validateSAMLemails"] pure ( statusCode resp == 200 - && ( (wsStatus <$> responseJsonMaybe @(WithStatus ValidateSAMLEmailsConfig) resp) + && ( ((.status) <$> responseJsonMaybe @(LockableFeature ValidateSAMLEmailsConfig) resp) == Just FeatureStatusEnabled ) ) diff --git a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs index 69a064400cf..6f7983a10b9 100644 --- a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs @@ -151,7 +151,7 @@ unlockFeature galley tid = setSndFactorPasswordChallengeStatus :: GalleyReq -> TeamId -> Public.FeatureStatus -> TestSpar () setSndFactorPasswordChallengeStatus galley tid status = do - let js = RequestBodyLBS $ encode $ Public.WithStatusNoLock @Public.SndFactorPasswordChallengeConfig status Public.SndFactorPasswordChallengeConfig Public.FeatureTTLUnlimited + let js = RequestBodyLBS $ encode $ Public.Feature @Public.SndFactorPasswordChallengeConfig status Public.SndFactorPasswordChallengeConfig call $ put (galley . paths ["i", "teams", toByteString' tid, "features", featureNameBS @Public.SndFactorPasswordChallengeConfig] . contentJson . body js) !!! const 200 === statusCode diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 30e18ed8cfa..250ef14efd4 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -385,7 +385,7 @@ putSSOEnabledInternal gly tid enabled = do void . put $ gly . paths ["i", "teams", toByteString' tid, "features", "sso"] - . json (WithStatusNoLock @SSOConfig enabled SSOConfig FeatureTTLUnlimited) + . json (Feature enabled SSOConfig) . expect2xx -- | cloned from `/services/brig/test/integration/API/Team/Util.hs`. diff --git a/services/spar/test-integration/Util/Email.hs b/services/spar/test-integration/Util/Email.hs index 0a1910127fe..3d639e0c3b9 100644 --- a/services/spar/test-integration/Util/Email.hs +++ b/services/spar/test-integration/Util/Email.hs @@ -110,6 +110,6 @@ activate brig (k, c) = setSamlEmailValidation :: (HasCallStack) => TeamId -> Feature.FeatureStatus -> TestSpar () setSamlEmailValidation tid status = do galley <- view teGalley - let req = put $ galley . paths p . json (Feature.WithStatusNoLock @Feature.ValidateSAMLEmailsConfig status Feature.ValidateSAMLEmailsConfig Feature.FeatureTTLUnlimited) + let req = put $ galley . paths p . json (Feature.Feature @Feature.ValidateSAMLEmailsConfig status Feature.ValidateSAMLEmailsConfig) p = ["/i/teams", toByteString' tid, "features", Feature.featureNameBS @Feature.ValidateSAMLEmailsConfig] call req !!! const 200 === statusCode diff --git a/tools/stern/default.nix b/tools/stern/default.nix index cde1f4ba46a..18246b4fc52 100644 --- a/tools/stern/default.nix +++ b/tools/stern/default.nix @@ -11,6 +11,7 @@ , bytestring-conversion , containers , cookie +, data-default , errors , exceptions , extended @@ -100,6 +101,7 @@ mkDerivation { bytestring-conversion containers cookie + data-default exceptions extra HsOpenSSL diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index b95aa15c989..611b366ca08 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -70,7 +70,7 @@ import Wire.API.Routes.Internal.Brig.Connection (ConnectionStatus) import Wire.API.Routes.Internal.Brig.EJPD qualified as EJPD import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Routes.Named (Named (Named)) -import Wire.API.Team.Feature hiding (setStatus) +import Wire.API.Team.Feature import Wire.API.Team.SearchVisibility import Wire.API.User import Wire.API.User.Search @@ -314,16 +314,16 @@ mkFeatureGetRoute :: Typeable cfg ) => TeamId -> - Handler (WithStatus cfg) + Handler (LockableFeature cfg) mkFeatureGetRoute = Intra.getTeamFeatureFlag @cfg mkFeaturePutRoute :: forall cfg. ( KnownSymbol (FeatureSymbol cfg), - ToJSON (WithStatusNoLock cfg) + ToJSON (Feature cfg) ) => TeamId -> - WithStatusNoLock cfg -> + Feature cfg -> Handler NoContent mkFeaturePutRoute tid payload = NoContent <$ Intra.setTeamFeatureFlag @cfg tid payload @@ -331,8 +331,8 @@ type MkFeaturePutConstraints cfg = ( IsFeatureConfig cfg, KnownSymbol (FeatureSymbol cfg), ToSchema cfg, - FromJSON (WithStatusNoLock cfg), - ToJSON (WithStatusNoLock cfg), + FromJSON (Feature cfg), + ToJSON (Feature cfg), Typeable cfg ) @@ -350,8 +350,8 @@ mkFeaturePutRouteTrivialConfigWithTTL tid status = mkFeaturePutRouteTrivialConfi mkFeaturePutRouteTrivialConfig :: forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> FeatureStatus -> Maybe FeatureTTLDays -> Handler NoContent -mkFeaturePutRouteTrivialConfig tid status (fmap convertFeatureTTLDaysToSeconds -> ttl) = do - let patch = wsPatch (Just status) Nothing Nothing ttl +mkFeaturePutRouteTrivialConfig tid status _ = do + let patch = LockableFeaturePatch (Just status) Nothing Nothing NoContent <$ Intra.patchTeamFeatureFlag @cfg tid patch getSearchVisibility :: TeamId -> Handler TeamSearchVisibilityView diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index 93b99fce9f1..f0472676e47 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -484,7 +484,7 @@ type MkFeatureGetRoute (feature :: Type) = :> Capture "tid" TeamId :> "features" :> FeatureSymbol feature - :> Get '[JSON] (WithStatus feature) + :> Get '[JSON] (LockableFeature feature) type MkFeaturePutRouteNoTTL (feature :: Type) = Summary "Disable / enable status for a given feature / team" @@ -522,5 +522,5 @@ type MkFeaturePutRoute (feature :: Type) = :> Capture "tid" TeamId :> "features" :> FeatureSymbol feature - :> ReqBody '[JSON] (WithStatusNoLock feature) + :> ReqBody '[JSON] (Feature feature) :> Put '[JSON] NoContent diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index f3350ee7bcc..14e2c62e1fc 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -504,12 +504,12 @@ setBlacklistStatus status email = do getTeamFeatureFlag :: forall cfg. - ( Typeable (Public.WithStatus cfg), - FromJSON (Public.WithStatus cfg), + ( Typeable (Public.LockableFeature cfg), + FromJSON (Public.LockableFeature cfg), KnownSymbol (Public.FeatureSymbol cfg) ) => TeamId -> - Handler (Public.WithStatus cfg) + Handler (Public.LockableFeature cfg) getTeamFeatureFlag tid = do info $ msg "Getting team feature status" gly <- view galley @@ -518,21 +518,20 @@ getTeamFeatureFlag tid = do . Bilge.paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] resp <- catchRpcErrors $ rpc' "galley" gly req case Bilge.statusCode resp of - 200 -> pure $ responseJsonUnsafe @(Public.WithStatus cfg) resp + 200 -> pure $ responseJsonUnsafe @(Public.LockableFeature cfg) resp 404 -> throwE (mkError status404 "bad-upstream" "team doesnt exist") _ -> throwE (mkError status502 "bad-upstream" (errorMessage resp)) setTeamFeatureFlag :: forall cfg. - ( ToJSON (Public.WithStatusNoLock cfg), + ( ToJSON (Public.Feature cfg), KnownSymbol (Public.FeatureSymbol cfg) ) => TeamId -> - Public.WithStatusNoLock cfg -> + Public.Feature cfg -> Handler () setTeamFeatureFlag tid status = do info $ msg "Setting team feature status" - checkDaysLimit (wssTTL status) galleyRpc $ method PUT . Bilge.paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] @@ -541,15 +540,14 @@ setTeamFeatureFlag tid status = do patchTeamFeatureFlag :: forall cfg. - ( ToJSON (Public.WithStatusPatch cfg), + ( ToJSON (Public.LockableFeaturePatch cfg), KnownSymbol (Public.FeatureSymbol cfg) ) => TeamId -> - Public.WithStatusPatch cfg -> + Public.LockableFeaturePatch cfg -> Handler () patchTeamFeatureFlag tid patch = do info $ msg "Patching team feature status" - for_ (wspTTL patch) $ \ttl -> checkDaysLimit ttl galleyRpc $ method PATCH . Bilge.paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] @@ -566,26 +564,6 @@ galleyRpc req = do 403 -> throwE (mkError status403 "bad-upstream" "config cannot be changed") _ -> throwE (mkError status502 "bad-upstream" (errorMessage resp)) -checkDaysLimit :: FeatureTTL -> Handler () -checkDaysLimit = \case - FeatureTTLUnlimited -> pure () - FeatureTTLSeconds ((`div` (60 * 60 * 24)) -> days) -> do - unless (days <= daysLimit) $ do - throwE - ( mkError - status400 - "bad-data" - ( LT.pack $ - "ttl limit is " - <> show daysLimit - <> " days; I got " - <> show days - <> "." - ) - ) - where - daysLimit = 2000 - setTeamFeatureLockStatus :: forall cfg. ( KnownSymbol (Public.FeatureSymbol cfg) diff --git a/tools/stern/stern.cabal b/tools/stern/stern.cabal index 01b6639617a..ba50b7edb6b 100644 --- a/tools/stern/stern.cabal +++ b/tools/stern/stern.cabal @@ -251,6 +251,7 @@ executable stern-integration , bytestring-conversion , containers , cookie + , data-default , exceptions , extra >=1.3 , HsOpenSSL diff --git a/tools/stern/test/integration/API.hs b/tools/stern/test/integration/API.hs index b35aadcf554..de4d3917d9c 100644 --- a/tools/stern/test/integration/API.hs +++ b/tools/stern/test/integration/API.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedRecordDot #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -- This file is part of the Wire Server implementation. -- @@ -30,6 +30,7 @@ import Control.Lens hiding ((.=)) import Data.Aeson (ToJSON, Value) import Data.Aeson qualified as A import Data.ByteString.Conversion +import Data.Default import Data.Handle import Data.Id import Data.Range (unsafeRange) @@ -105,8 +106,8 @@ tests s = -- - `POST /teams/:tid/billing` ] -defConfCalling :: WithStatus ConferenceCallingConfig -defConfCalling = setStatus FeatureStatusDisabled defFeatureStatus +defConfCalling :: LockableFeature ConferenceCallingConfig +defConfCalling = def {status = FeatureStatusDisabled} testRudSsoDomainRedirect :: TestM () testRudSsoDomainRedirect = do @@ -261,7 +262,7 @@ testLegalholdConfig :: TestM () testLegalholdConfig = do (_, tid, _) <- createTeamWithNMembers 10 cfg <- getFeatureConfig @LegalholdConfig tid - liftIO $ cfg @?= defFeatureStatus @LegalholdConfig + liftIO $ cfg @?= def -- Legal hold is enabled for teams via server config and cannot be changed here putFeatureStatus @LegalholdConfig tid FeatureStatusEnabled Nothing !!! const 403 === statusCode @@ -278,11 +279,11 @@ testFeatureConfig :: testFeatureConfig = do (_, tid, _) <- createTeamWithNMembers 10 cfg <- getFeatureConfig @cfg tid - liftIO $ cfg @?= defFeatureStatus @cfg - let newStatus = if wsStatus cfg == FeatureStatusEnabled then FeatureStatusDisabled else FeatureStatusEnabled - putFeatureConfig @cfg tid (setStatus newStatus cfg) !!! const 200 === statusCode + liftIO $ cfg @?= def + let newStatus = if cfg.status == FeatureStatusEnabled then FeatureStatusDisabled else FeatureStatusEnabled + putFeatureConfig @cfg tid cfg {status = newStatus} !!! const 200 === statusCode cfg' <- getFeatureConfig @cfg tid - liftIO $ wsStatus cfg' @?= newStatus + liftIO $ cfg'.status @?= newStatus testGetFeatureConfig :: forall cfg. @@ -298,7 +299,7 @@ testGetFeatureConfig :: testGetFeatureConfig mDef = do (_, tid, _) <- createTeamWithNMembers 10 cfg <- getFeatureConfig @cfg tid - liftIO $ wsStatus cfg @?= fromMaybe (wsStatus $ defFeatureStatus @cfg) mDef + liftIO $ cfg.status @?= fromMaybe (def @(Feature cfg)).status mDef testFeatureStatus :: forall cfg. @@ -310,7 +311,7 @@ testFeatureStatus :: Show cfg ) => TestM () -testFeatureStatus = testFeatureStatusOptTtl (defFeatureStatus @cfg) Nothing +testFeatureStatus = testFeatureStatusOptTtl @cfg def Nothing testFeatureStatusOptTtl :: forall cfg. @@ -321,18 +322,18 @@ testFeatureStatusOptTtl :: Eq cfg, Show cfg ) => - WithStatus cfg -> + LockableFeature cfg -> Maybe FeatureTTL -> TestM () testFeatureStatusOptTtl defValue mTtl = do (_, tid, _) <- createTeamWithNMembers 10 cfg <- getFeatureConfig @cfg tid liftIO $ cfg @?= defValue - when (wsLockStatus cfg == LockStatusLocked) $ unlockFeature @cfg tid - let newStatus = if wsStatus cfg == FeatureStatusEnabled then FeatureStatusDisabled else FeatureStatusEnabled + when (cfg.lockStatus == LockStatusLocked) $ unlockFeature @cfg tid + let newStatus = if cfg.status == FeatureStatusEnabled then FeatureStatusDisabled else FeatureStatusEnabled putFeatureStatus @cfg tid newStatus mTtl !!! const 200 === statusCode cfg' <- getFeatureConfig @cfg tid - liftIO $ wsStatus cfg' @?= newStatus + liftIO $ cfg'.status @?= newStatus testFeatureStatusWithLock :: forall cfg. @@ -348,31 +349,31 @@ 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 + cfg @?= def -- 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 + cfg.lockStatus @?= LockStatusLocked + cfg.status @?= FeatureStatusDisabled void $ putFeatureStatusLock @cfg tid LockStatusUnlocked mTtl getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do - wsLockStatus cfg @?= LockStatusUnlocked - wsStatus cfg @?= FeatureStatusDisabled + cfg.lockStatus @?= LockStatusUnlocked + cfg.status @?= FeatureStatusDisabled void $ putFeatureStatus @cfg tid FeatureStatusEnabled Nothing getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do - wsLockStatus cfg @?= LockStatusUnlocked - wsStatus cfg @?= FeatureStatusEnabled + cfg.lockStatus @?= LockStatusUnlocked + cfg.status @?= FeatureStatusEnabled void $ putFeatureStatusLock @cfg tid LockStatusLocked mTtl getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do - wsLockStatus cfg @?= LockStatusLocked - wsStatus cfg @?= FeatureStatusDisabled + cfg.lockStatus @?= LockStatusLocked + cfg.status @?= FeatureStatusDisabled void $ putFeatureStatusLock @cfg tid LockStatusUnlocked mTtl getFeatureConfig @cfg tid >>= \cfg -> liftIO $ do - wsLockStatus cfg @?= LockStatusUnlocked - wsStatus cfg @?= FeatureStatusEnabled + cfg.lockStatus @?= LockStatusUnlocked + cfg.status @?= FeatureStatusEnabled testGetConsentLog :: TestM () testGetConsentLog = do @@ -614,7 +615,7 @@ getFeatureConfig :: IsFeatureConfig cfg ) => TeamId -> - TestM (WithStatus cfg) + TestM (LockableFeature cfg) getFeatureConfig tid = do s <- view tsStern r <- get (s . paths ["teams", toByteString' tid, "features", Public.featureNameBS @cfg] . expect2xx) @@ -669,10 +670,10 @@ putFeatureConfig :: ToSchema cfg, Typeable cfg, IsFeatureConfig cfg, - ToJSON (WithStatus cfg) + ToJSON (LockableFeature cfg) ) => TeamId -> - WithStatus cfg -> + LockableFeature cfg -> TestM ResponseLBS putFeatureConfig tid cfg = do s <- view tsStern @@ -706,7 +707,7 @@ unlockFeature :: ToSchema cfg, Typeable cfg, IsFeatureConfig cfg, - ToJSON (WithStatus cfg) + ToJSON (LockableFeature cfg) ) => TeamId -> TestM ()