问题

Question

问题

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

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

我有链中使用的HTTPRequest RequestLine Headers Message和HTTPResponse StatusLine Headers Message类型。 socketReadS从套接字中获取字节并将它们转发到parseRequest，它使用Attoparsec将字节解析为HTTPRequest对象。然后，我希望管道分支至少两次，可能更多，具体取决于我实现的HTTP方法数量。每个handle<method>函数都应该从上游和前向HTTPRequest对象接收HTTPResponse个对象到packRequest，它只是将ByteString中的HTTPResponse对象打包准备好发送与socketWriteS。

如果我让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

Answer 1

当我原先说你无法处理钻石拓扑时，我错了。后来我发现了一种使用ArrowChoice类似界面的合理方法，并以pipes-3.2.0和leftD组合形式包含了rightD中的解决方案。我将解释它是如何工作的：

不是嵌套代理转换器，而是使用Left或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

如果您有两个以上的分支，则必须嵌套Either，但这只是ArrowChoice工作方式的限制。

Answer 2

我没有运行你的代码，但我认为我发现了一个问题。

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

routeRequest'''正在请求来自unitU的数据，该数据没有供应，因此它会挂起。

:t runProxy $ unitU >-> printD

会输入检查但没有运行。

似乎数据被发送到monad变换器的错误级别，流入routeRequest的数据应该流入routeRequest'''。流入monad变换器的错误级别的数据可能导致您需要保留类型签名以获取要检查的所有内容。类型签名routeRequest期待来自上游的()，我敢打赌，没有类型签名，它被允许是多态的。

在routeRequest的定义中，你可以“关闭管道”，我认为这就是所谓的，通过使用unitD，即使routeRequest'''没有类型签名，也会禁止你的构造

Haskell管道和分支

问题

代码

修改

2 个答案: