Introduce API v5

changelog.d/1-api-changes/introduce-v5

@@ -0,0 +1 @@
+Introduce v5 development version

docs/src/developer/developer/api-versioning.md

@@ -110,8 +110,7 @@ are several steps to make apart from deciding what endpoint changes are part of
 the version:
 
  - In `wire-api` extend the `Version` type with a new version by appending the
-   new version to the end, e.g., by adding `V4`. Make sure to update its
-   `ToSchema` instance,
+   new version to the end, e.g., by adding `V4`.
  - In the same `Version` module update the `developmentVersions` value to list
    only the new version,
  - Consider updating the `backendApiVersion` value in Stern, which is

integration/test/Test/Brig.hs

@@ -139,7 +139,7 @@ testCrudOAuthClient = do
 testSwagger :: HasCallStack => App ()
 testSwagger = do
   let existingVersions :: [Int]
-      existingVersions = [0, 1, 2, 3, 4]
+      existingVersions = [0, 1, 2, 3, 4, 5]
 
       internalApis :: [String]
       internalApis = ["brig", "cannon", "cargohold", "cannon", "spar"]

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

@@ -68,6 +68,7 @@ import Servant
 import Servant.Swagger
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named (Named)
+import Wire.API.Routes.Version
 
 -- | Runtime representation of a statically-known error.
 data DynError = DynError
@@ -167,6 +168,10 @@ instance RoutesToPaths api => RoutesToPaths (CanThrow err :> api) where
 instance RoutesToPaths api => RoutesToPaths (CanThrowMany errs :> api) where
   getRoutes = getRoutes @api
 
+type instance
+  SpecialiseToVersion v (CanThrow e :> api) =
+    CanThrow e :> SpecialiseToVersion v api
+
 instance (HasServer api ctx) => HasServer (CanThrow e :> api) ctx where
   type ServerT (CanThrow e :> api) m = ServerT api m
 
@@ -185,6 +190,10 @@ instance
   where
   toSwagger _ = addToSwagger @e (toSwagger (Proxy @api))
 
+type instance
+  SpecialiseToVersion v (CanThrowMany es :> api) =
+    CanThrowMany es :> SpecialiseToVersion v api
+
 instance HasSwagger api => HasSwagger (CanThrowMany '() :> api) where
   toSwagger _ = toSwagger (Proxy @api)
 

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

@@ -48,6 +48,7 @@ import Servant.Swagger
 import Test.QuickCheck (Arbitrary)
 import TransitiveAnns.Types
 import Unsafe.Coerce (unsafeCoerce)
+import Wire.API.Routes.Version
 import Wire.Arbitrary (GenericUniform (..))
 
 -- | This function exists only to provide a convenient place for the
@@ -151,6 +152,10 @@ type family ShowComponent (x :: Component) = (res :: Symbol) | res -> x where
   ShowComponent 'Galley = "galley"
   ShowComponent 'Cargohold = "cargohold"
 
+type instance
+  SpecialiseToVersion v (MakesFederatedCall comp name :> api) =
+    MakesFederatedCall comp name :> SpecialiseToVersion v api
+
 -- | 'MakesFederatedCall' annotates the swagger documentation with an extension
 -- tag @x-wire-makes-federated-calls-to@.
 instance (HasSwagger api, KnownSymbol name, KnownSymbol (ShowComponent comp)) => HasSwagger (MakesFederatedCall comp name :> api :: Type) where

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

@@ -16,7 +16,8 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Wire.API.Routes.API
-  ( API,
+  ( ServiceAPI (..),
+    API,
     hoistAPIHandler,
     hoistAPI,
     mkAPI,
@@ -29,14 +30,28 @@ module Wire.API.Routes.API
 where
 
 import Data.Domain
+import Data.Kind
 import Data.Proxy
+import Data.Swagger qualified as S
 import Imports
 import Polysemy
 import Polysemy.Error
 import Polysemy.Internal
 import Servant hiding (Union)
+import Servant.Swagger
 import Wire.API.Error
 import Wire.API.Routes.Named
+import Wire.API.Routes.Version
+
+class ServiceAPI service (v :: Version) where
+  type ServiceAPIRoutes service
+  type SpecialisedAPIRoutes v service :: Type
+  type SpecialisedAPIRoutes v service = SpecialiseToVersion v (ServiceAPIRoutes service)
+  serviceSwagger :: HasSwagger (SpecialisedAPIRoutes v service) => S.Swagger
+  serviceSwagger = toSwagger (Proxy @(SpecialisedAPIRoutes v service))
+
+instance ServiceAPI VersionAPITag v where
+  type ServiceAPIRoutes VersionAPITag = VersionAPI
 
 -- | A Servant handler on a polysemy stack. This is used to help with type inference.
 newtype API api r = API {unAPI :: ServerT api (Sem r)}

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

@@ -26,6 +26,7 @@ import Data.Text.Encoding qualified as T
 import Imports
 import Servant
 import Servant.Swagger
+import Wire.API.Routes.Version
 
 newtype Bearer a = Bearer {unBearer :: a}
 
@@ -42,6 +43,10 @@ type BearerQueryParam =
     [Lenient, Description "Access token"]
     "access_token"
 
+type instance
+  SpecialiseToVersion v (Bearer a :> api) =
+    Bearer a :> SpecialiseToVersion v api
+
 instance HasSwagger api => HasSwagger (Bearer a :> api) where
   toSwagger _ =
     toSwagger (Proxy @api)

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

@@ -29,6 +29,7 @@ import Imports
 import Servant
 import Servant.Swagger
 import Web.Cookie (parseCookies)
+import Wire.API.Routes.Version
 
 data (:::) a b
 
@@ -58,6 +59,10 @@ newtype CookieTuple cs = CookieTuple {unCookieTuple :: NP I (CookieTypes cs)}
 
 type CookieMap = Map ByteString (NonEmpty ByteString)
 
+type instance
+  SpecialiseToVersion v (Cookies cs :> api) =
+    Cookies cs :> SpecialiseToVersion v api
+
 instance HasSwagger api => HasSwagger (Cookies cs :> api) where
   toSwagger _ = toSwagger (Proxy @api)
 

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

@@ -37,6 +37,7 @@ import Servant.Server hiding (respond)
 import Servant.Server.Internal
 import Servant.Swagger as S
 import Servant.Swagger.Internal as S
+import Wire.API.Routes.Version
 
 -- FUTUREWORK: make it possible to generate headers at runtime
 data LowLevelStream method status (headers :: [(Symbol, Symbol)]) desc ctype
@@ -84,6 +85,10 @@ instance
       status = statusFromNat (Proxy :: Proxy status)
       extraHeaders = renderHeaders @headers
 
+type instance
+  SpecialiseToVersion v (LowLevelStream m s h d t) =
+    LowLevelStream m s h d t
+
 instance
   (Accept ctype, KnownNat status, KnownSymbol desc, SwaggerMethod method) =>
   HasSwagger (LowLevelStream method status headers desc ctype)

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

@@ -55,6 +55,7 @@ import Servant.Server.Internal.DelayedIO
 import Servant.Server.Internal.Router (Router)
 import Servant.Swagger (HasSwagger (toSwagger))
 import Wire.API.OAuth qualified as OAuth
+import Wire.API.Routes.Version
 
 mapRequestArgument ::
   forall mods a b.
@@ -196,20 +197,29 @@ type ZOptHostHeader =
 instance HasSwagger api => HasSwagger (ZHostOpt :> api) where
   toSwagger _ = toSwagger (Proxy @api)
 
+type instance SpecialiseToVersion v (ZHostOpt :> api) = ZHostOpt :> SpecialiseToVersion v api
+
+addZAuthSwagger :: Swagger -> Swagger
+addZAuthSwagger s =
+  s
+    & securityDefinitions <>~ SecurityDefinitions (InsOrdHashMap.singleton "ZAuth" secScheme)
+    & security <>~ [SecurityRequirement $ InsOrdHashMap.singleton "ZAuth" []]
+  where
+    secScheme =
+      SecurityScheme
+        { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader),
+          _securitySchemeDescription = Just "Must be a token retrieved by calling 'POST /login' or 'POST /access'. It must be presented in this format: 'Bearer \\<token\\>'."
+        }
+
+type instance
+  SpecialiseToVersion v (ZAuthServant t opts :> api) =
+    ZAuthServant t opts :> SpecialiseToVersion v api
+
 instance HasSwagger api => HasSwagger (ZAuthServant 'ZAuthUser _opts :> api) where
-  toSwagger _ =
-    toSwagger (Proxy @api)
-      & securityDefinitions <>~ SecurityDefinitions (InsOrdHashMap.singleton "ZAuth" secScheme)
-      & security <>~ [SecurityRequirement $ InsOrdHashMap.singleton "ZAuth" []]
-    where
-      secScheme =
-        SecurityScheme
-          { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader),
-            _securitySchemeDescription = Just "Must be a token retrieved by calling 'POST /login' or 'POST /access'. It must be presented in this format: 'Bearer \\<token\\>'."
-          }
+  toSwagger _ = addZAuthSwagger (toSwagger (Proxy @api))
 
 instance HasSwagger api => HasSwagger (ZAuthServant 'ZLocalAuthUser opts :> api) where
-  toSwagger _ = toSwagger (Proxy @(ZAuthServant 'ZAuthUser opts :> api))
+  toSwagger _ = addZAuthSwagger (toSwagger (Proxy @api))
 
 instance HasLink endpoint => HasLink (ZAuthServant usr opts :> endpoint) where
   type MkLink (ZAuthServant _ _ :> endpoint) a = MkLink endpoint a
@@ -286,11 +296,18 @@ instance ToSchema a => ToSchema (Headers ls a) where
 
 data DescriptionOAuthScope (scope :: OAuth.OAuthScope)
 
-instance (HasSwagger api, OAuth.IsOAuthScope scope) => HasSwagger (DescriptionOAuthScope scope :> api) where
-  toSwagger _ = toSwagger (Proxy @api) & addScopeDescription
-    where
-      addScopeDescription :: Swagger -> Swagger
-      addScopeDescription = allOperations . description %~ Just . (<> "\nOAuth scope: `" <> cs (toByteString (OAuth.toOAuthScope @scope)) <> "`") . fold
+type instance
+  SpecialiseToVersion v (DescriptionOAuthScope scope :> api) =
+    DescriptionOAuthScope scope :> SpecialiseToVersion v api
+
+instance
+  (HasSwagger api, OAuth.IsOAuthScope scope) =>
+  HasSwagger (DescriptionOAuthScope scope :> api)
+  where
+  toSwagger _ = addScopeDescription @scope (toSwagger (Proxy @api))
+
+addScopeDescription :: forall scope. OAuth.IsOAuthScope scope => Swagger -> Swagger
+addScopeDescription = allOperations . description %~ Just . (<> "\nOAuth scope: `" <> cs (toByteString (OAuth.toOAuthScope @scope)) <> "`") . fold
 
 instance (HasServer api ctx) => HasServer (DescriptionOAuthScope scope :> api) ctx where
   type ServerT (DescriptionOAuthScope scope :> api) m = ServerT api m

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

@@ -39,7 +39,6 @@ import Imports hiding (head)
 import Network.Wai.Utilities
 import Servant (JSON)
 import Servant hiding (Handler, JSON, addHeader, respond)
-import Servant.Swagger (HasSwagger (toSwagger))
 import Servant.Swagger.Internal.Orphans ()
 import Wire.API.Call.Config (RTCConfiguration)
 import Wire.API.Connection hiding (MissingLegalholdConsent)
@@ -51,6 +50,7 @@ import Wire.API.MLS.Servant
 import Wire.API.MakesFederatedCall
 import Wire.API.OAuth
 import Wire.API.Properties
+import Wire.API.Routes.API
 import Wire.API.Routes.Bearer
 import Wire.API.Routes.Cookies
 import Wire.API.Routes.MultiVerb
@@ -93,8 +93,10 @@ type BrigAPI =
     :<|> SystemSettingsAPI
     :<|> OAuthAPI
 
-brigSwagger :: Swagger
-brigSwagger = toSwagger (Proxy @BrigAPI)
+data BrigAPITag
+
+instance ServiceAPI BrigAPITag v where
+  type ServiceAPIRoutes BrigAPITag = BrigAPI
 
 -------------------------------------------------------------------------------
 -- User API

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

@@ -19,14 +19,13 @@ module Wire.API.Routes.Public.Brig.OAuth where
 
 import Data.Id as Id
 import Data.SOP
-import Data.Swagger (Swagger)
 import Imports hiding (exp, head)
 import Servant (JSON)
 import Servant hiding (Handler, JSON, Tagged, addHeader, respond)
-import Servant.Swagger
 import Servant.Swagger.Internal.Orphans ()
 import Wire.API.Error
 import Wire.API.OAuth
+import Wire.API.Routes.API
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named (Named (..))
 import Wire.API.Routes.Public
@@ -156,5 +155,7 @@ instance AsUnion CreateOAuthAuthorizationCodeResponses CreateOAuthCodeResponse w
   fromUnion (S (S (S (S (Z (I _)))))) = CreateOAuthCodeRedirectUrlMissMatch
   fromUnion (S (S (S (S (S x))))) = case x of {}
 
-swaggerDoc :: Swagger
-swaggerDoc = toSwagger (Proxy @OAuthAPI)
+data OAuthAPITag
+
+instance ServiceAPI OAuthAPITag v where
+  type ServiceAPIRoutes OAuthAPITag = OAuthAPI

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

@@ -18,14 +18,13 @@
 module Wire.API.Routes.Public.Cannon where
 
 import Data.Id
-import Data.Swagger
 import Servant
-import Servant.Swagger
+import Wire.API.Routes.API
 import Wire.API.Routes.Named
 import Wire.API.Routes.Public (ZConn, ZUser)
 import Wire.API.Routes.WebSocket
 
-type PublicAPI =
+type CannonAPI =
   Named
     "await-notifications"
     ( Summary "Establish websocket connection"
@@ -43,5 +42,7 @@ type PublicAPI =
         :> WebSocketPending
     )
 
-swaggerDoc :: Swagger
-swaggerDoc = toSwagger (Proxy @PublicAPI)
+data CannonAPITag
+
+instance ServiceAPI CannonAPITag v where
+  type ServiceAPIRoutes CannonAPITag = CannonAPI

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

@@ -22,16 +22,15 @@ import Data.Kind
 import Data.Metrics.Servant
 import Data.Qualified
 import Data.SOP
-import Data.Swagger qualified as Swagger
 import Imports
 import Servant
-import Servant.Swagger.Internal
 import Servant.Swagger.Internal.Orphans ()
 import URI.ByteString
 import Wire.API.Asset
 import Wire.API.Error
 import Wire.API.Error.Cargohold
 import Wire.API.MakesFederatedCall
+import Wire.API.Routes.API
 import Wire.API.Routes.AssetBody
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Public
@@ -56,8 +55,9 @@ type instance ApplyPrincipalPath 'BotPrincipalTag api = ZBot :> "bot" :> "assets
 
 type instance ApplyPrincipalPath 'ProviderPrincipalTag api = ZProvider :> "provider" :> "assets" :> api
 
-instance HasSwagger (ApplyPrincipalPath tag api) => HasSwagger (tag :> api) where
-  toSwagger _ = toSwagger (Proxy @(ApplyPrincipalPath tag api))
+type instance
+  SpecialiseToVersion v ((tag :: PrincipalTag) :> api) =
+    SpecialiseToVersion v (ApplyPrincipalPath tag api)
 
 instance HasServer (ApplyPrincipalPath tag api) ctx => HasServer (tag :> api) ctx where
   type ServerT (tag :> api) m = ServerT (ApplyPrincipalPath tag api) m
@@ -90,7 +90,7 @@ type GetAsset =
     '[ErrorResponse 'AssetNotFound, AssetRedirect]
     (Maybe (AssetLocation Absolute))
 
-type ServantAPI =
+type CargoholdAPI =
   ( Summary "Renew an asset token"
       :> Until 'V2
       :> CanThrow 'AssetNotFound
@@ -315,5 +315,7 @@ type MainAPI =
                   ()
          )
 
-swaggerDoc :: Swagger.Swagger
-swaggerDoc = toSwagger (Proxy @ServantAPI)
+data CargoholdAPITag
+
+instance ServiceAPI CargoholdAPITag v where
+  type ServiceAPIRoutes CargoholdAPITag = CargoholdAPI