Partial reverse proxy with Haskell Servant

Question

I'm trying to build a web server in Haskell with Servant where part of the api works as a reverse proxy to another api.

I found an example of how to achieve this. But it seems that it doesn't work:

type API
    = "cat" :> Get '[JSON] Cat

newtype Cat = Cat { cat :: String }

instance ToJSON Cat where
    toJSON (Cat mew) =
        object [ "cat" .= mew ]

server :: Server API
server = pure (Cat { cat = "mrowl" })

api :: Proxy (API :<|> Raw)
api = Proxy

app :: Manager -> Application
app manager =
    serve api $ server :<|> waiProxyTo forwardRequest defaultOnExc manager

forwardRequest :: Request -> IO WaiProxyResponse
forwardRequest _ =
    pure . WPRProxyDest . ProxyDest "127.0.0.1" $ 4567

startApp :: IO ()
startApp = do
    manager <- newManager defaultManagerSettings
    run 8080 (app manager)

It gives the following type error (when I try it in my own code base):

    • Couldn't match type ‘Request
                           -> (Response -> IO ResponseReceived) -> IO ResponseReceived’
                     with ‘Tagged Handler Application’
      Expected type: Server (API :<|> Raw)
        Actual type: Handler Cat :<|> Application
    • In the second argument of ‘($)’, namely
        ‘server :<|> waiProxyTo forwardRequest defaultOnExc manager’
      In the expression:
        serve api
          $ server :<|> waiProxyTo forwardRequest defaultOnExc manager
      In an equation for ‘app’:
          app manager
            = serve api
                $ server :<|> waiProxyTo forwardRequest defaultOnExc manager
   |
32 |     serve api $ server :<|> waiProxyTo forwardRequest defaultOnExc manager
   |                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

(My interpretation is that :<|> has changed to not accept combing Server and Application since the example was written.)

What can I replace waiProxyTo forwardRequest defaultOnExc manager with to make this work?

Answer 1

I don't fully understand why this works but I got it working by mimicking how serveDirectoryWith works:

import Servant.Server (ServerT, Tagged)
import Network.HTTP.Client (Manager)
import Network.HTTP.ReverseProxy
  ( WaiProxyResponse, WaiProxyResponse(WPRProxyDest)
  , ProxyDest(ProxyDest), waiProxyTo, defaultOnExc)

{- ... -}

forwardServer :: Manager -> ServerT Raw m
forwardServer manager = 
  Tagged $ waiProxyTo forwardRequest defaultOnExc manager

forwardRequest :: Request -> IO WaiProxyResponse
forwardRequest _ =
    pure . WPRProxyDest . ProxyDest "127.0.0.1" $ 4567

app :: Manager -> Application
app manager =
    serve api $ server :<|> (forwardServer manager)