X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpd.hs;h=fb87d820f13f42a665c1b4a86cc99f6678fdaed4;hb=57b93dc50655857941cc176aed2fc085e6555ff7;hp=c127250d9ededf0a1770c43a6e3d3097e937232c;hpb=2bcf36a739341aaaf56d812286d57233fff81ad5;p=Lucu.git diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index c127250..fb87d82 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -4,8 +4,7 @@ #-} -- |The entry point of Lucu httpd. module Network.HTTP.Lucu.Httpd - ( FallbackHandler - , runHttpd + ( runHttpd ) where import Control.Concurrent @@ -16,9 +15,9 @@ import Data.Maybe import Network.BSD import Network.Socket import Network.HTTP.Lucu.Config +import Network.HTTP.Lucu.Dispatcher import Network.HTTP.Lucu.Interaction import Network.HTTP.Lucu.RequestReader -import Network.HTTP.Lucu.Resource.Tree import Network.HTTP.Lucu.ResponseWriter import Network.HTTP.Lucu.SocketLike as SL import Prelude.Unicode @@ -32,24 +31,26 @@ import Prelude.Unicode -- > {-# LANGUAGE OverloadedStrings #-} -- > {-# LANGUAGE QuasiQuotes #-} -- > module Main where +-- > import Network -- > import Network.HTTP.Lucu -- > -- > main :: IO () -- > main = let config = defaultConfig -- > resources = mkResTree [ ([], helloWorld) ] -- > in --- > runHttpd config resourcees [] +-- > withSocketsDo $ runHttpd config resourcees [] -- > --- > helloWorld :: ResourceDef +-- > helloWorld :: Resource -- > helloWorld = emptyResource { -- > resGet -- > = Just $ do setContentType [mimeType| text/plain |] -- > putChunk "Hello, world!" -- > } -runHttpd ∷ Config → ResTree → [FallbackHandler] → IO () -runHttpd cnf tree fbs - = withSocketsDo $ - do let launchers +-- +-- FIXME: update the above example +runHttpd ∷ Config → HostMap → IO () +runHttpd cnf hm + = do let launchers = catMaybes [ do addr ← cnfServerV4Addr cnf return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf) @@ -92,7 +93,9 @@ runHttpd cnf tree fbs addrs ← getAddrInfo (Just hints) (Just host) (Just srv) let addr = head addrs bracketOnError - (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) + (socket (addrFamily addr) + (addrSocketType addr) + (addrProtocol addr)) sClose (\ sock → do setSocketOption sock ReuseAddr 1 @@ -105,9 +108,9 @@ runHttpd cnf tree fbs httpLoop port so = do (h, addr) ← SL.accept so tQueue ← mkInteractionQueue - readerTID ← forkIO $ requestReader cnf tree fbs h port addr tQueue + readerTID ← forkIO $ requestReader cnf hm h port addr tQueue _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID httpLoop port so waitForever ∷ IO () - waitForever = forever (threadDelay 1000000) + waitForever = forever $ threadDelay 1000000