10

问题

我正在尝试使用 Haskell 和 Pipes 库实现一个简单的 Web 服务器。我现在明白循环或菱形拓扑对于管道是不可能的，但是我认为我想要的是。因此，我想要的拓扑是：

                                 -GET--> handleGET >-> packRequest >-> socketWriteD
                                 |
socketReadS >-> parseRequest >-routeRequest
                                 |
                                 -POST-> handlePOST >-> packRequest >-> socketWriteD

我有链中使用的类型HTTPRequest RequestLine Headers Message。从套接字获取字节并将它们转发给，后者使用 Attoparsec 将字节解析为对象。然后，我希望管道至少分支两次，并且可能更多，这取决于我实现了多少 HTTP 方法。每个函数都应该从上游接收对象并将对象转发到，这只是将 HTTPResponse 对象打包到准备好与 一起发送。HTTPResponse StatusLine Headers MessagesocketReadSparseRequestHTTPRequesthandle<method>HTTPRequestHTTPResponsepackRequestByteStringsocketWriteS

如果我让 GHC 推断类型，则以下代码类型检查routeRequest'''（我的似乎有点偏离）。但是，之后似乎没有任何执行parseRequest。谁能帮我弄清楚为什么？

代码

我有以下代码routeRequest应该处理分支。

routeRequest''' ::
    (Monad m, Proxy p1, Proxy p2, Proxy p3)
    => () -> Consumer p1 HTTPRequest (Pipe p2 HTTPRequest HTTPRequest (Pipe p3 HTTPRequest HTTPRequest m)) r
routeRequest''' () = runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ forever $ do
    httpReq <- request ()
    let method = getMethod httpReq
    let (URI uri) = getURI httpReq
    case method of
      GET -> lift $ respond httpReq
      POST -> lift $ lift $ respond httpReq

routeRequest'' = runProxyK $ routeRequest''' <-< unitU
routeRequest' socket = runProxyK $ raiseK (p4 socket <-< handleGET) <-< routeRequest''
routeRequest socket = (p4 socket <-< handlePOST) <-< (routeRequest' socket)

handleGET并handlePOST这样实现：

handleGET :: Proxy p => () -> p () HTTPRequest r ByteString IO r
handleGET () = runIdentityP $ do
    httpReq <- request ()
    let (URI uri) = getURI httpReq
    lift $ Prelude.putStrLn "GET"
    respond $ B.append (B.pack "GET ") uri


handlePOST :: Proxy p => () -> p () HTTPRequest r ByteString IO r
handlePOST () = runIdentityP $ do
    httpReq <- request ()
    let (URI uri) = getURI httpReq
    lift $ Prelude.putStrLn "POST"
    respond $ B.append (B.pack "POST ") uri

我有以下代理的简写：

p1 socket = socketReadS 32 socket
p2 = parseRequestProxy 
p4 socket = socketWriteD socket

最后，我像这样运行整个事情：

main = serveFork (Host "127.0.0.1") "8080" $
    \(socket, remoteAddr) -> do
        ret <- runProxy $ runEitherK $ p1 socket >-> printD >-> p2 >-> printD  >-> routeRequest socket 
        Prelude.putStrLn $ show ret

的类型签名parseRequestProxy是这样的：

parseRequestProxy
  :: (Monad m, Proxy p) =>
     ()
     -> Pipe
          (EitherP Control.Proxy.Attoparsec.Types.BadInput p)
          ByteString
          HTTPRequest
          m
          r

编辑

这是带有源代码的存储库。请注意，它没有经过修饰，因此使用风险自负。https://bitbucket.org/Dwilson1234/haskell-web-server/overview

4

2 回答 2

8

当我最初说您无法处理菱形拓扑时，我错了。后来我发现了一种使用类似接口的明智方法，并以and组合子的形式ArrowChoice包含了解决方案。我将解释它是如何工作的：pipes-3.2.0leftDrightD

不是嵌套代理转换器，而是使用Leftor包装结果Right

routeRequest ::
    (Monad m, Proxy p)
    => () -> Pipe p HTTPRequest (Either HTTPRequest HTTPRequest) m r
routeRequest () = runIdentityP $ forever $ do
    httpReq <- request ()
    let method = getMethod httpReq
    let (URI uri) = getURI httpReq
    respond $ case method of
      GET  -> Left  httpReq
      POST -> Right httpReq

然后您可以有选择地将每个处理程序应用于每个分支，然后合并分支：

routeRequest >-> leftD handleGET >-> rightD handlePOST >-> mapD (either id id)
    :: (Monad m, Proxy p) => () -> Pipe p HTTPRequest ByteString IO r

如果您有两个以上的分支，那么您将不得不嵌套Eithers，但这只是ArrowChoice工作方式的限制。

于 2013-04-25T03:53:58.130 回答
1

I have not run your code, but I think I spotted a problem.

routeRequest'' = runProxyK $ routeRequest''' <-< unitU

routeRequest''' is requesting data from unitU which has nothing to supply, so it hangs.

:t runProxy $ unitU >-> printD

Will type check but nothing runs.

It seems like the data is being sent to the wrong level of the monad transformer, data which is flowing into routeRequest should be flowing into routeRequest'''. The data flowing into the wrong level of the monad transformer is what is probably causing you to need to leave of the type signature to get everything to type check. With the type signature routeRequest is expecting a () coming from upstream and, I bet, with no type signature it is allowed to be polymorphic.

In your definition of routeRequest you could "close the pipe", I think that is what it is called, by using unitD which would disallow your construction even when routeRequest''' does not have the type signature.

于 2013-04-25T03:24:06.737 回答