Partial reverse proxy with Haskell Servant - haskell

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)