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 -- FIXME: use monad-parallel's MonadFork instead of IO.
54 runHttpd ∷ HostMapper α ⇒ Config → α → IO ()
58 [ do addr ← cnfServerV4Addr cnf
59 return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf)
61 , do addr ← cnfServerV6Addr cnf
62 return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf)
65 , do scnf ← cnfSSLConfig cnf
66 addr ← cnfServerV4Addr cnf
67 return ( do so ← listenOn AF_INET addr (sslServerPort scnf)
68 launchListener (sslContext scnf, so)
70 , do scnf ← cnfSSLConfig cnf
71 addr ← cnfServerV6Addr cnf
72 return ( do so ← listenOn AF_INET6 addr (sslServerPort scnf)
73 launchListener (sslContext scnf, so)
80 launchListener ∷ SocketLike s ⇒ s → IO ()
82 = do p ← SL.socketPort so
83 -- FIXME: Don't throw away the thread ID as we can't
84 -- kill it later then.
85 void ∘ forkIO $ httpLoop p so
87 listenOn ∷ Family → HostName → ServiceName → IO Socket
89 = do proto ← getProtocolNumber "tcp"
90 let hints = defaultHints {
91 addrFlags = [AI_PASSIVE]
93 , addrSocketType = Stream
94 , addrProtocol = proto
96 addrs ← getAddrInfo (Just hints) (Just host) (Just srv)
99 (socket (addrFamily addr)
100 (addrSocketType addr)
104 do setSocketOption sock ReuseAddr 1
105 bindSocket sock (addrAddress addr)
106 listen sock maxListenQueue
110 httpLoop ∷ SocketLike s ⇒ PortNumber → s → IO ()
112 = do (h, addr) ← SL.accept so
113 tQueue ← mkInteractionQueue
114 readerTID ← forkIO $ requestReader cnf hm h port addr tQueue
115 _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID
119 waitForever = forever $ threadDelay 1000000