X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpd.hs;h=3f2d7330796d7acea4cebf8a39680a24a44fa0b9;hb=8a7649cdf5d96d511dd6e2dfa4e2b741ffac4f9a;hp=c8a21b7d256d8c0d7128205c18e747dd0b52246f;hpb=46ea3a688edea377e83794d1387f3f2d203bb0c6;p=Lucu.git diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index c8a21b7..3f2d733 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -1,5 +1,6 @@ {-# LANGUAGE - UnicodeSyntax + CPP + , UnicodeSyntax #-} -- |The entry point of Lucu httpd. module Network.HTTP.Lucu.Httpd @@ -28,6 +29,7 @@ import Network.HTTP.Lucu.SocketLike as SL -- Example: -- -- > {-# LANGUAGE OverloadedStrings #-} +-- > {-# LANGUAGE QuasiQuotes #-} -- > module Main where -- > import Network.HTTP.Lucu -- > @@ -40,7 +42,7 @@ import Network.HTTP.Lucu.SocketLike as SL -- > helloWorld :: ResourceDef -- > helloWorld = emptyResource { -- > resGet --- > = Just $ do setContentType $ parseMIMEType "text/plain" +-- > = Just $ do setContentType [mimeType| text/plain |] -- > putChunk "Hello, world!" -- > } runHttpd ∷ Config → ResTree → [FallbackHandler] → IO () @@ -48,7 +50,14 @@ runHttpd cnf tree fbs = withSocketsDo $ do let launchers = catMaybes - [ do scnf ← cnfSSLConfig cnf + [ do addr ← cnfServerV4Addr cnf + return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf) + ) + , do addr ← cnfServerV6Addr cnf + return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf) + ) +#if defined(HAVE_SSL) + , do scnf ← cnfSSLConfig cnf addr ← cnfServerV4Addr cnf return ( do so ← listenOn AF_INET addr (sslServerPort scnf) launchListener (sslContext scnf, so) @@ -58,12 +67,7 @@ runHttpd cnf tree fbs return ( do so ← listenOn AF_INET6 addr (sslServerPort scnf) launchListener (sslContext scnf, so) ) - , do addr ← cnfServerV4Addr cnf - return ( launchListener =≪ listenOn AF_INET addr (cnfServerPort cnf) - ) - , do addr ← cnfServerV6Addr cnf - return ( launchListener =≪ listenOn AF_INET6 addr (cnfServerPort cnf) - ) +#endif ] sequence_ launchers waitForever