From fc1d21ab3ad54d761f3eac4917d1b14cdd85e064 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 8 Aug 2024 09:22:25 +0200 Subject: [PATCH 1/7] More superclass constraints for IsFeatureConfig --- libs/galley-types/default.nix | 2 - libs/galley-types/galley-types.cabal | 1 - libs/galley-types/src/Galley/Types/Teams.hs | 3 +- .../src/Wire/API/Event/FeatureConfig.hs | 6 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 19 ++++-- .../brig/test/integration/API/User/Util.hs | 5 +- services/galley/default.nix | 2 - services/galley/galley.cabal | 1 - .../galley/src/Galley/API/Teams/Features.hs | 8 +-- services/galley/test/integration/API/Teams.hs | 61 +++++++++---------- .../test/integration/API/Util/TeamFeature.hs | 36 +++++------ tools/stern/src/Stern/API.hs | 10 +-- tools/stern/src/Stern/Intra.hs | 20 ++---- 13 files changed, 71 insertions(+), 103 deletions(-) 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/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/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 095c2fe5f9b..b24dcdeb9f3 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -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 @@ -213,10 +220,10 @@ data FeatureSingleton cfg where class HasDeprecatedFeatureName cfg where type 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 +296,7 @@ defUnlockedFeature = config = def } -instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where +instance (IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where schema = object name $ LockableFeature @@ -1310,9 +1317,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/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/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 38d16da2f45..f8a626b7de1 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -44,9 +44,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 +174,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 +248,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, 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 From 35bc8bc714b358042a9091f5263e7ea99bad339b Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 8 Aug 2024 11:05:40 +0200 Subject: [PATCH 2/7] Remove unnecessary error constraint --- .../src/Wire/API/Routes/Internal/Galley.hs | 14 ++++++-------- .../src/Wire/API/Routes/Public/Galley/Feature.hs | 14 ++++++-------- services/galley/src/Galley/API/Teams/Features.hs | 1 - 3 files changed, 12 insertions(+), 17 deletions(-) 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..d9c4126a882 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -58,14 +58,12 @@ import Wire.API.User.Client type LegalHoldFeatureStatusChangeErrors = '( 'ActionDenied 'RemoveConversationMember, - '( AuthenticationError, - '( 'CannotEnableLegalHoldServiceLargeTeam, - '( 'LegalHoldNotEnabled, - '( 'LegalHoldDisableUnimplemented, - '( 'LegalHoldServiceNotRegistered, - '( 'UserLegalHoldIllegalOperation, - '( 'LegalHoldCouldNotBlockConnections, '()) - ) + '( 'CannotEnableLegalHoldServiceLargeTeam, + '( 'LegalHoldNotEnabled, + '( 'LegalHoldDisableUnimplemented, + '( 'LegalHoldServiceNotRegistered, + '( 'UserLegalHoldIllegalOperation, + '( 'LegalHoldCouldNotBlockConnections, '()) ) ) ) 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..f593a74c873 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 @@ -42,14 +42,12 @@ type FeatureAPI = MakesFederatedCall 'Galley "on-mls-message-sent" ] '( 'ActionDenied 'RemoveConversationMember, - '( AuthenticationError, - '( 'CannotEnableLegalHoldServiceLargeTeam, - '( 'LegalHoldNotEnabled, - '( 'LegalHoldDisableUnimplemented, - '( 'LegalHoldServiceNotRegistered, - '( 'UserLegalHoldIllegalOperation, - '( 'LegalHoldCouldNotBlockConnections, '()) - ) + '( 'CannotEnableLegalHoldServiceLargeTeam, + '( 'LegalHoldNotEnabled, + '( 'LegalHoldDisableUnimplemented, + '( 'LegalHoldServiceNotRegistered, + '( 'UserLegalHoldIllegalOperation, + '( 'LegalHoldCouldNotBlockConnections, '()) ) ) ) diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index f8a626b7de1..5321d3cc68c 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -298,7 +298,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, From 358711d6b4442599c8d97cd277d85e98d48895b4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 8 Aug 2024 11:37:44 +0200 Subject: [PATCH 3/7] Abstract single feature internal API --- libs/wire-api/src/Wire/API/Error.hs | 8 +- libs/wire-api/src/Wire/API/Routes/Features.hs | 22 ++ .../src/Wire/API/Routes/Internal/Galley.hs | 198 ++++++------------ .../Wire/API/Routes/Public/Galley/Feature.hs | 79 +++---- libs/wire-api/wire-api.cabal | 1 + services/galley/src/Galley/API/Internal.hs | 106 ++++------ .../galley/src/Galley/API/Teams/Features.hs | 6 +- 7 files changed, 160 insertions(+), 260 deletions(-) create mode 100644 libs/wire-api/src/Wire/API/Routes/Features.hs 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/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 d9c4126a882..6ce403d75dd 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -38,6 +38,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,126 +57,40 @@ import Wire.API.Team.Member import Wire.API.Team.SearchVisibility import Wire.API.User.Client -type LegalHoldFeatureStatusChangeErrors = - '( 'ActionDenied 'RemoveConversationMember, - '( '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" @@ -391,62 +306,73 @@ 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 calls cfg = + Named + '("iput", cfg) + ( ApplyMods + calls + ( Description (FeatureAPIDesc cfg) + :> FeatureStatusBasePutInternal cfg + ) + ) -type IFeatureStatusPatchWithDesc calls errs f desc = Named '("ipatch", f) (ApplyMods calls (Description desc :> FeatureStatusBasePatchInternal errs f)) +type IFeatureStatusPatch calls cfg = + Named + '("ipatch", cfg) + ( ApplyMods + calls + ( 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/Public/Galley/Feature.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs index f593a74c873..9aac63212cc 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 @@ -22,11 +22,11 @@ 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 @@ -41,22 +41,9 @@ type FeatureAPI = '[ MakesFederatedCall 'Galley "on-conversation-updated", MakesFederatedCall 'Galley "on-mls-message-sent" ] - '( 'ActionDenied 'RemoveConversationMember, - '( 'CannotEnableLegalHoldServiceLargeTeam, - '( 'LegalHoldNotEnabled, - '( 'LegalHoldDisableUnimplemented, - '( 'LegalHoldServiceNotRegistered, - '( 'UserLegalHoldIllegalOperation, - '( 'LegalHoldCouldNotBlockConnections, '()) - ) - ) - ) - ) - ) - ) LegalholdConfig :<|> FeatureStatusGet SearchVisibilityAvailableConfig - :<|> FeatureStatusPut '[] '() 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 :<|> SearchVisibilityGet @@ -66,41 +53,33 @@ type FeatureAPI = :<|> 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 + :<|> FeatureStatusPut '[] AppLockConfig :<|> FeatureStatusGet FileSharingConfig - :<|> FeatureStatusPut '[] '() FileSharingConfig + :<|> FeatureStatusPut '[] FileSharingConfig :<|> FeatureStatusGet ClassifiedDomainsConfig :<|> FeatureStatusGet ConferenceCallingConfig - :<|> FeatureStatusPut '[] '() ConferenceCallingConfig + :<|> FeatureStatusPut '[] ConferenceCallingConfig :<|> FeatureStatusGet SelfDeletingMessagesConfig - :<|> FeatureStatusPut '[] '() SelfDeletingMessagesConfig + :<|> FeatureStatusPut '[] SelfDeletingMessagesConfig :<|> FeatureStatusGet GuestLinksConfig - :<|> FeatureStatusPut '[] '() GuestLinksConfig + :<|> FeatureStatusPut '[] GuestLinksConfig :<|> FeatureStatusGet SndFactorPasswordChallengeConfig - :<|> FeatureStatusPut '[] '() SndFactorPasswordChallengeConfig + :<|> FeatureStatusPut '[] SndFactorPasswordChallengeConfig :<|> From 'V5 ::> FeatureStatusGet MLSConfig - :<|> From 'V5 ::> FeatureStatusPut '[] '() MLSConfig + :<|> From 'V5 ::> FeatureStatusPut '[] MLSConfig :<|> FeatureStatusGet ExposeInvitationURLsToTeamAdminConfig - :<|> FeatureStatusPut '[] '() ExposeInvitationURLsToTeamAdminConfig + :<|> FeatureStatusPut '[] ExposeInvitationURLsToTeamAdminConfig :<|> FeatureStatusGet SearchVisibilityInboundConfig - :<|> FeatureStatusPut '[] '() SearchVisibilityInboundConfig + :<|> FeatureStatusPut '[] SearchVisibilityInboundConfig :<|> FeatureStatusGet OutlookCalIntegrationConfig - :<|> FeatureStatusPut '[] '() OutlookCalIntegrationConfig + :<|> FeatureStatusPut '[] OutlookCalIntegrationConfig :<|> From 'V5 ::> FeatureStatusGet MlsE2EIdConfig - :<|> From 'V5 ::> Until 'V6 ::> Named "put-MlsE2EIdConfig@v5" (ZUser :> FeatureStatusBasePutPublic '() MlsE2EIdConfig) - :<|> From 'V6 ::> FeatureStatusPut '[] '() 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 ::> FeatureStatusPut '[] MlsMigrationConfig + :<|> From 'V5 ::> FeatureStatusGet EnforceFileDownloadLocationConfig + :<|> From 'V5 ::> FeatureStatusPut '[] EnforceFileDownloadLocationConfig :<|> From 'V5 ::> FeatureStatusGet LimitedEventFanoutConfig :<|> AllFeatureConfigsUserGet :<|> AllFeatureConfigsTeamGet @@ -118,22 +97,18 @@ type FeatureAPI = :<|> 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 -type FeatureStatusGet f = FeatureStatusGetWithDesc f "" - -type FeatureStatusGetWithDesc f desc = +type FeatureStatusGet 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 FeatureStatusPut segs cfg = Named - '("put", f) - ( Description desc - :> (ApplyMods segs (ZUser :> FeatureStatusBasePutPublic errs f)) + '("put", cfg) + ( Description (FeatureAPIDesc cfg) + :> (ApplyMods segs (ZUser :> FeatureStatusBasePutPublic cfg)) ) type FeatureStatusDeprecatedGet d f = @@ -157,13 +132,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/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/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/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 5321d3cc68c..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, From e60fdcf2efdc0025750ac035cb093e43d8075478 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 9 Aug 2024 15:16:08 +0200 Subject: [PATCH 4/7] Reorganise deprecated feature flag endpoints --- .../src/Wire/API/Routes/Internal/Galley.hs | 23 ++--- .../Wire/API/Routes/Public/Galley/Feature.hs | 95 +++++++++++-------- libs/wire-api/src/Wire/API/Team/Feature.hs | 14 +-- .../galley/src/Galley/API/Public/Feature.hs | 28 ++++-- 4 files changed, 90 insertions(+), 70 deletions(-) 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 6ce403d75dd..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 @@ -69,8 +68,8 @@ type family IFeatureAPI1 cfg where type IFeatureAPI1Full cfg = IFeatureStatusGet cfg - :<|> IFeatureStatusPut '[] cfg - :<|> IFeatureStatusPatch '[] cfg + :<|> IFeatureStatusPut cfg + :<|> IFeatureStatusPatch cfg type family IAllFeaturesAPI cfgs where IAllFeaturesAPI '[cfg] = IFeatureAPI1 cfg @@ -313,24 +312,18 @@ type IFeatureStatusGet cfg = :> FeatureStatusBaseGet cfg ) -type IFeatureStatusPut calls cfg = +type IFeatureStatusPut cfg = Named '("iput", cfg) - ( ApplyMods - calls - ( Description (FeatureAPIDesc cfg) - :> FeatureStatusBasePutInternal cfg - ) + ( Description (FeatureAPIDesc cfg) + :> FeatureStatusBasePutInternal cfg ) -type IFeatureStatusPatch calls cfg = +type IFeatureStatusPatch cfg = Named '("ipatch", cfg) - ( ApplyMods - calls - ( Description (FeatureAPIDesc cfg) - :> FeatureStatusBasePatchInternal cfg - ) + ( Description (FeatureAPIDesc cfg) + :> FeatureStatusBasePatchInternal cfg ) type FeatureStatusBasePutInternal cfg = 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 9aac63212cc..cbda7b374af 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,10 +21,8 @@ import Data.Id import GHC.TypeLits import Servant import Servant.OpenApi.Internal.Orphans () -import Wire.API.ApplyMods 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 @@ -34,68 +32,84 @@ import Wire.API.Routes.Version import Wire.API.Team.Feature import Wire.API.Team.SearchVisibility (TeamSearchVisibilityView) +type FeatureAPIGetPut cfg = + FeatureStatusGet cfg :<|> FeatureStatusPut cfg + type FeatureAPI = FeatureStatusGet SSOConfig :<|> FeatureStatusGet LegalholdConfig - :<|> FeatureStatusPut - '[ MakesFederatedCall 'Galley "on-conversation-updated", - MakesFederatedCall 'Galley "on-mls-message-sent" - ] - LegalholdConfig + :<|> FeatureStatusPut 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 + :<|> FeatureStatusPut 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 + :<|> FeatureStatusPut AppLockConfig :<|> FeatureStatusGet FileSharingConfig - :<|> FeatureStatusPut '[] FileSharingConfig + :<|> FeatureStatusPut FileSharingConfig :<|> FeatureStatusGet ClassifiedDomainsConfig :<|> FeatureStatusGet ConferenceCallingConfig - :<|> FeatureStatusPut '[] ConferenceCallingConfig + :<|> FeatureStatusPut ConferenceCallingConfig :<|> FeatureStatusGet SelfDeletingMessagesConfig - :<|> FeatureStatusPut '[] SelfDeletingMessagesConfig + :<|> FeatureStatusPut SelfDeletingMessagesConfig :<|> FeatureStatusGet GuestLinksConfig - :<|> FeatureStatusPut '[] GuestLinksConfig + :<|> FeatureStatusPut GuestLinksConfig :<|> FeatureStatusGet SndFactorPasswordChallengeConfig - :<|> FeatureStatusPut '[] SndFactorPasswordChallengeConfig + :<|> FeatureStatusPut SndFactorPasswordChallengeConfig :<|> From 'V5 ::> FeatureStatusGet MLSConfig - :<|> From 'V5 ::> FeatureStatusPut '[] MLSConfig + :<|> From 'V5 ::> FeatureStatusPut MLSConfig :<|> FeatureStatusGet ExposeInvitationURLsToTeamAdminConfig - :<|> FeatureStatusPut '[] ExposeInvitationURLsToTeamAdminConfig + :<|> FeatureStatusPut ExposeInvitationURLsToTeamAdminConfig :<|> FeatureStatusGet SearchVisibilityInboundConfig - :<|> FeatureStatusPut '[] SearchVisibilityInboundConfig + :<|> FeatureStatusPut SearchVisibilityInboundConfig :<|> FeatureStatusGet OutlookCalIntegrationConfig - :<|> FeatureStatusPut '[] OutlookCalIntegrationConfig + :<|> FeatureStatusPut OutlookCalIntegrationConfig :<|> From 'V5 ::> FeatureStatusGet MlsE2EIdConfig :<|> From 'V5 ::> Until 'V6 ::> Named "put-MlsE2EIdConfig@v5" (ZUser :> FeatureStatusBasePutPublic MlsE2EIdConfig) - :<|> From 'V6 ::> FeatureStatusPut '[] MlsE2EIdConfig + :<|> From 'V6 ::> FeatureStatusPut MlsE2EIdConfig :<|> From 'V5 ::> FeatureStatusGet MlsMigrationConfig - :<|> From 'V5 ::> FeatureStatusPut '[] MlsMigrationConfig + :<|> From 'V5 ::> FeatureStatusPut MlsMigrationConfig :<|> From 'V5 ::> FeatureStatusGet EnforceFileDownloadLocationConfig - :<|> From 'V5 ::> FeatureStatusPut '[] EnforceFileDownloadLocationConfig + :<|> From 'V5 ::> FeatureStatusPut EnforceFileDownloadLocationConfig :<|> From 'V5 ::> FeatureStatusGet 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 family AllDeprecatedFeatureConfigAPI cfgs where + AllDeprecatedFeatureConfigAPI '[cfg] = FeatureConfigDeprecatedGet DeprecationNotice2 cfg + AllDeprecatedFeatureConfigAPI (cfg : cfgs) = + FeatureConfigDeprecatedGet DeprecationNotice2 cfg + :<|> AllDeprecatedFeatureConfigAPI cfgs + +type DeprecatedFeatureAPI = + FeatureStatusDeprecatedGet DeprecationNotice1 SearchVisibilityAvailableConfig + :<|> FeatureStatusDeprecatedPut DeprecationNotice1 SearchVisibilityAvailableConfig + :<|> FeatureStatusDeprecatedGet DeprecationNotice1 ValidateSAMLEmailsConfig + :<|> FeatureStatusDeprecatedGet DeprecationNotice2 DigitalSignaturesConfig type FeatureStatusGet cfg = Named @@ -104,11 +118,12 @@ type FeatureStatusGet cfg = :> (ZUser :> FeatureStatusBaseGet cfg) ) -type FeatureStatusPut segs cfg = +type FeatureStatusPut cfg = Named '("put", cfg) ( Description (FeatureAPIDesc cfg) - :> (ApplyMods segs (ZUser :> FeatureStatusBasePutPublic cfg)) + :> ZUser + :> FeatureStatusBasePutPublic cfg ) type FeatureStatusDeprecatedGet d f = diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index b24dcdeb9f3..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 @@ -217,8 +217,7 @@ 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. (IsFeatureConfig cfg) => Text featureName = T.pack $ symbolVal (Proxy @(FeatureSymbol cfg)) @@ -658,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 @@ -686,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 @@ -711,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 diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs index d19ddefe523..ac49239b400 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 @@ -27,21 +30,22 @@ 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) (callsFed (exposeAnnotations (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 @'("put", LegalholdConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", SearchVisibilityAvailableConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("put", SearchVisibilityAvailableConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get-deprecated", SearchVisibilityAvailableConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put-deprecated", SearchVisibilityAvailableConfig) (setFeatureStatus . DoAuth) <@> 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) @@ -73,7 +77,19 @@ featureAPI = <@> 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 From d9ef9e429000df83a4ac0ab5628621c7ea024106 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 9 Aug 2024 16:04:25 +0200 Subject: [PATCH 5/7] Join Get and Put feature endpoints when possible --- libs/wire-api/src/Wire/API/Routes/Named.hs | 4 ++ .../Wire/API/Routes/Public/Galley/Feature.hs | 62 +++++++------------ .../galley/src/Galley/API/Public/Feature.hs | 45 +++++--------- 3 files changed, 43 insertions(+), 68 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Named.hs b/libs/wire-api/src/Wire/API/Routes/Named.hs index d7aad87521a..2f19bcfcb24 100644 --- a/libs/wire-api/src/Wire/API/Routes/Named.hs +++ b/libs/wire-api/src/Wire/API/Routes/Named.hs @@ -147,3 +147,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 cbda7b374af..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 @@ -33,47 +33,33 @@ import Wire.API.Team.Feature import Wire.API.Team.SearchVisibility (TeamSearchVisibilityView) type FeatureAPIGetPut cfg = - FeatureStatusGet cfg :<|> FeatureStatusPut cfg + FeatureAPIGet cfg :<|> FeatureAPIPut cfg type FeatureAPI = - FeatureStatusGet SSOConfig - :<|> FeatureStatusGet LegalholdConfig - :<|> FeatureStatusPut LegalholdConfig - :<|> FeatureStatusGet SearchVisibilityAvailableConfig - :<|> FeatureStatusPut SearchVisibilityAvailableConfig + FeatureAPIGet SSOConfig + :<|> FeatureAPIGetPut LegalholdConfig + :<|> FeatureAPIGetPut SearchVisibilityAvailableConfig :<|> SearchVisibilityGet :<|> SearchVisibilitySet - :<|> FeatureStatusGet ValidateSAMLEmailsConfig - :<|> FeatureStatusGet 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 + :<|> 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 ::> FeatureStatusPut MlsE2EIdConfig - :<|> From 'V5 ::> FeatureStatusGet MlsMigrationConfig - :<|> From 'V5 ::> FeatureStatusPut MlsMigrationConfig - :<|> From 'V5 ::> FeatureStatusGet EnforceFileDownloadLocationConfig - :<|> From 'V5 ::> FeatureStatusPut EnforceFileDownloadLocationConfig - :<|> From 'V5 ::> FeatureStatusGet LimitedEventFanoutConfig + :<|> From 'V6 ::> FeatureAPIPut MlsE2EIdConfig + :<|> From 'V5 ::> FeatureAPIGetPut MlsMigrationConfig + :<|> From 'V5 ::> FeatureAPIGetPut EnforceFileDownloadLocationConfig + :<|> From 'V5 ::> FeatureAPIGet LimitedEventFanoutConfig :<|> AllFeatureConfigsUserGet :<|> AllFeatureConfigsTeamGet :<|> DeprecatedFeatureAPI @@ -111,14 +97,14 @@ type DeprecatedFeatureAPI = :<|> FeatureStatusDeprecatedGet DeprecationNotice1 ValidateSAMLEmailsConfig :<|> FeatureStatusDeprecatedGet DeprecationNotice2 DigitalSignaturesConfig -type FeatureStatusGet cfg = +type FeatureAPIGet cfg = Named '("get", cfg) ( Description (FeatureAPIDesc cfg) :> (ZUser :> FeatureStatusBaseGet cfg) ) -type FeatureStatusPut cfg = +type FeatureAPIPut cfg = Named '("put", cfg) ( Description (FeatureAPIDesc cfg) diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs index ac49239b400..45703385cc4 100644 --- a/services/galley/src/Galley/API/Public/Feature.hs +++ b/services/galley/src/Galley/API/Public/Feature.hs @@ -25,7 +25,6 @@ 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 @@ -33,47 +32,33 @@ import Wire.API.Team.Feature featureAPIGetPut :: forall cfg r. (_) => API (FeatureAPIGetPut cfg) r featureAPIGetPut = mkNamedAPI @'("get", cfg) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", cfg) (callsFed (exposeAnnotations (setFeatureStatus . DoAuth))) + <@> mkNamedAPI @'("put", cfg) (setFeatureStatus . DoAuth) featureAPI :: API FeatureAPI GalleyEffects featureAPI = mkNamedAPI @'("get", SSOConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", LegalholdConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", LegalholdConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", SearchVisibilityAvailableConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", SearchVisibilityAvailableConfig) (setFeatureStatus . DoAuth) + <@> featureAPIGetPut + <@> featureAPIGetPut <@> mkNamedAPI @"get-search-visibility" getSearchVisibility <@> mkNamedAPI @"set-search-visibility" (setSearchVisibility (featureEnabledForTeam @SearchVisibilityAvailableConfig)) <@> mkNamedAPI @'("get", ValidateSAMLEmailsConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", 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 From a96cdd5a845b843a169f9c2248c1fe035d9dbf98 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 12 Aug 2024 07:40:28 +0200 Subject: [PATCH 6/7] Add CHANGELOG entry --- changelog.d/5-internal/feature-flag-refactoring-2 | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/feature-flag-refactoring-2 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 From 554259c095dbc6f78140b724f413f104f84f1362 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 12 Aug 2024 14:51:40 +0200 Subject: [PATCH 7/7] Haddocks for (::>) --- libs/wire-api/src/Wire/API/Routes/Named.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Named.hs b/libs/wire-api/src/Wire/API/Routes/Named.hs index 2f19bcfcb24..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 ::>