{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} 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 import Network.Wai.Application.Static -- imports from "mateamt" import qualified "mateamt" Types as MT -- internal imports import API import Types import Control import Client 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) let backend = mkClientEnv mngr (BaseUrl (if apiSec then Https else Http) (T.unpack apiHost) (fromIntegral apiPort) (T.unpack apiUri) ) putStrLn "Checking connectivity to backend..." emeta <- runClientM metaGet backend case emeta of Right (MT.MetaInformation version symbol) -> do withStdoutLogger $ \ilog -> do let settings = setPort (fromIntegral listenPort) $ setLogger ilog defaultSettings initState = ReadState -- { rsManager = manager { rsL10n = l10n , rsBackend = backend , rsHashParams = recommendedHashParams , rsCurrencySymbol = symbol , rsBackendVersion = version } putStrLn "Starting up..." runSettings settings (userApp initState) Left err -> error $ "Connection with backend failed: " <> (fromString $ show err) 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 :<|> cashBuyPurchaseControl mcookie :<|> journalControl mcookie :<|> journalGetCheckControl mcookie :<|> journalPostCheckControl mcookie :<|> productGetPriceList mcookie :<|> productGetRefill mcookie :<|> productPostRefill mcookie :<|> productGetNew mcookie :<|> productPostNew mcookie :<|> authControl mcookie :<|> authPostControl mcookie :<|> authLogoutControl mcookie :<|> (\_ -> return $ staticApp (defaultFileServerSettings "static")) mcookie ) userApi :: Proxy UserAPI userApi = Proxy