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.
31 -- > {-# LANGUAGE OverloadedStrings #-}
32 -- > {-# LANGUAGE QuasiQuotes #-}
33 -- > module Main where
35 -- > import Network.HTTP.Lucu
38 -- > main = let config = defaultConfig
39 -- > resources = mkResTree [ ([], helloWorld) ]
41 -- > withSocketsDo $ runHttpd config resourcees []
43 -- > helloWorld :: Resource
44 -- > helloWorld = emptyResource {
46 -- > = Just $ do setContentType [mimeType| text/plain |]
47 -- > putChunk "Hello, world!"
50 -- FIXME: update the above example
51 runHttpd ∷ HostMapper α ⇒ Config → α → IO ()
55 [ do addr ← cnfServerV4Addr cnf
56 return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf)
58 , do addr ← cnfServerV6Addr cnf
59 return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf)
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)
77 launchListener ∷ SocketLike s ⇒ s → IO ()
79 = do p ← SL.socketPort so
80 -- FIXME: Don't throw away the thread ID as we can't
81 -- kill it later then.
82 void ∘ forkIO $ httpLoop p so
84 listenOn ∷ Family → HostName → ServiceName → IO Socket
86 = do proto ← getProtocolNumber "tcp"
87 let hints = defaultHints {
88 addrFlags = [AI_PASSIVE]
90 , addrSocketType = Stream
91 , addrProtocol = proto
93 addrs ← getAddrInfo (Just hints) (Just host) (Just srv)
96 (socket (addrFamily addr)
101 do setSocketOption sock ReuseAddr 1
102 bindSocket sock (addrAddress addr)
103 listen sock maxListenQueue
107 httpLoop ∷ SocketLike s ⇒ PortNumber → s → IO ()
109 = do (h, addr) ← SL.accept so
110 tQueue ← mkInteractionQueue
111 readerTID ← forkIO $ requestReader cnf hm h port addr tQueue
112 _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID
116 waitForever = forever $ threadDelay 1000000