cerberus-0.1.0.0: app/Main.hs

{-# 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