diff --git a/changelog.d/5-internal/feature-flag-refactoring-2 b/changelog.d/5-internal/feature-flag-refactoring-2 new file mode 100644 index 00000000000..8c985d1f6b3 --- /dev/null +++ b/changelog.d/5-internal/feature-flag-refactoring-2 @@ -0,0 +1 @@ +Clean up and reorganise feature flag endpoints diff --git a/libs/galley-types/default.nix b/libs/galley-types/default.nix index f977e3444c9..c7b207c15d7 100644 --- a/libs/galley-types/default.nix +++ b/libs/galley-types/default.nix @@ -17,7 +17,6 @@ , lib , memory , QuickCheck -, schema-profunctor , text , types-common , utf8-string @@ -41,7 +40,6 @@ mkDerivation { lens memory QuickCheck - schema-profunctor text types-common utf8-string diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 7a07066d2e3..2a13877a49c 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -81,7 +81,6 @@ library , lens >=4.12 , memory , QuickCheck - , schema-profunctor , text >=0.11 , types-common >=0.16 , utf8-string diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 23300b55c27..13c2c063653 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -66,7 +66,6 @@ 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 import Imports import Test.QuickCheck (Arbitrary) @@ -153,7 +152,7 @@ instance FromJSON FeatureFlags where <*> (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 :: forall cfg. (IsFeatureConfig cfg) => Object -> Key -> A.Parser (Defaults (ImplicitLockStatus cfg)) withImplicitLockStatusOrDefault obj fieldName = fromMaybe (Defaults (ImplicitLockStatus def)) <$> obj .:? fieldName instance FromJSON FeatureSSO where diff --git a/libs/wire-api/src/Wire/API/Error.hs b/libs/wire-api/src/Wire/API/Error.hs index 275d554a139..f37711ac06f 100644 --- a/libs/wire-api/src/Wire/API/Error.hs +++ b/libs/wire-api/src/Wire/API/Error.hs @@ -164,7 +164,7 @@ instance (KnownError e) => ToSchema (SStaticError e) where data CanThrow e -data CanThrowMany e +data CanThrowMany (es :: [k]) instance (RoutesToPaths api) => RoutesToPaths (CanThrow err :> api) where getRoutes = getRoutes @api @@ -203,18 +203,18 @@ type instance SpecialiseToVersion v (CanThrowMany es :> api) = CanThrowMany es :> SpecialiseToVersion v api -instance (HasOpenApi api) => HasOpenApi (CanThrowMany '() :> api) where +instance (HasOpenApi api) => HasOpenApi (CanThrowMany '[] :> api) where toOpenApi _ = toOpenApi (Proxy @api) instance (HasOpenApi (CanThrowMany es :> api), IsSwaggerError e) => - HasOpenApi (CanThrowMany '(e, es) :> api) + HasOpenApi (CanThrowMany (e : es) :> api) where toOpenApi _ = addToOpenApi @e (toOpenApi (Proxy @(CanThrowMany es :> api))) type family DeclaredErrorEffects api :: EffectRow where DeclaredErrorEffects (CanThrow e :> api) = (ErrorEffect e ': DeclaredErrorEffects api) - DeclaredErrorEffects (CanThrowMany '(e, es) :> api) = + DeclaredErrorEffects (CanThrowMany (e : es) :> api) = DeclaredErrorEffects (CanThrow e :> CanThrowMany es :> api) DeclaredErrorEffects (x :> api) = DeclaredErrorEffects api DeclaredErrorEffects (Named n api) = DeclaredErrorEffects api diff --git a/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs b/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs index ca1e3fc7534..30242dccf7f 100644 --- a/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs +++ b/libs/wire-api/src/Wire/API/Event/FeatureConfig.hs @@ -28,7 +28,6 @@ import Data.Aeson.KeyMap qualified as KeyMap import Data.Json.Util (ToJSONObject (toJSONObject)) import Data.OpenApi qualified as S import Data.Schema -import GHC.TypeLits (KnownSymbol) import Imports import Test.QuickCheck.Gen import Wire.API.Team.Feature @@ -42,7 +41,7 @@ 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 :: forall cfg. (IsFeatureConfig cfg, Arbitrary cfg) => Gen A.Value arbitraryFeature = toJSON <$> arbitrary @(LockableFeature cfg) class AllArbitraryFeatures cfgs where @@ -53,7 +52,6 @@ instance AllArbitraryFeatures '[] where instance ( IsFeatureConfig cfg, - ToSchema cfg, Arbitrary cfg, AllArbitraryFeatures cfgs ) => @@ -99,5 +97,5 @@ instance ToJSONObject Event where instance S.ToSchema Event where declareNamedSchema = schemaToSwagger -mkUpdateEvent :: forall cfg. (IsFeatureConfig cfg, ToSchema cfg, KnownSymbol (FeatureSymbol cfg)) => LockableFeature cfg -> Event +mkUpdateEvent :: forall cfg. (IsFeatureConfig cfg) => LockableFeature cfg -> Event mkUpdateEvent ws = Event Update (featureName @cfg) (toJSON ws) diff --git a/libs/wire-api/src/Wire/API/Routes/Features.hs b/libs/wire-api/src/Wire/API/Routes/Features.hs new file mode 100644 index 00000000000..d61ab5546aa --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Features.hs @@ -0,0 +1,22 @@ +module Wire.API.Routes.Features where + +import Wire.API.Conversation.Role +import Wire.API.Error.Galley +import Wire.API.Team.Feature + +type family FeatureErrors cfg where + FeatureErrors LegalholdConfig = + '[ 'ActionDenied 'RemoveConversationMember, + 'CannotEnableLegalHoldServiceLargeTeam, + 'LegalHoldNotEnabled, + 'LegalHoldDisableUnimplemented, + 'LegalHoldServiceNotRegistered, + 'UserLegalHoldIllegalOperation, + 'LegalHoldCouldNotBlockConnections + ] + FeatureErrors _ = '[] + +type family FeatureAPIDesc cfg where + FeatureAPIDesc EnforceFileDownloadLocationConfig = + "

Custom feature: only supported on some dedicated on-prem systems.

" + FeatureAPIDesc _ = "" 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 b8f6b73b324..f05386dff80 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -26,7 +26,6 @@ import GHC.TypeLits (AppendSymbol) import Imports hiding (head) import Servant import Servant.OpenApi -import Wire.API.ApplyMods import Wire.API.Bot import Wire.API.Bot.Service import Wire.API.Conversation @@ -38,6 +37,7 @@ import Wire.API.Event.Conversation import Wire.API.FederationStatus import Wire.API.MakesFederatedCall import Wire.API.Provider.Service (ServiceRef) +import Wire.API.Routes.Features import Wire.API.Routes.Internal.Brig.EJPD import Wire.API.Routes.Internal.Galley.ConversationsIntra import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti @@ -56,128 +56,40 @@ import Wire.API.Team.Member import Wire.API.Team.SearchVisibility import Wire.API.User.Client -type LegalHoldFeatureStatusChangeErrors = - '( 'ActionDenied 'RemoveConversationMember, - '( AuthenticationError, - '( 'CannotEnableLegalHoldServiceLargeTeam, - '( 'LegalHoldNotEnabled, - '( 'LegalHoldDisableUnimplemented, - '( 'LegalHoldServiceNotRegistered, - '( 'UserLegalHoldIllegalOperation, - '( 'LegalHoldCouldNotBlockConnections, '()) - ) - ) - ) - ) - ) - ) - ) - type LegalHoldFeaturesStatusChangeFederatedCalls = '[ MakesFederatedCall 'Galley "on-conversation-updated", MakesFederatedCall 'Galley "on-mls-message-sent" ] +type family IFeatureAPI1 cfg where + -- special case for classified domains, since it cannot be set + IFeatureAPI1 ClassifiedDomainsConfig = IFeatureStatusGet ClassifiedDomainsConfig + IFeatureAPI1 cfg = IFeatureAPI1Full cfg + +type IFeatureAPI1Full cfg = + IFeatureStatusGet cfg + :<|> IFeatureStatusPut cfg + :<|> IFeatureStatusPatch cfg + +type family IAllFeaturesAPI cfgs where + IAllFeaturesAPI '[cfg] = IFeatureAPI1 cfg + IAllFeaturesAPI (cfg : cfgs) = IFeatureAPI1 cfg :<|> IAllFeaturesAPI cfgs + type IFeatureAPI = - -- SSOConfig - IFeatureStatusGet SSOConfig - :<|> IFeatureStatusPut '[] '() SSOConfig - :<|> IFeatureStatusPatch '[] '() SSOConfig - -- LegalholdConfig - :<|> IFeatureStatusGet LegalholdConfig - :<|> IFeatureStatusPut - LegalHoldFeaturesStatusChangeFederatedCalls - LegalHoldFeatureStatusChangeErrors - LegalholdConfig - :<|> IFeatureStatusPatch - LegalHoldFeaturesStatusChangeFederatedCalls - LegalHoldFeatureStatusChangeErrors - LegalholdConfig - -- SearchVisibilityAvailableConfig - :<|> IFeatureStatusGet SearchVisibilityAvailableConfig - :<|> IFeatureStatusPut '[] '() SearchVisibilityAvailableConfig - :<|> IFeatureStatusPatch '[] '() SearchVisibilityAvailableConfig - -- ValidateSAMLEmailsConfig - :<|> IFeatureStatusGet ValidateSAMLEmailsConfig - :<|> IFeatureStatusPut '[] '() ValidateSAMLEmailsConfig - :<|> IFeatureStatusPatch '[] '() ValidateSAMLEmailsConfig - -- DigitalSignaturesConfig - :<|> IFeatureStatusGet DigitalSignaturesConfig - :<|> IFeatureStatusPut '[] '() DigitalSignaturesConfig - :<|> IFeatureStatusPatch '[] '() DigitalSignaturesConfig - -- AppLockConfig - :<|> IFeatureStatusGet AppLockConfig - :<|> IFeatureStatusPut '[] '() AppLockConfig - :<|> IFeatureStatusPatch '[] '() AppLockConfig - -- FileSharingConfig - :<|> IFeatureStatusGet FileSharingConfig - :<|> IFeatureStatusPut '[] '() FileSharingConfig + IAllFeaturesAPI Features + -- legacy lock status put endpoints :<|> IFeatureStatusLockStatusPut FileSharingConfig - :<|> IFeatureStatusPatch '[] '() FileSharingConfig - -- ConferenceCallingConfig - :<|> IFeatureStatusGet ConferenceCallingConfig - :<|> IFeatureStatusPut '[] '() ConferenceCallingConfig :<|> IFeatureStatusLockStatusPut ConferenceCallingConfig - :<|> IFeatureStatusPatch '[] '() ConferenceCallingConfig - -- SelfDeletingMessagesConfig - :<|> IFeatureStatusGet SelfDeletingMessagesConfig - :<|> IFeatureStatusPut '[] '() SelfDeletingMessagesConfig :<|> IFeatureStatusLockStatusPut SelfDeletingMessagesConfig - :<|> IFeatureStatusPatch '[] '() SelfDeletingMessagesConfig - -- GuestLinksConfig - :<|> IFeatureStatusGet GuestLinksConfig - :<|> IFeatureStatusPut '[] '() GuestLinksConfig :<|> IFeatureStatusLockStatusPut GuestLinksConfig - :<|> IFeatureStatusPatch '[] '() GuestLinksConfig - -- SndFactorPasswordChallengeConfig - :<|> IFeatureStatusGet SndFactorPasswordChallengeConfig - :<|> IFeatureStatusPut '[] '() SndFactorPasswordChallengeConfig :<|> IFeatureStatusLockStatusPut SndFactorPasswordChallengeConfig - :<|> IFeatureStatusPatch '[] '() SndFactorPasswordChallengeConfig - -- SearchVisibilityInboundConfig - :<|> IFeatureStatusGet SearchVisibilityInboundConfig - :<|> IFeatureStatusPut '[] '() SearchVisibilityInboundConfig - :<|> IFeatureStatusPatch '[] '() SearchVisibilityInboundConfig - :<|> IFeatureNoConfigMultiGet SearchVisibilityInboundConfig - -- ClassifiedDomainsConfig - :<|> IFeatureStatusGet ClassifiedDomainsConfig - -- MLSConfig - :<|> IFeatureStatusGet MLSConfig - :<|> IFeatureStatusPut '[] '() MLSConfig - :<|> IFeatureStatusPatch '[] '() MLSConfig :<|> IFeatureStatusLockStatusPut MLSConfig - -- ExposeInvitationURLsToTeamAdminConfig - :<|> IFeatureStatusGet ExposeInvitationURLsToTeamAdminConfig - :<|> IFeatureStatusPut '[] '() ExposeInvitationURLsToTeamAdminConfig - :<|> IFeatureStatusPatch '[] '() ExposeInvitationURLsToTeamAdminConfig - -- SearchVisibilityInboundConfig - :<|> IFeatureStatusGet SearchVisibilityInboundConfig - :<|> IFeatureStatusPut '[] '() SearchVisibilityInboundConfig - :<|> IFeatureStatusPatch '[] '() SearchVisibilityInboundConfig - -- OutlookCalIntegrationConfig - :<|> IFeatureStatusGet OutlookCalIntegrationConfig - :<|> IFeatureStatusPut '[] '() OutlookCalIntegrationConfig - :<|> IFeatureStatusPatch '[] '() OutlookCalIntegrationConfig :<|> IFeatureStatusLockStatusPut OutlookCalIntegrationConfig - -- MlsE2EIdConfig - :<|> IFeatureStatusGet MlsE2EIdConfig - :<|> IFeatureStatusPut '[] '() MlsE2EIdConfig - :<|> IFeatureStatusPatch '[] '() MlsE2EIdConfig :<|> IFeatureStatusLockStatusPut MlsE2EIdConfig - -- MlsMigrationConfig - :<|> IFeatureStatusGet MlsMigrationConfig - :<|> IFeatureStatusPut '[] '() MlsMigrationConfig - :<|> IFeatureStatusPatch '[] '() MlsMigrationConfig :<|> IFeatureStatusLockStatusPut MlsMigrationConfig - -- EnforceFileDownloadLocationConfig - :<|> IFeatureStatusGetWithDesc EnforceFileDownloadLocationConfig "

Custom feature: only supported for some decidated on-prem systems.

" - :<|> IFeatureStatusPutWithDesc '[] '() EnforceFileDownloadLocationConfig "

Custom feature: only supported for some decidated on-prem systems.

" - :<|> IFeatureStatusPatchWithDesc '[] '() EnforceFileDownloadLocationConfig "

Custom feature: only supported for some decidated on-prem systems.

" - :<|> IFeatureStatusLockStatusPutWithDesc EnforceFileDownloadLocationConfig "

Custom feature: only supported for some decidated on-prem systems.

" - -- LimitedEventFanoutConfig - :<|> IFeatureStatusGet LimitedEventFanoutConfig - :<|> IFeatureStatusPut '[] '() LimitedEventFanoutConfig - :<|> IFeatureStatusPatch '[] '() LimitedEventFanoutConfig + :<|> IFeatureStatusLockStatusPut EnforceFileDownloadLocationConfig + -- special endpoints + :<|> IFeatureNoConfigMultiGet SearchVisibilityInboundConfig -- all feature configs :<|> Named "feature-configs-internal" @@ -393,62 +305,67 @@ type ITeamsAPIBase = ) ) -type IFeatureStatusGet f = IFeatureStatusGetWithDesc f "" - -type IFeatureStatusGetWithDesc f desc = Named '("iget", f) (Description desc :> FeatureStatusBaseGet f) - -type IFeatureStatusPut calls errs f = IFeatureStatusPutWithDesc calls errs f "" - -type IFeatureStatusPutWithDesc calls errs f desc = Named '("iput", f) (ApplyMods calls (Description desc :> FeatureStatusBasePutInternal errs f)) +type IFeatureStatusGet cfg = + Named + '("iget", cfg) + ( Description (FeatureAPIDesc cfg) + :> FeatureStatusBaseGet cfg + ) -type IFeatureStatusPatch calls errs f = IFeatureStatusPatchWithDesc calls errs f "" +type IFeatureStatusPut cfg = + Named + '("iput", cfg) + ( Description (FeatureAPIDesc cfg) + :> FeatureStatusBasePutInternal cfg + ) -type IFeatureStatusPatchWithDesc calls errs f desc = Named '("ipatch", f) (ApplyMods calls (Description desc :> FeatureStatusBasePatchInternal errs f)) +type IFeatureStatusPatch cfg = + Named + '("ipatch", cfg) + ( Description (FeatureAPIDesc cfg) + :> FeatureStatusBasePatchInternal cfg + ) -type FeatureStatusBasePutInternal errs featureConfig = +type FeatureStatusBasePutInternal cfg = FeatureStatusBaseInternal - (AppendSymbol "Put config for " (FeatureSymbol featureConfig)) - errs - featureConfig - ( ReqBody '[JSON] (Feature featureConfig) - :> Put '[JSON] (LockableFeature featureConfig) + (AppendSymbol "Put config for " (FeatureSymbol cfg)) + cfg + ( ReqBody '[JSON] (Feature cfg) + :> Put '[JSON] (LockableFeature cfg) ) -type FeatureStatusBasePatchInternal errs featureConfig = +type FeatureStatusBasePatchInternal cfg = FeatureStatusBaseInternal - (AppendSymbol "Patch config for " (FeatureSymbol featureConfig)) - errs - featureConfig - ( ReqBody '[JSON] (LockableFeaturePatch featureConfig) - :> Patch '[JSON] (LockableFeature featureConfig) + (AppendSymbol "Patch config for " (FeatureSymbol cfg)) + cfg + ( ReqBody '[JSON] (LockableFeaturePatch cfg) + :> Patch '[JSON] (LockableFeature cfg) ) -type FeatureStatusBaseInternal desc errs featureConfig a = +type FeatureStatusBaseInternal desc cfg a = Summary desc :> CanThrow OperationDenied :> CanThrow 'NotATeamMember :> CanThrow 'TeamNotFound :> CanThrow TeamFeatureError - :> CanThrowMany errs + :> CanThrowMany (FeatureErrors cfg) :> "teams" :> Capture "tid" TeamId :> "features" - :> FeatureSymbol featureConfig + :> FeatureSymbol cfg :> a -type IFeatureStatusLockStatusPut featureName = IFeatureStatusLockStatusPutWithDesc featureName "" - -type IFeatureStatusLockStatusPutWithDesc featureName desc = +type IFeatureStatusLockStatusPut cfg = Named - '("ilock", featureName) - ( Summary (AppendSymbol "(Un-)lock " (FeatureSymbol featureName)) - :> Description desc + '("ilock", cfg) + ( Summary (AppendSymbol "(Un-)lock " (FeatureSymbol cfg)) + :> Description (FeatureAPIDesc cfg) :> CanThrow 'NotATeamMember :> CanThrow 'TeamNotFound :> "teams" :> Capture "tid" TeamId :> "features" - :> FeatureSymbol featureName + :> FeatureSymbol cfg :> Capture "lockStatus" LockStatus :> Put '[JSON] LockStatusResponse ) diff --git a/libs/wire-api/src/Wire/API/Routes/Named.hs b/libs/wire-api/src/Wire/API/Routes/Named.hs index d7aad87521a..acfd4e79fae 100644 --- a/libs/wire-api/src/Wire/API/Routes/Named.hs +++ b/libs/wire-api/src/Wire/API/Routes/Named.hs @@ -137,9 +137,14 @@ namedClient :: Client m endpoint namedClient = clientIn (Proxy @endpoint) (Proxy @m) ---------------------------------------------- --- Utility to add a combinator to a Named API - +-- | Utility to push a Servant combinator inside Named APIs. +-- +-- For example: +-- @@ +-- From 'V5 ::> (Named "foo" (Get '[JSON] Foo) :<|> Named "bar" (Post '[JSON] Bar)) +-- == +-- Named "foo" (From 'V5 :> Get '[JSON] Foo) :<|> Named "bar" (From 'V5 :> Post '[JSON] Bar) +-- @@ type family x ::> api infixr 4 ::> @@ -147,3 +152,7 @@ infixr 4 ::> type instance x ::> (Named name api) = Named name (x :> api) + +type instance + x ::> (api1 :<|> api2) = + (x ::> api1) :<|> (x ::> api2) 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 5e69d130941..92b015e4062 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 @@ -21,12 +21,10 @@ import Data.Id import GHC.TypeLits import Servant import Servant.OpenApi.Internal.Orphans () -import Wire.API.ApplyMods -import Wire.API.Conversation.Role import Wire.API.Error import Wire.API.Error.Galley -import Wire.API.MakesFederatedCall import Wire.API.OAuth +import Wire.API.Routes.Features import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named import Wire.API.Routes.Public @@ -34,108 +32,84 @@ import Wire.API.Routes.Version import Wire.API.Team.Feature import Wire.API.Team.SearchVisibility (TeamSearchVisibilityView) +type FeatureAPIGetPut cfg = + FeatureAPIGet cfg :<|> FeatureAPIPut cfg + type FeatureAPI = - FeatureStatusGet SSOConfig - :<|> FeatureStatusGet LegalholdConfig - :<|> FeatureStatusPut - '[ MakesFederatedCall 'Galley "on-conversation-updated", - MakesFederatedCall 'Galley "on-mls-message-sent" - ] - '( 'ActionDenied 'RemoveConversationMember, - '( AuthenticationError, - '( 'CannotEnableLegalHoldServiceLargeTeam, - '( 'LegalHoldNotEnabled, - '( 'LegalHoldDisableUnimplemented, - '( 'LegalHoldServiceNotRegistered, - '( 'UserLegalHoldIllegalOperation, - '( 'LegalHoldCouldNotBlockConnections, '()) - ) - ) - ) - ) - ) - ) - ) - LegalholdConfig - :<|> FeatureStatusGet SearchVisibilityAvailableConfig - :<|> FeatureStatusPut '[] '() SearchVisibilityAvailableConfig - :<|> FeatureStatusDeprecatedGet "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" SearchVisibilityAvailableConfig - :<|> FeatureStatusDeprecatedPut "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" SearchVisibilityAvailableConfig + FeatureAPIGet SSOConfig + :<|> FeatureAPIGetPut LegalholdConfig + :<|> FeatureAPIGetPut SearchVisibilityAvailableConfig :<|> SearchVisibilityGet :<|> SearchVisibilitySet - :<|> FeatureStatusGet ValidateSAMLEmailsConfig - :<|> FeatureStatusDeprecatedGet "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" ValidateSAMLEmailsConfig - :<|> FeatureStatusGet DigitalSignaturesConfig - :<|> FeatureStatusDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is potentially used by the old Android client. It is not used by team management, or webapp as of June 2022" DigitalSignaturesConfig - :<|> FeatureStatusGet AppLockConfig - :<|> FeatureStatusPut '[] '() AppLockConfig - :<|> FeatureStatusGet FileSharingConfig - :<|> FeatureStatusPut '[] '() FileSharingConfig - :<|> FeatureStatusGet ClassifiedDomainsConfig - :<|> FeatureStatusGet ConferenceCallingConfig - :<|> FeatureStatusPut '[] '() ConferenceCallingConfig - :<|> FeatureStatusGet SelfDeletingMessagesConfig - :<|> FeatureStatusPut '[] '() SelfDeletingMessagesConfig - :<|> FeatureStatusGet GuestLinksConfig - :<|> FeatureStatusPut '[] '() GuestLinksConfig - :<|> FeatureStatusGet SndFactorPasswordChallengeConfig - :<|> FeatureStatusPut '[] '() SndFactorPasswordChallengeConfig - :<|> From 'V5 ::> FeatureStatusGet MLSConfig - :<|> From 'V5 ::> FeatureStatusPut '[] '() MLSConfig - :<|> FeatureStatusGet ExposeInvitationURLsToTeamAdminConfig - :<|> FeatureStatusPut '[] '() ExposeInvitationURLsToTeamAdminConfig - :<|> FeatureStatusGet SearchVisibilityInboundConfig - :<|> FeatureStatusPut '[] '() SearchVisibilityInboundConfig - :<|> FeatureStatusGet OutlookCalIntegrationConfig - :<|> FeatureStatusPut '[] '() OutlookCalIntegrationConfig - :<|> From 'V5 ::> FeatureStatusGet MlsE2EIdConfig - :<|> From 'V5 ::> Until 'V6 ::> Named "put-MlsE2EIdConfig@v5" (ZUser :> FeatureStatusBasePutPublic '() MlsE2EIdConfig) - :<|> From 'V6 ::> FeatureStatusPut '[] '() MlsE2EIdConfig - :<|> From 'V5 ::> FeatureStatusGet MlsMigrationConfig - :<|> From 'V5 ::> FeatureStatusPut '[] '() MlsMigrationConfig - :<|> From 'V5 - ::> FeatureStatusGetWithDesc - EnforceFileDownloadLocationConfig - "

Custom feature: only supported for some decidated on-prem systems.

" - :<|> From 'V5 - ::> FeatureStatusPutWithDesc - '[] - '() - EnforceFileDownloadLocationConfig - "

Custom feature: only supported for some decidated on-prem systems.

" - :<|> From 'V5 ::> FeatureStatusGet LimitedEventFanoutConfig + :<|> FeatureAPIGet ValidateSAMLEmailsConfig + :<|> FeatureAPIGet DigitalSignaturesConfig + :<|> FeatureAPIGetPut AppLockConfig + :<|> FeatureAPIGetPut FileSharingConfig + :<|> FeatureAPIGet ClassifiedDomainsConfig + :<|> FeatureAPIGetPut ConferenceCallingConfig + :<|> FeatureAPIGetPut SelfDeletingMessagesConfig + :<|> FeatureAPIGetPut GuestLinksConfig + :<|> FeatureAPIGetPut SndFactorPasswordChallengeConfig + :<|> From 'V5 ::> FeatureAPIGetPut MLSConfig + :<|> FeatureAPIGetPut ExposeInvitationURLsToTeamAdminConfig + :<|> FeatureAPIGetPut SearchVisibilityInboundConfig + :<|> FeatureAPIGetPut OutlookCalIntegrationConfig + :<|> From 'V5 ::> FeatureAPIGet MlsE2EIdConfig + :<|> From 'V5 ::> Until 'V6 ::> Named "put-MlsE2EIdConfig@v5" (ZUser :> FeatureStatusBasePutPublic MlsE2EIdConfig) + :<|> From 'V6 ::> FeatureAPIPut MlsE2EIdConfig + :<|> From 'V5 ::> FeatureAPIGetPut MlsMigrationConfig + :<|> From 'V5 ::> FeatureAPIGetPut EnforceFileDownloadLocationConfig + :<|> From 'V5 ::> FeatureAPIGet LimitedEventFanoutConfig :<|> AllFeatureConfigsUserGet :<|> AllFeatureConfigsTeamGet - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" LegalholdConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" SSOConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" SearchVisibilityAvailableConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ValidateSAMLEmailsConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" DigitalSignaturesConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" AppLockConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" FileSharingConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ClassifiedDomainsConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ConferenceCallingConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" SelfDeletingMessagesConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" GuestLinksConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" SndFactorPasswordChallengeConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" MLSConfig + :<|> DeprecatedFeatureAPI + :<|> AllDeprecatedFeatureConfigAPI DeprecatedFeatureConfigs + +type DeprecationNotice1 = "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" + +type DeprecationNotice2 = "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" + +type DeprecatedFeatureConfigs = + [ LegalholdConfig, + SSOConfig, + SearchVisibilityAvailableConfig, + ValidateSAMLEmailsConfig, + DigitalSignaturesConfig, + AppLockConfig, + FileSharingConfig, + ClassifiedDomainsConfig, + ConferenceCallingConfig, + SelfDeletingMessagesConfig, + GuestLinksConfig, + SndFactorPasswordChallengeConfig, + MLSConfig + ] -type FeatureStatusGet f = FeatureStatusGetWithDesc f "" +type family AllDeprecatedFeatureConfigAPI cfgs where + AllDeprecatedFeatureConfigAPI '[cfg] = FeatureConfigDeprecatedGet DeprecationNotice2 cfg + AllDeprecatedFeatureConfigAPI (cfg : cfgs) = + FeatureConfigDeprecatedGet DeprecationNotice2 cfg + :<|> AllDeprecatedFeatureConfigAPI cfgs -type FeatureStatusGetWithDesc f desc = +type DeprecatedFeatureAPI = + FeatureStatusDeprecatedGet DeprecationNotice1 SearchVisibilityAvailableConfig + :<|> FeatureStatusDeprecatedPut DeprecationNotice1 SearchVisibilityAvailableConfig + :<|> FeatureStatusDeprecatedGet DeprecationNotice1 ValidateSAMLEmailsConfig + :<|> FeatureStatusDeprecatedGet DeprecationNotice2 DigitalSignaturesConfig + +type FeatureAPIGet cfg = Named - '("get", f) - ( Description desc - :> (ZUser :> FeatureStatusBaseGet f) + '("get", cfg) + ( Description (FeatureAPIDesc cfg) + :> (ZUser :> FeatureStatusBaseGet cfg) ) -type FeatureStatusPut segs errs f = FeatureStatusPutWithDesc segs errs f "" - -type FeatureStatusPutWithDesc segs errs f desc = +type FeatureAPIPut cfg = Named - '("put", f) - ( Description desc - :> (ApplyMods segs (ZUser :> FeatureStatusBasePutPublic errs f)) + '("put", cfg) + ( Description (FeatureAPIDesc cfg) + :> ZUser + :> FeatureStatusBasePutPublic cfg ) type FeatureStatusDeprecatedGet d f = @@ -159,13 +133,13 @@ type FeatureStatusBaseGet featureConfig = :> FeatureSymbol featureConfig :> Get '[Servant.JSON] (LockableFeature featureConfig) -type FeatureStatusBasePutPublic errs featureConfig = +type FeatureStatusBasePutPublic featureConfig = Summary (AppendSymbol "Put config for " (FeatureSymbol featureConfig)) :> CanThrow OperationDenied :> CanThrow 'NotATeamMember :> CanThrow 'TeamNotFound :> CanThrow TeamFeatureError - :> CanThrowMany errs + :> CanThrowMany (FeatureErrors featureConfig) :> "teams" :> Capture "tid" TeamId :> "features" diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 095c2fe5f9b..525a8be49dc 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -49,7 +49,7 @@ module Wire.API.Team.Feature genericComputeFeature, IsFeatureConfig (..), FeatureSingleton (..), - HasDeprecatedFeatureName (..), + DeprecatedFeatureName, LockStatusResponse (..), One2OneCalls (..), -- Features @@ -178,7 +178,14 @@ 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 (Default cfg, Default (LockableFeature cfg)) => IsFeatureConfig cfg where +class + ( Default cfg, + ToSchema cfg, + Default (LockableFeature cfg), + KnownSymbol (FeatureSymbol cfg) + ) => + IsFeatureConfig cfg + where type FeatureSymbol cfg :: Symbol featureSingleton :: FeatureSingleton cfg @@ -210,13 +217,12 @@ data FeatureSingleton cfg where FeatureSingletonEnforceFileDownloadLocationConfig :: FeatureSingleton EnforceFileDownloadLocationConfig FeatureSingletonLimitedEventFanoutConfig :: FeatureSingleton LimitedEventFanoutConfig -class HasDeprecatedFeatureName cfg where - type DeprecatedFeatureName cfg :: Symbol +type family DeprecatedFeatureName cfg :: Symbol -featureName :: forall cfg. (KnownSymbol (FeatureSymbol cfg)) => Text +featureName :: forall cfg. (IsFeatureConfig cfg) => Text featureName = T.pack $ symbolVal (Proxy @(FeatureSymbol cfg)) -featureNameBS :: forall cfg. (KnownSymbol (FeatureSymbol cfg)) => ByteString +featureNameBS :: forall cfg. (IsFeatureConfig cfg) => ByteString featureNameBS = UTF8.fromString $ symbolVal (Proxy @(FeatureSymbol cfg)) -------------------------------------------------------------------------------- @@ -289,7 +295,7 @@ defUnlockedFeature = config = def } -instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where +instance (IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where schema = object name $ LockableFeature @@ -651,8 +657,7 @@ instance IsFeatureConfig SearchVisibilityAvailableConfig where instance ToSchema SearchVisibilityAvailableConfig where schema = object "SearchVisibilityAvailableConfig" objectSchema -instance HasDeprecatedFeatureName SearchVisibilityAvailableConfig where - type DeprecatedFeatureName SearchVisibilityAvailableConfig = "search-visibility" +type instance DeprecatedFeatureName SearchVisibilityAvailableConfig = "search-visibility" -------------------------------------------------------------------------------- -- ValidateSAMLEmails feature @@ -679,8 +684,7 @@ instance IsFeatureConfig ValidateSAMLEmailsConfig where featureSingleton = FeatureSingletonValidateSAMLEmailsConfig objectSchema = pure ValidateSAMLEmailsConfig -instance HasDeprecatedFeatureName ValidateSAMLEmailsConfig where - type DeprecatedFeatureName ValidateSAMLEmailsConfig = "validate-saml-emails" +type instance DeprecatedFeatureName ValidateSAMLEmailsConfig = "validate-saml-emails" -------------------------------------------------------------------------------- -- DigitalSignatures feature @@ -704,8 +708,7 @@ instance IsFeatureConfig DigitalSignaturesConfig where featureSingleton = FeatureSingletonDigitalSignaturesConfig objectSchema = pure DigitalSignaturesConfig -instance HasDeprecatedFeatureName DigitalSignaturesConfig where - type DeprecatedFeatureName DigitalSignaturesConfig = "digital-signatures" +type instance DeprecatedFeatureName DigitalSignaturesConfig = "digital-signatures" instance ToSchema DigitalSignaturesConfig where schema = object "DigitalSignaturesConfig" objectSchema @@ -1310,9 +1313,9 @@ 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 +class (IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstraints cfg -instance (IsFeatureConfig cfg, ToSchema cfg, KnownSymbol (FeatureSymbol cfg)) => FeatureFieldConstraints cfg +instance (IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstraints cfg instance ToSchema AllFeatureConfigs where schema = diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index e875f415f6c..3d84b9414dc 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -151,6 +151,7 @@ library Wire.API.Routes.ClientAlgebra Wire.API.Routes.Cookies Wire.API.Routes.CSV + Wire.API.Routes.Features Wire.API.Routes.FederationDomainConfig Wire.API.Routes.Internal.Brig Wire.API.Routes.Internal.Brig.Connection diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 8a1c1004ad9..c5a77e3de7b 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -47,7 +47,6 @@ import Data.String.Conversions import Data.Text.Ascii qualified as Ascii import Data.Vector qualified as Vec import Data.ZAuth.Token qualified as ZAuth -import GHC.TypeLits (KnownSymbol) import Imports import Test.Tasty.Cannon qualified as WS import Test.Tasty.HUnit @@ -61,7 +60,7 @@ import Wire.API.Federation.Component import Wire.API.Internal.Notification (Notification (..)) import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.MultiTablePaging (LocalOrRemoteTable, MultiTablePagingState) -import Wire.API.Team.Feature (featureNameBS) +import Wire.API.Team.Feature (IsFeatureConfig, featureNameBS) import Wire.API.Team.Feature qualified as Public import Wire.API.User import Wire.API.User qualified as Public @@ -450,7 +449,7 @@ setTeamFeatureLockStatus :: MonadIO m, MonadHttp m, HasCallStack, - KnownSymbol (Public.FeatureSymbol cfg) + IsFeatureConfig cfg ) => Galley -> TeamId -> diff --git a/services/galley/default.nix b/services/galley/default.nix index c3ef5ddd9e3..6e1d3c62f7a 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -80,7 +80,6 @@ , retry , safe-exceptions , saml2-web-sso -, schema-profunctor , servant , servant-client , servant-client-core @@ -191,7 +190,6 @@ mkDerivation { retry safe-exceptions saml2-web-sso - schema-profunctor servant servant-client servant-server diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 3437caf3795..5bd145d2eb3 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -340,7 +340,6 @@ library , retry >=0.5 , safe-exceptions >=0.1 , saml2-web-sso >=0.20 - , schema-profunctor , servant , servant-client , servant-server diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 7dc40d9c289..ebb62143d63 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -42,13 +45,13 @@ import Galley.API.MLS.Removal import Galley.API.One2One import Galley.API.Public.Servant import Galley.API.Query qualified as Query -import Galley.API.Teams (uncheckedDeleteTeamMember) +import Galley.API.Teams import Galley.API.Teams qualified as Teams import Galley.API.Teams.Features +import Galley.API.Teams.Features.Get import Galley.API.Update qualified as Update import Galley.API.Util import Galley.App -import Galley.Cassandra.TeamFeatures (getAllFeatureConfigsForServer) import Galley.Data.Conversation qualified as Data import Galley.Effects import Galley.Effects.BackendNotificationQueueAccess @@ -231,80 +234,55 @@ miscAPI = <@> mkNamedAPI @"put-custom-backend" setCustomBackend <@> mkNamedAPI @"delete-custom-backend" deleteCustomBackend +featureAPI1Full :: + forall cfg r. + (_) => + API (IFeatureAPI1Full cfg) r +featureAPI1Full = + mkNamedAPI @'("iget", cfg) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", cfg) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", cfg) patchFeatureStatusInternal + +allFeaturesAPI :: API (IAllFeaturesAPI Features) GalleyEffects +allFeaturesAPI = + featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> mkNamedAPI @'("iget", ClassifiedDomainsConfig) (getFeatureStatus DontDoAuth) + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + <@> featureAPI1Full + featureAPI :: API IFeatureAPI GalleyEffects featureAPI = - mkNamedAPI @'("iget", SSOConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", SSOConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", SSOConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", LegalholdConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", LegalholdConfig) (callsFed (exposeAnnotations setFeatureStatusInternal)) - <@> mkNamedAPI @'("ipatch", LegalholdConfig) (callsFed (exposeAnnotations patchFeatureStatusInternal)) - <@> mkNamedAPI @'("iget", SearchVisibilityAvailableConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", SearchVisibilityAvailableConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", SearchVisibilityAvailableConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", ValidateSAMLEmailsConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", ValidateSAMLEmailsConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", ValidateSAMLEmailsConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", DigitalSignaturesConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", DigitalSignaturesConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", DigitalSignaturesConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", AppLockConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", AppLockConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", AppLockConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", FileSharingConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", FileSharingConfig) setFeatureStatusInternal + allFeaturesAPI + -- legacy endpoints <@> mkNamedAPI @'("ilock", FileSharingConfig) (updateLockStatus @FileSharingConfig) - <@> mkNamedAPI @'("ipatch", FileSharingConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", ConferenceCallingConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", ConferenceCallingConfig) setFeatureStatusInternal <@> mkNamedAPI @'("ilock", ConferenceCallingConfig) (updateLockStatus @ConferenceCallingConfig) - <@> mkNamedAPI @'("ipatch", ConferenceCallingConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", SelfDeletingMessagesConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", SelfDeletingMessagesConfig) setFeatureStatusInternal <@> mkNamedAPI @'("ilock", SelfDeletingMessagesConfig) (updateLockStatus @SelfDeletingMessagesConfig) - <@> mkNamedAPI @'("ipatch", SelfDeletingMessagesConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", GuestLinksConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", GuestLinksConfig) setFeatureStatusInternal <@> mkNamedAPI @'("ilock", GuestLinksConfig) (updateLockStatus @GuestLinksConfig) - <@> mkNamedAPI @'("ipatch", GuestLinksConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", SndFactorPasswordChallengeConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", SndFactorPasswordChallengeConfig) setFeatureStatusInternal <@> mkNamedAPI @'("ilock", SndFactorPasswordChallengeConfig) (updateLockStatus @SndFactorPasswordChallengeConfig) - <@> mkNamedAPI @'("ipatch", SndFactorPasswordChallengeConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", SearchVisibilityInboundConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", SearchVisibilityInboundConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", SearchVisibilityInboundConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("igetmulti", SearchVisibilityInboundConfig) getFeatureStatusMulti - <@> mkNamedAPI @'("iget", ClassifiedDomainsConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iget", MLSConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", MLSConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", MLSConfig) patchFeatureStatusInternal <@> mkNamedAPI @'("ilock", MLSConfig) (updateLockStatus @MLSConfig) - <@> mkNamedAPI @'("iget", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", ExposeInvitationURLsToTeamAdminConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", ExposeInvitationURLsToTeamAdminConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", SearchVisibilityInboundConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", SearchVisibilityInboundConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", SearchVisibilityInboundConfig) patchFeatureStatusInternal - <@> mkNamedAPI @'("iget", OutlookCalIntegrationConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", OutlookCalIntegrationConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", OutlookCalIntegrationConfig) patchFeatureStatusInternal <@> mkNamedAPI @'("ilock", OutlookCalIntegrationConfig) (updateLockStatus @OutlookCalIntegrationConfig) - <@> mkNamedAPI @'("iget", MlsE2EIdConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", MlsE2EIdConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", MlsE2EIdConfig) patchFeatureStatusInternal <@> mkNamedAPI @'("ilock", MlsE2EIdConfig) (updateLockStatus @MlsE2EIdConfig) - <@> mkNamedAPI @'("iget", MlsMigrationConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", MlsMigrationConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", MlsMigrationConfig) patchFeatureStatusInternal <@> mkNamedAPI @'("ilock", MlsMigrationConfig) (updateLockStatus @MlsMigrationConfig) - <@> mkNamedAPI @'("iget", EnforceFileDownloadLocationConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", EnforceFileDownloadLocationConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", EnforceFileDownloadLocationConfig) patchFeatureStatusInternal <@> mkNamedAPI @'("ilock", EnforceFileDownloadLocationConfig) (updateLockStatus @EnforceFileDownloadLocationConfig) - <@> mkNamedAPI @'("iget", LimitedEventFanoutConfig) (getFeatureStatus DontDoAuth) - <@> mkNamedAPI @'("iput", LimitedEventFanoutConfig) setFeatureStatusInternal - <@> mkNamedAPI @'("ipatch", LimitedEventFanoutConfig) patchFeatureStatusInternal + -- special endpoints + <@> mkNamedAPI @'("igetmulti", SearchVisibilityInboundConfig) getFeatureStatusMulti + -- all features <@> mkNamedAPI @"feature-configs-internal" (maybe getAllFeatureConfigsForServer getAllFeatureConfigsForUser) rmUser :: diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs index d19ddefe523..45703385cc4 100644 --- a/services/galley/src/Galley/API/Public/Feature.hs +++ b/services/galley/src/Galley/API/Public/Feature.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -22,58 +25,56 @@ import Galley.API.Teams.Features import Galley.API.Teams.Features.Get import Galley.App import Imports -import Wire.API.Federation.API import Wire.API.Routes.API import Wire.API.Routes.Public.Galley.Feature import Wire.API.Team.Feature +featureAPIGetPut :: forall cfg r. (_) => API (FeatureAPIGetPut cfg) r +featureAPIGetPut = + mkNamedAPI @'("get", cfg) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", cfg) (setFeatureStatus . DoAuth) + featureAPI :: API FeatureAPI GalleyEffects featureAPI = mkNamedAPI @'("get", SSOConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", LegalholdConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", LegalholdConfig) (callsFed (exposeAnnotations (setFeatureStatus . DoAuth))) - <@> mkNamedAPI @'("get", SearchVisibilityAvailableConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", SearchVisibilityAvailableConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get-deprecated", SearchVisibilityAvailableConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put-deprecated", SearchVisibilityAvailableConfig) (setFeatureStatus . DoAuth) + <@> featureAPIGetPut + <@> featureAPIGetPut <@> mkNamedAPI @"get-search-visibility" getSearchVisibility <@> mkNamedAPI @"set-search-visibility" (setSearchVisibility (featureEnabledForTeam @SearchVisibilityAvailableConfig)) <@> mkNamedAPI @'("get", ValidateSAMLEmailsConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get-deprecated", ValidateSAMLEmailsConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", DigitalSignaturesConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get-deprecated", DigitalSignaturesConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", AppLockConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", AppLockConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", FileSharingConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", FileSharingConfig) (setFeatureStatus . DoAuth) + <@> featureAPIGetPut + <@> featureAPIGetPut <@> mkNamedAPI @'("get", ClassifiedDomainsConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", ConferenceCallingConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", ConferenceCallingConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", SelfDeletingMessagesConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", SelfDeletingMessagesConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", GuestLinksConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", GuestLinksConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", SndFactorPasswordChallengeConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", SndFactorPasswordChallengeConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", MLSConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", MLSConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", SearchVisibilityInboundConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", SearchVisibilityInboundConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", OutlookCalIntegrationConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", OutlookCalIntegrationConfig) (setFeatureStatus . DoAuth) + <@> featureAPIGetPut + <@> featureAPIGetPut + <@> featureAPIGetPut + <@> featureAPIGetPut + <@> hoistAPI id featureAPIGetPut + <@> featureAPIGetPut + <@> featureAPIGetPut + <@> featureAPIGetPut <@> mkNamedAPI @'("get", MlsE2EIdConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @"put-MlsE2EIdConfig@v5" (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("put", MlsE2EIdConfig) (guardMlsE2EIdConfig (setFeatureStatus . DoAuth)) - <@> mkNamedAPI @'("get", MlsMigrationConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", MlsMigrationConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", EnforceFileDownloadLocationConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", EnforceFileDownloadLocationConfig) (setFeatureStatus . DoAuth) + <@> hoistAPI id featureAPIGetPut + <@> hoistAPI id featureAPIGetPut <@> mkNamedAPI @'("get", LimitedEventFanoutConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @"get-all-feature-configs-for-user" getAllFeatureConfigsForUser <@> mkNamedAPI @"get-all-feature-configs-for-team" getAllFeatureConfigsForTeam - <@> mkNamedAPI @'("get-config", LegalholdConfig) getSingleFeatureConfigForUser + <@> deprecatedFeatureConfigAPI + <@> deprecatedFeatureAPI + +deprecatedFeatureConfigAPI :: API DeprecatedFeatureAPI GalleyEffects +deprecatedFeatureConfigAPI = + mkNamedAPI @'("get-deprecated", SearchVisibilityAvailableConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put-deprecated", SearchVisibilityAvailableConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get-deprecated", ValidateSAMLEmailsConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get-deprecated", DigitalSignaturesConfig) (getFeatureStatus . DoAuth) + +deprecatedFeatureAPI :: API (AllDeprecatedFeatureConfigAPI DeprecatedFeatureConfigs) GalleyEffects +deprecatedFeatureAPI = + mkNamedAPI @'("get-config", LegalholdConfig) getSingleFeatureConfigForUser <@> mkNamedAPI @'("get-config", SSOConfig) getSingleFeatureConfigForUser <@> mkNamedAPI @'("get-config", SearchVisibilityAvailableConfig) getSingleFeatureConfigForUser <@> mkNamedAPI @'("get-config", ValidateSAMLEmailsConfig) getSingleFeatureConfigForUser diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 38d16da2f45..5f31df7e247 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -26,10 +26,8 @@ module Galley.API.Teams.Features getAllFeatureConfigsForTeam, getAllFeatureConfigsForUser, updateLockStatus, - -- Don't export methods of this typeclass - GetFeatureConfig, - -- Don't export methods of this typeclass - SetFeatureConfig, + GetFeatureConfig (..), + SetFeatureConfig (..), guardSecondFactorDisabled, DoAuth (..), featureEnabledForTeam, @@ -44,9 +42,7 @@ import Data.Id import Data.Json.Util import Data.Kind import Data.Qualified (Local) -import Data.Schema import Data.Time (UTCTime) -import GHC.TypeLits (KnownSymbol) import Galley.API.Error (InternalError) import Galley.API.LegalHold qualified as LegalHold import Galley.API.Teams (ensureNotTooLargeToActivateLegalHold) @@ -176,9 +172,7 @@ updateLockStatus tid lockStatus = do persistAndPushEvent :: forall cfg r. - ( KnownSymbol (FeatureSymbol cfg), - ToSchema cfg, - GetFeatureConfig cfg, + ( GetFeatureConfig cfg, ComputeFeatureConstraints cfg r, Member (Input Opts) r, Member TeamFeatureStore r, @@ -252,8 +246,6 @@ class (GetFeatureConfig cfg) => SetFeatureConfig cfg where Sem r (LockableFeature cfg) default setConfigForTeam :: ( ComputeFeatureConstraints cfg r, - KnownSymbol (FeatureSymbol cfg), - ToSchema cfg, Member (Input Opts) r, Member TeamFeatureStore r, Member (P.Logger (Log.Msg -> Log.Msg)) r, @@ -304,7 +296,6 @@ instance SetFeatureConfig LegalholdConfig where Member BrigAccess r, Member CodeStore r, Member ConversationStore r, - Member (Error AuthenticationError) r, Member (Error FederationError) r, Member (Error InternalError) r, Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r, diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 72bd68fa8e5..b318c0358bc 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -57,7 +57,6 @@ import Data.UUID qualified as UUID import Data.UUID.Util qualified as UUID import Data.UUID.V1 qualified as UUID import Data.Vector qualified as V -import GHC.TypeLits (KnownSymbol) import Galley.Env qualified as Galley import Galley.Options (featureFlags, maxConvSize, maxFanoutSize, settings) import Galley.Types.Conversations.Roles @@ -84,7 +83,7 @@ import Wire.API.Routes.Internal.Galley.TeamsIntra as TeamsIntra import Wire.API.Routes.Version import Wire.API.Team import Wire.API.Team.Export (TeamExportUser (..)) -import Wire.API.Team.Feature qualified as Public +import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member qualified as Member import Wire.API.Team.Member qualified as TM @@ -396,9 +395,9 @@ testEnableSSOPerTeam = do owner <- Util.randomUser tid <- Util.createBindingTeamInternal "foo" owner assertTeamActivate "create team" tid - let check :: (HasCallStack) => String -> Public.FeatureStatus -> TestM () + let check :: (HasCallStack) => String -> FeatureStatus -> TestM () check msg enabledness = do - feat :: Public.Feature Public.SSOConfig <- responseJsonUnsafe <$> (getSSOEnabledInternal tid (getSSOEnabledInternal tid TestM () putSSOEnabledInternalCheckNotImplemented = do @@ -408,25 +407,25 @@ testEnableSSOPerTeam = do <$> put ( g . paths ["i", "teams", toByteString' tid, "features", "sso"] - . json (Public.Feature Public.FeatureStatusDisabled Public.SSOConfig) + . json (Feature FeatureStatusDisabled SSOConfig) ) liftIO $ do assertEqual "bad status" status403 (Wai.code waierr) assertEqual "bad label" "not-implemented" (Wai.label waierr) featureSSO <- view (tsGConf . settings . featureFlags . flagSSO) case featureSSO of - FeatureSSOEnabledByDefault -> check "Teams should start with SSO enabled" Public.FeatureStatusEnabled - FeatureSSODisabledByDefault -> check "Teams should start with SSO disabled" Public.FeatureStatusDisabled - putSSOEnabledInternal tid Public.FeatureStatusEnabled - check "Calling 'putEnabled True' should enable SSO" Public.FeatureStatusEnabled + FeatureSSOEnabledByDefault -> check "Teams should start with SSO enabled" FeatureStatusEnabled + FeatureSSODisabledByDefault -> check "Teams should start with SSO disabled" FeatureStatusDisabled + putSSOEnabledInternal tid FeatureStatusEnabled + check "Calling 'putEnabled True' should enable SSO" FeatureStatusEnabled putSSOEnabledInternalCheckNotImplemented testEnableTeamSearchVisibilityPerTeam :: TestM () testEnableTeamSearchVisibilityPerTeam = do (tid, owner, member : _) <- Util.createBindingTeamWithMembers 2 - let check :: String -> Public.FeatureStatus -> TestM () + let check :: String -> FeatureStatus -> TestM () check msg enabledness = do - feat :: Public.Feature Public.SearchVisibilityAvailableConfig <- responseJsonUnsafe <$> (Util.getTeamFeatureInternal @Public.SearchVisibilityAvailableConfig tid (Util.getTeamFeatureInternal @SearchVisibilityAvailableConfig tid TeamId -> Public.LockStatus -> TestM () +setFeatureLockStatus :: forall cfg. (IsFeatureConfig cfg) => TeamId -> LockStatus -> TestM () setFeatureLockStatus tid status = do g <- viewGalley - put (g . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg, toByteString' status]) !!! const 200 === statusCode + put (g . paths ["i", "teams", toByteString' tid, "features", featureNameBS @cfg, toByteString' status]) !!! const 200 === statusCode generateVerificationCode :: Public.SendVerificationCode -> TestM () generateVerificationCode req = do @@ -1129,11 +1128,11 @@ generateVerificationCode req = do let js = RequestBodyLBS $ encode req post (brig . paths ["verification-code", "send"] . contentJson . body js) !!! const 200 === statusCode -setTeamSndFactorPasswordChallenge :: TeamId -> Public.FeatureStatus -> TestM () +setTeamSndFactorPasswordChallenge :: TeamId -> FeatureStatus -> TestM () setTeamSndFactorPasswordChallenge tid status = do g <- viewGalley - 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 + let js = RequestBodyLBS $ encode $ Feature status SndFactorPasswordChallengeConfig + put (g . paths ["i", "teams", toByteString' tid, "features", featureNameBS @SndFactorPasswordChallengeConfig] . contentJson . body js) !!! const 200 === statusCode getVerificationCode :: UserId -> Public.VerificationAction -> TestM Code.Value getVerificationCode uid action = do @@ -1739,11 +1738,11 @@ newTeamMember' perms uid = Member.mkTeamMember uid perms Nothing LH.defUserLegal -- and with different kinds of internal checks, it's quite tedious to do so. getSSOEnabledInternal :: (HasCallStack) => TeamId -> TestM ResponseLBS -getSSOEnabledInternal = Util.getTeamFeatureInternal @Public.SSOConfig +getSSOEnabledInternal = Util.getTeamFeatureInternal @SSOConfig -putSSOEnabledInternal :: (HasCallStack) => TeamId -> Public.FeatureStatus -> TestM () +putSSOEnabledInternal :: (HasCallStack) => TeamId -> FeatureStatus -> TestM () putSSOEnabledInternal tid statusValue = - void $ Util.putTeamFeatureInternal @Public.SSOConfig expect2xx tid (Public.Feature statusValue Public.SSOConfig) + void $ Util.putTeamFeatureInternal @SSOConfig expect2xx tid (Feature statusValue SSOConfig) getSearchVisibility :: (HasCallStack) => (Request -> Request) -> UserId -> TeamId -> (MonadHttp m) => m ResponseLBS getSearchVisibility g uid tid = do diff --git a/services/galley/test/integration/API/Util/TeamFeature.hs b/services/galley/test/integration/API/Util/TeamFeature.hs index 873eb4e51ea..6d60c2bdb7a 100644 --- a/services/galley/test/integration/API/Util/TeamFeature.hs +++ b/services/galley/test/integration/API/Util/TeamFeature.hs @@ -25,15 +25,13 @@ import API.Util (HasGalley (viewGalley), zUser) import API.Util qualified as Util import Bilge import Control.Lens ((.~)) -import Data.Aeson (ToJSON) import Data.ByteString.Conversion (toByteString') import Data.Id (ConvId, TeamId, UserId) -import GHC.TypeLits (KnownSymbol) import Galley.Options (featureFlags, settings) import Galley.Types.Teams import Imports import TestSetup -import Wire.API.Team.Feature qualified as Public +import Wire.API.Team.Feature withCustomSearchFeature :: FeatureTeamSearchVisibilityAvailability -> TestM () -> TestM () withCustomSearchFeature flag action = do @@ -42,15 +40,15 @@ withCustomSearchFeature flag action = do putTeamSearchVisibilityAvailableInternal :: (HasCallStack) => TeamId -> - Public.FeatureStatus -> + FeatureStatus -> (MonadIO m, MonadHttp m, HasGalley m) => m () putTeamSearchVisibilityAvailableInternal tid statusValue = void $ putTeamFeatureInternal - @Public.SearchVisibilityAvailableConfig + @SearchVisibilityAvailableConfig expect2xx tid - (Public.Feature statusValue Public.SearchVisibilityAvailableConfig) + (Feature statusValue SearchVisibilityAvailableConfig) putTeamFeatureInternal :: forall cfg m. @@ -58,36 +56,32 @@ putTeamFeatureInternal :: HasGalley m, MonadHttp m, HasCallStack, - KnownSymbol (Public.FeatureSymbol cfg), - ToJSON (Public.Feature cfg) + IsFeatureConfig cfg ) => (Request -> Request) -> TeamId -> - Public.Feature cfg -> + Feature cfg -> m ResponseLBS putTeamFeatureInternal reqmod tid status = do galley <- viewGalley put $ galley - . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] + . paths ["i", "teams", toByteString' tid, "features", featureNameBS @cfg] . json status . reqmod putTeamFeature :: forall cfg. - ( HasCallStack, - KnownSymbol (Public.FeatureSymbol cfg), - ToJSON (Public.Feature cfg) - ) => + (HasCallStack, IsFeatureConfig cfg) => UserId -> TeamId -> - Public.Feature cfg -> + Feature cfg -> TestM ResponseLBS putTeamFeature uid tid status = do galley <- viewGalley put $ galley - . paths ["teams", toByteString' tid, "features", Public.featureNameBS @cfg] + . paths ["teams", toByteString' tid, "features", featureNameBS @cfg] . json status . zUser uid @@ -100,23 +94,23 @@ getGuestLinkStatus :: getGuestLinkStatus galley u cid = get $ galley - . paths ["conversations", toByteString' cid, "features", Public.featureNameBS @Public.GuestLinksConfig] + . paths ["conversations", toByteString' cid, "features", featureNameBS @GuestLinksConfig] . zUser u getTeamFeatureInternal :: forall cfg m. - (HasGalley m, MonadIO m, MonadHttp m, KnownSymbol (Public.FeatureSymbol cfg)) => + (HasGalley m, MonadIO m, MonadHttp m, IsFeatureConfig cfg) => TeamId -> m ResponseLBS getTeamFeatureInternal tid = do g <- viewGalley get $ g - . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] + . paths ["i", "teams", toByteString' tid, "features", featureNameBS @cfg] getTeamFeature :: forall cfg m. - (HasGalley m, MonadIO m, MonadHttp m, HasCallStack, KnownSymbol (Public.FeatureSymbol cfg)) => + (HasGalley m, MonadIO m, MonadHttp m, HasCallStack, IsFeatureConfig cfg) => UserId -> TeamId -> m ResponseLBS @@ -124,5 +118,5 @@ getTeamFeature uid tid = do galley <- viewGalley get $ galley - . paths ["teams", toByteString' tid, "features", Public.featureNameBS @cfg] + . paths ["teams", toByteString' tid, "features", featureNameBS @cfg] . zUser uid diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 611b366ca08..5011becb775 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -308,20 +308,14 @@ getTeamAdminInfo = fmap toAdminInfo . Intra.getTeamInfo mkFeatureGetRoute :: forall cfg. - ( IsFeatureConfig cfg, - ToSchema cfg, - KnownSymbol (FeatureSymbol cfg), - Typeable cfg - ) => + (IsFeatureConfig cfg, Typeable cfg) => TeamId -> Handler (LockableFeature cfg) mkFeatureGetRoute = Intra.getTeamFeatureFlag @cfg mkFeaturePutRoute :: forall cfg. - ( KnownSymbol (FeatureSymbol cfg), - ToJSON (Feature cfg) - ) => + (IsFeatureConfig cfg) => TeamId -> Feature cfg -> Handler NoContent diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 14e2c62e1fc..8051169cfc3 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -86,14 +86,12 @@ import Data.Id import Data.Int import Data.List.Split (chunksOf) import Data.Map qualified as Map -import Data.Proxy (Proxy (Proxy)) import Data.Qualified (qUnqualified) import Data.Text (strip) import Data.Text.Encoding import Data.Text.Encoding.Error import Data.Text.Lazy as LT (pack) import Data.Text.Lazy.Encoding qualified as TL -import GHC.TypeLits (KnownSymbol, symbolVal) import Imports import Network.HTTP.Types (urlEncode) import Network.HTTP.Types.Method @@ -504,10 +502,7 @@ setBlacklistStatus status email = do getTeamFeatureFlag :: forall cfg. - ( Typeable (Public.LockableFeature cfg), - FromJSON (Public.LockableFeature cfg), - KnownSymbol (Public.FeatureSymbol cfg) - ) => + (IsFeatureConfig cfg, Typeable cfg) => TeamId -> Handler (Public.LockableFeature cfg) getTeamFeatureFlag tid = do @@ -524,9 +519,7 @@ getTeamFeatureFlag tid = do setTeamFeatureFlag :: forall cfg. - ( ToJSON (Public.Feature cfg), - KnownSymbol (Public.FeatureSymbol cfg) - ) => + (IsFeatureConfig cfg) => TeamId -> Public.Feature cfg -> Handler () @@ -540,9 +533,7 @@ setTeamFeatureFlag tid status = do patchTeamFeatureFlag :: forall cfg. - ( ToJSON (Public.LockableFeaturePatch cfg), - KnownSymbol (Public.FeatureSymbol cfg) - ) => + (IsFeatureConfig cfg) => TeamId -> Public.LockableFeaturePatch cfg -> Handler () @@ -566,13 +557,12 @@ galleyRpc req = do setTeamFeatureLockStatus :: forall cfg. - ( KnownSymbol (Public.FeatureSymbol cfg) - ) => + (IsFeatureConfig cfg) => TeamId -> LockStatus -> Handler () setTeamFeatureLockStatus tid lstat = do - info $ msg ("Setting lock status: " <> show (symbolVal (Proxy @(Public.FeatureSymbol cfg)), lstat)) + info $ msg ("Setting lock status: " <> featureName @cfg) gly <- view galley fromResponseBody <=< catchRpcErrors