Haskell 仆人的部分反向代理
Partial reverse proxy with Haskell Servant
我正在尝试使用 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
来完成这项工作?
我不完全明白为什么会这样,但我通过模仿 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)
我正在尝试使用 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
来完成这项工作?
我不完全明白为什么会这样,但我通过模仿 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)