wai-cli 0.1.1 → 0.2.0
raw patch · 3 files changed
+94/−34 lines, 3 filesdep +iproutedep +wai-handler-fastcgidep ~network
Dependencies added: iproute, wai-handler-fastcgi
Dependency ranges changed: network
Files
- README.md +2/−0
- library/Network/Wai/Cli.hs +80/−29
- wai-cli.cabal +12/−5
README.md view
@@ -13,6 +13,8 @@ Extracted from [sweetroll](https://github.com/myfreeweb/sweetroll) and [microformats2-parser](https://github.com/myfreeweb/microformats2-parser)'s demo web app. +Now used in the [magicbane](https://github.com/myfreeweb/magicbane) framework (which was also extracted from sweetroll).+ ## Usage Add a dependency on `wai-cli` and write something like this:
library/Network/Wai/Cli.hs view
@@ -8,6 +8,9 @@ #ifdef WaiCliTLS import Network.Wai.Handler.WarpTLS #endif+#ifdef WaiCliFastCGI+import qualified Network.Wai.Handler.FastCGI as FCGI+#endif import Network.Wai.Middleware.RequestLogger (logStdoutDev) import Network.HTTP.Types (serviceUnavailable503) import Network.Socket.Activation@@ -15,41 +18,61 @@ import GHC.Conc (getNumCapabilities, forkIO) import System.Posix.Internals (setNonBlockingFD) import System.Posix.Signals (installHandler, sigTERM, Handler(CatchOnce))-import Data.Streaming.Network (bindPath)+import Data.Streaming.Network (bindPath, bindPortTCP) import System.Console.ANSI import Control.Concurrent.STM import Control.Monad import Control.Monad.Trans (liftIO) import Control.Exception (bracket) import Options+import Data.List (intercalate)+import Data.String (fromString)+import Data.IP (fromHostAddress, fromHostAddress6) data GracefulMode = ServeNormally | Serve503 data WaiOptions = WaiOptions- { port ∷ Int- , socket ∷ String- , protocol ∷ String+ { wHttpPort ∷ Int+ , wHttpHost ∷ String+ , wUnixSock ∷ String+ , wProtocol ∷ String #ifdef WaiCliTLS- , tlsKeyFile ∷ String- , tlsCertFile ∷ String+ , wTlsKeyFile ∷ String+ , wTlsCertFile ∷ String #endif- , gracefulMode ∷ String- , devlogging ∷ Maybe Bool }+ , wGracefulMode ∷ String+ , wDevlogging ∷ Maybe Bool } instance Options WaiOptions where defineOptions = pure WaiOptions <*> simpleOption "port" 3000 "The port the app should listen for connections on (for http)"+ <*> simpleOption "host" "*4" "Host preference (for http)" <*> simpleOption "socket" "wai.sock" "The UNIX domain socket path the app should listen for connections on (for unix)"+ <*> simpleOption "protocol" "http" ("The protocol for the server. One of: " ++ availableProtocols) #ifdef WaiCliTLS- <*> simpleOption "protocol" "http" "The protocol for the server. One of: http, http+tls, unix, unix+tls, activate, activate+tls, cgi" <*> simpleOption "tlskey" "" "Path to the TLS private key file for +tls protocols" <*> simpleOption "tlscert" "" "Path to the TLS certificate bundle file for +tls protocols"-#else- <*> simpleOption "protocol" "http" "The protocol for the server. One of: http, unix, activate, cgi" #endif <*> simpleOption "graceful" "serve-normally" "Graceful shutdown mode. One of: none, serve-normally, serve-503" <*> simpleOption "devlogging" Nothing "Whether development logging should be enabled"+ where+ availableProtocols = intercalate ", " $ concat+ [coreProtocols, tlsProtocols, fcgiProtocol]+ coreProtocols = ["http", "unix", "activate", "cgi"]+ tlsProtocols =+#ifdef WaiCliTLS+ ["http+tls", "unix+tls", "activate+tls"]+#else+ []+#endif+ fcgiProtocol =+#ifdef WaiCliFastCGI+ ["fastcgi"]+#else+ []+#endif + runActivated ∷ (Settings → S.Socket → Application → IO ()) → Settings → Application → IO () runActivated run warps app = do sockets ← getActivatedSockets@@ -80,28 +103,55 @@ conns ← readTVar activeConnections when (conns /= 0) retry +-- | Adjusts 'WaiOptions' with an address assigned to a newly created+-- server socket, uses those to set a "before main loop" function in+-- Warp 'Settings', which are then used to run an application.+runWarp :: (WaiOptions -> IO ())+ -- ^ A "before main loop" function+ -> WaiOptions+ -- ^ Original options+ -> (Settings -> S.Socket -> Application -> IO ())+ -- ^ A function such as 'runSettingsSocket'+ -> Settings -> Application -> IO ()+runWarp putListening opts runSocket set app = S.withSocketsDo $+ bracket (bindPortTCP (getPort set) (getHost set)) S.close $ \s -> do+ sa <- S.getSocketName s+ S.setCloseOnExecIfNeeded $ S.fdSocket s+ runSocket (setBeforeMainLoop (putListening $ updateOptions sa opts) set) s app+ where+ updateOptions :: S.SockAddr -> WaiOptions -> WaiOptions+ updateOptions (S.SockAddrInet pn ha) opt =+ opt { wHttpPort = fromIntegral pn, wHttpHost = show (fromHostAddress ha) }+ updateOptions (S.SockAddrInet6 pn _flow ha _scope) opt =+ opt { wHttpPort = fromIntegral pn, wHttpHost = show (fromHostAddress6 ha) }+ updateOptions _ opt = opt+ waiMain ∷ (WaiOptions → IO ()) → (WaiOptions → IO ()) → Application → IO () waiMain putListening putWelcome app = runCommand $ \opts _ → do #ifdef WaiCliTLS- let tlss = tlsSettings (tlsCertFile opts) (tlsKeyFile opts)+ let tlss = tlsSettings (wTlsCertFile opts) (wTlsKeyFile opts) #endif- let warps = setBeforeMainLoop (putListening opts) $ setPort (port opts) defaultSettings- let app' = if devlogging opts == Just True then logStdoutDev app else app- if protocol opts == "cgi"- then CGI.run app'- else do- let run = case protocol opts of- "http" → runSettings- "unix" → \warps' app'' → bracket (bindPath $ socket opts) S.close (\sock → runSettingsSocket warps' sock app'')+ let warps = setBeforeMainLoop (putListening opts) $ setPort (wHttpPort opts) $+ setHost (fromString $ wHttpHost opts) defaultSettings+ let app' = if wDevlogging opts == Just True then logStdoutDev app else app+ case wProtocol opts of+ "cgi" → CGI.run app'+#ifdef WaiCliFastCGI+ "fastcgi" → FCGI.run app'+#endif+ _ → do+ let run = case wProtocol opts of+ "http" → runWarp putListening opts runSettingsSocket+ "unix" → \warps' app'' → bracket (bindPath $ wUnixSock opts) S.close (\sock → runSettingsSocket warps' sock app'') "activate" → runActivated runSettingsSocket #ifdef WaiCliTLS- "http+tls" → runTLS tlss- "unix+tls" → \warps' app'' → bracket (bindPath $ socket opts) S.close (\sock → runTLSSocket tlss warps' sock app'')+ "http+tls" → runWarp putListening opts (runTLSSocket tlss)+ "unix+tls" → \warps' app'' → bracket (bindPath $ wUnixSock opts) S.close (\sock → runTLSSocket tlss warps' sock app'') "activate+tls" → runActivated (runTLSSocket tlss) #endif x → \_ _ → putStrLn $ "Unsupported protocol: " ++ x putWelcome opts- case gracefulMode opts of+ case wGracefulMode opts of "none" → run warps app' "serve-normally" → runGraceful ServeNormally run warps app' "serve-503" → runGraceful Serve503 run warps app'@@ -109,14 +159,15 @@ defPutListening ∷ WaiOptions → IO () defPutListening opts = getNumCapabilities >>= putMain- where putMain cpus = reset "Running on " >> blue (protocol opts) >> putProto >> reset " with " >> green (show cpus ++ " CPUs") >> setReset >> putStrLn ""- putProto = case protocol opts of- "http" → reset " port " >> boldMagenta (show $ port opts)- "unix" → reset " socket " >> boldMagenta (show $ socket opts)+ where putMain cpus = reset "Running on " >> blue (wProtocol opts) >> putProto >> reset " with " >> green (show cpus ++ " CPUs") >> setReset >> putStrLn ""+ putProto = case wProtocol opts of+ "http" → reset " host " >> boldMagenta (wHttpHost opts)+ >> reset ", port " >> boldMagenta (show $ wHttpPort opts)+ "unix" → reset " socket " >> boldMagenta (show $ wUnixSock opts) "activate" → reset " activated socket" #ifdef WaiCliTLS- "http+tls" → reset " (TLS) port " >> boldMagenta (show $ port opts)- "unix+tls" → reset " (TLS) socket " >> boldMagenta (show $ socket opts)+ "http+tls" → reset " (TLS) port " >> boldMagenta (show $ wHttpPort opts)+ "unix+tls" → reset " (TLS) socket " >> boldMagenta (show $ wUnixSock opts) "activate+tls" → reset " (TLS) activated socket" #endif _ → setReset
wai-cli.cabal view
@@ -1,5 +1,5 @@ name: wai-cli-version: 0.1.1+version: 0.2.0 synopsis: Command line runner for Wai apps (using Warp) with TLS, CGI, socket activation & graceful shutdown description: Command line runner for Wai apps (using Warp) with support for UNIX domain sockets,@@ -9,7 +9,7 @@ category: Web homepage: https://github.com/myfreeweb/wai-cli author: Greg V-copyright: 2017 Greg V <greg@unrelenting.technology>+copyright: 2017-2019 Greg V <greg@unrelenting.technology> maintainer: greg@unrelenting.technology license: PublicDomain license-file: UNLICENSE@@ -18,8 +18,7 @@ extra-source-files: README.md tested-with:- GHC == 8.0.2- GHC == 7.10.3+ GHC == 8.6.3 source-repository head type: git@@ -29,6 +28,10 @@ description: Include warp-tls default: True +flag fastcgi+ description: Include wai-handler-fastcgi+ default: False+ library build-depends: base >= 4.8.0.0 && < 5@@ -40,10 +43,11 @@ , monads-tf , stm , unix- , network+ , network >= 2.7 , wai , wai-extra , ansi-terminal+ , iproute default-language: Haskell2010 exposed-modules: Network.Wai.Cli@@ -52,3 +56,6 @@ if flag(tls) build-depends: warp-tls cpp-options: -DWaiCliTLS+ if flag(fastcgi)+ build-depends: wai-handler-fastcgi+ cpp-options: -DWaiCliFastCGI