diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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: diff --git a/library/Network/Wai/Cli.hs b/library/Network/Wai/Cli.hs --- a/library/Network/Wai/Cli.hs +++ b/library/Network/Wai/Cli.hs @@ -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 diff --git a/wai-cli.cabal b/wai-cli.cabal --- a/wai-cli.cabal +++ b/wai-cli.cabal @@ -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 +copyright: 2017-2019 Greg V 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