1 -- |The entry point of Lucu httpd.
2 module Network.HTTP.Lucu.Httpd
8 import Control.Concurrent
9 import Control.Exception
14 import Network.HTTP.Lucu.Config
15 import Network.HTTP.Lucu.Interaction
16 import Network.HTTP.Lucu.RequestReader
17 import Network.HTTP.Lucu.Resource.Tree
18 import Network.HTTP.Lucu.ResponseWriter
19 import Network.HTTP.Lucu.SocketLike as SL
20 import System.Posix.Signals
22 -- |This is the entry point of Lucu httpd. It listens to a socket and
23 -- waits for clients. Computation of 'runHttpd' never stops by itself
24 -- so the only way to stop it is to raise an exception in the thread
27 -- Note that 'runHttpd' automatically makes SIGPIPE be ignored by
28 -- computing @'System.Posix.Signals.installHandler'
29 -- 'System.Posix.Signals.sigPIPE' 'System.Posix.Signals.Ignore'
30 -- 'Prelude.Nothing'@. This can hardly cause a problem but it may do.
34 -- > module Main where
35 -- > import Network.HTTP.Lucu
38 -- > main = let config = defaultConfig
39 -- > resources = mkResTree [ ([], helloWorld) ]
41 -- > runHttpd config resourcees []
43 -- > helloWorld :: ResourceDef
44 -- > helloWorld = ResourceDef {
45 -- > resUsesNativeThread = False
46 -- > , resIsGreedy = False
48 -- > = Just $ do setContentType $ read "text/plain"
49 -- > output "Hello, world!"
50 -- > , resHead = Nothing
51 -- > , resPost = Nothing
52 -- > , resPut = Nothing
53 -- > , resDelete = Nothing
55 runHttpd :: Config -> ResTree -> [FallbackHandler] -> IO ()
58 do _ <- installHandler sigPIPE Ignore Nothing
62 [ do scnf <- cnfSSLConfig cnf
63 addr <- cnfServerV4Addr cnf
64 return ( do so <- listenOn AF_INET addr (sslServerPort scnf)
65 launchListener (sslContext scnf, so)
67 , do scnf <- cnfSSLConfig cnf
68 addr <- cnfServerV6Addr cnf
69 return ( do so <- listenOn AF_INET6 addr (sslServerPort scnf)
70 launchListener (sslContext scnf, so)
72 , do addr <- cnfServerV4Addr cnf
73 return ( launchListener =<< listenOn AF_INET addr (cnfServerPort cnf)
75 , do addr <- cnfServerV6Addr cnf
76 return ( launchListener =<< listenOn AF_INET6 addr (cnfServerPort cnf)
83 launchListener :: SocketLike s => s -> IO ()
85 = do p <- SL.socketPort so
86 -- FIXME: Don't throw away the thread ID as we can't
87 -- kill it later then. [1]
88 _ <- forkIO $ httpLoop p so
91 listenOn :: Family -> HostName -> ServiceName -> IO Socket
93 = do proto <- getProtocolNumber "tcp"
94 let hints = defaultHints {
95 addrFlags = [AI_PASSIVE]
97 , addrSocketType = Stream
98 , addrProtocol = proto
100 addrs <- getAddrInfo (Just hints) (Just host) (Just srv)
101 let addr = head addrs
103 (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
106 do setSocketOption sock ReuseAddr 1
107 bindSocket sock (addrAddress addr)
108 listen sock maxListenQueue
112 httpLoop :: SocketLike s => PortNumber -> s -> IO ()
114 = do (h, addr) <- SL.accept so
115 tQueue <- newInteractionQueue
116 readerTID <- forkIO $ requestReader cnf tree fbs h port addr tQueue
117 _writerTID <- forkIO $ responseWriter cnf h tQueue readerTID
121 waitForever = forever (threadDelay 1000000)