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 8e7a8991d31..ec19655f7c2 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -394,7 +394,7 @@ type ITeamsAPIBase = type IFeatureStatusGet f = IFeatureStatusGetWithDesc f "" -type IFeatureStatusGetWithDesc f desc = Named '("iget", f) (Description desc :> FeatureStatusBaseGet f) +type IFeatureStatusGetWithDesc f desc = Named '("iget", f) (Description desc :> FeatureStatusBaseGet Nothing f) type IFeatureStatusPut calls errs f = IFeatureStatusPutWithDesc calls errs f "" 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 654f79657a2..56512459738 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs @@ -19,6 +19,7 @@ module Wire.API.Routes.Public.Galley.Feature where import Data.Id import GHC.TypeLits +import Imports import Servant hiding (WithStatus) import Servant.OpenApi.Internal.Orphans () import Wire.API.ApplyMods @@ -31,6 +32,7 @@ import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named import Wire.API.Routes.Public import Wire.API.Routes.Version +import Wire.API.Routes.Versioned import Wire.API.Team.Feature import Wire.API.Team.SearchVisibility (TeamSearchVisibilityView) @@ -79,7 +81,7 @@ type FeatureAPI = :<|> FeatureStatusPut '[] '() GuestLinksConfig :<|> FeatureStatusGet SndFactorPasswordChallengeConfig :<|> FeatureStatusPut '[] '() SndFactorPasswordChallengeConfig - :<|> From 'V5 ::> FeatureStatusGet MLSConfig + :<|> From 'V5 ::> Until 'V6 ::> FeatureStatusGetVersioned 'V5 MLSConfig :<|> From 'V5 ::> FeatureStatusPut '[] '() MLSConfig :<|> FeatureStatusGet ExposeInvitationURLsToTeamAdminConfig :<|> FeatureStatusPut '[] '() ExposeInvitationURLsToTeamAdminConfig @@ -121,11 +123,20 @@ type FeatureAPI = type FeatureStatusGet f = FeatureStatusGetWithDesc f "" +type FeatureStatusGetVersioned v f = FeatureStatusGetWithDescVersioned v f "" + type FeatureStatusGetWithDesc f desc = Named '("get", f) ( Description desc - :> (ZUser :> FeatureStatusBaseGet f) + :> (ZUser :> FeatureStatusBaseGet Nothing f) + ) + +type FeatureStatusGetWithDescVersioned v f desc = + Named + '(AppendSymbol "get@" (VersionSymbol v), f) + ( Description desc + :> (ZUser :> FeatureStatusBaseGet (Just v) f) ) type FeatureStatusPut segs errs f = FeatureStatusPutWithDesc segs errs f "" @@ -147,7 +158,13 @@ type FeatureStatusDeprecatedPut d f = '("put-deprecated", f) (ZUser :> FeatureStatusBaseDeprecatedPut d f) -type FeatureStatusBaseGet featureConfig = +type family FeatureVerb (verb :: StdMethod) featureConfig (mVersion :: Maybe Version) + +type instance FeatureVerb verb featureConfig 'Nothing = Verb verb 200 '[Servant.JSON] (WithStatus featureConfig) + +type instance FeatureVerb verb featureConfig ('Just v) = Verb verb 200 '[Servant.JSON] (Versioned v (WithStatus featureConfig)) + +type FeatureStatusBaseGet mVersion featureConfig = Summary (AppendSymbol "Get config for " (FeatureSymbol featureConfig)) :> CanThrow OperationDenied :> CanThrow 'NotATeamMember @@ -156,7 +173,7 @@ type FeatureStatusBaseGet featureConfig = :> Capture "tid" TeamId :> "features" :> FeatureSymbol featureConfig - :> Get '[Servant.JSON] (WithStatus featureConfig) + :> FeatureVerb 'GET featureConfig mVersion type FeatureStatusBasePutPublic errs featureConfig = Summary (AppendSymbol "Put config for " (FeatureSymbol featureConfig)) diff --git a/libs/wire-api/src/Wire/API/Routes/Version.hs b/libs/wire-api/src/Wire/API/Routes/Version.hs index 2256e54ac69..b9711015e2c 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version.hs +++ b/libs/wire-api/src/Wire/API/Routes/Version.hs @@ -39,6 +39,7 @@ module Wire.API.Routes.Version developmentVersions, expandVersionExp, maxAvailableVersion, + VersionSymbol, -- * Servant combinators Until, @@ -117,6 +118,22 @@ versionText = ("v" <>) . toUrlPiece . versionInt @Int versionByteString :: Version -> ByteString versionByteString = ("v" <>) . toByteString' . versionInt @Int +type family VersionSymbol (v :: Version) :: Symbol + +type instance VersionSymbol 'V0 = "v0" + +type instance VersionSymbol 'V1 = "v1" + +type instance VersionSymbol 'V2 = "v2" + +type instance VersionSymbol 'V3 = "v3" + +type instance VersionSymbol 'V4 = "v4" + +type instance VersionSymbol 'V5 = "v5" + +type instance VersionSymbol 'V6 = "v6" + instance ToSchema Version where schema = enum @Text "Version" . mconcat $ (\v -> element (versionText v) v) <$> [minBound ..] diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index f2fec9ce3d6..c26c48090aa 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -123,6 +123,8 @@ import Test.QuickCheck.Gen (suchThat) import Wire.API.Conversation.Protocol import Wire.API.MLS.CipherSuite (CipherSuiteTag (MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519)) import Wire.API.Routes.Named (RenderableSymbol (renderSymbol)) +import Wire.API.Routes.Version +import Wire.API.Routes.Versioned import Wire.Arbitrary (Arbitrary, GenericUniform (..)) ---------------------------------------------------------------------- @@ -301,6 +303,9 @@ instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (WithStatus cfg) where inner = schema @cfg name = fromMaybe "" (getName (schemaDoc inner)) <> ".WithStatus" +instance ToSchema (Versioned 'V5 (WithStatus cfg)) where + schema = undefined + instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (WithStatus cfg) where arbitrary = WithStatusBase <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary @@ -935,15 +940,21 @@ data MLSConfig = MLSConfig instance RenderableSymbol MLSConfig where renderSymbol = "MLSConfig" +mlsConfigSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc MLSConfig +mlsConfigSchema mv = + object ("MLSConfig" <> T.pack (foldMap show mv)) $ + MLSConfig + <$> mlsProtocolToggleUsers .= fieldWithDocModifier "protocolToggleUsers" (S.description ?~ "allowlist of users that may change protocols") (array schema) + <*> mlsDefaultProtocol .= field "defaultProtocol" schema + <*> mlsAllowedCipherSuites .= field "allowedCipherSuites" (array schema) + <*> mlsDefaultCipherSuite .= field "defaultCipherSuite" schema + <*> mlsSupportedProtocols .= field "supportedProtocols" (array schema) + instance ToSchema MLSConfig where - schema = - object "MLSConfig" $ - MLSConfig - <$> mlsProtocolToggleUsers .= fieldWithDocModifier "protocolToggleUsers" (S.description ?~ "allowlist of users that may change protocols") (array schema) - <*> mlsDefaultProtocol .= field "defaultProtocol" schema - <*> mlsAllowedCipherSuites .= field "allowedCipherSuites" (array schema) - <*> mlsDefaultCipherSuite .= field "defaultCipherSuite" schema - <*> mlsSupportedProtocols .= field "supportedProtocols" (array schema) + schema = mlsConfigSchema Nothing + +instance ToSchema (Versioned 'V5 MLSConfig) where + schema = Versioned <$> unVersioned .= mlsConfigSchema (Just V5) instance IsFeatureConfig MLSConfig where type FeatureSymbol MLSConfig = "mls" diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs index 3e9d3f68a54..f1a7d2e51e6 100644 --- a/services/galley/src/Galley/API/Public/Feature.hs +++ b/services/galley/src/Galley/API/Public/Feature.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -24,6 +26,7 @@ import Imports import Wire.API.Federation.API import Wire.API.Routes.API import Wire.API.Routes.Public.Galley.Feature +import Wire.API.Routes.Versioned import Wire.API.Team.Feature featureAPI :: API FeatureAPI GalleyEffects @@ -53,7 +56,7 @@ featureAPI = <@> mkNamedAPI @'("put", GuestLinksConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", SndFactorPasswordChallengeConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("put", SndFactorPasswordChallengeConfig) (setFeatureStatus . DoAuth) - <@> mkNamedAPI @'("get", MLSConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get@v5", MLSConfig) (\uid tid -> Versioned <$> (getFeatureStatus (DoAuth uid) tid)) <@> mkNamedAPI @'("put", MLSConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("put", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatus . DoAuth)