summaryrefslogtreecommitdiff
path: root/Com/MusicMeetsComics/Server
diff options
context:
space:
mode:
Diffstat (limited to 'Com/MusicMeetsComics/Server')
-rw-r--r--Com/MusicMeetsComics/Server/Config.hs102
-rw-r--r--Com/MusicMeetsComics/Server/Init.hs6
2 files changed, 60 insertions, 48 deletions
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