diff --git a/app/AppTypes.hs b/app/AppTypes.hs new file mode 100644 index 0000000..3e914d9 --- /dev/null +++ b/app/AppTypes.hs @@ -0,0 +1,5 @@ +module AppTypes + ( module T + ) where + +import AppTypes.Configuration as T diff --git a/app/AppTypes/Configuration.hs b/app/AppTypes/Configuration.hs new file mode 100644 index 0000000..e39e5d5 --- /dev/null +++ b/app/AppTypes/Configuration.hs @@ -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" + ) diff --git a/app/Main.hs b/app/Main.hs index 3c17e60..9736ba7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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) diff --git a/config.yaml b/config.yaml new file mode 100644 index 0000000..33f77f7 --- /dev/null +++ b/config.yaml @@ -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: "€" diff --git a/mateamt.cabal b/mateamt.cabal index f0b0c4f..8f06067 100644 --- a/mateamt.cabal +++ b/mateamt.cabal @@ -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