cerberus (empty) → 0.1.0.0
raw patch · 6 files changed
+294/−0 lines, 6 filesdep +basedep +blaze-builderdep +bytestringsetup-changed
Dependencies added: base, blaze-builder, bytestring, cerberus, cmdargs, conduit-extra, ekg, ekg-core, hslogger, http-client, http-client-tls, http-reverse-proxy, http-types, pretty-show, text, wai, wai-middleware-caching, wai-middleware-caching-lru, wai-middleware-caching-redis, wai-middleware-throttle, warp
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +94/−0
- cerberus.cabal +63/−0
- src/Cerberus/Lib.hs +103/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Yann Esposito (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Yann Esposito nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Char (toLower)+import Data.Monoid ((<>))+import System.Console.CmdArgs.Implicit+import System.Log.Formatter+import System.Log.Handler (setFormatter)+import System.Log.Handler.Simple+import System.Log.Handler.Syslog+import System.Log.Logger+import System.Metrics+import System.Remote.Monitoring (forkServerWith)+import Text.Show.Pretty (ppShow)++import Cerberus.Lib++data Options = Options { proxyUrl :: String+ , debug :: Bool+ , proxyPort :: Int+ , port :: Int+ , maxNbReqBySeconds :: Int+ , infoPort :: Int+ , cacheSize :: Integer+ , backendCache :: String+ , redisHost :: String+ , redisPort :: Int+ , redisPass :: Maybe String+ } deriving (Show, Data, Typeable)+options :: Options+options = Options {+ debug = False &= help "Debug mode"+ , proxyUrl = ("api.projectoxford.ai" :: String)+ &= name "proxy-url"+ &= help "External HTTPS URL to proxy to."+ &= typ "HOST"+ , backendCache = "LRU" &= name "backend-cache" &= help "Could be LRU or Redis"+ , proxyPort = 443 &= name "proxy-port" &= help "External Port default 443"+ , port = 3000 &= help "port to listen to"+ , maxNbReqBySeconds = 60+ &= name "max-nb-req-by-sec"+ &= help "max number of requests by seconds"+ , infoPort = 8000+ &= help "port to look at monitoring infos"+ &= name "info-port"+ , cacheSize = 10000000+ &= name "cache-size"+ &= help "size of cache"+ , redisHost = "localhost" &= name "redis-host" &= help "Redis host" &= groupname "Redis"+ , redisPort = 6379 &= name "redis-port" &= help "Redis port" &= groupname "Redis"+ , redisPass = Nothing &= name "redis-password" &= groupname "Redis"+ } &= program "cerberus" &= summary "cerberus v0.1 © Vigiglobe 2015"++initLogging :: Bool -> IO ()+initLogging debugMode = do+ let defaultLevel = if debugMode then DEBUG else WARNING+ h <- fileHandler "cerberus.log" defaultLevel+ >>= \lh -> return (setFormatter lh (simpleLogFormatter "[$time : $loggername : $prio] $msg"))+ updateGlobalLogger rootLoggerName (addHandler h)+ s <- openlog "tornado" [PID] LOCAL7 defaultLevel+ updateGlobalLogger rootLoggerName (addHandler s)+ updateGlobalLogger rootLoggerName (setLevel defaultLevel)++main :: IO ()+main = do+ opts <- cmdArgsRun (cmdArgsMode options)+ initLogging (debug opts)+ putStrLn (ppShow opts)+ store <- newStore+ req <- createCounter "cerberus.requests_count" store+ reqF <- createCounter "cerberus.requests_followed_count" store+ reqC <- createCounter "cerberus.requests_cached_count" store+ _ <- forkServerWith store "localhost" (infoPort opts)+ putStrLn ("Go to http://localhost:" <> show (port opts)+ <> " to reach https://" <> proxyUrl opts+ <> ":" <> show (proxyPort opts))+ let+ backend = case map toLower (backendCache opts) of+ "redis" -> Redis+ "lru" -> LRU+ _ -> error "Unrecognized backend cache should be LRU or Redis."+ proxyOpts = ProxyOpts req reqF reqC+ (cacheSize opts)+ (port opts)+ (proxyUrl opts)+ (proxyPort opts)+ (fromIntegral (maxNbReqBySeconds opts))+ backend+ (redisHost opts)+ (redisPort opts)+ (redisPass opts)+ serveProxy proxyOpts
+ cerberus.cabal view
@@ -0,0 +1,63 @@+name: cerberus+version: 0.1.0.0+synopsis: Protect and control API access with cerberus+description: Please see README.md+homepage: http://github.com/yogsototh/cerberus#readme+license: BSD3+license-file: LICENSE+author: Yann Esposito+maintainer: yann.esposito@gmail.com+copyright: 2015 Yann Esposito+category: Development+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Cerberus.Lib+ build-depends: base >= 4.7 && < 5+ , blaze-builder+ , bytestring+ , conduit-extra+ , ekg+ , ekg-core+ , hslogger+ , http-types+ , http-client+ , http-client-tls+ , http-reverse-proxy+ , text+ , wai+ , wai-middleware-throttle+ , wai-middleware-caching >= 0.1.0.2+ , wai-middleware-caching-lru+ , wai-middleware-caching-redis+ , warp+ default-language: Haskell2010++executable cerberus+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -Wall -O2 -threaded -optc-O3 -rtsopts -auto-all -caf-all -with-rtsopts=-TN+ build-depends: base+ , ekg+ , ekg-core+ , hslogger+ , cerberus+ , cmdargs+ , pretty-show+ default-language: Haskell2010++test-suite cerberus-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , cerberus+ ghc-options: -Wall -O2 -threaded -optc-O3 -rtsopts -auto-all -caf-all -with-rtsopts=-TN+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/yogsototh/cerberus
+ src/Cerberus/Lib.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}+module Cerberus.Lib+ (serveProxy, ProxyOpts(..), CacheBackend(..)) where++import Control.Arrow ((>>>))+import Data.ByteString.Char8 (ByteString, pack)+import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS+import Network.HTTP.ReverseProxy+import Network.HTTP.Types+import Network.Wai (Application, Middleware)+import Network.Wai.Handler.Warp (run)+import qualified Network.Wai.Internal as I+import Network.Wai.Middleware.Cache (cache)+import qualified Network.Wai.Middleware.LRUCache as LRUCache+import Network.Wai.Middleware.RedisCache (ConnectInfo (..), PortID(..),+ defaultConnectInfo)+import qualified Network.Wai.Middleware.RedisCache as RedisCache+import Network.Wai.Middleware.Throttle+import System.Log.Logger+import System.Metrics.Counter (Counter)+import qualified System.Metrics.Counter as Counter++data CacheBackend = LRU | Redis deriving (Eq,Show)++data ProxyOpts = ProxyOpts { _req :: Counter+ , _reqF :: Counter+ , _reqC :: Counter+ , _cacheSize :: Integer+ , _localPort :: Int+ , _url :: String+ , _portN :: Int+ , _maxNbReqBySeq :: Integer+ , _cacheBackend :: CacheBackend+ , _redisHost :: String+ , _redisPort :: Int+ , _redisPass :: Maybe String+ }++updateHeaders :: Header -> [Header] -> [Header]+updateHeaders h headers = let removed = filter (fst >>> (/= fst h)) headers+ in h:removed++proxyRequest :: ByteString -> I.Request -> I.Request+proxyRequest url req =+ req {I.requestHeaderHost = Just url+ ,I.requestHeaders =+ updateHeaders ("Host",url)+ (I.requestHeaders req)}++proxyToApp :: Counter -> String -> Int -> IO Application+proxyToApp reqF url portN = do+ mng <- newManager tlsManagerSettings+ return (waiProxyTo (\req -> do+ debugM "Cerberus.Lib" (show req)+ Counter.inc reqF+ return (WPRModifiedRequestSecure+ (proxyRequest (pack url) req)+ (ProxyDest (pack url) portN)))+ defaultOnExc+ mng)++throttleSettings :: Integer -> ThrottleSettings+throttleSettings nbReqBySec =+ defaultThrottleSettings { throttleRate = 1+ , throttleBurst = nbReqBySec+ }++countRequests :: Counter -> Middleware+countRequests req app = newapp+ where newapp request respond = do+ Counter.inc req+ app request respond++_serveProxy :: Middleware -- ^ Cache Middleware+ -> ProxyOpts -- ^ Proxy Options+ -> IO ()+_serveProxy cacheM opts = do+ reverseApp <- proxyToApp (_reqF opts) (_url opts) (_portN opts)+ st <- initThrottler+ run (_localPort opts)+ ((countRequests (_req opts)+ >>> throttle (throttleSettings (_maxNbReqBySeq opts)) st+ >>> cacheM)+ reverseApp)++serveProxy :: ProxyOpts -> IO ()+serveProxy opts+ | _cacheBackend opts == LRU = do+ cb <- LRUCache.newCacheBackend (Just (_cacheSize opts))+ (const . const . return $ True)+ (const . const . Counter.inc . _req $ opts)+ (const . const . Counter.inc . _reqC $ opts)+ _serveProxy (cache cb) opts+ | _cacheBackend opts == Redis = do+ cb <- RedisCache.newCacheBackend (defaultConnectInfo { connectHost = _redisHost opts+ , connectPort = PortNumber (fromIntegral (_redisPort opts))+ , connectAuth = fmap pack (_redisPass opts)})+ (const . const . return $ True)+ (const . const . Counter.inc . _req $ opts)+ (const . const . Counter.inc . _reqC $ opts)+ _serveProxy (cache cb) opts+ | otherwise = error ("Unsupported Cache Backend: " ++ show (_cacheBackend opts))
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"