5 -- |The entry point of Lucu httpd.
6 module Network.HTTP.Lucu.Httpd
10 import Control.Concurrent
11 import Control.Exception
13 import Control.Monad.Unicode
17 import Network.HTTP.Lucu.Config
18 import Network.HTTP.Lucu.Dispatcher
19 import Network.HTTP.Lucu.Interaction
20 import Network.HTTP.Lucu.RequestReader
21 import Network.HTTP.Lucu.ResponseWriter
22 import Network.HTTP.Lucu.SocketLike as SL
23 import Prelude.Unicode
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.
32 -- {-\# LANGUAGE OverloadedStrings \#-}
33 -- {-\# LANGUAGE QuasiQuotes \#-}
35 -- import qualified "Data.Collections" as C
37 -- import "Network.HTTP.Lucu"
40 -- main = let config = 'defaultConfig'
41 -- tree :: 'ResourceTree'
42 -- tree = C.fromList [ ([], 'nonGreedy' helloWorld) ]
44 -- 'Network.withSocketsDo' '.' 'runHttpd' config '$' 'resourceMap' tree
46 -- helloWorld :: 'Network.HTTP.Lucu.Resource'
47 -- helloWorld = C.fromList
48 -- [ ( 'Network.HTTP.Lucu.GET'
49 -- , do 'Network.HTTP.Lucu.setContentType' ['Network.HTTP.Lucu.mimeType'| text/plain |]
50 -- 'Network.HTTP.Lucu.putChunk' \"Hello, world!\"
53 runHttpd ∷ HostMapper α ⇒ Config → α → IO ()
57 [ do addr ← cnfServerV4Addr cnf
58 return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf)
60 , do addr ← cnfServerV6Addr cnf
61 return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf)
64 , do scnf ← cnfSSLConfig cnf
65 addr ← cnfServerV4Addr cnf
66 return ( do so ← listenOn AF_INET addr (sslServerPort scnf)
67 launchListener (sslContext scnf, so)
69 , do scnf ← cnfSSLConfig cnf
70 addr ← cnfServerV6Addr cnf
71 return ( do so ← listenOn AF_INET6 addr (sslServerPort scnf)
72 launchListener (sslContext scnf, so)
79 launchListener ∷ SocketLike s ⇒ s → IO ()
81 = do p ← SL.socketPort so
82 -- FIXME: Don't throw away the thread ID as we can't
83 -- kill it later then.
84 void ∘ forkIO $ httpLoop p so
86 listenOn ∷ Family → HostName → ServiceName → IO Socket
88 = do proto ← getProtocolNumber "tcp"
89 let hints = defaultHints {
90 addrFlags = [AI_PASSIVE]
92 , addrSocketType = Stream
93 , addrProtocol = proto
95 addrs ← getAddrInfo (Just hints) (Just host) (Just srv)
98 (socket (addrFamily addr)
103 do setSocketOption sock ReuseAddr 1
104 bindSocket sock (addrAddress addr)
105 listen sock maxListenQueue
109 httpLoop ∷ SocketLike s ⇒ PortNumber → s → IO ()
111 = do (h, addr) ← SL.accept so
112 tQueue ← mkInteractionQueue
113 readerTID ← forkIO $ requestReader cnf hm h port addr tQueue
114 _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID
118 waitForever = forever $ threadDelay 1000000