Fix swagger

changelog.d/4-docs/fix-swagger

@@ -0,0 +1 @@
+Fix: show openapi docs for blocked versions

libs/wire-api/default.nix

@@ -83,6 +83,7 @@
 , servant-client-core
 , servant-conduit
 , servant-multipart
+, servant-multipart-api
 , servant-openapi3
 , servant-server
 , singletons
@@ -188,6 +189,7 @@ mkDerivation {
     servant-client-core
     servant-conduit
     servant-multipart
+    servant-multipart-api
     servant-openapi3
     servant-server
     singletons

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

@@ -21,7 +21,9 @@ module Wire.API.Routes.SpecialiseToVersion where
 import Data.Singletons.Base.TH
 import GHC.TypeLits
 import Servant
+import Servant.API.Extended
 import Servant.API.Extended.RawM qualified as RawM
+import Servant.Multipart.API
 import Wire.API.Deprecated
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named
@@ -45,6 +47,10 @@ type instance
   SpecialiseToVersion v (Named n api) =
     Named n (SpecialiseToVersion v api)
 
+type instance
+  SpecialiseToVersion v (NoContentVerb m) =
+    NoContentVerb m
+
 type instance
   SpecialiseToVersion v (Capture' mod sym a :> api) =
     Capture' mod sym a :> SpecialiseToVersion v api
@@ -92,3 +98,11 @@ type instance SpecialiseToVersion v EmptyAPI = EmptyAPI
 type instance
   SpecialiseToVersion v (api1 :<|> api2) =
     SpecialiseToVersion v api1 :<|> SpecialiseToVersion v api2
+
+type instance
+  SpecialiseToVersion v (ReqBodyCustomError t l x :> api) =
+    ReqBodyCustomError t l x :> SpecialiseToVersion v api
+
+type instance
+  SpecialiseToVersion v (MultipartForm x b :> api) =
+    MultipartForm x b :> SpecialiseToVersion v api

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

@@ -44,8 +44,8 @@ module Wire.API.Routes.Version
     Until,
     From,
 
-    -- * Swagger instances
-    SpecialiseToVersion,
+    -- * Swagger
+    module Wire.API.Routes.SpecialiseToVersion,
   )
 where
 
@@ -65,15 +65,10 @@ import Data.Set qualified as Set
 import Data.Singletons.Base.TH
 import Data.Text qualified as Text
 import Data.Text.Encoding as Text
-import GHC.TypeLits
 import Imports hiding ((\\))
 import Servant
-import Servant.API.Extended (ReqBodyCustomError)
-import Servant.API.Extended.RawM qualified as RawM
-import Servant.Multipart (MultipartForm)
-import Wire.API.Deprecated
-import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Named hiding (unnamed)
+import Wire.API.Routes.SpecialiseToVersion
 import Wire.API.VersionInfo
 import Wire.Arbitrary (Arbitrary, GenericUniform (GenericUniform))
 
@@ -253,84 +248,4 @@ expandVersionExp :: VersionExp -> Set Version
 expandVersionExp (VersionExpConst v) = Set.singleton v
 expandVersionExp VersionExpDevelopment = Set.fromList developmentVersions
 
--- Version-aware swagger generation
-
 $(promoteOrdInstances [''Version])
-
-type family SpecialiseToVersion (v :: Version) api
-
-type instance
-  SpecialiseToVersion v (From w :> api) =
-    If (v < w) EmptyAPI (SpecialiseToVersion v api)
-
-type instance
-  SpecialiseToVersion v (Until w :> api) =
-    If (v < w) (SpecialiseToVersion v api) EmptyAPI
-
-type instance
-  SpecialiseToVersion v ((s :: Symbol) :> api) =
-    s :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (Named n api) =
-    Named n (SpecialiseToVersion v api)
-
-type instance
-  SpecialiseToVersion v (Capture' mod sym a :> api) =
-    Capture' mod sym a :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (Summary s :> api) =
-    Summary s :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (Deprecated :> api) =
-    Deprecated :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (Verb m s t r) =
-    Verb m s t r
-
-type instance
-  SpecialiseToVersion v (MultiVerb m t r x) =
-    MultiVerb m t r x
-
-type instance
-  SpecialiseToVersion v (NoContentVerb m) =
-    NoContentVerb m
-
-type instance SpecialiseToVersion v RawM.RawM = RawM.RawM
-
-type instance
-  SpecialiseToVersion v (ReqBody t x :> api) =
-    ReqBody t x :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (ReqBodyCustomError t l x :> api) =
-    ReqBodyCustomError t l x :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (MultipartForm x b :> api) =
-    MultipartForm x b :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (QueryParam' mods l x :> api) =
-    QueryParam' mods l x :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (Header' opts l x :> api) =
-    Header' opts l x :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (Description desc :> api) =
-    Description desc :> SpecialiseToVersion v api
-
-type instance
-  SpecialiseToVersion v (StreamBody' opts f t x :> api) =
-    StreamBody' opts f t x :> SpecialiseToVersion v api
-
-type instance SpecialiseToVersion v EmptyAPI = EmptyAPI
-
-type instance
-  SpecialiseToVersion v (api1 :<|> api2) =
-    SpecialiseToVersion v api1 :<|> SpecialiseToVersion v api2

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

@@ -74,8 +74,8 @@ looksLikeVersion version = case T.splitAt 1 version of (h, t) -> h == "v" && T.a
 -- | swagger-delivering end-points are not disableable: they should work for all versions.
 requestIsDisableable :: Request -> Bool
 requestIsDisableable (pathInfo -> path) = case path of
-  ["api", "swagger-ui"] -> False
-  ["api", "swagger.json"] -> False
+  ("api" : "swagger-ui" : _) -> False
+  ("api" : "swagger.json" : _) -> False
   _ -> True
 
 removeVersionHeader :: Request -> Request

libs/wire-api/wire-api.cabal

@@ -324,6 +324,7 @@ library
     , servant-client-core
     , servant-conduit
     , servant-multipart
+    , servant-multipart-api
     , servant-openapi3
     , servant-server
     , singletons

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

@@ -263,7 +263,7 @@ internalEndpointsSwaggerDocsAPI ::
   PortNumber ->
   S.OpenApi ->
   Servant.Server (VersionedSwaggerDocsAPIBase service)
-internalEndpointsSwaggerDocsAPI _ _ _ (Just _) = emptySwagger
+internalEndpointsSwaggerDocsAPI _ _ _ (Just _) = emptySwagger "Internal APIs are not versioned!"
 internalEndpointsSwaggerDocsAPI service examplePort swagger Nothing =
   swaggerSchemaUIServer $
     swagger

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

@@ -123,12 +123,9 @@ adjustSwaggerForFederationEndpoints service swagger =
     tag :: InsOrdSet.InsOrdHashSet S.TagName
     tag = InsOrdSet.singleton @S.TagName (T.pack service)
 
-emptySwagger :: Servant.Server (ServiceSwaggerDocsAPIBase a)
-emptySwagger =
-  swaggerSchemaUIServer $
-    mempty @S.OpenApi
-      & S.info . S.description
-        ?~ "There is no Swagger documentation for this version. Please refer to v5 or later."
+emptySwagger :: Text -> Servant.Server (ServiceSwaggerDocsAPIBase a)
+emptySwagger msg =
+  swaggerSchemaUIServer $ mempty @S.OpenApi & S.info . S.description ?~ msg
 
 eventNotificationSchemas :: [S.Definitions S.Schema]
 eventNotificationSchemas = fst . (`S.runDeclare` mempty) <$> renderAll