1 -- |The entry point of Lucu httpd.
2 module Network.HTTP.Lucu.Httpd
8 import Control.Concurrent
10 import qualified Network.Socket as So
11 import Network.HTTP.Lucu.Config
12 import Network.HTTP.Lucu.Interaction
13 import Network.HTTP.Lucu.RequestReader
14 import Network.HTTP.Lucu.Resource.Tree
15 import Network.HTTP.Lucu.ResponseWriter
17 import System.Posix.Signals
19 -- |This is the entry point of Lucu httpd. It listens to a socket and
20 -- waits for clients. Computation of 'runHttpd' never stops by itself
21 -- so the only way to stop it is to raise an exception in the thread
24 -- Note that 'runHttpd' automatically makes SIGPIPE be ignored by
25 -- computing @'System.Posix.Signals.installHandler'
26 -- 'System.Posix.Signals.sigPIPE' 'System.Posix.Signals.Ignore'
27 -- 'Prelude.Nothing'@. This can hardly cause a problem but it may do.
31 -- > module Main where
32 -- > import Network.HTTP.Lucu
35 -- > main = let config = defaultConfig
36 -- > resources = mkResTree [ ([], helloWorld) ]
38 -- > runHttpd config resourcees []
40 -- > helloWorld :: ResourceDef
41 -- > helloWorld = ResourceDef {
42 -- > resUsesNativeThread = False
43 -- > , resIsGreedy = False
45 -- > = Just $ do setContentType $ read "text/plain"
46 -- > output "Hello, world!"
47 -- > , resHead = Nothing
48 -- > , resPost = Nothing
49 -- > , resPut = Nothing
50 -- > , resDelete = Nothing
52 runHttpd :: Config -> ResTree -> [FallbackHandler] -> IO ()
55 do installHandler sigPIPE Ignore Nothing
56 so <- listenOn (cnfServerPort cnf)
59 loop :: Socket -> IO ()
61 -- 本當は Network.accept を使ひたいが、このアクションは勝手に
62 -- リモートのIPを逆引きするので、使へない。
63 = do (h, addr) <- accept' so
64 tQueue <- newInteractionQueue
65 readerTID <- forkIO $ requestReader cnf tree fbs h addr tQueue
66 _writerTID <- forkIO $ responseWriter cnf h tQueue readerTID
69 accept' :: Socket -> IO (Handle, So.SockAddr)
71 = do (soPeer, addr) <- So.accept soSelf
72 hPeer <- So.socketToHandle soPeer ReadWriteMode