5 -- |The entry point of Lucu httpd.
6 module Network.HTTP.Lucu.Httpd
11 import Control.Concurrent
12 import Control.Exception
14 import Control.Monad.Unicode
18 import Network.HTTP.Lucu.Config
19 import Network.HTTP.Lucu.Interaction
20 import Network.HTTP.Lucu.RequestReader
21 import Network.HTTP.Lucu.Resource.Tree
22 import Network.HTTP.Lucu.ResponseWriter
23 import Network.HTTP.Lucu.SocketLike as SL
25 -- |This is the entry point of Lucu httpd. It listens to a socket and
26 -- waits for clients. 'runHttpd' never stops by itself so the only way
27 -- to stop it is to raise an exception in the thread running it.
31 -- > {-# LANGUAGE OverloadedStrings #-}
32 -- > module Main where
33 -- > import Network.HTTP.Lucu
36 -- > main = let config = defaultConfig
37 -- > resources = mkResTree [ ([], helloWorld) ]
39 -- > runHttpd config resourcees []
41 -- > helloWorld :: ResourceDef
42 -- > helloWorld = emptyResource {
44 -- > = Just $ do setContentType $ parseMIMEType "text/plain"
45 -- > putChunk "Hello, world!"
47 runHttpd ∷ Config → ResTree → [FallbackHandler] → IO ()
52 [ do addr ← cnfServerV4Addr cnf
53 return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf)
55 , do addr ← cnfServerV6Addr cnf
56 return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf)
59 , do scnf ← cnfSSLConfig cnf
60 addr ← cnfServerV4Addr cnf
61 return ( do so ← listenOn AF_INET addr (sslServerPort scnf)
62 launchListener (sslContext scnf, so)
64 , do scnf ← cnfSSLConfig cnf
65 addr ← cnfServerV6Addr cnf
66 return ( do so ← listenOn AF_INET6 addr (sslServerPort scnf)
67 launchListener (sslContext scnf, so)
74 launchListener ∷ SocketLike s ⇒ s → IO ()
76 = do p ← SL.socketPort so
77 -- FIXME: Don't throw away the thread ID as we can't
78 -- kill it later then. [1]
79 void $ forkIO $ httpLoop p so
81 listenOn ∷ Family → HostName → ServiceName → IO Socket
83 = do proto ← getProtocolNumber "tcp"
84 let hints = defaultHints {
85 addrFlags = [AI_PASSIVE]
87 , addrSocketType = Stream
88 , addrProtocol = proto
90 addrs ← getAddrInfo (Just hints) (Just host) (Just srv)
93 (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
96 do setSocketOption sock ReuseAddr 1
97 bindSocket sock (addrAddress addr)
98 listen sock maxListenQueue
102 httpLoop ∷ SocketLike s ⇒ PortNumber → s → IO ()
104 = do (h, addr) ← SL.accept so
105 tQueue ← mkInteractionQueue
106 readerTID ← forkIO $ requestReader cnf tree fbs h port addr tQueue
107 _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID
111 waitForever = forever (threadDelay 1000000)