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
24 import Prelude.Unicode
26 -- |This is the entry point of Lucu httpd. It listens to a socket and
27 -- waits for clients. 'runHttpd' never stops by itself so the only way
28 -- to stop it is to raise an exception in the thread running it.
32 -- > {-# LANGUAGE OverloadedStrings #-}
33 -- > {-# LANGUAGE QuasiQuotes #-}
34 -- > module Main where
35 -- > import Network.HTTP.Lucu
38 -- > main = let config = defaultConfig
39 -- > resources = mkResTree [ ([], helloWorld) ]
41 -- > runHttpd config resourcees []
43 -- > helloWorld :: Resource
44 -- > helloWorld = emptyResource {
46 -- > = Just $ do setContentType [mimeType| text/plain |]
47 -- > putChunk "Hello, world!"
49 runHttpd ∷ Config → ResTree → [FallbackHandler] → IO ()
54 [ do addr ← cnfServerV4Addr cnf
55 return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf)
57 , do addr ← cnfServerV6Addr cnf
58 return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf)
61 , do scnf ← cnfSSLConfig cnf
62 addr ← cnfServerV4Addr cnf
63 return ( do so ← listenOn AF_INET addr (sslServerPort scnf)
64 launchListener (sslContext scnf, so)
66 , do scnf ← cnfSSLConfig cnf
67 addr ← cnfServerV6Addr cnf
68 return ( do so ← listenOn AF_INET6 addr (sslServerPort scnf)
69 launchListener (sslContext scnf, so)
76 launchListener ∷ SocketLike s ⇒ s → IO ()
78 = do p ← SL.socketPort so
79 -- FIXME: Don't throw away the thread ID as we can't
80 -- kill it later then.
81 void ∘ forkIO $ httpLoop p so
83 listenOn ∷ Family → HostName → ServiceName → IO Socket
85 = do proto ← getProtocolNumber "tcp"
86 let hints = defaultHints {
87 addrFlags = [AI_PASSIVE]
89 , addrSocketType = Stream
90 , addrProtocol = proto
92 addrs ← getAddrInfo (Just hints) (Just host) (Just srv)
95 (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
98 do setSocketOption sock ReuseAddr 1
99 bindSocket sock (addrAddress addr)
100 listen sock maxListenQueue
104 httpLoop ∷ SocketLike s ⇒ PortNumber → s → IO ()
106 = do (h, addr) ← SL.accept so
107 tQueue ← mkInteractionQueue
108 readerTID ← forkIO $ requestReader cnf tree fbs h port addr tQueue
109 _writerTID ← forkIO $ responseWriter cnf h tQueue readerTID
113 waitForever = forever (threadDelay 1000000)