add configuration options

This commit is contained in:
nek0 2019-10-27 22:45:07 +01:00
parent f1c9d4282e
commit 0e32c7ae98
5 changed files with 121 additions and 18 deletions

5
app/AppTypes.hs Normal file
View File

@ -0,0 +1,5 @@
module AppTypes
( module T
) where
import AppTypes.Configuration as T

View File

@ -0,0 +1,45 @@
{-# LANGUAGE OverloadedStrings #-}
module AppTypes.Configuration where
import qualified Data.Text as T
import Data.YAML as Y
import Options.Applicative as O
data ServerConfig = ServerConfig
{ configDbHost :: T.Text
, configDbPort :: Word
, configDbName :: T.Text
, configDbUser :: T.Text
, configDbPasswd :: T.Text
, configCurrencySymbol :: T.Text
, configListenPort :: Word
, configListenHost :: T.Text
}
deriving (Show)
instance FromYAML ServerConfig where
parseYAML = withMap "Configuration" $ \m -> ServerConfig
<$> m .: "db_host"
<*> m .: "db_port"
<*> m .: "db_name"
<*> m .: "db_user"
<*> m .: "db_passwd"
<*> m .: "currency"
<*> m .: "listen_port"
<*> m .:? "listen_host" .!= "127.0.0.1"
newtype Options = Options
{ optConfigLocation :: T.Text
}
deriving (Show)
options :: O.Parser Options
options = Options
<$> strOption
( long "configuration"
<> short 'c'
<> metavar "FILEPATH"
<> help "Location of the configuration YAML-file"
)

View File

@ -8,7 +8,11 @@ module Main where
import Servant
import Servant.Server.Experimental.Auth
import Data.Set (empty)
import Data.Set as S (empty)
import Data.ByteString.Lazy as BL hiding (putStrLn)
import qualified Data.Text as T
import Data.String
import Data.YAML
import Database.PostgreSQL.Simple
@ -20,33 +24,68 @@ import Control.Monad.Reader
import Control.Concurrent.STM.TVar
import Options.Applicative
-- internal imports
import API
import Model as M
import AppTypes
import Types
import Control
main :: IO ()
main = do
conn <- connectPostgreSQL
"host='localhost' port=5432 dbname='mateamt' user='mateamt' password='mateamt'"
store <- newTVarIO empty
void $ execute_ conn initAvatar
void $ execute_ conn initUser
void $ execute_ conn initProduct
void $ execute_ conn initToken
void $ execute_ conn initAuthData
void $ execute_ conn initAmount
void $ execute_ conn initJournal
withStdoutLogger $ \ilog -> do
let settings = setPort 8000 $ setLogger ilog defaultSettings
initState = ReadState
{ rsConnection = conn
, rsTicketStore = store
}
runSettings settings (app initState)
(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
(ServerConfig
db_host
db_port
db_name
db_user
db_passwd
sym
lport
lhost
) -> do
conn <- connectPostgreSQL (
"host='" <> fromString (T.unpack db_host) <> "' " <>
"port=" <> fromString (show db_port) <> " " <>
"dbname='" <> fromString (T.unpack db_name) <> "' " <>
"user='" <> fromString (T.unpack db_user) <> "' " <>
"password='" <> fromString (T.unpack db_passwd) <> "'"
)
store <- newTVarIO S.empty
void $ execute_ conn initAvatar
void $ execute_ conn initUser
void $ execute_ conn initProduct
void $ execute_ conn initToken
void $ execute_ conn initAuthData
void $ execute_ conn initAmount
void $ execute_ conn initJournal
withStdoutLogger $ \ilog -> do
let settings = setPort (fromIntegral lport) $
setHost (fromString $ T.unpack lhost) $
setLogger ilog defaultSettings
initState = ReadState
{ rsConnection = conn
, rsTicketStore = store
}
runSettings settings (app initState)
where
opts = info (options <**> helper)
( fullDesc
<> progDesc "Run the \"mateamt\" API-Server."
<> header "mateamt - Your friendly mate distribution office"
)
app :: ReadState -> Application
-- app conn = serveWithContext userApi genAuthServerContext (users conn)

8
config.yaml Normal file
View File

@ -0,0 +1,8 @@
db_host: "localhost"
db_port: 5432
db_name: "mateamt"
db_user: "mateamt"
db_passwd: "mateamt"
listen_port: 8000
#listen_host: "127.0.0.1"
currency: "€"

View File

@ -22,9 +22,13 @@ flag develop
executable mateamt
main-is: Main.hs
other-modules: AppTypes
, AppTypes.Configuration
-- other-extensions:
build-depends: base ^>=4.12.0.0
, mateamt
, text
, bytestring
, base16-bytestring
, containers
, mtl
@ -37,6 +41,8 @@ executable mateamt
, warp
, wai
, wai-logger
, HsYAML
, optparse-applicative
hs-source-dirs: app
ghc-options: -Wall
default-language: Haskell2010