From 61e21346a6947327bf5394f6c73499621c494986 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 10 Apr 2020 16:33:00 -0700 Subject: Deploy herocomics.app production server This also includes some drive-by formatting changes and config changes needed to get it up and running. --- Com/MusicMeetsComics/Server/Config.hs | 102 +++++++++++++++++++--------------- Com/MusicMeetsComics/Server/Init.hs | 6 +- 2 files changed, 60 insertions(+), 48 deletions(-) (limited to 'Com/MusicMeetsComics/Server') diff --git a/Com/MusicMeetsComics/Server/Config.hs b/Com/MusicMeetsComics/Server/Config.hs index ac634a2..0de3379 100644 --- a/Com/MusicMeetsComics/Server/Config.hs +++ b/Com/MusicMeetsComics/Server/Config.hs @@ -8,23 +8,38 @@ module Com.MusicMeetsComics.Server.Config where import Com.MusicMeetsComics.Server.Logger -import Control.Concurrent (ThreadId) -import Control.Monad.Except (ExceptT, MonadError) +import Control.Concurrent ( ThreadId ) +import Control.Monad.Except ( ExceptT + , MonadError + ) import Control.Monad.IO.Class -import Control.Monad.Logger (MonadLogger(..)) -import Control.Monad.Metrics (Metrics, MonadMetrics, getMetrics) -import qualified Control.Monad.Metrics as M -import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, asks) -import Data.Text (pack) -import GHC.Base (String) -import Network.Wai (Middleware) -import Network.Wai.Handler.Warp (Port) -import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) +import Control.Monad.Logger ( MonadLogger(..) ) +import Control.Monad.Metrics ( Metrics + , MonadMetrics + , getMetrics + ) +import qualified Control.Monad.Metrics as M +import Control.Monad.Reader ( MonadIO + , MonadReader + , ReaderT + , asks + ) +import Data.Text ( pack ) +import GHC.Base ( String ) +import Network.Wai ( Middleware ) +import Network.Wai.Handler.Warp ( Port ) +import Network.Wai.Middleware.RequestLogger + ( logStdout + , logStdoutDev + ) import Protolude -import Safe (readMay) -import Servant (ServerError) -import System.Environment (lookupEnv) -import System.Remote.Monitoring (forkServer, serverMetricStore, serverThreadId) +import Safe ( readMay ) +import Servant ( ServerError ) +import System.Environment ( lookupEnv ) +import System.Remote.Monitoring ( forkServer + , serverMetricStore + , serverThreadId + ) -- | This type represents the effects we want to have for our application. -- We wrap the standard Servant monad with 'ReaderT Config', which gives us @@ -35,13 +50,9 @@ import System.Remote.Monitoring (forkServer, serverMetricStore, server -- monad stack without having to modify code that uses the current layout. newtype AppT m a = AppT { runApp :: ReaderT Config (ExceptT ServerError m) a - } deriving ( Functor - , Applicative - , Monad - , MonadReader Config - , MonadError ServerError - , MonadIO - ) + } + deriving (Functor, Applicative, Monad, MonadReader Config, MonadError + ServerError, MonadIO) type App = AppT IO @@ -53,6 +64,7 @@ data Config = Config , configEkgServer :: ThreadId , configLogEnv :: LogEnv , configPort :: Port + , configClient :: FilePath } instance Monad m => MonadMetrics (AppT m) where @@ -60,7 +72,7 @@ instance Monad m => MonadMetrics (AppT m) where -- | Katip instance for @AppT m@ instance MonadIO m => Katip (AppT m) where - getLogEnv = asks configLogEnv + getLogEnv = asks configLogEnv localLogEnv = panic "not implemented" -- | MonadLogger instance to use within @AppT m@ @@ -81,42 +93,42 @@ data Environment -- | This returns a 'Middleware' based on the environment that we're in. setLogger :: Environment -> Middleware -setLogger Test = identity +setLogger Test = identity setLogger Development = logStdoutDev -setLogger Production = logStdout +setLogger Production = logStdout -- | Web request logger (currently unimplemented and unused). For inspiration -- see ApacheLogger from wai-logger package. katipLogger :: LogEnv -> Middleware -katipLogger env app req respond = - runKatipT env $ do - logMsg "web" InfoS "todo: received some request" - -- todo: log proper request data - liftIO $ app req respond +katipLogger env app req respond = runKatipT env $ do + logMsg "web" InfoS "todo: received some request" + -- todo: log proper request data + liftIO $ app req respond -- | The number of pools to use for a given environment. envPool :: Environment -> Int -envPool Test = 1 +envPool Test = 1 envPool Development = 1 -envPool Production = 8 +envPool Production = 8 -- | Allocates resources for 'Config' acquire :: IO Config acquire = do - port <- lookupSetting "PORT" 3001 - env <- lookupSetting "ENV" Development - logEnv <- defaultLogEnv + port <- lookupSetting "PORT" 3001 + clientDir <- lookupSetting "CLIENT_DIR" + "_bild/Com.MusicMeetsComics.Client/static" + env <- lookupSetting "ENV" Development + logEnv <- defaultLogEnv ekgServer <- forkServer "localhost" 8000 let store = serverMetricStore ekgServer metr <- M.initializeWith store - pure - Config - { configEnv = env - , configMetrics = metr - , configLogEnv = logEnv - , configPort = port - , configEkgServer = serverThreadId ekgServer - } + pure Config { configEnv = env + , configMetrics = metr + , configLogEnv = logEnv + , configPort = port + , configEkgServer = serverThreadId ekgServer + , configClient = clientDir + } -- | Looks up a setting in the environment, with a provided default, and -- 'read's that information into the inferred type. @@ -127,5 +139,5 @@ lookupSetting env def_ = do Nothing -> return def_ Just str -> maybe (handleFailedRead str) return (readMay str) where - handleFailedRead str = panic - $ mconcat ["Failed to read [[", pack str, "]] for environment variable ", pack env] + handleFailedRead str = panic $ mconcat + ["Failed to read [[", pack str, "]] for environment variable ", pack env] diff --git a/Com/MusicMeetsComics/Server/Init.hs b/Com/MusicMeetsComics/Server/Init.hs index 7ad3ebf..04ddc88 100644 --- a/Com/MusicMeetsComics/Server/Init.hs +++ b/Com/MusicMeetsComics/Server/Init.hs @@ -18,7 +18,7 @@ import qualified System.IO as IO -- | An action that creates a WAI 'Application' together with its resources, -- runs it, and tears it down on exit runApp :: (Config.Config -> Application) -> IO () -runApp app = bracket Config.acquire shutdownApp jog +runApp app = bracket Config.acquire shutdown jog where say = IO.hPutStrLn IO.stderr jog config = do @@ -39,8 +39,8 @@ compress :: Middleware compress = gzip def { gzipFiles = GzipCompress } -- | Takes care of cleaning up 'Config.Config' resources -shutdownApp :: Config.Config -> IO () -shutdownApp cfg = do +shutdown :: Config.Config -> IO () +shutdown cfg = do _ <- Katip.closeScribes (Config.configLogEnv cfg) -- Monad.Metrics does not provide a function to destroy metrics store -- so, it'll hopefully get torn down when async exception gets thrown -- cgit v1.2.3