Main.hs

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString as B

import Control.Monad (forever, liftM)
import Control.Exception.Base

import Network.Socket hiding (recv, send)
import Network.Socket.ByteString (recv, send)
import Network.BSD

import Pipes
import Data.Attoparsec (parse)
import Network.Types
import Network.Parser.Rfc2616 (request)

sockToPipe :: Socket -> (Producer B.ByteString IO (), Consumer B.ByteString IO ())
sockToPipe sock = (producer, consumer)
  where producer = (liftIO $ recv sock 4096) >>= yield >> producer
        consumer = await >>= (\s -> liftIO $ send sock s) >> consumer

handleConnection :: (Socket, a) -> IO ()
handleConnection (sock, addr) = do
  line <- recvAll
  print $ parse request line
  where recvAll = recv sock 4096 >>= (\l -> 
                    if not $ B.null l
                      then liftM (B.append l) recvAll
                      else return "")

listenConnections :: PortNumber -> Producer Socket IO ()
listenConnections port = do
           sock <- liftIO $ listeningSocket
           (s, a) <- liftIO $ accept sock 
           yield s 
           liftIO $ close s
  where listeningSocket = do
           proto <- getProtocolNumber "tcp"
           sock <- socket AF_INET Stream proto
           bindSocket sock (SockAddrInet port iNADDR_ANY)
           listen sock 5
           return sock 

main = do
 let pipe = \(prod, cons) -> prod >-> cons
 runEffect $ for (listenConnections 4242) (lift . runEffect . pipe . sockToPipe)