How to get GHC to apply my orphaned instances `HasServer` and `HasClient` for `AuthProtect`?

I use the AuthProtect combinator from servant: Servant.API.Experimental.Auth. There is not much code there, the instance HasServer (AuthProtect tag) is in servant-server and the insance HasClient (AuthProtect tag) in whatever servant client you use.

I use servant-snap instead of servant-server and a custom HasClient implementation for an obelisk project, with a project structure that consists of three cabal packages:

frontend (compiled by ghcjs)
common (compiled by ghcjs and ghc)
backend (compiled by ghc)

I used to have a custom implementation of AuthProtect along with the instances in the common package. However, common can neither depend on servant-snap nor on snap-core because of ghcjs.

Now I moved the HasServer instance to the backend ... no problem, right? Wrong. Once the HasServer instance is orphaned, ghc does not correctly resolve my api type anymore. It's just as if the orphaned instance were not there at all.

Why is that?

What is there, I can do?

Solution

Either of those solves my problem:

instance HasServer api context m => HasServer (AuthProtect "jwt" :> api) context m where
  type ServerT (AuthProtect "jwt" :> api) context m =
    String -> ServerT api context m

  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

  route (Proxy :: Proxy (AuthProtect "jwt" :> api)) context subserver =
    route (Proxy :: Proxy api) context (subserver `addAuthCheck` withRequest authCheck)
      where
        authCheck :: Request -> DelayedM m String
        authCheck =
          liftIO . evalSnap (pure "account info")
                            (\x -> pure $! (x `seq` ()))
                            (\f -> let !_ = f 0 in pure ())

If I don't want specialize to AuthProtect "jwt" for some reason, I have to provide the constraint KnownSymbol tag.

instance (KnownSymbol tag, HasServer api context m) => HasServer (AuthProtect tag :> api) context m where
  type ServerT (AuthProtect tag :> api) context m =
    String -> ServerT api context m

  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

  route (Proxy :: Proxy (AuthProtect tag :> api)) context subserver =
    route (Proxy :: Proxy api) context (subserver `addAuthCheck` withRequest authCheck)
      where
        authCheck :: Request -> DelayedM m String
        authCheck =
          liftIO . evalSnap (pure "account info")
                            (\x -> pure $! (x `seq` ()))
                            (\f -> let !_ = f 0 in pure ())