summaryrefslogtreecommitdiff
path: root/Com/MusicMeetsComics/Server/Config.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Com/MusicMeetsComics/Server/Config.hs')
-rw-r--r--Com/MusicMeetsComics/Server/Config.hs143
1 files changed, 0 insertions, 143 deletions
diff --git a/Com/MusicMeetsComics/Server/Config.hs b/Com/MusicMeetsComics/Server/Config.hs
deleted file mode 100644
index 0de3379..0000000
--- a/Com/MusicMeetsComics/Server/Config.hs
+++ /dev/null
@@ -1,143 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Com.MusicMeetsComics.Server.Config where
-
-import Com.MusicMeetsComics.Server.Logger
-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 Protolude
-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
--- access to the application configuration using the 'MonadReader'
--- interface's 'ask' function.
---
--- By encapsulating the effects in our newtype, we can add layers to the
--- 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)
-
-type App = AppT IO
-
--- | The Config for our application is (for now) the 'Environment' we're
--- running in and a Persistent 'ConnectionPool'.
-data Config = Config
- { configEnv :: Environment
- , configMetrics :: Metrics
- , configEkgServer :: ThreadId
- , configLogEnv :: LogEnv
- , configPort :: Port
- , configClient :: FilePath
- }
-
-instance Monad m => MonadMetrics (AppT m) where
- getMetrics = asks configMetrics
-
--- | Katip instance for @AppT m@
-instance MonadIO m => Katip (AppT m) where
- getLogEnv = asks configLogEnv
- localLogEnv = panic "not implemented"
-
--- | MonadLogger instance to use within @AppT m@
-instance MonadIO m => MonadLogger (AppT m) where
- monadLoggerLog = adapt logMsg
-
--- | MonadLogger instance to use in @makePool@
-instance MonadIO m => MonadLogger (KatipT m) where
- monadLoggerLog = adapt logMsg
-
--- | Right now, we're distinguishing between three environments. We could
--- also add a @Staging@ environment if we needed to.
-data Environment
- = Development
- | Test
- | Production
- deriving (Eq, Show, Read)
-
--- | This returns a 'Middleware' based on the environment that we're in.
-setLogger :: Environment -> Middleware
-setLogger Test = identity
-setLogger Development = logStdoutDev
-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
-
--- | The number of pools to use for a given environment.
-envPool :: Environment -> Int
-envPool Test = 1
-envPool Development = 1
-envPool Production = 8
-
--- | Allocates resources for 'Config'
-acquire :: IO Config
-acquire = do
- 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
- , configClient = clientDir
- }
-
--- | Looks up a setting in the environment, with a provided default, and
--- 'read's that information into the inferred type.
-lookupSetting :: Read a => String -> a -> IO a
-lookupSetting env def_ = do
- maybeValue <- lookupEnv env
- case maybeValue of
- 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]