WPB-9139 Update team feature MLS config

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 ""
 

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))

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 ..]
 

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"

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 <[email protected]>
@@ -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)