[WPB-15206] Unit test that compares generated swagger files against frozen ones.

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

@@ -30,6 +30,7 @@ module Wire.API.Routes.Version
 
     -- * Version
     Version (..),
+    KnownVersion (versionVal),
     versionInt,
     versionText,
     versionedName,
@@ -86,6 +87,27 @@ data Version = V0 | V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8
   deriving (FromJSON, ToJSON) via (Schema Version)
   deriving (Arbitrary) via (GenericUniform Version)
 
+class KnownVersion (v :: Version) where
+  versionVal :: Version
+
+instance KnownVersion V0 where versionVal = V0
+
+instance KnownVersion V1 where versionVal = V1
+
+instance KnownVersion V2 where versionVal = V2
+
+instance KnownVersion V3 where versionVal = V3
+
+instance KnownVersion V4 where versionVal = V4
+
+instance KnownVersion V5 where versionVal = V5
+
+instance KnownVersion V6 where versionVal = V6
+
+instance KnownVersion V7 where versionVal = V7
+
+instance KnownVersion V8 where versionVal = V8
+
 -- | Manual enumeration of version integrals (the `<n>` in the constructor `V<n>`).
 --
 -- This is not the same as 'fromEnum': we will remove unsupported versions in the future,

services/brig/brig.cabal

@@ -507,11 +507,14 @@ test-suite brig-tests
     Test.Brig.Effects.Delay
     Test.Brig.InternalNotification
     Test.Brig.MLS
+    Test.Brig.OpenAPI
 
   hs-source-dirs: test/unit
   ghc-options:    -funbox-strict-fields -threaded -with-rtsopts=-N
   build-depends:
     , aeson
+    , aeson-diff
+    , aeson-pretty
     , base
     , binary
     , brig
@@ -522,11 +525,15 @@ test-suite brig-tests
     , dns
     , dns-util
     , exceptions
-    , HsOpenSSL          >=0.10
+    , file-embed
+    , HsOpenSSL           >=0.10
+    , http-api-data
     , imports
     , lens
+    , lens-aeson
     , polysemy
     , polysemy-wire-zoo
+    , string-conversions
     , tasty
     , tasty-hunit
     , tasty-quickcheck

services/brig/default.nix

@@ -4,6 +4,8 @@
 # dependencies are added or removed.
 { mkDerivation
 , aeson
+, aeson-diff
+, aeson-pretty
 , amazonka
 , amazonka-core
 , amazonka-dynamodb
@@ -376,6 +378,8 @@ mkDerivation {
   ];
   testHaskellDepends = [
     aeson
+    aeson-diff
+    aeson-pretty
     base
     binary
     brig-types
@@ -385,11 +389,15 @@ mkDerivation {
     dns
     dns-util
     exceptions
+    file-embed
     HsOpenSSL
+    http-api-data
     imports
     lens
+    lens-aeson
     polysemy
     polysemy-wire-zoo
+    string-conversions
     tasty
     tasty-hunit
     tasty-quickcheck

services/brig/src/Brig/API/Public.hs

@@ -57,7 +57,6 @@ import Brig.User.Auth.Cookie qualified as Auth
 import Cassandra qualified as C
 import Cassandra qualified as Data
 import Control.Error hiding (bool, note)
-import Control.Lens ((.~), (?~))
 import Control.Monad.Catch (throwM)
 import Control.Monad.Except
 import Data.Aeson hiding (json)
@@ -67,7 +66,6 @@ import Data.Code qualified as Code
 import Data.CommaSeparatedList
 import Data.Default
 import Data.Domain
-import Data.FileEmbed
 import Data.Handle (Handle)
 import Data.Handle qualified as Handle
 import Data.HavePendingInvitations
@@ -83,7 +81,6 @@ import Data.Schema ()
 import Data.Text.Encoding qualified as Text
 import Data.Time.Clock
 import Data.ZAuth.Token qualified as ZAuth
-import FileEmbedLzma
 import Imports hiding (head)
 import Network.Socket (PortNumber)
 import Network.Wai.Utilities (CacheControl (..), (!>>))
@@ -107,7 +104,6 @@ import Wire.API.Federation.API.Galley qualified as GalleyFederationAPI
 import Wire.API.Federation.Error
 import Wire.API.Federation.Version qualified as Fed
 import Wire.API.Properties qualified as Public
-import Wire.API.Routes.API
 import Wire.API.Routes.Internal.Brig qualified as BrigInternalAPI
 import Wire.API.Routes.Internal.Cannon qualified as CannonInternalAPI
 import Wire.API.Routes.Internal.Cargohold qualified as CargoholdInternalAPI
@@ -117,13 +113,6 @@ import Wire.API.Routes.Internal.Spar qualified as SparInternalAPI
 import Wire.API.Routes.MultiTablePaging qualified as Public
 import Wire.API.Routes.Named (Named (Named))
 import Wire.API.Routes.Public.Brig
-import Wire.API.Routes.Public.Brig.OAuth
-import Wire.API.Routes.Public.Cannon
-import Wire.API.Routes.Public.Cargohold
-import Wire.API.Routes.Public.Galley
-import Wire.API.Routes.Public.Gundeck
-import Wire.API.Routes.Public.Proxy
-import Wire.API.Routes.Public.Spar
 import Wire.API.Routes.Public.Util
 import Wire.API.Routes.Version
 import Wire.API.SwaggerHelper (cleanupSwagger)
@@ -208,22 +197,7 @@ internalEndpointsSwaggerDocsAPIs =
 --
 -- Dual to `internalEndpointsSwaggerDocsAPI`.
 versionedSwaggerDocsAPI :: Servant.Server VersionedSwaggerDocsAPI
-versionedSwaggerDocsAPI (Just (VersionNumber V8)) =
-  swaggerSchemaUIServer $
-    ( serviceSwagger @VersionAPITag @'V8
-        <> serviceSwagger @BrigAPITag @'V8
-        <> serviceSwagger @GalleyAPITag @'V8
-        <> serviceSwagger @SparAPITag @'V8
-        <> serviceSwagger @CargoholdAPITag @'V8
-        <> serviceSwagger @CannonAPITag @'V8
-        <> serviceSwagger @GundeckAPITag @'V8
-        <> serviceSwagger @ProxyAPITag @'V8
-        <> serviceSwagger @OAuthAPITag @'V8
-    )
-      & S.info . S.title .~ "Wire-Server API"
-      & S.info . S.description ?~ $(embedText =<< makeRelativeToProject "docs/swagger.md")
-      & S.servers .~ [S.Server ("/" <> toUrlPiece V8) Nothing mempty]
-      & cleanupSwagger
+versionedSwaggerDocsAPI (Just (VersionNumber V8)) = swaggerSchemaUIServer (genSwagger @V8)
 versionedSwaggerDocsAPI (Just (VersionNumber V7)) = swaggerPregenUIServer $(pregenSwagger V7)
 versionedSwaggerDocsAPI (Just (VersionNumber V6)) = swaggerPregenUIServer $(pregenSwagger V6)
 versionedSwaggerDocsAPI (Just (VersionNumber V5)) = swaggerPregenUIServer $(pregenSwagger V5)

services/brig/src/Brig/API/Public/Swagger.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 module Brig.API.Public.Swagger
   ( VersionedSwaggerDocsAPI,
     InternalEndpointsSwaggerDocsAPI,
@@ -6,6 +8,8 @@ module Brig.API.Public.Swagger
     ServiceSwaggerDocsAPIBase,
     DocsAPI,
     FederationSwaggerDocsAPI,
+    genSwagger,
+    HasAllOpenAPIs,
     pregenSwagger,
     swaggerPregenUIServer,
     eventNotificationSchemas,
@@ -30,12 +34,23 @@ import Imports hiding (head)
 import Language.Haskell.TH
 import Network.Socket
 import Servant
+import Servant.OpenApi
 import Servant.OpenApi.Internal.Orphans ()
 import Servant.Swagger.UI
 import Wire.API.Event.Conversation qualified
 import Wire.API.Event.FeatureConfig qualified
 import Wire.API.Event.Team qualified
+import Wire.API.Routes.API
+import Wire.API.Routes.Public.Brig (BrigAPITag)
+import Wire.API.Routes.Public.Brig.OAuth (OAuthAPITag)
+import Wire.API.Routes.Public.Cannon (CannonAPITag)
+import Wire.API.Routes.Public.Cargohold (CargoholdAPITag)
+import Wire.API.Routes.Public.Galley (GalleyAPITag)
+import Wire.API.Routes.Public.Gundeck (GundeckAPITag)
+import Wire.API.Routes.Public.Proxy (ProxyAPITag)
+import Wire.API.Routes.Public.Spar (SparAPITag)
 import Wire.API.Routes.Version
+import Wire.API.SwaggerHelper
 
 type SwaggerDocsAPIBase = SwaggerSchemaUI "swagger-ui" "swagger.json"
 
@@ -73,6 +88,35 @@ type DocsAPI =
     :<|> InternalEndpointsSwaggerDocsAPI
     :<|> FederationSwaggerDocsAPI
 
+type HasAllOpenAPIs (v :: Version) =
+  ( HasOpenApi (SpecialisedAPIRoutes v VersionAPITag),
+    HasOpenApi (SpecialisedAPIRoutes v BrigAPITag),
+    HasOpenApi (SpecialisedAPIRoutes v GalleyAPITag),
+    HasOpenApi (SpecialisedAPIRoutes v SparAPITag),
+    HasOpenApi (SpecialisedAPIRoutes v CargoholdAPITag),
+    HasOpenApi (SpecialisedAPIRoutes v CannonAPITag),
+    HasOpenApi (SpecialisedAPIRoutes v GundeckAPITag),
+    HasOpenApi (SpecialisedAPIRoutes v ProxyAPITag),
+    HasOpenApi (SpecialisedAPIRoutes v OAuthAPITag)
+  )
+
+genSwagger :: forall (v :: Version). (KnownVersion v, HasAllOpenAPIs v) => S.OpenApi
+genSwagger =
+  ( serviceSwagger @VersionAPITag @v
+      <> serviceSwagger @BrigAPITag @v
+      <> serviceSwagger @GalleyAPITag @v
+      <> serviceSwagger @SparAPITag @v
+      <> serviceSwagger @CargoholdAPITag @v
+      <> serviceSwagger @CannonAPITag @v
+      <> serviceSwagger @GundeckAPITag @v
+      <> serviceSwagger @ProxyAPITag @v
+      <> serviceSwagger @OAuthAPITag @v
+  )
+    & S.info . S.title .~ "Wire-Server API"
+    & S.info . S.description ?~ $(embedText =<< makeRelativeToProject "docs/swagger.md")
+    & S.servers .~ [S.Server ("/" <> toUrlPiece (versionVal @v)) Nothing mempty]
+    & cleanupSwagger
+
 pregenSwagger :: Version -> Q Exp
 pregenSwagger v =
   embedLazyByteString

services/brig/test/unit/Run.hs

@@ -25,6 +25,7 @@ import Test.Brig.Calling qualified
 import Test.Brig.Calling.Internal qualified
 import Test.Brig.InternalNotification qualified
 import Test.Brig.MLS qualified
+import Test.Brig.OpenAPI
 import Test.Tasty
 
 main :: IO ()
@@ -35,5 +36,6 @@ main =
       [ Test.Brig.Calling.tests,
         Test.Brig.Calling.Internal.tests,
         Test.Brig.MLS.tests,
-        Test.Brig.InternalNotification.tests
+        Test.Brig.InternalNotification.tests,
+        Test.Brig.OpenAPI.tests
       ]

services/brig/test/unit/Test/Brig/OpenAPI.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2025 Wire Swiss GmbH <[email protected]>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module Test.Brig.OpenAPI where
+
+import Brig.API.Public.Swagger
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.Diff qualified as AD
+import Data.Aeson.Encode.Pretty
+import Data.Aeson.Lens
+import Data.String.Conversions (cs)
+import Imports
+import Test.Tasty qualified as T
+import Test.Tasty.HUnit
+import Wire.API.Routes.Version
+
+tests :: T.TestTree
+tests =
+  T.testGroup "OpenAPI3 aka Swagger" $
+    [ T.testGroup "frozen api versions" [testCase "must be stable" frozenApiVersions]
+    ]
+
+frozenApiVersions :: Assertion
+frozenApiVersions = do
+  filter (not . isDevelopmentVersion) [minBound ..] @=? [V0 .. V7]
+  -- if not, change the expected value and add more cases in `frozenApiVersions` below and in
+  -- `frozenSpec`
+
+  frozenApiVersion @V7
+  frozenApiVersion @V6
+  frozenApiVersion @V5
+  frozenApiVersion @V4
+  frozenApiVersion @V3
+  frozenApiVersion @V2
+  frozenApiVersion @V1
+  frozenApiVersion @V0
+
+frozenSpec :: Version -> LByteString
+frozenSpec V0 = $(pregenSwagger V0)
+frozenSpec V1 = $(pregenSwagger V1)
+frozenSpec V2 = $(pregenSwagger V2)
+frozenSpec V3 = $(pregenSwagger V3)
+frozenSpec V4 = $(pregenSwagger V4)
+frozenSpec V5 = $(pregenSwagger V5)
+frozenSpec V6 = $(pregenSwagger V6)
+frozenSpec V7 = $(pregenSwagger V7)
+
+frozenApiVersion :: forall (v :: Version). (KnownVersion v, HasAllOpenAPIs v) => Assertion
+frozenApiVersion = do
+  let frozen = parseSpec $ frozenSpec (versionVal @v)
+      generated = toJSON $ genSwagger @v
+  frozen `shouldMatchJSON` generated
+
+parseSpec :: LByteString -> Value
+parseSpec = either error id . eitherDecode'
+
+-- | Inspired by the  `shouldMatchWithMsg` from /integration.
+shouldMatchJSON :: Value -> Value -> Assertion
+shouldMatchJSON a b = do
+  unless (a == b) do
+    let pa = encodePretty a
+        pb = encodePretty b
+
+        -- show diff, but only in the interesting cases.
+        diff =
+          if isObj || isArr
+            then "\nDiff:\n" <> encodePretty (AD.diff a b)
+            else ""
+          where
+            isObj = isJust (a ^? _Object) && isJust (b ^? _Object)
+            isArr = isJust (a ^? _Array) && isJust (b ^? _Array)
+
+    assertFailure . cs $ "\n*** JSON values do not coincide.\n" <> "Actual:\n" <> pa <> "\nExpected:\n" <> pb <> diff