matebeamter/src/Main.hs

117 lines
3.5 KiB
Haskell
Raw Normal View History

2019-09-18 13:24:23 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
2019-09-06 23:57:25 +00:00
module Main where
2019-09-08 00:37:50 +00:00
import Servant
2019-09-16 07:44:46 +00:00
import Servant.Client
2019-09-08 00:37:50 +00:00
import Network.Wai.Handler.Warp
import Network.Wai.Logger
2019-09-08 10:48:57 +00:00
import Network.HTTP.Client hiding (Proxy)
import Control.Monad.Reader
2019-10-27 10:42:12 +00:00
import Data.String (fromString)
2019-09-08 15:27:38 +00:00
import Data.Text.I18n.Po
2019-10-27 10:42:12 +00:00
import qualified Data.Text as T
import Data.ByteString.Lazy as BL hiding (putStrLn)
import Data.YAML
import Options.Applicative
2019-09-08 15:27:38 +00:00
2019-12-24 12:17:45 +00:00
import Network.Wai.Application.Static
-- imports from "mateamt"
import qualified "mateamt" Types as MT
2019-09-08 00:37:50 +00:00
-- internal imports
import API
import Types
2019-09-08 10:48:57 +00:00
import Control
import Client
2019-09-08 00:37:50 +00:00
2019-09-06 23:57:25 +00:00
main :: IO ()
2019-09-08 00:37:50 +00:00
main = do
2019-10-27 10:42:12 +00:00
(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)
2019-10-27 10:42:12 +00:00
where
opts = info (options <**> helper)
( fullDesc
2019-10-27 21:46:37 +00:00
<> progDesc "Run the \"matebeamter\" frontend to the \"mateamt\" API."
<> header "matebeamter - a client for mateamt"
)
2019-09-08 10:48:57 +00:00
2019-10-16 16:07:12 +00:00
userApp :: ReadState -> Application
userApp initState = serveWithContext userApi EmptyContext $
2019-09-08 10:48:57 +00:00
hoistServerWithContext
userApi
Proxy
(`runReaderT` initState)
2019-10-04 07:04:23 +00:00
(\mcookie -> userSelectControl mcookie
:<|> userOverviewControl mcookie
:<|> buyControl mcookie
:<|> purchaseControl mcookie
2019-11-01 11:22:28 +00:00
:<|> userRechargeControl mcookie
:<|> userPostRechargeControl mcookie
:<|> userManageControl mcookie
:<|> userManageDetailsSubmitControl mcookie
:<|> userManageAuthCreateControl mcookie
:<|> userManageAuthDeleteControl mcookie
2019-10-15 06:38:32 +00:00
:<|> userNewControl mcookie
:<|> userNewPostControl mcookie
2019-11-03 11:30:46 +00:00
:<|> cashBuyOverviewControl mcookie
2019-11-09 11:29:29 +00:00
:<|> cashBuyPurchaseControl mcookie
2019-11-02 21:53:23 +00:00
:<|> journalControl mcookie
2019-12-11 23:45:22 +00:00
:<|> journalGetCheckControl mcookie
:<|> journalPostCheckControl mcookie
:<|> productGetPriceList mcookie
2019-12-14 23:05:12 +00:00
:<|> productGetRefill mcookie
2019-12-17 00:56:22 +00:00
:<|> productPostRefill mcookie
:<|> productGetNew mcookie
:<|> productPostNew mcookie
2019-10-04 07:04:23 +00:00
:<|> authControl mcookie
:<|> authPostControl mcookie
2019-10-14 18:10:30 +00:00
:<|> authLogoutControl mcookie
2019-12-24 12:17:45 +00:00
:<|> (\_ -> return $ staticApp (defaultFileServerSettings "static")) mcookie
2019-09-08 10:48:57 +00:00
)
2019-09-08 00:37:50 +00:00
userApi :: Proxy UserAPI
userApi = Proxy