Use full header type in response header instances

[worm2fed]

This is required to be able provide Description into headers, for example like this:

type PaginationTotalCountHeader =
  Header'
    '[ Description "Indicates to the client total count of items in collection"
     , Optional
     , Strict
     ]
    "Total-Count"
    Int

This PR is related to another one: https://github.com/biocad/servant-openapi3/pull/48 and related to issue https://github.com/biocad/servant-openapi3/issues/45

[tchoutri]

@worm2fed thanks a lot for this PR. Does this unlock nice things beyond the openapi feature? If so we should probably have a changelog entry for it. :)

[worm2fed]

@tchoutri thank you) I hope yes, it allows to bring more information into generated openapi3 spec.

As I can see there a few things have to be done:

• add entry to changelog
• update documentation to reflect that this is possible to provide descriptions to Headers via modifiers

• review more instances where limited; I found that it's not possible to use functions with AddHeader, for example addHeader :: [AddHeader](https://hackage.haskell.org/package/servant-0.20/docs/Servant-API.html#t:AddHeader) h v orig new => v -> orig -> new

  Maybe it will be better to define helper type

  -- | Helper type to define 'Header' with 'Description'.
  type HeaderWithDescription description = 
  Header' '[Description description, Optional, Strict]

[worm2fed]

Seems like problem with order of mods in AddHeader. When I add it to the end I got another error

>     • Expected one of:
>           '[WithStatus 200 (Headers '[Header "H1" Int] String),
>             WithStatus 404 String]
>       But got:
>           WithStatus
>             200 (Headers '[Servant.API.Header.Header' mods0 "H1" Int] [Char])
>     • In the first argument of ‘(.)’, namely ‘respond’
>       In the first argument of ‘($)’, namely
>         ‘respond . WithStatus @200 . addHeader @"H1" (5 :: Int)’
>       In the expression:
>         respond . WithStatus @200 . addHeader @"H1" (5 :: Int)
>           $ ("foo" :: String)
>     |
> 749 | uverbResponseHeadersServer True = respond . WithStatus @200 . addHeader @"H1" (5 :: Int) $ ("foo" :: String)

Actually, I think it's correct to do that - add mods to AddHeader. Before it was type alias with mods as well, but with specific ones. The reason I've added mods to AddHeader is because of strange error in these two instances:

-- In this instance, we add a Header on top of something that is already decorated with some headers
instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v )
         => AddHeader h v (Headers (fst ': rest) a) (Headers (Header' mods h v  ': fst ': rest) a) where
    addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads)

-- In this instance, 'a' parameter is decorated with a Header.
instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v , new ~ Headers '[Header' mods h v] a)
         => AddHeader h v a new where
    addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)

Here is this error:

>     • Illegal instance declaration for
>         ‘AddHeader
>            h
>            v
>            (Headers (fst : rest) a)
>            (Headers (Header' mods h v : fst : rest) a)’
>         The liberal coverage condition fails in class ‘AddHeader’
>           for functional dependency: ‘h v orig -> new’
>         Reason: lhs types ‘h’, ‘v’, ‘Headers (fst : rest) a’
>           do not jointly determine rhs type ‘Headers
>                                                (Header' mods h v : fst : rest) a’
>         Un-determined variable: mods
>     • In the instance declaration for
>         ‘AddHeader h v (Headers (fst : rest) a) (Headers (Header' mods h v
>                                                           : fst : rest) a)’
>     |
> 166 | instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v )
>     |                              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
> 
>     • Illegal instance declaration for ‘AddHeader h v a new’
>         The liberal coverage condition fails in class ‘AddHeader’
>           for functional dependency: ‘h v orig -> new’
>         Reason: lhs types ‘h’, ‘v’, ‘a’
>           do not jointly determine rhs type ‘new’
>         Un-determined variable: new
>     • In the instance declaration for ‘AddHeader h v a new’
>     |
> 171 | instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v , new ~ Headers '[Header' mods h v] a)
>     |        

Honestly, I do not understand what is it

[worm2fed]

@tchoutri maybe you can explain what is going on?

My current understanding is that

-- We need all these fundeps to save type inference
class AddHeader h v orig new (mods :: [*])
    | h v orig mods -> new, new -> h, new -> v, new -> orig, new -> mods where
  addOptionalHeader :: ResponseHeader h v -> orig -> new  -- ^ N.B.: The same header can't be added multiple times

in this class all these dependencies required to validate that there is only one exact header. And by using mods we break this rule, cause Header' '[Optional, Strict] "MyHeader" Int is not same as Header' '[Description "Just header", Optional, Strict] "MyHeader" Int

And in sense of logic it is same because description is just "documentation label", but current implementation of providing description to headers via modifiers limits to implement this. Any way, it can raise another question, how would we have two "same" headers but with different description.

So, to perform such validation we need to add mods to AddHeader. Add this leads to error in tests.

HLS gives me a bit more information:

• Expected one of:
      '[WithStatus 200 (Headers '[Header "H1" Int] String),
        WithStatus 404 String]
  But got:
      WithStatus
        200 (Headers '[Servant.API.Header.Header' mods0 "H1" Int] [Char])
• In the first argument of ‘(.)’, namely ‘respond’
  In the first argument of ‘($)’, namely
    ‘respond . WithStatus @200 . addHeader @"H1" (5 :: Int)’
  In the expression:
    respond . WithStatus @200 . addHeader @"H1" (5 :: Int)
      $ ("foo" :: String)typecheck(-Wdeferred-type-errors)
• Overlapping instances for Servant.API.UVerb.Union.UElem
                              (WithStatus
                                 200 (Headers '[Servant.API.Header.Header' mods0 "H1" Int] [Char]))
                              '[WithStatus 200 (Headers '[Header "H1" Int] String),
                                WithStatus 404 String]
    arising from a use of ‘respond’
  Matching instances:
    instance [overlapping] forall a (x :: a) (xs :: [a]) (x' :: a).
                           Servant.API.UVerb.Union.UElem x xs =>
                           Servant.API.UVerb.Union.UElem x (x' : xs)
      -- Defined in ‘Servant.API.UVerb.Union’
    instance [overlapping] forall a (x :: a) (xs :: [a]).
                           Servant.API.UVerb.Union.UElem x (x : xs)
      -- Defined in ‘Servant.API.UVerb.Union’
  (The choice depends on the instantiation of ‘mods0’
   To pick the first instance above, use IncoherentInstances
   when compiling the other instance declarations)
• In the first argument of ‘(.)’, namely ‘respond’
  In the first argument of ‘($)’, namely
    ‘respond . WithStatus @200 . addHeader @"H1" (5 :: Int)’
  In the expression:
    respond . WithStatus @200 . addHeader @"H1" (5 :: Int)
      $ ("foo" :: String)typecheck(-Wdeferred-type-errors)

[worm2fed]

Oh, I see in test addHeader @"H1" (5 :: Int) $ ("foo" :: String) must become addHeader @"H1" @_ @_ @_ @('[Optional, Strict]) (5 :: Int) $ ("foo" :: String)

[blackheaven]

I think you may consider mimicking Summary:

Describe "Indicates to the client total count of items in collection"
  (Header "Total-Count" Int)

[worm2fed]

@blackheaven I do no see how it will work with servant-openapi3 this way, only by providing an instance there to extract that description.

I will take a look

[worm2fed]

so, smith like this:

data Describe (sym :: Symbol) (a :: *)

instance (KnownSymbol sym, ToParamSchema a, KnownSymbol description) => ToResponseHeader (Describe description (Header sym a)) where
  toResponseHeader _ = (hname, header)
    where
      hname = Text.pack (symbolVal (Proxy :: Proxy sym))
      header = mempty
        & description ?~ Text.pack (symbolVal (Proxy :: Proxy description))
        & schema ?~ Inline (toParamSchema (Proxy :: Proxy a))

which can be used not only for response headers, but for any

@blackheaven is it what you are suggesting?

[blackheaven]

Exactly, thanks.

[worm2fed]

@blackheaven I think it will be good to include Describe into servant package but it will be slower. Or, we can keep all in servant-openapi3, wdyt?

[blackheaven]

I would say, in a perfect world, it should be in servant-openapi3, but

1. There is already Summary
2. It not a big patch
3. It contribute to a better API readability

[worm2fed]

@blackheaven it is a little more difficult than it might seem at first

I've added test and it's failing, addHeader cannot add Header wrapped in Describe. So it's required to add AddHeader instance / change current. I left a commented version there, but it's not working. Do you know how to solve this problem without introducing new param to AddHeader?

servant-server/test/Servant/ServerSpec.hs:137:24: error:
    • Couldn't match type: Describe "desc" (Header "D" Int)
                     with: Servant.API.Header.Header'
                             '[Servant.API.Modifiers.Optional, Strict] h0 v0
        arising from a use of ‘addHeader’
    • In the first argument of ‘return’, namely ‘(addHeader 5 alice)’
      In the first argument of ‘(:<|>)’, namely
        ‘return (addHeader 5 alice)’
      In the second argument of ‘(:<|>)’, namely
        ‘return (addHeader 5 alice)
           :<|>             
             (return alice :<|> return "B")
               :<|> return (S.source ["bytestring"])’
    |                       
137 |           :<|> return (addHeader 5 alice)

This showed, that it will be impossible to add this just to servant-opeanapi3, because servant changes required as well

[blackheaven]

I tried also, I didn't find a solution, it doesn't seems a good idea in the end, sorry for that :/

[worm2fed]

I will leave diff here, maybe someone else will want to try but I will revert this PR to initial version

haskell-servant_servant_pull_1697.diff.txt

[worm2fed]

@tchoutri should I add servant-auth targets to stack.yaml? currently they are only in .cabal

[tchoutri]

@worm2fed good question, I must admit I haven't used stack in some years now. If you add them and it works, I'll approve it. :)

[worm2fed]

mm.. seems like MonadPlus and guard not in base for ghc 9.6.2

[ysangkok]

They are in base, you just don't get them automatically through mtl. See changelog

[worm2fed]

@ysangkok thanks for explanation

[worm2fed]

@tchoutri can you please review this PR?

[worm2fed]

@tchoutri I think we had to squash fixups before merge..

Any way, thanks)

[tchoutri]

@worm2fed I'm pretty sure I did! Please do check though :) https://github.com/haskell-servant/servant/commit/72f5d5c86ef3db22888b34450abe8339e1f5e6b1

[worm2fed]

@tchoutri oh, I see, sorry Was it merge-with squash?

[tchoutri]

Yep

[maksbotan]

Hi @worm2fed!

As far as I understand, your change to AddHeader (adding mods type argument) is not backwards-compatible and therefore would require a new servant version, e.g. 0.21.

Can we instead add AddHeader' with new argument and make AddHeader an alias to it? So that we can release this in 0.20 series without breaking public API.

@tchoutri what do you think?

[tchoutri]

A compat alias could be nice yes!