4 -- |The entry point of Lucu httpd.
5 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.Interaction
19 import Network.HTTP.Lucu.RequestReader
20 import Network.HTTP.Lucu.Resource.Tree
21 import Network.HTTP.Lucu.ResponseWriter
22 import Network.HTTP.Lucu.SocketLike as SL
24 -- |This is the entry point of Lucu httpd. It listens to a socket and
25 -- waits for clients. 'runHttpd' never stops by itself so the only way
26 -- to stop it is to raise an exception in the thread running it.
30 -- > {-# LANGUAGE OverloadedStrings #-}
31 -- > module Main where
32 -- > import Network.HTTP.Lucu
35 -- > main = let config = defaultConfig
36 -- > resources = mkResTree [ ([], helloWorld) ]
38 -- > runHttpd config resourcees []
40 -- > helloWorld :: ResourceDef
41 -- > helloWorld = emptyResource {
43 -- > = Just $ do setContentType $ parseMIMEType "text/plain"
44 -- > putChunk "Hello, world!"
46 runHttpd ∷ Config → ResTree → [FallbackHandler] → IO ()
51 [ do scnf ← cnfSSLConfig cnf
52 addr ← cnfServerV4Addr cnf
53 return ( do so ← listenOn AF_INET addr (sslServerPort scnf)
54 launchListener (sslContext scnf, so)
56 , do scnf ← cnfSSLConfig cnf
57 addr ← cnfServerV6Addr cnf
58 return ( do so ← listenOn AF_INET6 addr (sslServerPort scnf)
59 launchListener (sslContext scnf, so)
61 , do addr ← cnfServerV4Addr cnf
62 return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf)
64 , do addr ← cnfServerV6Addr cnf
65 return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf)
71 launchListener ∷ SocketLike s ⇒ s → IO ()
73 = do p ← SL.socketPort so
74 -- FIXME: Don't throw away the thread ID as we can't
75 -- kill it later then. [1]
76 void $ forkIO $ httpLoop p so
78 listenOn ∷ Family → HostName → ServiceName → IO Socket
80 = do proto ← getProtocolNumber "tcp"
81 let hints = defaultHints {
82 addrFlags = [AI_PASSIVE]
84 , addrSocketType = Stream
85 , addrProtocol = proto
87 addrs ← getAddrInfo (Just hints) (Just host) (Just srv)
90 (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
93 do setSocketOption sock ReuseAddr 1
94 bindSocket sock (addrAddress addr)
95 listen sock maxListenQueue
99 httpLoop ∷ SocketLike s ⇒ PortNumber → s → IO ()
101 = do (h, addr) ← SL.accept so
102 tQueue ← mkInteractionQueue
103 readerTID ← forkIO $ requestReader cnf tree fbs h port addr tQueue
104 _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID
108 waitForever = forever (threadDelay 1000000)