module Serve where

import Control.Concurrent        (forkIO)
import Control.Exception         (bracket, finally)
import Control.Proxy             (Pipe, ProxyFast, Server, Client, (>->), (<-<), runProxy)
import Control.Proxy.Trans       (liftP)
import Control.Proxy.Trans.State (StateP, evalStateK)
import Control.Monad             (forever)
import Data.ByteString           (ByteString, empty)
import Network                   (listenOn, socketReader, socketWriter)
import Network.Socket            (Socket, SockAddr, accept, sClose)
import Request                   (pipeBody, parseRequest)
import Response                  (responseWriter)
import Types                     (Request, Response)


-- | a 'Handler' essentially a 'Request' and returns a 'Response'
--
-- The Pipe allows use to incrementally read 'ByteString' chuncks from
-- the Request body and incrementally write 'ByteString' chunks in the
-- 'Response' body.
type Handler m = (Request -> Pipe ProxyFast ByteString ByteString m (Response m))

------------------------------------------------------------------------------
-- serve
------------------------------------------------------------------------------

-- | listen on a port and handle 'Requests'
serve :: Int -- ^ port number to listen on
      -> Handler IO -- ^ handler
      -> IO ()
serve port handler =
    bracket (listenOn port) sClose $ \listenSocket ->
        serveSocket listenSocket handler

------------------------------------------------------------------------------
-- internals
------------------------------------------------------------------------------

serveSocket :: Socket     -- ^ socket to listen on
            -> Handler IO -- ^ handler
            -> IO ()
serveSocket listenSocket handler =
    forever $
      do (sock, addr) <- accept listenSocket
         let reader = socketReader sock
             writer = socketWriter sock
         forkIO $ (requestLoop False addr reader writer handler) `finally` (sClose sock)

-- | this is where we construct the pipe that reads from the socket,
-- processes the request, and sends the response
requestLoop :: Bool     -- ^ is this an HTTPS connection
            -> SockAddr -- ^ ip of the client
            -> (() -> Server ProxyFast () ByteString IO ()) -- ^ Server to read data (Request) from
            -> (() -> Client ProxyFast () ByteString IO ()) -- ^ Client to write data (Response) to
            -> Handler IO -- ^ handler
            -> IO ()

requestLoop secure addr reader writer handler =
    runProxy $ reader >-> (evalStateK empty $ httpPipe secure addr handler) >-> writer

-- | and this is the real heart of things
httpPipe :: Bool -- ^ is this an HTTPS connection
         -> SockAddr
         -> Handler IO
         -> ()
         -> StateP ByteString ProxyFast () ByteString () ByteString IO b
httpPipe secure addr handler () =
    forever $
      do request  <- parseRequest secure addr
         response <- ((liftP . (const $ handler request)) <-< pipeBody request) ()
         liftP $ responseWriter (response :: Response IO)
         return ()