AddSetCookies missing an instance for when the left tree is the same before and after the transformation

[mastarija]

So, I've got this error

server/Server/SRV.hs:63:14: error:
    • Overlapping instances for Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
                                  ('Servant.Auth.Server.Internal.AddSetCookie.S
                                     ('Servant.Auth.Server.Internal.AddSetCookie.S
                                        'Servant.Auth.Server.Internal.AddSetCookie.Z))
                                  ((Data.Tagged.Tagged Handler Network.Wai.Application
                                    Servant.API.Alternative.:<|> ((Data.Text.Internal.Text
                                                                   -> Data.Tagged.Tagged
                                                                        Handler
                                                                        Network.Wai.Application)
                                                                  Servant.API.Alternative.:<|> Data.Tagged.Tagged
                                                                                                 Handler
                                                                                                 Network.Wai.Application))
                                   Servant.API.Alternative.:<|> (Data.Tagged.Tagged
                                                                   Handler Network.Wai.Application
                                                                 Servant.API.Alternative.:<|> ((Data.Text.Internal.Text
                                                                                                -> Data.Tagged.Tagged
                                                                                                     Handler
                                                                                                     Network.Wai.Application)
                                                                                               Servant.API.Alternative.:<|> Server.API.PdxfAPI.PdxfAPI
                                                                                                                              Flouble
                                                                                                                              (AsServerT
                                                                                                                                 Handler))))
                                  ((Data.Tagged.Tagged Handler Network.Wai.Application
                                    Servant.API.Alternative.:<|> ((Data.Text.Internal.Text
                                                                   -> Data.Tagged.Tagged
                                                                        Handler
                                                                        Network.Wai.Application)
                                                                  Servant.API.Alternative.:<|> Data.Tagged.Tagged
                                                                                                 Handler
                                                                                                 Network.Wai.Application))
                                   Servant.API.Alternative.:<|> (Data.Tagged.Tagged
                                                                   Handler Network.Wai.Application
                                                                 Servant.API.Alternative.:<|> ((Data.Text.Internal.Text
                                                                                                -> Data.Tagged.Tagged
                                                                                                     Handler
                                                                                                     Network.Wai.Application)
                                                                                               Servant.API.Alternative.:<|> Data.Tagged.Tagged
                                                                                                                              Handler
                                                                                                                              Network.Wai.Application)))
        arising from a use of ‘genericServeTWithContext’
      Matching instances:
        two instances involving out-of-scope types
          instance [overlappable] (Functor m,
                                   Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
                                     n (m old) (m cookied),
                                   Servant.API.ResponseHeaders.AddHeader
                                     "Set-Cookie" Web.Cookie.SetCookie cookied new) =>
                                  Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
                                    ('Servant.Auth.Server.Internal.AddSetCookie.S n) (m old) (m new)
            -- Defined in ‘Servant.Auth.Server.Internal.AddSetCookie’
          instance [overlap ok] (Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
                                   ('Servant.Auth.Server.Internal.AddSetCookie.S n) a a',
                                 Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
                                   ('Servant.Auth.Server.Internal.AddSetCookie.S n) b b') =>
                                Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
                                  ('Servant.Auth.Server.Internal.AddSetCookie.S n)
                                  (a Servant.API.Alternative.:<|> b)
                                  (a' Servant.API.Alternative.:<|> b')
            -- Defined in ‘Servant.Auth.Server.Internal.AddSetCookie’
    • In the second argument of ‘($)’, namely
        ‘genericServeTWithContext tran srv ctx’
      In a stmt of a 'do' block:
        run 8088 $ genericServeTWithContext tran srv ctx
      In the second argument of ‘($)’, namely
        ‘do let jwk = hs256jwk "aXTrwbg2peHxiY6JKAXVX8kFrcPZ2Mto"
                ctx
                  = defaultCookieSettings :. defaultJWTSettings jwk :. EmptyContext
            run 8088 $ genericServeTWithContext tran srv ctx’
   |
63 |   run 8088 $ genericServeTWithContext tran srv ctx
   |

If we look carefully, it's saying that for this type:

AddSetCookies
  ('S ('S 'Z))
  (
    (
      Tagged Handler Application
      :<|>
      (
        (Text -> Tagged Handler Application)
        :<|>
        Tagged Handler Application
      )
    )
    :<|>
    (
      Tagged Handler Application
      :<|>
      (
        ( Text -> Tagged Handler Application)
        :<|>
        PdxfAPI Flouble (AsServerT Handler)
      )
    )
  )

  (
    (
      Tagged Handler Application
      :<|>
      (
        (Text -> Tagged Handler Application)
        :<|>
        Tagged Handler Application
      )
    )
    :<|>
    (
      Tagged Handler Application
      :<|>
      (
        ( Text -> Tagged Handler Application)
        :<|>
        Tagged Handler Application
      )
    )
  )

It cannot decide if it should use AddSetCookies ('S n) (m old) (m new) or AddSetCookies ('S n) (a :<|> b) (a' :<|> b').

This is because the first branch is the same e.g. AddSetCookies ('S n) (a:<|>b) (a :<|>b) and therefore a :<|> can be interpreted as m in AddSetCookies ('S n) (m old) (m new).

It's seems perfectly reasonable to me that the a branch can stay the same after the AddSetCookie transformation. I've written this orphan instance that fixed my issue.

instance {-# OVERLAPPING #-}
  ( AddSetCookies ('S n) a a
  , AddSetCookies ('S n) b b'
  )
  => AddSetCookies ('S n) (a :<|> b) (a :<|> b') where
  addSetCookies cookies ( a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b

[mastarija]

If someone more experienced with servant could confirm that this is indeed the case and this instance should exist (and it's not just working by accident) then I'd be happy to do a pull request for this issue.

[silky]

is this not solved by this - https://github.com/haskell-servant/servant/pull/1531 ?

[mastarija]

@silky I'm not sure. #1531 was merged in February, but I still experienced this problem in August. :/

[silky]

i see

well, i'm no expert, but your solution certainly seems reasonable to me :)

[endgame]

A colleague and I hit this problem with one of our API types and spent a good amount of time looking at the proposed new instance, as well as reading the GHC description of overlapping instance pragmas. I'm pretty sure this is correct, and #1653 is probably not what's wanted.

[mastarija]

@endgame well, I guess that's enough encouragement for me to open a PR then :). I'll try to do it over the weekend.

[tchoutri]

Fantastic, thank you both

[endgame]

1702 was merged. Should this be closed?

[mastarija]

@endgame I think so