haskell - Haskell Servant 的部分反向代理

Question

我正在尝试使用 Servant 在 Haskell 中构建 Web 服务器，其中部分 API 作为另一个 API 的反向代理。

I found an example 如何实现这一点。但是好像不行:

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)

它给出了以下类型错误(当我在自己的代码库中尝试时):

    • 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
   |                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

(我的解释是 :<|> 自从编写示例后已更改为不接受服务器和应用程序的组合。)

我可以用什么替换 waiProxyTo forwardRequest defaultOnExc manager 来使它工作？

Answer 1

我不完全理解为什么会这样，但我通过模仿 serveDirectoryWith 的工作方式让它工作:

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)