Tagging endpoints on Sub APIs

[wduncanfraser]

Running into some issues trying to tag endpoints when we have broken up the API so it doesn't live in one monolithic file/type.

For example, we have a top level:

type Routes =
  ApiTerm :> VersionTerm :> (
         AdminTerm :> AdminApi
    :<|> ClientTerm :> ClientApi
  )

with

type ClientApi =
       AuthTerm :> AuthApi
  :<|> UserTerm :> UserApi

and

type UserApi =
  -- Users API
       GetUserApi
  :<|> CreateUserApi

and then

type GetUserApi =
  Capture "id" UserId :>
    Get '[JSON] UserReadable

What would be the proper way to tag the endpoint?

appSwagger = toSwagger (Proxy::Proxy Routes)
  & info.title        .~ "App API"
  & info.version      .~ "1"
  & info.description  ?~ "This is the App API spec"
  & applyTagsFor (subOperations (Proxy :: Proxy GetUserApi) (Proxy :: Proxy UserApi)) ["Client_User" & description ?~ "App Client API"]

Results in the tag getting created, but not associated with the endpoint. Attempting to specify Routes as the whole API results int he following type error:

src/App.hs:58:19: error:
    • Could not deduce: Servant.Swagger.Internal.TypeLevel.API.IsIn
                          (Capture "id" Model.User.Types.UserId
                           :> Verb 'GET 200 '[JSON] Model.User.JSON.UserReadable)
                          (ApiTerm
                           :> (VersionTerm
                               :> ((AdminTerm :> Routes.Admin.AdminApi)
                                   :<|> (ClientTerm :> ClientApi))))
        arising from a use of ‘subOperations’
      from the context: Applicative f
        bound by a type expected by the context:
                   Applicative f => (Operation -> f Operation) -> Swagger -> f Swagger
        at src/App.hs:58:5-136

[michalrus]

IMO, it’s much more sensible, modular etc. to define this symbol:

data SwaggerTag name description
  deriving (Typeable)

instance HasServer api ctx =>
         HasServer (SwaggerTag name description
                    :> api) ctx where
  type ServerT (SwaggerTag name description
                :> api) m = ServerT api m
  route _ = route (Proxy @api)
  hoistServerWithContext _ = hoistServerWithContext (Proxy @api)

instance HasClient m api =>
         HasClient m (SwaggerTag name description
                      :> api) where
  type Client m (SwaggerTag name description
                 :> api) = Client m api
  clientWithRoute _ _ = clientWithRoute (Proxy @m) (Proxy @api)
  hoistClientMonad pm _ = hoistClientMonad pm (Proxy @api)

instance (HasSwagger api, KnownSymbol name, KnownSymbol description) =>
         HasSwagger (SwaggerTag name description
                     :> api) where
  toSwagger _ =
    let tag =
          Tag
            (pack $ symbolVal (Proxy @name))
            ((\case
                "" -> Nothing
                t -> Just t) .
             pack $
             symbolVal (Proxy @description))
            Nothing
     in toSwagger (Proxy @api) & applyTags [tag]

And then you can add tags like:

type UserAPI
   = "user"
     :> SwaggerTag "User" "User sub-API is very important."
     :> (RegisterAPI
         :<|> LoginAPI
         :<|> LogoutAPI)

… and all three of Register, Login and Logout will get that particular tag.

And other parts of your API (that don’t have that SwaggerTag "User") will not.

=)

[neongreen]

Is there a good reason it's not in servant-swagger, or is that simply due to lack of time / something?

[michalrus]

I wouldn’t know that, but my idea is rather, hmm, arbitrary, so to say. I’m not sure if I’d want it in, hmm, somewhat official servant-swagger. =)

It doesn’t seem enough, IMO, more like a quick hack.

[chreekat]

+1 for this, @michalrus you should send that as a PR!

[chreekat]

Or give me a day, and I'll do it :)

[cdupont]

I think this is done in the package right? https://hackage.haskell.org/package/servant-swagger-tags

[domenkozar]

Would be amazing if someone made a PR with that tag implementation :)

cc @nakaji-dayo

[chreekat]

I was gonna give it a shot, but servant-swagger's tests aren't passing due to hash map keys being printed in a different order between test runs :upside_down_face:

So I fixed that first: #140

[domenkozar]

@chreekat awesome :) Can I request to include https://github.com/nakaji-dayo/servant-swagger-tags/pull/1/?

[chreekat]

Hey @domenkozar , unfortunately I remembered that https://hackage.haskell.org/package/openapi3 exists, which reduced my enthusiasm for contributing here 😇

[domenkozar]

Sounds good, we need this then for https://github.com/biocad/servant-openapi3

[akhesaCaro]

Hi, Servant-swagger will be moved into the main Servant repo (see : https://github.com/haskell-servant/servant/pull/1475) If this issue is still relevant, would it be possible for you to summit it there? : https://github.com/haskell-servant/servant/issues

Thanks in advance!