2019-09-18 13:24:23 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
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-09-08 00:37:50 +00:00
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import API
|
|
|
|
import Types
|
2019-09-08 10:48:57 +00:00
|
|
|
import Control
|
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)
|
|
|
|
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
|
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
|
2019-10-22 03:54:55 +00:00
|
|
|
:<|> buyControl mcookie
|
2019-10-24 05:39:46 +00:00
|
|
|
:<|> purchaseControl mcookie
|
2019-11-01 11:22:28 +00:00
|
|
|
:<|> userRechargeControl mcookie
|
|
|
|
:<|> userPostRechargeControl mcookie
|
2019-10-14 13:07:17 +00:00
|
|
|
:<|> 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
|
2019-10-04 07:04:23 +00:00
|
|
|
:<|> authControl mcookie
|
|
|
|
:<|> authPostControl mcookie
|
2019-10-14 18:10:30 +00:00
|
|
|
:<|> authLogoutControl mcookie
|
2019-09-08 10:48:57 +00:00
|
|
|
)
|
2019-09-08 00:37:50 +00:00
|
|
|
|
|
|
|
userApi :: Proxy UserAPI
|
|
|
|
userApi = Proxy
|