packages feed

wai-cli (empty) → 0.1.0

raw patch · 5 files changed

+250/−0 lines, 5 filesdep +ansi-terminaldep +basedep +http-typessetup-changed

Dependencies added: ansi-terminal, base, http-types, monads-tf, network, options, socket-activation, stm, streaming-commons, unix, wai, wai-extra, warp, warp-tls

Files

+ README.md view
@@ -0,0 +1,40 @@+# wai-cli [![Hackage](https://img.shields.io/hackage/v/wai-cli.svg?style=flat)](https://hackage.haskell.org/package/wai-cli) [![Build Status](https://img.shields.io/travis/myfreeweb/wai-cli.svg?style=flat)](https://travis-ci.org/myfreeweb/wai-cli) [![unlicense](https://img.shields.io/badge/un-license-green.svg?style=flat)](http://unlicense.org)++A command line runner for Wai apps (using Warp) with support for:++- `--protocol http --port 8000` TCP sockets+- `--protocol unix --socket /var/run/app/sock` UNIX domain sockets+- `--protocol cgi` running as a CGI app (the original serverless lambda functions from the 90s)+- `--protocol activate` socket activation (systemd-compatible, but not restricted to systemd in any way. see [soad](https://github.com/myfreeweb/soad) for an interesting use of (de)activation!)+- `--protocol (http+tls|unix+tls|activate+tls) --tlskey key.pem --tlscert cert.pem` TLS (can be turned off with a cabal flag to avoid compiling [the TLS library](https://github.com/vincenthz/hs-tls))+- `--graceful (none|serve-normally|serve-503)` graceful shutdown (on TERM signal)+- `--devlogging` development logging (from `wai-extra`)+- printing a pretty and colorful run message (e.g. `Running on http port 3000 with 4 CPUs`) (you can replace it with your own, or with nothing)++Extracted from [sweetroll](https://github.com/myfreeweb/sweetroll) / [wai-cli](https://github.com/myfreeweb/wai-cli)'s demo web app.++## Usage++Add a dependency on `wai-cli` and write something like this:++```haskell+{-# LANGUAGE OverloadedStrings #-}+import Web.Scotty+import Network.Wai.Cli+import Data.Monoid (mconcat)++app = scottyApp $ do+  get "/:word" $ do+    beam <- param "word"+    html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]++main = defWaiMain =<< app+```++Want to use command line args for your application-specific settings? Don't.+Use environment variables instead. (Possibly with [dotenv](https://github.com/stackbuilders/dotenv-hs) to load some of them from a file.)++## License++This is free and unencumbered software released into the public domain.  +For more information, please refer to the `UNLICENSE` file or [unlicense.org](http://unlicense.org).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UNLICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>
+ library/Network/Wai/Cli.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE CPP, OverloadedStrings, UnicodeSyntax #-}++module Network.Wai.Cli (module Network.Wai.Cli) where++import           Network.Wai (responseLBS, Application)+import qualified Network.Wai.Handler.CGI as CGI+import           Network.Wai.Handler.Warp hiding (run)+#ifdef WaiCliTLS+import           Network.Wai.Handler.WarpTLS+#endif+import           Network.Wai.Middleware.RequestLogger (logStdoutDev)+import           Network.HTTP.Types (serviceUnavailable503)+import           Network.Socket.Activation+import qualified Network.Socket as S+import           GHC.Conc (getNumCapabilities, forkIO)+import           System.Posix.Internals (setNonBlockingFD)+import           System.Posix.Signals (installHandler, sigTERM, Handler(CatchOnce))+import           Data.Streaming.Network (bindPath)+import           System.Console.ANSI+import           Control.Concurrent.STM+import           Control.Monad+import           Control.Monad.Trans (liftIO)+import           Control.Exception (bracket)+import           Options++data GracefulMode = ServeNormally | Serve503++data WaiOptions = WaiOptions+  { port                     ∷ Int+  , socket                   ∷ String+  , protocol                 ∷ String+#ifdef WaiCliTLS+  , tlsKeyFile               ∷ String+  , tlsCertFile              ∷ String+#endif+  , gracefulMode             ∷ String+  , devlogging               ∷ Maybe Bool }++instance Options WaiOptions where+  defineOptions = pure WaiOptions+    <*> simpleOption "port"              3000                "The port the app should listen for connections on (for http)"+    <*> simpleOption "socket"            "wai.sock"          "The UNIX domain socket path the app should listen for connections on (for unix)"+#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"++runActivated ∷ (Settings → S.Socket → Application → IO ()) → Settings → Application → IO ()+runActivated run warps app = do+  sockets ← getActivatedSockets+  case sockets of+    Just socks →+      void $ forM socks $ \sock → do+        setNonBlockingFD (S.fdSocket sock) True+        forkIO $ run warps sock app+    Nothing → putStrLn "No sockets to activate"++runGraceful ∷ GracefulMode → (Settings → Application → IO ()) → Settings → Application → IO ()+runGraceful mode run warps app = do+  -- based on https://gist.github.com/NathanHowell/5435345+  -- XXX: an option to stop accepting (need change stuff inside Warp?)+  shutdown ← newEmptyTMVarIO+  activeConnections ← newTVarIO (0 ∷ Int)+  _ ← installHandler sigTERM (CatchOnce $ atomically $ putTMVar shutdown ()) Nothing+  let warps' = setOnOpen  (\_ → atomically (modifyTVar' activeConnections (+1)) >> return True) $+               setOnClose (\_ → atomically (modifyTVar' activeConnections (subtract 1)) >> return ()) warps+  let app' = case mode of+        ServeNormally → app+        Serve503 → \req respond → do+          shouldRun ← liftIO . atomically $ isEmptyTMVar shutdown+          if shouldRun then app req respond else respond $ responseLBS serviceUnavailable503 [] ""+  void $ forkIO $ run warps' app'+  atomically $ do+    takeTMVar shutdown+    conns ← readTVar activeConnections+    when (conns /= 0) retry++waiMain ∷ (WaiOptions → IO ()) → (WaiOptions → IO ()) → Application → IO ()+waiMain putListening putWelcome app = runCommand $ \opts _ → do+#ifdef WaiCliTLS+  let tlss = tlsSettings (tlsCertFile opts) (tlsKeyFile 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'')+             "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'')+             "activate+tls" → runActivated (runTLSSocket tlss)+#endif+             x → \_ _ → putStrLn $ "Unsupported protocol: " ++ x+       putWelcome opts+       case gracefulMode opts of+             "none" → run warps app'+             "serve-normally" → runGraceful ServeNormally run warps app'+             "serve-503" → runGraceful Serve503 run warps app'+             x  → putStrLn $ "Unsupported graceful mode: " ++ x++defPutListening ∷ WaiOptions → IO ()+defPutListening opts = getNumCapabilities >>= putMain+  where putMain cpus = reset "Running on " >> blue (protocol opts) >> putProto >> reset " with " >> green (show cpus ++ " CPUs") >> putStrLn ""+        putProto = case protocol opts of+                     "http" → reset " port "   >> boldMagenta (show $ port opts)+                     "unix" → reset " socket " >> boldMagenta (show $ socket opts)+                     "activate" → reset " activated socket"+#ifdef SweetrollTLS+                     "http+tls" → reset " (TLS) port "   >> boldMagenta (show $ port opts)+                     "unix+tls" → reset " (TLS) socket " >> boldMagenta (show $ socket opts)+                     "activate+tls" → reset " (TLS) activated socket"+#endif+                     _      → setReset+        setReset = setSGR [ Reset ]+        boldMagenta x = setReset >> setSGR [ SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Magenta ] >> putStr x+        green x = setReset >> setSGR [ SetColor Foreground Dull Green ] >> putStr x+        blue  x = setReset >> setSGR [ SetColor Foreground Dull Blue ] >> putStr x+        reset x = setReset >> putStr x++defWaiMain ∷ Application → IO ()+defWaiMain = waiMain defPutListening (\_ → return ())
+ wai-cli.cabal view
@@ -0,0 +1,54 @@+name:            wai-cli+version:         0.1.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,+    TLS (can be turned off with a cabal flag to avoid compiling the TLS library), CGI,+    socket activation (systemd-compatible, but see https://github.com/myfreeweb/soad for a more interesting (and not linux-only) thing than what systemd does),+    and graceful shutdown (on TERM signal).+category:        Web+homepage:        https://github.com/myfreeweb/wai-cli+author:          Greg V+copyright:       2017 Greg V <greg@unrelenting.technology>+maintainer:      greg@unrelenting.technology+license:         PublicDomain+license-file:    UNLICENSE+build-type:      Simple+cabal-version:   >= 1.10+extra-source-files:+    README.md+tested-with:+    GHC == 8.0.1+    GHC == 7.10.3++source-repository head+    type: git+    location: git://github.com/myfreeweb/wai-cli.git++flag tls+    description: Include warp-tls+    default: True++library+    build-depends:+        base >= 4.8.0.0 && < 5+      , options+      , warp+      , socket-activation+      , streaming-commons+      , http-types+      , monads-tf+      , stm+      , unix+      , network+      , wai+      , wai-extra+      , ansi-terminal+    default-language: Haskell2010+    exposed-modules:+        Network.Wai.Cli+    ghc-options: -Wall+    hs-source-dirs: library+    if flag(tls)+        build-depends: warp-tls+        cpp-options: -DWaiCliTLS