Network/HTTP/Lucu/Httpd.hs

   1 module Network.HTTP.Lucu.Httpd
   2     ( ResourceTable
   3     , mkResourceTable -- [ ([String], Resource ()) ] -> ResourceTable
   4     , runHttpd        -- Config -> ResourceTable -> IO ()
   5     )
   6     where
   7
   8 import           Control.Concurrent
   9 import qualified Data.ByteString.Lazy.Char8 as B
  10 import           Data.ByteString.Lazy.Char8 (ByteString)
  11 import           Data.Map as M
  12 import           Data.Map (Map)
  13 import           Network
  14 import           Network.HTTP.Lucu.Config
  15 import           Network.HTTP.Lucu.Parser
  16 import           Network.HTTP.Lucu.Request
  17 import           Network.HTTP.Lucu.Resource
  18 import           Network.HTTP.Lucu.Response
  19 import           System.IO
  20
  21
  22 type ResourceTable = Map [String] (Resource ())
  23
  24
  25 mkResourceTable :: [ ([String], Resource ()) ] -> ResourceTable
  26 mkResourceTable = M.fromList
  27
  28
  29 runHttpd :: Config -> ResourceTable -> IO ()
  30 runHttpd cnf table
  31     = withSocketsDo $
  32       do so <- listenOn (cnfServerPort cnf)
  33          loop so
  34     where
  35       loop :: Socket -> IO ()
  36       loop so
  37           = do (h, host, port) <- accept so
  38                forkIO $ service h host port
  39                loop so
  40
  41
  42 service :: Handle -> HostName -> PortNumber -> IO ()
  43 service h host port
  44     = do input <- B.hGetContents h
  45          loop input
  46     where
  47       loop :: ByteString -> IO ()
  48       loop input = case parse requestP input of
  49                      Nothing
  50                          -> fail "FIXME"
  51                      Just (req, input')
  52                          -> print req