X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpd.hs;h=03fde6b714fde24a307005202ddb5564bd611a56;hb=667baf9;hp=4d724eb92843f6f9d1fd6c97dc46cef553aaa376;hpb=b22e702f8161447a460847c6e6c97104c150534f;p=Lucu.git diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index 4d724eb..03fde6b 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,13 +31,14 @@ 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 :: Resource -- > helloWorld = emptyResource { @@ -46,10 +46,10 @@ import Prelude.Unicode -- > = 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 → SchemeMap → IO () +runHttpd cnf sm + = do let launchers = catMaybes [ do addr ← cnfServerV4Addr cnf return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf) @@ -92,7 +92,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 +107,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 sm h port addr tQueue _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID httpLoop port so waitForever ∷ IO () - waitForever = forever (threadDelay 1000000) + waitForever = forever $ threadDelay 1000000