add configuration

This commit is contained in:
nek0 2019-10-27 11:42:12 +01:00
parent 80b3cfa07e
commit 52968be8b1
5 changed files with 91 additions and 12 deletions

6
conig.yaml Normal file
View file

@ -0,0 +1,6 @@
api_host: "localhost"
api_port: 8000
#api_uri: ""
#api_secure: false
listen_port: 3000
locales_location: "./locales"

View file

@ -29,6 +29,7 @@ executable matebeamter
, Types.Reader , Types.Reader
, Types.Views , Types.Views
, Types.Orphans , Types.Orphans
, Types.Configuration
, Control , Control
, Control.Auth , Control.Auth
, Control.User , Control.User
@ -71,6 +72,8 @@ executable matebeamter
, stm , stm
, stm-containers , stm-containers
, either , either
, optparse-applicative
, HsYAML
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall

View file

@ -12,7 +12,13 @@ import Network.HTTP.Client hiding (Proxy)
import Control.Monad.Reader import Control.Monad.Reader
import Data.String (fromString)
import Data.Text.I18n.Po import Data.Text.I18n.Po
import qualified Data.Text as T
import Data.ByteString.Lazy as BL hiding (putStrLn)
import Data.YAML
import Options.Applicative
-- internal imports -- internal imports
@ -22,18 +28,38 @@ import Control
main :: IO () main :: IO ()
main = do main = do
(Options confLoc) <- execParser opts
raw <- BL.readFile (T.unpack confLoc)
case decode1 raw of
Left (loc, msg) ->
error (T.unpack $ confLoc <> ":" <>
fromString (prettyPosWithSource loc raw " error") <>
fromString msg)
Right (Configuration apiHost apiPort apiUri apiSec listenPort locs) -> do
mngr <- newManager defaultManagerSettings mngr <- newManager defaultManagerSettings
(l10n, _) <- getL10n "./locales" (l10n, _) <- getL10n (T.unpack locs)
withStdoutLogger $ \ilog -> do withStdoutLogger $ \ilog -> do
let settings = setPort 3000 $ setLogger ilog defaultSettings let settings = setPort (fromIntegral listenPort) $
setLogger ilog defaultSettings
initState = ReadState initState = ReadState
-- { rsManager = manager -- { rsManager = manager
{ rsL10n = l10n { rsL10n = l10n
, rsBackend = mkClientEnv mngr (BaseUrl Http "localhost" 8000 "") , rsBackend = mkClientEnv mngr
(BaseUrl
(if apiSec then Https else Http)
(T.unpack apiHost)
(fromIntegral apiPort)
(T.unpack apiUri)
)
, rsHashParams = recommendedHashParams , rsHashParams = recommendedHashParams
} }
putStrLn "Starting up..."
runSettings settings (userApp initState) runSettings settings (userApp initState)
where
opts = info (options <**> helper)
( fullDesc
<> progDesc "Run the \"matebeamter\" frontend to the \"mateamt\" API."
<> header "matebeamter - a client for mateamt" )
userApp :: ReadState -> Application userApp :: ReadState -> Application
userApp initState = serveWithContext userApi EmptyContext $ userApp initState = serveWithContext userApi EmptyContext $

View file

@ -7,3 +7,4 @@ import Types.Page as T
import Types.Reader as T import Types.Reader as T
import Types.Views as T import Types.Views as T
import Types.Orphans as T import Types.Orphans as T
import Types.Configuration as T

View file

@ -0,0 +1,43 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Types.Configuration where
import qualified Data.Text as T
import Options.Applicative as O
import Data.YAML as Y
import GHC.Generics
data Configuration = Configuration
{ configApiHost :: T.Text
, configApiPort :: Word
, configApiUri :: T.Text
, configApiSecure :: Bool
, configListenPort :: Word
, configLocalesLocation :: T.Text
}
deriving (Generic, Show)
instance FromYAML Configuration where
parseYAML = withMap "Configuration" $ \m -> Configuration
<$> m .: "api_host"
<*> m .: "api_port"
<*> m .:? "api_uri" .!= ""
<*> m .:? "api_secure" .!= False
<*> m .: "listen_port"
<*> m .: "locales_location"
data Options = Options
{ optConfigLocation :: T.Text
}
options :: O.Parser Options
options = Options
<$> strOption
( long "configuration"
<> short 'c'
<> metavar "FILEPATH"
<> help "The location of the configuration YAML-file"
)