matebeamter/src/Main.hs

93 lines
2.6 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Servant
import Servant.Client
import Network.Wai.Handler.Warp
import Network.Wai.Logger
import Network.HTTP.Client hiding (Proxy)
import Control.Monad.Reader
import Data.String (fromString)
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
import API
import Types
import Control
main :: IO ()
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
(l10n, _) <- getL10n (T.unpack locs)
withStdoutLogger $ \ilog -> do
let settings = setPort (fromIntegral listenPort) $
setLogger ilog defaultSettings
initState = ReadState
-- { rsManager = manager
{ rsL10n = l10n
, rsBackend = mkClientEnv mngr
(BaseUrl
(if apiSec then Https else Http)
(T.unpack apiHost)
(fromIntegral apiPort)
(T.unpack apiUri)
)
, rsHashParams = recommendedHashParams
}
putStrLn "Starting up..."
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 initState = serveWithContext userApi EmptyContext $
hoistServerWithContext
userApi
Proxy
(`runReaderT` initState)
(\mcookie -> userSelectControl mcookie
:<|> userOverviewControl mcookie
:<|> buyControl mcookie
:<|> purchaseControl mcookie
:<|> userRechargeControl mcookie
:<|> userPostRechargeControl mcookie
:<|> userManageControl mcookie
:<|> userManageDetailsSubmitControl mcookie
:<|> userManageAuthCreateControl mcookie
:<|> userManageAuthDeleteControl mcookie
:<|> userNewControl mcookie
:<|> userNewPostControl mcookie
:<|> cashBuyOverviewControl mcookie
:<|> const (error "not yet implemented")
:<|> journalControl mcookie
:<|> authControl mcookie
:<|> authPostControl mcookie
:<|> authLogoutControl mcookie
)
userApi :: Proxy UserAPI
userApi = Proxy