ClientAPI: Include unnesting of capabilties in V7, ensure consumable …

…notifs are not part of the enum (#4366)

* ClientAPI: Ensure unnecessary nesting of capabilities is removed in API v7

* ClientAPI: Ensure consumable-notifications capability doesn't leak to API <= V7

* wire-api: Avoid adding double version suffix

* wire-api: Name versioned Client consistently in swagger

* Regenerate swagger-v7.json

* wire-api: Add golden test for ClientCapabilityListV7

changelog.d/3-bug-fixes/WPB-11973-bump-api-version

@@ -1 +1 @@
-Freeze API version 7, create new dev version 8.  Also update checklist.
+Freeze API version 7, create new dev version 8.  Also update checklist. (#4356, ##)

integration/test/Test/Client.hs

@@ -116,8 +116,16 @@ testGetClientCapabilitiesV7 = do
     resp.status `shouldMatchInt` 200
     resp.json %. "0.capabilities" `shouldMatchSet` allCapabilities
 
-  -- In API v7 and below, the "capabilities" field is an enum, so having a new
-  -- value for this enum is a breaking change.
+  -- The "capabilities" field is an enum, so having a new value for this enum is
+  -- a breaking change. So in API v7 and below, we should not see the
+  -- "consumable-notifications" value.
   withAPIVersion 7 $ getSelfClients alice `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "0.capabilities" `shouldMatchSet` ["legalhold-implicit-consent"]
+
+  -- In API v6 and below, the "capabilities" field is doubly nested. However,
+  -- the consumable-notifications value should not be considered part of the
+  -- enum.
+  withAPIVersion 6 $ getSelfClients alice `bindResponse` \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "0.capabilities.capabilities" `shouldMatchSet` ["legalhold-implicit-consent"]

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -750,9 +750,9 @@ type UserClientAPI =
   -- - ClientAdded event to self
   -- - ClientRemoved event to self, if removing old clients due to max number
   Named
-    "add-client@v7"
+    "add-client@v6"
     ( Summary "Register a new client"
-        :> Until 'V8
+        :> Until 'V7
         :> CanThrow 'TooManyClients
         :> CanThrow 'MissingAuth
         :> CanThrow 'MalformedPrekeys
@@ -761,16 +761,39 @@ type UserClientAPI =
         :> ZLocalUser
         :> ZConn
         :> "clients"
-        :> VersionedReqBody 'V7 '[JSON] NewClient
+        :> VersionedReqBody 'V6 '[JSON] NewClient
         :> MultiVerb1
              'POST
              '[JSON]
              ( WithHeaders
                  ClientHeaders
                  Client
-                 (VersionedRespond 'V7 201 "Client registered" Client)
+                 (VersionedRespond 'V6 201 "Client registered" Client)
              )
     )
+    :<|> Named
+           "add-client@v7"
+           ( Summary "Register a new client"
+               :> From 'V7
+               :> Until 'V8
+               :> CanThrow 'TooManyClients
+               :> CanThrow 'MissingAuth
+               :> CanThrow 'MalformedPrekeys
+               :> CanThrow 'CodeAuthenticationFailed
+               :> CanThrow 'CodeAuthenticationRequired
+               :> ZLocalUser
+               :> ZConn
+               :> "clients"
+               :> VersionedReqBody 'V7 '[JSON] NewClient
+               :> MultiVerb1
+                    'POST
+                    '[JSON]
+                    ( WithHeaders
+                        ClientHeaders
+                        Client
+                        (VersionedRespond 'V7 201 "Client registered" Client)
+                    )
+           )
     :<|> Named
            "add-client"
            ( Summary "Register a new client"
@@ -793,9 +816,21 @@ type UserClientAPI =
                         (Respond 201 "Client registered" Client)
                     )
            )
+    :<|> Named
+           "update-client@v6"
+           ( Summary "Update a registered client"
+               :> Until 'V7
+               :> CanThrow 'MalformedPrekeys
+               :> ZUser
+               :> "clients"
+               :> CaptureClientId "client"
+               :> VersionedReqBody 'V6 '[JSON] UpdateClient
+               :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "Client updated")
+           )
     :<|> Named
            "update-client@v7"
            ( Summary "Update a registered client"
+               :> From 'V7
                :> Until 'V8
                :> CanThrow 'MalformedPrekeys
                :> ZUser
@@ -807,6 +842,7 @@ type UserClientAPI =
     :<|> Named
            "update-client"
            ( Summary "Update a registered client"
+               :> From 'V8
                :> CanThrow 'MalformedPrekeys
                :> ZUser
                :> "clients"
@@ -827,9 +863,22 @@ type UserClientAPI =
           :> ReqBody '[JSON] RmClient
           :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 200 "Client deleted"] ()
       )
+    :<|> Named
+           "list-clients@v6"
+           ( Summary "List the registered clients"
+               :> Until 'V7
+               :> ZUser
+               :> "clients"
+               :> MultiVerb1
+                    'GET
+                    '[JSON]
+                    ( VersionedRespond 'V6 200 "List of clients" [Client]
+                    )
+           )
     :<|> Named
            "list-clients@v7"
            ( Summary "List the registered clients"
+               :> From 'V7
                :> Until 'V8
                :> ZUser
                :> "clients"
@@ -851,9 +900,25 @@ type UserClientAPI =
                     ( Respond 200 "List of clients" [Client]
                     )
            )
+    :<|> Named
+           "get-client@v6"
+           ( Summary "Get a registered client by ID"
+               :> Until 'V7
+               :> ZUser
+               :> "clients"
+               :> CaptureClientId "client"
+               :> MultiVerb
+                    'GET
+                    '[JSON]
+                    '[ EmptyErrorForLegacyReasons 404 "Client not found",
+                       VersionedRespond 'V6 200 "Client found" Client
+                     ]
+                    (Maybe Client)
+           )
     :<|> Named
            "get-client@v7"
            ( Summary "Get a registered client by ID"
+               :> From 'V7
                :> Until 'V8
                :> ZUser
                :> "clients"
@@ -881,9 +946,23 @@ type UserClientAPI =
                      ]
                     (Maybe Client)
            )
+    :<|> Named
+           "get-client-capabilities@v6"
+           ( Summary "Read back what the client has been posting about itself"
+               :> Until 'V7
+               :> ZUser
+               :> "clients"
+               :> CaptureClientId "client"
+               :> "capabilities"
+               :> MultiVerb1
+                    'GET
+                    '[JSON]
+                    (VersionedRespond 'V6 200 "capabilities" ClientCapabilityList)
+           )
     :<|> Named
            "get-client-capabilities@v7"
            ( Summary "Read back what the client has been posting about itself"
+               :> From 'V7
                :> Until 'V8
                :> ZUser
                :> "clients"
@@ -897,6 +976,7 @@ type UserClientAPI =
     :<|> Named
            "get-client-capabilities"
            ( Summary "Read back what the client has been posting about itself"
+               :> From 'V8
                :> ZUser
                :> "clients"
                :> CaptureClientId "client"

libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs

@@ -145,9 +145,27 @@ type BotAPI =
                :> ReqBody '[JSON] UpdateBotPrekeys
                :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "")
            )
+    :<|> Named
+           "bot-get-client@v6"
+           ( Summary "Get client for bot"
+               :> Until 'V7
+               :> CanThrow 'AccessDenied
+               :> CanThrow 'ClientNotFound
+               :> ZBot
+               :> "bot"
+               :> "client"
+               :> MultiVerb
+                    'GET
+                    '[JSON]
+                    '[ ErrorResponse 'ClientNotFound,
+                       VersionedRespond 'V6 200 "Client found" Client
+                     ]
+                    (Maybe Client)
+           )
     :<|> Named
            "bot-get-client@v7"
            ( Summary "Get client for bot"
+               :> From 'V7
                :> Until 'V8
                :> CanThrow 'AccessDenied
                :> CanThrow 'ClientNotFound

libs/wire-api/src/Wire/API/Routes/Version.hs

@@ -32,6 +32,7 @@ module Wire.API.Routes.Version
     Version (..),
     versionInt,
     versionText,
+    versionedName,
     VersionNumber (..),
     VersionExp (..),
     supportedVersions,
@@ -108,6 +109,10 @@ supportedVersions = [minBound .. maxBound]
 maxAvailableVersion :: Set Version -> Maybe Version
 maxAvailableVersion disabled = Set.lookupMax $ Set.fromList supportedVersions \\ disabled
 
+versionedName :: Maybe Version -> Text -> Text
+versionedName Nothing unversionedName = unversionedName
+versionedName (Just v) unversionedName = unversionedName <> Text.pack (show v)
+
 ----------------------------------------------------------------------
 
 versionText :: Version -> Text

libs/wire-api/src/Wire/API/Routes/Versioned.hs

@@ -23,6 +23,7 @@ import Data.Metrics.Servant
 import Data.OpenApi qualified as S
 import Data.Schema
 import Data.Singletons
+import Data.Text qualified as Text
 import GHC.TypeLits
 import Imports
 import Servant
@@ -116,4 +117,13 @@ deriving via Schema (Versioned v a) instance (ToSchema (Versioned v a)) => ToJSO
 instance (SingI v, ToSchema (Versioned v a), Typeable a, Typeable v) => S.ToSchema (Versioned v a) where
   declareNamedSchema _ = do
     S.NamedSchema n s <- schemaToSwagger (Proxy @(Versioned v a))
-    pure $ S.NamedSchema (fmap (<> toUrlPiece (demote @v)) n) s
+    pure $ S.NamedSchema (fmap withVersionSuffix n) s
+    where
+      versionSuffix :: Text
+      versionSuffix = Text.pack $ show (demote @v)
+
+      withVersionSuffix :: Text -> Text
+      withVersionSuffix origName =
+        if versionSuffix `Text.isSuffixOf` origName
+          then origName
+          else origName <> versionSuffix

libs/wire-api/src/Wire/API/User/Client.hs

@@ -157,6 +157,17 @@ instance ToSchema ClientCapability where
       element "legalhold-implicit-consent" ClientSupportsLegalholdImplicitConsent
         <> element "consumable-notifications" ClientSupportsConsumableNotifications
 
+data ClientCapabilityV7 = ClientSupportsLegalholdImplicitConsentV7
+  deriving (Eq)
+
+capabilitySchemaV7 :: ValueSchema NamedSwaggerDoc ClientCapabilityV7
+capabilitySchemaV7 =
+  enum @Text "ClientCapabilityV7" $
+    element "legalhold-implicit-consent" ClientSupportsLegalholdImplicitConsentV7
+
+clientCapabilityFromV7 :: ClientCapabilityV7 -> ClientCapability
+clientCapabilityFromV7 ClientSupportsLegalholdImplicitConsentV7 = ClientSupportsLegalholdImplicitConsent
+
 instance C.Cql ClientCapability where
   ctype = C.Tagged C.IntColumn
 
@@ -179,25 +190,37 @@ newtype ClientCapabilityList = ClientCapabilityList {fromClientCapabilityList ::
 instance ToSchema ClientCapabilityList where
   schema = capabilitiesSchema Nothing
 
-instance ToSchema (Versioned V7 ClientCapabilityList) where
+instance ToSchema (Versioned V6 ClientCapabilityList) where
   schema =
-    object "ClientCapabilityListV7" $
+    object "ClientCapabilityListV6Wrapper" $
       Versioned
-        <$> unVersioned .= field "capabilities" (capabilitiesSchema (Just V7))
+        <$> unVersioned .= field "capabilities" (capabilitiesSchema (Just V6))
+
+instance ToSchema (Versioned V7 ClientCapabilityList) where
+  schema =
+    Versioned
+      <$> unVersioned .= capabilitiesSchema (Just V7)
 
 capabilitiesSchema ::
   Maybe Version ->
   ValueSchema NamedSwaggerDoc ClientCapabilityList
 capabilitiesSchema mVersion =
-  named "ClientCapabilityList" $
+  named (versionedName mVersion "ClientCapabilityList") $
     ClientCapabilityList
-      <$> (Set.toList . dropIncompatibleCapabilities . fromClientCapabilityList) .= (Set.fromList <$> array schema)
+      <$> (Set.toList . fromClientCapabilityList) .= (Set.fromList <$> listSchema)
   where
-    dropIncompatibleCapabilities :: Set ClientCapability -> Set ClientCapability
-    dropIncompatibleCapabilities caps =
+    listSchema :: ValueSchema SwaggerDoc [ClientCapability]
+    listSchema =
       case mVersion of
-        Just v | v <= V7 -> Set.delete ClientSupportsConsumableNotifications caps
-        _ -> caps
+        Just v
+          | v <= V7 ->
+              map clientCapabilityFromV7
+                <$> mapMaybe toCapabilityV7 .= array (capabilitySchemaV7)
+        _ -> array schema
+
+    toCapabilityV7 :: ClientCapability -> Maybe ClientCapabilityV7
+    toCapabilityV7 ClientSupportsConsumableNotifications = Nothing
+    toCapabilityV7 ClientSupportsLegalholdImplicitConsent = Just ClientSupportsLegalholdImplicitConsentV7
 
 --------------------------------------------------------------------------------
 -- UserClientMap
@@ -511,7 +534,7 @@ mlsPublicKeysSchema =
 
 clientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Client
 clientSchema mVersion =
-  object "Client" $
+  object (versionedName mVersion "Client") $
     Client
       <$> clientId .= field "id" schema
       <*> clientType .= field "type" schema
@@ -528,21 +551,32 @@ clientSchema mVersion =
     caps = case mVersion of
       -- broken capability serialisation for backwards compatibility
       Just v
-        | v <= V7 ->
+        | v <= V6 ->
+            dimap Versioned unVersioned $ schema @(Versioned V6 ClientCapabilityList)
+        | v == V7 ->
             dimap Versioned unVersioned $ schema @(Versioned V7 ClientCapabilityList)
       _ -> schema @ClientCapabilityList
 
 instance ToSchema Client where
   schema = clientSchema Nothing
 
+instance ToSchema (Versioned 'V6 Client) where
+  schema = Versioned <$> unVersioned .= clientSchema (Just V6)
+
 instance ToSchema (Versioned 'V7 Client) where
   schema = Versioned <$> unVersioned .= clientSchema (Just V7)
 
+instance {-# OVERLAPPING #-} ToSchema (Versioned 'V6 [Client]) where
+  schema =
+    Versioned
+      <$> unVersioned
+        .= named "ClientListV6" (array (clientSchema (Just V6)))
+
 instance {-# OVERLAPPING #-} ToSchema (Versioned 'V7 [Client]) where
   schema =
     Versioned
       <$> unVersioned
-        .= named "ClientList" (array (clientSchema (Just V7)))
+        .= named "ClientListV7" (array (clientSchema (Just V7)))
 
 mlsPublicKeysFieldSchema :: ObjectSchema SwaggerDoc MLSPublicKeys
 mlsPublicKeysFieldSchema = fromMaybe mempty <$> optField "mls_public_keys" mlsPublicKeysSchema
@@ -754,6 +788,9 @@ newClientSchema mVersion =
 instance ToSchema NewClient where
   schema = newClientSchema Nothing
 
+instance ToSchema (Versioned 'V6 NewClient) where
+  schema = Versioned <$> unVersioned .= newClientSchema (Just V6)
+
 instance ToSchema (Versioned 'V7 NewClient) where
   schema = Versioned <$> unVersioned .= newClientSchema (Just V7)
 
@@ -835,6 +872,9 @@ updateClientSchema mVersion =
 instance ToSchema UpdateClient where
   schema = updateClientSchema Nothing
 
+instance ToSchema (Versioned 'V6 UpdateClient) where
+  schema = Versioned <$> unVersioned .= updateClientSchema (Just V6)
+
 instance ToSchema (Versioned 'V7 UpdateClient) where
   schema = Versioned <$> unVersioned .= updateClientSchema (Just V7)