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