Serialisation of client capabilities (take 2)

changelog.d/0-release-notes/client-internal-api

@@ -0,0 +1 @@
+The "addClient" internal endpoint of galley has been changed. This can cause temporary failures during upgrades if brig attempts to use this endpoint on a different version of galley.

changelog.d/1-api-changes/client-capabilities

@@ -0,0 +1 @@
+Create version 6 of client-related endpoints, fixing an oddity in the serialisation of capabilities.

integration/test/Test/Notifications.hs

@@ -1,9 +1,11 @@
 {-# OPTIONS -Wno-ambiguous-fields #-}
 module Test.Notifications where
 
+import API.Brig
 import API.Common
 import API.Gundeck
 import API.GundeckInternal
+import Notifications
 import SetupHelpers
 import Testlib.Prelude
 
@@ -89,3 +91,20 @@ testInvalidNotification = do
     void $
       getNotifications user def {since = Just notifId}
         >>= getJSON 404
+
+-- | Check that client-add notifications use the V5 format:
+-- @
+--   "capabilities": { "capabilities": [..] }
+-- @
+--
+-- Migration plan: clients must be able to parse both old and new schema starting from V6.  Once V5 is deprecated, the backend can start sending notifications in the new form.
+testAddClientNotification :: HasCallStack => App ()
+testAddClientNotification = do
+  alice <- randomUser OwnDomain def
+
+  e <- withWebSocket alice $ \ws -> do
+    void $ addClient alice def
+    n <- awaitMatch isUserClientAddNotif ws
+    nPayload n
+
+  void $ e %. "client.capabilities.capabilities" & asList

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

@@ -65,6 +65,7 @@ import Wire.API.Routes.Public.Brig.Services (ServicesAPI)
 import Wire.API.Routes.Public.Util
 import Wire.API.Routes.QualifiedCapture
 import Wire.API.Routes.Version
+import Wire.API.Routes.Versioned
 import Wire.API.SystemSettings
 import Wire.API.Team.Invitation
 import Wire.API.Team.Size
@@ -126,8 +127,6 @@ type QualifiedCaptureUserId name = QualifiedCapture' '[Description "User Id"] na
 
 type CaptureClientId name = Capture' '[Description "ClientId"] name ClientId
 
-type NewClientResponse = Headers '[Header "Location" ClientId] Client
-
 type DeleteSelfResponses =
   '[ RespondEmpty 200 "Deletion is initiated.",
      RespondWithDeletionCodeTimeout
@@ -730,15 +729,18 @@ type PrekeyAPI =
                :> Post '[JSON] QualifiedUserClientPrekeyMapV4
            )
 
-type UserClientAPI =
-  -- User Client API ----------------------------------------------------
+-- User Client API ----------------------------------------------------
+
+type ClientHeaders = '[DescHeader "Location" "Client ID" ClientId]
 
+type UserClientAPI =
   -- This endpoint can lead to the following events being sent:
   -- - ClientAdded event to self
   -- - ClientRemoved event to self, if removing old clients due to max number
   Named
-    "add-client"
+    "add-client-v5"
     ( Summary "Register a new client"
+        :> Until 'V6
         :> MakesFederatedCall 'Brig "send-connection-action"
         :> CanThrow 'TooManyClients
         :> CanThrow 'MissingAuth
@@ -749,8 +751,38 @@ type UserClientAPI =
         :> ZConn
         :> "clients"
         :> ReqBody '[JSON] NewClient
-        :> Verb 'POST 201 '[JSON] NewClientResponse
+        :> MultiVerb1
+             'POST
+             '[JSON]
+             ( WithHeaders
+                 ClientHeaders
+                 Client
+                 (VersionedRespond 'V5 201 "Client registered" Client)
+             )
     )
+    :<|> Named
+           "add-client"
+           ( Summary "Register a new client"
+               :> From 'V6
+               :> MakesFederatedCall 'Brig "send-connection-action"
+               :> CanThrow 'TooManyClients
+               :> CanThrow 'MissingAuth
+               :> CanThrow 'MalformedPrekeys
+               :> CanThrow 'CodeAuthenticationFailed
+               :> CanThrow 'CodeAuthenticationRequired
+               :> ZUser
+               :> ZConn
+               :> "clients"
+               :> ReqBody '[JSON] NewClient
+               :> MultiVerb1
+                    'POST
+                    '[JSON]
+                    ( WithHeaders
+                        ClientHeaders
+                        Client
+                        (Respond 201 "Client registered" Client)
+                    )
+           )
     :<|> Named
            "update-client"
            ( Summary "Update a registered client"
@@ -774,16 +806,49 @@ type UserClientAPI =
           :> ReqBody '[JSON] RmClient
           :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 200 "Client deleted"] ()
       )
+    :<|> Named
+           "list-clients-v5"
+           ( Summary "List the registered clients"
+               :> Until 'V6
+               :> ZUser
+               :> "clients"
+               :> MultiVerb1
+                    'GET
+                    '[JSON]
+                    ( VersionedRespond 'V5 200 "List of clients" [Client]
+                    )
+           )
     :<|> Named
            "list-clients"
            ( Summary "List the registered clients"
+               :> From 'V6
+               :> ZUser
+               :> "clients"
+               :> MultiVerb1
+                    'GET
+                    '[JSON]
+                    ( Respond 200 "List of clients" [Client]
+                    )
+           )
+    :<|> Named
+           "get-client-v5"
+           ( Summary "Get a registered client by ID"
+               :> Until 'V6
                :> ZUser
                :> "clients"
-               :> Get '[JSON] [Client]
+               :> CaptureClientId "client"
+               :> MultiVerb
+                    'GET
+                    '[JSON]
+                    '[ EmptyErrorForLegacyReasons 404 "Client not found",
+                       VersionedRespond 'V5 200 "Client found" Client
+                     ]
+                    (Maybe Client)
            )
     :<|> Named
            "get-client"
            ( Summary "Get a registered client by ID"
+               :> From 'V6
                :> ZUser
                :> "clients"
                :> CaptureClientId "client"

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

@@ -30,6 +30,8 @@ import Wire.API.Provider.Bot (BotUserView)
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named (Named)
 import Wire.API.Routes.Public
+import Wire.API.Routes.Version
+import Wire.API.Routes.Versioned
 import Wire.API.User
 import Wire.API.User.Client
 import Wire.API.User.Client.Prekey (PrekeyId)
@@ -39,11 +41,6 @@ type DeleteResponses =
      Respond 200 "User found" RemoveBotResponse
    ]
 
-type GetClientResponses =
-  '[ ErrorResponse 'ClientNotFound,
-     Respond 200 "Client found" Client
-   ]
-
 type BotAPI =
   Named
     "add-bot"
@@ -116,15 +113,39 @@ type BotAPI =
                :> ReqBody '[JSON] UpdateBotPrekeys
                :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "")
            )
+    :<|> Named
+           "bot-get-client-v5"
+           ( Summary "Get client for bot"
+               :> Until 'V6
+               :> CanThrow 'AccessDenied
+               :> CanThrow 'ClientNotFound
+               :> ZBot
+               :> "bot"
+               :> "client"
+               :> MultiVerb
+                    'GET
+                    '[JSON]
+                    '[ ErrorResponse 'ClientNotFound,
+                       VersionedRespond 'V5 200 "Client found" Client
+                     ]
+                    (Maybe Client)
+           )
     :<|> Named
            "bot-get-client"
            ( Summary "Get client for bot"
+               :> From 'V6
                :> CanThrow 'AccessDenied
                :> CanThrow 'ClientNotFound
                :> ZBot
                :> "bot"
                :> "client"
-               :> MultiVerb 'GET '[JSON] GetClientResponses (Maybe Client)
+               :> MultiVerb
+                    'GET
+                    '[JSON]
+                    '[ ErrorResponse 'ClientNotFound,
+                       Respond 200 "Client found" Client
+                     ]
+                    (Maybe Client)
            )
     :<|> Named
            "bot-claim-users-prekeys"

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

@@ -46,6 +46,7 @@ module Wire.API.User.Client
 
     -- * Client
     Client (..),
+    clientSchema,
     PubClient (..),
     ClientType (..),
     ClientClass (..),
@@ -85,9 +86,11 @@ import Data.Misc (Latitude (..), Longitude (..), PlainTextPassword6)
 import Data.OpenApi hiding (Schema, ToSchema, nullable, schema)
 import Data.OpenApi qualified as Swagger hiding (nullable)
 import Data.Qualified
+import Data.SOP hiding (fn)
 import Data.Schema
 import Data.Set qualified as Set
-import Data.Text.Encoding qualified as Text.E
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
 import Data.Time.Clock
 import Data.UUID (toASCIIBytes)
 import Deriving.Swagger
@@ -98,6 +101,9 @@ import Deriving.Swagger
   )
 import Imports
 import Wire.API.MLS.CipherSuite
+import Wire.API.Routes.MultiVerb
+import Wire.API.Routes.Version
+import Wire.API.Routes.Versioned
 import Wire.API.User.Auth
 import Wire.API.User.Client.Prekey as Prekey
 import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..), generateExample, mapOf', setOf')
@@ -376,7 +382,7 @@ instance ToJSON UserClientsFull where
     toJSON . Map.foldrWithKey' fn Map.empty . userClientsFull
     where
       fn u c m =
-        let k = Text.E.decodeLatin1 (toASCIIBytes (toUUID u))
+        let k = T.decodeLatin1 (toASCIIBytes (toUUID u))
          in Map.insert k c m
 
 instance FromJSON UserClientsFull where
@@ -498,24 +504,46 @@ mlsPublicKeysSchema =
     mapSchema :: ValueSchema SwaggerDoc MLSPublicKeys
     mapSchema = map_ base64Schema
 
+clientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Client
+clientSchema mv =
+  object ("Client" <> T.pack (foldMap show mv)) $
+    Client
+      <$> clientId .= field "id" schema
+      <*> clientType .= field "type" schema
+      <*> clientTime .= field "time" schema
+      <*> clientClass .= maybe_ (optField "class" schema)
+      <*> clientLabel .= maybe_ (optField "label" schema)
+      <*> clientCookie .= maybe_ (optField "cookie" schema)
+      <*> clientModel .= maybe_ (optField "model" schema)
+      <*> clientCapabilities .= (fromMaybe mempty <$> caps)
+      <*> clientMLSPublicKeys .= mlsPublicKeysFieldSchema
+      <*> clientLastActive .= maybe_ (optField "last_active" utcTimeSchema)
+  where
+    caps :: ObjectSchemaP SwaggerDoc ClientCapabilityList (Maybe ClientCapabilityList)
+    caps = case mv of
+      -- broken capability serialisation for backwards compatibility
+      Just v | v <= V5 -> optField "capabilities" schema
+      _ -> fmap ClientCapabilityList <$> fromClientCapabilityList .= capabilitiesFieldSchema
+
 instance ToSchema Client where
+  schema = clientSchema Nothing
+
+instance ToSchema (Versioned 'V5 Client) where
+  schema = Versioned <$> unVersioned .= clientSchema (Just V5)
+
+instance {-# OVERLAPPING #-} ToSchema (Versioned 'V5 [Client]) where
   schema =
-    object "Client" $
-      Client
-        <$> clientId .= field "id" schema
-        <*> clientType .= field "type" schema
-        <*> clientTime .= field "time" schema
-        <*> clientClass .= maybe_ (optField "class" schema)
-        <*> clientLabel .= maybe_ (optField "label" schema)
-        <*> clientCookie .= maybe_ (optField "cookie" schema)
-        <*> clientModel .= maybe_ (optField "model" schema)
-        <*> clientCapabilities .= (fromMaybe mempty <$> optField "capabilities" schema)
-        <*> clientMLSPublicKeys .= mlsPublicKeysFieldSchema
-        <*> clientLastActive .= maybe_ (optField "last_active" utcTimeSchema)
+    Versioned
+      <$> unVersioned
+        .= named "ClientList" (array (clientSchema (Just V5)))
 
 mlsPublicKeysFieldSchema :: ObjectSchema SwaggerDoc MLSPublicKeys
 mlsPublicKeysFieldSchema = fromMaybe mempty <$> optField "mls_public_keys" mlsPublicKeysSchema
 
+instance AsHeaders '[ClientId] Client Client where
+  toHeaders c = (I (clientId c) :* Nil, c)
+  fromHeaders = snd
+
 --------------------------------------------------------------------------------
 -- ClientList
 

libs/wire-api/src/Wire/API/UserEvent.hs

@@ -33,6 +33,7 @@ import Imports
 import System.Logger.Message hiding (field, (.=))
 import Wire.API.Connection
 import Wire.API.Properties
+import Wire.API.Routes.Version
 import Wire.API.User
 import Wire.API.User.Client
 import Wire.API.User.Client.Prekey
@@ -380,7 +381,7 @@ eventObjectSchema =
               _ClientEvent
               ( tag
                   _ClientAdded
-                  (field "client" schema)
+                  (field "client" (clientSchema (Just V5)))
               )
           EventTypeClientRemoved ->
             tag