title: Haskell Pipes and Branching
body: <h1>Problem</h1>
  
  <p>I'm attempting to implement a simple web server with Haskell and the Pipes library. I understand now that cyclic or diamond topologies aren't possible with pipes, however I thought that what I am trying to is. My desired topology is thus:</p>
  
  <pre><code>                                 -GET--&gt; handleGET &gt;-&gt; packRequest &gt;-&gt; socketWriteD
                                   |
  socketReadS &gt;-&gt; parseRequest &gt;-routeRequest
                                   |
                                   -POST-&gt; handlePOST &gt;-&gt; packRequest &gt;-&gt; socketWriteD
  </code></pre>
  
  <p>I have <code>HTTPRequest RequestLine Headers Message</code> and <code>HTTPResponse StatusLine Headers Message</code> types which are used in the chain. <code>socketReadS</code> takes bytes from the socket and forwards them to <code>parseRequest</code>, which uses Attoparsec to parse the bytes into an <code>HTTPRequest</code> object. I would then like the pipe to branch at least twice and possibly more depending on how many HTTP methods I implement. Each <code>handle&lt;method&gt;</code> function should receive <code>HTTPRequest</code> objects from upstream and forward <code>HTTPResponse</code> objects to <code>packRequest</code>, which simply packs up the HTTPResponse objects in a <code>ByteString</code> ready to be sent with <code>socketWriteS</code>.</p>
  
  <p>The following code typechecks if I let GHC infer the type for <code>routeRequest'''</code> (mine seems to be slightly off somehow). However nothing seems to be executing after <code>parseRequest</code>. Can anyone help me figure out why?</p>
  
  <h2>Code</h2>
  
  <p>I have the following code for <code>routeRequest</code> which should handle the branching.</p>
  
  <pre><code>routeRequest''' ::
      (Monad m, Proxy p1, Proxy p2, Proxy p3)
      =&gt; () -&gt; Consumer p1 HTTPRequest (Pipe p2 HTTPRequest HTTPRequest (Pipe p3 HTTPRequest HTTPRequest m)) r
  routeRequest''' () = runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ forever $ do
      httpReq &lt;- request ()
      let method = getMethod httpReq
      let (URI uri) = getURI httpReq
      case method of
        GET -&gt; lift $ respond httpReq
        POST -&gt; lift $ lift $ respond httpReq
  
  routeRequest'' = runProxyK $ routeRequest''' &lt;-&lt; unitU
  routeRequest' socket = runProxyK $ raiseK (p4 socket &lt;-&lt; handleGET) &lt;-&lt; routeRequest''
  routeRequest socket = (p4 socket &lt;-&lt; handlePOST) &lt;-&lt; (routeRequest' socket)
  </code></pre>
  
  <p><code>handleGET</code> and <code>handlePOST</code> are implemented as such:</p>
  
  <pre><code>handleGET :: Proxy p =&gt; () -&gt; p () HTTPRequest r ByteString IO r
  handleGET () = runIdentityP $ do
      httpReq &lt;- request ()
      let (URI uri) = getURI httpReq
      lift $ Prelude.putStrLn "GET"
      respond $ B.append (B.pack "GET ") uri
  
  
  handlePOST :: Proxy p =&gt; () -&gt; p () HTTPRequest r ByteString IO r
  handlePOST () = runIdentityP $ do
      httpReq &lt;- request ()
      let (URI uri) = getURI httpReq
      lift $ Prelude.putStrLn "POST"
      respond $ B.append (B.pack "POST ") uri
  </code></pre>
  
  <p>I have the following shorthands for proxies:</p>
  
  <pre><code>p1 socket = socketReadS 32 socket
  p2 = parseRequestProxy 
  p4 socket = socketWriteD socket
  </code></pre>
  
  <p>Finally, I run the whole thing like this:</p>
  
  <pre><code>main = serveFork (Host "127.0.0.1") "8080" $
      \(socket, remoteAddr) -&gt; do
          ret &lt;- runProxy $ runEitherK $ p1 socket &gt;-&gt; printD &gt;-&gt; p2 &gt;-&gt; printD  &gt;-&gt; routeRequest socket 
          Prelude.putStrLn $ show ret
  </code></pre>
  
  <p>The type signature of <code>parseRequestProxy</code> is this:</p>
  
  <pre><code>parseRequestProxy
    :: (Monad m, Proxy p) =&gt;
       ()
       -&gt; Pipe
            (EitherP Control.Proxy.Attoparsec.Types.BadInput p)
            ByteString
            HTTPRequest
            m
            r
  </code></pre>
  
  <h2>Edit</h2>
  
  <p>Here's the repository with the source code. Be warned it has not been prettied up so use at your own risk. <a href="https://bitbucket.org/Dwilson1234/haskell-web-server/overview" rel="nofollow">https://bitbucket.org/Dwilson1234/haskell-web-server/overview</a></p>