wai-middleware-consul (empty) → 0.1.0.0
raw patch · 7 files changed
+584/−0 lines, 7 filesdep +asyncdep +basedep +base-preludesetup-changed
Dependencies added: async, base, base-prelude, bytestring, conduit, conduit-extra, consul-haskell, enclosed-exceptions, http-client, http-types, monad-control, monad-logger, network, process, resourcet, text, transformers, void, wai, wai-app-static, wai-conduit, wai-extra, wai-middleware-consul, warp
Files
- LICENSE +20/−0
- README.md +114/−0
- Setup.hs +2/−0
- example/Main.hs +24/−0
- src/Network/Wai/Middleware/Consul.hs +252/−0
- src/Network/Wai/Middleware/Consul/GitHub.hs +106/−0
- wai-middleware-consul.cabal +66/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015, FPComplete and Contributors++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++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 OR COPYRIGHT HOLDERS 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.
+ README.md view
@@ -0,0 +1,114 @@+# WAI Consul Middleware+++++This library assists you in monitoring Consul k/v data & with+proxying data to Consul safely from the Internet. The first use+case is receiving Github 'push' notifications when a repository is+updated and doing a git pull on all webservers to update content.+The [example](./example) app shows GitHub Webhooks working.++ ┌─────────┐ ┌─────────┐+ │ Github │ │ │+ │ Repo │─────▶│ AWS ELB │+ │ Webhook │ │ │+ └─────────┘ └─────────┘+ │+ ┌────────────┬──────┘─ ─ ─+ │ │+ ▼ ▼ ▼+ ┌─────────┐ ┌─────────┐ ┌─────────┐+ │ │ │ │ │ │+ ┌──│ WAI App │ │ WAI App │ │ WAI App │+ │ │ │ │ │ │ │+ │ └─────────┘ └─────────┘ └─────────┘+ │ ▲ ▲+ │ │ │+ │ ┌────────────┴────────────┘+ │ │+ │ │+ │ ┌─────────┐ ┌─────────┐ ┌─────────┐+ │ │ │ │ │ │ │+ └─▶│ Consul │──│ Consul │──│ Consul │+ │ │ │ │ │ │+ └─────────┘ └─────────┘ └─────────┘++## Install++ cabal install wai-middleware-consul++Or if you want to play with the example github webhook web-app:++ cabal install -fexample wai-middleware-consul++## Example++You'll need to launch a small Consul cluster to try the example app.+It's easy to do with Docker. Please use the following steps:++### Launch 4 containers of Docker w/ Consul running on each++ docker run -d --name node1 -h node1 progrium/consul -server -bootstrap-expect 3+ sleep 10+ JOIN_IP="$(docker inspect -f '{{.NetworkSettings.IPAddress}}' node1)"+ docker run -d --name node2 -h node2 progrium/consul -server -join $JOIN_IP+ docker run -d --name node3 -h node3 progrium/consul -server -join $JOIN_IP+ docker run -d -p 8400:8400 -p 8500:8500 -p 8600:53/udp --name node4 -h node4 progrium/consul -join $JOIN_IP+ sleep 10++1. Try out all the interfaces of Consul++ 1. Browse the [Web UI Interface](http://localhost:8500/ui/#/dc1/services/consul)++ 2. Query Consul at the command line++ consul members++ 3. Query the HTTP Interface++ curl 0.0.0.0:8500/v1/catalog/nodes++ 4. Query the DNS Interface++ dig @0.0.0.0 -p 8600 node1.node.consul++### Setting up a Github Webhook++First we start \`ngrok\` to proxy HTTP requests from the Internet to+our local machine (most likely behind a firewall). Then we'll start+the example web application to receive webhooks from Github.++Run the example application (in the root Github directory for+wai-middleware-consul). We need to be in this directory so our+example app can find/read cabal & Github version status.++ ./.cabal-sandbox/bin/wai-middleware-consul-example++Try navigating to the example app page. <http://0.0.0.0:8080>++Run ngrok to expose the example application to the Internet:++ ngrok 8080 ;# take note of this public web address for Github++Set up the webhook for the repo on Github. Point it to the ngrok web+address and add the path /github onto that URL ( eg,+<https://be2f75d.ngrok.com/github> ). This is the specific route in+the example application for Github->Consul data updates.++Now that we have the application running and a proxy to the public+Internet established, we can receive webhook events.++Try pushing to the repository. You should see notifications that an+event was received in the web application STDOUT log. The event+should be pushed into Consul also. The web application will be+listening to events from Consul & this will fire also. You should+see it try to \`git pull\` the repository & you should see the changes+if you refresh the home page of the example app.++### Cleanup (kill & remove Consul containers)++ for n in $(seq 1 4); do+ docker kill node$n+ docker rm node$n+ done
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Main.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++import BasePrelude+import Control.Monad.IO.Class ( MonadIO(liftIO) )+import Control.Monad.Logger ( runStdoutLoggingT )+import Network.Wai.Application.Static+ ( staticApp, defaultWebAppSettings )+import Network.Wai.Handler.Warp ( run )+import Network.Wai.Middleware.Consul ( withConsul )+import Network.Wai.Middleware.Consul.GitHub ( gitHubPullOnWebhook )+import Network.Wai.Middleware.RequestLogger ( logStdoutDev )++main :: IO ()+main =+ runStdoutLoggingT+ (void (withConsul+ gitHubPullOnWebhook+ (\middleware ->+ liftIO (run 8080+ (logStdoutDev $+ middleware $+ staticApp $+ defaultWebAppSettings ".")))))
+ src/Network/Wai/Middleware/Consul.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++{-|+Module : Network.Wai.Middleware.Consul+Description : WAI Middleware for Consul+Copyright : (c) FPComplete, 2015+License : MIT+Maintainer : Tim Dysinger <tim@fpcomplete.com>+Stability : experimental+Portability : POSIX++This module helps you proxy information to Consul from the internet &+also react to changes to K/V data coming from Consul.++@+ ┌─────────┐ ┌─────────┐+ │ JSON │ │ LOAD │+ │ HTTP │─────▶│ BALANCR │+ │ POST │ │ │+ └─────────┘ └─────────┘+ │+ ┌────────────┬──────┘─ ─ ─+ │ │+ ▼ ▼ ▼+ ┌─────────┐ ┌─────────┐ ┌─────────┐+ │ │ │ │ │ │+┌──│ WAI App │ │ WAI App │ │ WAI App │+│ │ │ │ │ │ │+│ └─────────┘ └─────────┘ └─────────┘+│ ▲ ▲+│ │ │+│ ┌────────────┴────────────┘+│ │+│ │+│ ┌─────────┐ ┌─────────┐ ┌─────────┐+│ │ │ │ │ │ │+└─▶│ Consul │──│ Consul │──│ Consul │+ │ │ │ │ │ │+ └─────────┘ └─────────┘ └─────────┘+@+-}++module Network.Wai.Middleware.Consul+ ( ConsulSettings+ , defaultConsulSettings+ , getConsulCallback+ , getConsulFilter+ , getConsulHost+ , getConsulKey+ , getConsulLimit+ , getConsulPort+ , mkConsulProxy+ , mkConsulWatch+ , setConsulCallback+ , setConsulFilter+ , setConsulHost+ , setConsulKey+ , setConsulLimit+ , setConsulPort+ , withConsul+ ) where++import BasePrelude+import Control.Concurrent.Async ( race )+import Control.Exception.Enclosed ( catchAny )+import Control.Monad.IO.Class ( MonadIO(..), liftIO )+import Control.Monad.Logger ( MonadLoggerIO, logWarn )+import Control.Monad.Trans.Control+ ( MonadBaseControl(liftBaseWith, restoreM) )+import Control.Monad.Trans.Resource ( runResourceT )+import qualified Data.ByteString.Lazy as LB ( toStrict )+import Data.Conduit ( ($$) )+import Data.Void ( Void(..), absurd )+import qualified Data.Conduit.Binary as C ( take )+import Data.Text ( Text )+import qualified Data.Text as T ( pack )+import Network.Consul+ ( KeyValue(kvModifyIndex),+ KeyValuePut(KeyValuePut, kvpCasIndex, kvpFlags, kvpKey, kvpValue),+ putKey,+ initializeConsulClient,+ getKey )+import Network.HTTP.Client+ ( defaultManagerSettings, managerResponseTimeout )+import Network.HTTP.Types ( status201, methodPost )+import Network.Socket ( PortNumber(PortNum) )+import Network.Wai+ ( Middleware, Request, responseBuilder, pathInfo, requestMethod )+import Network.Wai.Conduit ( sourceRequestBody )++-- | Consul Settings for watching & proxying Consul data+data ConsulSettings =+ ConsulSettings {csHost :: Text -- ^ Consul host address+ ,csPort :: PortNumber -- ^ Consul host port+ ,csKey :: Text -- ^ Consul key+ ,csFilter :: Request -> Bool -- ^ Filter for proxy put+ ,csLimit :: Maybe Int -- ^ Optional request body size limit+ ,csCallback :: ConsulCallback -- ^ Callback when data changes+ }++type ConsulCallback = forall (m :: * -> *).+ (MonadBaseControl IO m,MonadLoggerIO m) => KeyValue -> m ()++defaultConsulSettings :: ConsulSettings+defaultConsulSettings =+ ConsulSettings {csHost = "0.0.0.0"+ ,csPort = PortNum 8500+ ,csKey = "wai"+ ,csFilter =+ (\req ->+ (requestMethod req == methodPost) &&+ (pathInfo req ==+ ["wai"]))+ ,csLimit = Nothing+ ,csCallback = liftIO . print}++setConsulHost :: Text -> ConsulSettings -> ConsulSettings+setConsulHost a b = b { csHost = a }++getConsulHost :: ConsulSettings -> Text+getConsulHost = csHost++setConsulPort :: PortNumber -> ConsulSettings -> ConsulSettings+setConsulPort a b = b { csPort = a }++getConsulPort :: ConsulSettings -> PortNumber+getConsulPort = csPort++setConsulKey :: Text -> ConsulSettings -> ConsulSettings+setConsulKey a b = b { csKey = a }++getConsulKey :: ConsulSettings -> Text+getConsulKey = csKey++setConsulFilter :: (Request -> Bool) -> ConsulSettings -> ConsulSettings+setConsulFilter a b = b { csFilter = a }++getConsulFilter :: ConsulSettings -> Request -> Bool+getConsulFilter = csFilter++setConsulLimit :: Maybe Int -> ConsulSettings -> ConsulSettings+setConsulLimit a b = b { csLimit = a }++getConsulLimit :: ConsulSettings -> Maybe Int+getConsulLimit = csLimit++setConsulCallback :: ConsulCallback -> ConsulSettings -> ConsulSettings+setConsulCallback a b = b { csCallback = a }++getConsulCallback :: ConsulSettings -> ConsulCallback+getConsulCallback = csCallback++-- | Creates a complete Consul middleware for the cluster.+-- Combines mkConsulWatch async function (watches Consul data for+-- updates) & mkConsulProxy (proxys data from the internet to Consul)+-- into one common-use function. This will probably be the function+-- you want. See the example/ application for more insight.+withConsul :: (Monad m,MonadBaseControl IO m,MonadLoggerIO m)+ => ConsulSettings -> (Middleware -> m a) -> m a+withConsul cs f =+ fmap (either absurd id)+ (liftRace (mkConsulWatch cs)+ (mkConsulProxy cs >>= f))++liftRace :: MonadBaseControl IO m+ => m a -> m b -> m (Either a b)+liftRace x y =+ do res <-+ liftBaseWith+ (\run ->+ race (run x)+ (run y))+ case res of+ Left x' -> Left <$> restoreM x'+ Right y' -> Right <$> restoreM y'++-- | Creates a background process to receive notifications.+-- Notifications happen via blocking HTTP request. (The HTTP client+-- manager used has been configured to wait forever for a response.)+-- The ConsulSettings (csHost, csPort & csKey) are used to connect to+-- Consul and watch for key-value changes. When Consul's value+-- changes, it will respond to the HTTP request. Upon receiving a+-- good changed-value response, we fire the csCallback function to+-- allow for a reaction to the data change. If there there is a+-- problem with the request/response cycle or an exception in the+-- supplied callback function, we just re-make the rquest & wait+-- patiently for changes again.+mkConsulWatch :: (MonadBaseControl IO m,MonadLoggerIO m)+ => ConsulSettings -> m Void+mkConsulWatch cs =+ initializeConsulClient (csHost cs)+ (csPort cs)+ Nothing >>=+ go 0 >>=+ pure . absurd -- this function shouldn't exit under normal circumstances+ where go idx' cc =+ catchAny (do kv <-+ getKey cc+ (csKey cs)+ (Just idx')+ Nothing+ Nothing+ case kv of+ Nothing ->+ do liftIO (threadDelay $ 1000 * 1000)+ go idx' cc+ (Just kv') ->+ do (csCallback cs $ kv')+ go (kvModifyIndex kv') cc)+ (\ex ->+ do liftIO (threadDelay $ 1000 * 1000)+ $(logWarn) (T.pack $ show ex)+ go idx' cc)++-- | Create WAI middleware that can be used to proxy incoming data+-- into Consul (one-way). This function initiates our consul client+-- and returns the middleware for WAI to use. The middleware will+-- filter incoming requests that match ConsulSettings csFilter. If+-- there is a match it will create a make the key value put call for+-- Consul using the incoming request body as the data for the Consul+-- K/V.+mkConsulProxy :: (MonadIO m,Functor m)+ => ConsulSettings -> m Middleware+mkConsulProxy cs =+ proxyToConsul <$>+ initializeConsulClient (csHost cs)+ (csPort cs)+ Nothing+ where proxyToConsul cc app' req respond+ | csFilter cs req =+ do bs <-+ liftIO (runResourceT $+ sourceRequestBody req $$+ C.take (fromMaybe 5242880 (csLimit cs)))+ let keyValuePut =+ KeyValuePut {kvpKey = csKey cs+ ,kvpValue = LB.toStrict bs+ ,kvpCasIndex = Nothing+ ,kvpFlags = Nothing}+ _workedOK <-+ putKey cc keyValuePut Nothing+ -- TODO respond negatively if Consul 'put' didn't work+ respond (responseBuilder status201 [] "")+ | otherwise = app' req respond
+ src/Network/Wai/Middleware/Consul/GitHub.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{-|+Module : Network.Wai.Middleware.Consul+Description : WAI Middleware for Consul+Copyright : (c) FPComplete, 2015+License : MIT+Maintainer : Tim Dysinger <tim@fpcomplete.com>+Stability : experimental+Portability : POSIX++This module contains specific configuration for using WAI Middleware+for Consul with Github. We can configure a GitHub Webhook to POST to+consul middleware. Consul middleware will push the GitHub webhook+payload to Consul. Consul will let every WAI application know of the+data update & each application will execute `git pull` to update their+git repository contents.++@+ ┌─────────┐ ┌─────────┐+ │ Github │ │ │+ │ Repo │─────▶│ AWS ELB │+ │ Webhook │ │ │+ └─────────┘ └─────────┘+ │+ ┌────────────┬──────┘─ ─ ─+ │ │+ ▼ ▼ ▼+ ┌─────────┐ ┌─────────┐ ┌─────────┐+ │ │ │ │ │ │+┌──│ WAI App │ │ WAI App │ │ WAI App │+│ │ │ │ │ │ │+│ └─────────┘ └─────────┘ └─────────┘+│ ▲ ▲+│ │ │+│ ┌────────────┴────────────┘+│ │+│ │+│ ┌─────────┐ ┌─────────┐ ┌─────────┐+│ │ │ │ │ │ │+└─▶│ Consul │──│ Consul │──│ Consul │+ │ │ │ │ │ │+ └─────────┘ └─────────┘ └─────────┘+@+-}++module Network.Wai.Middleware.Consul.GitHub+ (gitHubPullOnWebhook)+ where++import BasePrelude++import Control.Monad.IO.Class ( liftIO )+import qualified Data.ByteString as B ( isPrefixOf )+import Network.HTTP.Types ( methodPost, hUserAgent )+import Network.Wai+ ( Request(pathInfo, requestHeaders, requestMethod) )+import Network.Wai.Middleware.Consul+ ( ConsulSettings,+ defaultConsulSettings,+ setConsulKey,+ setConsulFilter,+ setConsulCallback )+import System.Process ( callProcess )++-- | GitHub Webhook handler with Consul callback that does a `git pull`+-- when fired.+gitHubPullOnWebhook :: ConsulSettings+gitHubPullOnWebhook =+ (setConsulKey "github" .+ setConsulFilter isGitHubWebhook .+ setConsulCallback+ (\_ ->+ liftIO (callProcess "git"+ ["pull"]))) defaultConsulSettings++isGitHubWebhook :: Request -> Bool+isGitHubWebhook req =+ (requestMethod req == methodPost) &&+ -- https://developer.github.com/webhooks/#delivery-headers "When+ -- one of those events is triggered, we’ll send a HTTP POST+ -- payload to the webhook’s configured URL."+ (pathInfo req ==+ ["github"]) &&+ -- "X-Github-Event: Name of the event that triggered this+ -- delivery."+ (lookup' "X-Github-Event" (requestHeaders req) ==+ ["push"]) &&+ -- "X-Hub-Signature: HMAC hex digest of the payload, using the+ -- hook’s secret as the key (if configured)."+ (lookup' "X-Hub-Signature" (requestHeaders req) /=+ []) && -- FIXME: Validate HMAC+ -- "X-Github-Delivery: Unique ID for this delivery."+ (lookup' "X-Github-Delivery" (requestHeaders req) /=+ []) &&+ -- "Also, the User-Agent for the requests will have the prefix+ -- GitHub-Hookshot/"+ case lookup' hUserAgent (requestHeaders req) of+ [agent] -> "GitHub-Hookshot/" `B.isPrefixOf` agent+ _ -> False+ where lookup' a =+ map snd .+ filter (\x -> a == fst x)
+ wai-middleware-consul.cabal view
@@ -0,0 +1,66 @@+name: wai-middleware-consul+version: 0.1.0.0+homepage: https://github.com/fpco/wai-middleware-consul+synopsis: Wai Middleware for Consul+description: Proxies data to/from Consul. Watches for updates.+category: Network+license: MIT+license-file: LICENSE+author: FP Complete Developers+maintainer: dev@fpcomplete.com+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++flag example+ description: enable example-app executable+ default: False++source-repository head+ type: git+ location: https://github.com/fpco/wai-middleware-consul++library+ default-language: Haskell2010+ hs-source-dirs: src+ exposed-modules: Network.Wai.Middleware.Consul+ , Network.Wai.Middleware.Consul.GitHub+ build-depends: async+ , base >=4 && <5+ , base-prelude+ , bytestring+ , conduit+ , conduit-extra+ , consul-haskell+ , enclosed-exceptions+ , http-client+ , http-types+ , monad-control+ , monad-logger+ , network+ , process+ , resourcet+ , text+ , transformers+ , void+ , wai+ , wai-conduit++executable wai-middleware-consul-example+ if flag(example)+ buildable: True+ else+ buildable: False+ default-language: Haskell2010+ hs-source-dirs: example+ main-is: Main.hs+ build-depends: async+ , base >=4 && <5+ , base-prelude+ , monad-logger+ , transformers+ , wai+ , wai-app-static+ , wai-extra+ , wai-middleware-consul+ , warp