fetch and incorporate provided meta information
This commit is contained in:
parent
31f6665fee
commit
e80cc68204
16 changed files with 211 additions and 142 deletions
|
@ -71,6 +71,7 @@ type UserAPI =
|
||||||
:> ReqBody '[FormUrlEncoded] CashCheck
|
:> ReqBody '[FormUrlEncoded] CashCheck
|
||||||
:> Post '[HTML] JournalPage
|
:> Post '[HTML] JournalPage
|
||||||
:<|> "product" :> "list"
|
:<|> "product" :> "list"
|
||||||
|
:> QueryParam "refine" MT.ProductRefine
|
||||||
:> Get '[HTML] ProductPriceListPage
|
:> Get '[HTML] ProductPriceListPage
|
||||||
:<|> "product" :> "refill"
|
:<|> "product" :> "refill"
|
||||||
:> Get '[HTML] ProductRefillPage
|
:> Get '[HTML] ProductRefillPage
|
||||||
|
|
|
@ -96,6 +96,8 @@ avatarUpdate
|
||||||
-> ClientM ()
|
-> ClientM ()
|
||||||
avatarList :: ClientM [MT.Avatar]
|
avatarList :: ClientM [MT.Avatar]
|
||||||
|
|
||||||
|
metaGet :: ClientM MT.MetaInformation
|
||||||
|
|
||||||
( authGet :<|>
|
( authGet :<|>
|
||||||
authSend :<|>
|
authSend :<|>
|
||||||
authLogout :<|>
|
authLogout :<|>
|
||||||
|
@ -126,7 +128,9 @@ avatarList :: ClientM [MT.Avatar]
|
||||||
avatarGet :<|>
|
avatarGet :<|>
|
||||||
avatarInsert :<|>
|
avatarInsert :<|>
|
||||||
avatarUpdate :<|>
|
avatarUpdate :<|>
|
||||||
avatarList
|
avatarList :<|>
|
||||||
|
|
||||||
|
metaGet
|
||||||
) = client mateApi
|
) = client mateApi
|
||||||
|
|
||||||
getClients clientEnv = hoistClient
|
getClients clientEnv = hoistClient
|
||||||
|
|
|
@ -64,7 +64,7 @@ authControl mcookie mDestination = do
|
||||||
Nothing
|
Nothing
|
||||||
)
|
)
|
||||||
(Just authUser, Nothing) -> do
|
(Just authUser, Nothing) -> do
|
||||||
(ReadState _ backend _) <- ask
|
(ReadState _ backend _ _ _) <- ask
|
||||||
let trs = map
|
let trs = map
|
||||||
(MT.TicketRequest
|
(MT.TicketRequest
|
||||||
(read (T.unpack authUser) :: Int))
|
(read (T.unpack authUser) :: Int))
|
||||||
|
@ -99,7 +99,7 @@ authControl mcookie mDestination = do
|
||||||
]
|
]
|
||||||
AuthPage)
|
AuthPage)
|
||||||
digestAuthInfo tupAuthInfos = do
|
digestAuthInfo tupAuthInfos = do
|
||||||
(ReadState l10n _ _) <- ask
|
(ReadState l10n _ _ _ version) <- ask
|
||||||
let loc = Locale
|
let loc = Locale
|
||||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||||
ticketHeaders = map
|
ticketHeaders = map
|
||||||
|
@ -110,7 +110,7 @@ authControl mcookie mDestination = do
|
||||||
return $
|
return $
|
||||||
addHeader (head ticketHeaders) $
|
addHeader (head ticketHeaders) $
|
||||||
addHeader (ticketHeaders !! 1) $
|
addHeader (ticketHeaders !! 1) $
|
||||||
authPage l10n loc mDestination mcookie
|
authPage l10n loc mDestination version mcookie
|
||||||
|
|
||||||
authPostControl
|
authPostControl
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
|
@ -122,7 +122,7 @@ authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
|
||||||
parseCookieText cookies
|
parseCookieText cookies
|
||||||
case mticket of
|
case mticket of
|
||||||
Just ticket -> do
|
Just ticket -> do
|
||||||
(ReadState _ backend _) <- ask
|
(ReadState _ backend _ _ _) <- ask
|
||||||
hashedPass <- hashPassword pass
|
hashedPass <- hashPassword pass
|
||||||
etoken <- liftIO $ runClientM
|
etoken <- liftIO $ runClientM
|
||||||
(authSend
|
(authSend
|
||||||
|
@ -175,7 +175,7 @@ authLogoutControl
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
-> UserHandler UserOverviewPage
|
-> UserHandler UserOverviewPage
|
||||||
authLogoutControl mcookie = do
|
authLogoutControl mcookie = do
|
||||||
(ReadState _ backend _) <- ask
|
(ReadState _ backend _ _ _) <- ask
|
||||||
let mParsedCookie = fmap parseCookieText mcookie
|
let mParsedCookie = fmap parseCookieText mcookie
|
||||||
token = T.unpack $ fromMaybe "secret"
|
token = T.unpack $ fromMaybe "secret"
|
||||||
(lookup "x-token" =<< mParsedCookie)
|
(lookup "x-token" =<< mParsedCookie)
|
||||||
|
|
|
@ -45,7 +45,7 @@ buyControl
|
||||||
buyControl mcookie uid pds forceBuy =
|
buyControl mcookie uid pds forceBuy =
|
||||||
if not (null pds)
|
if not (null pds)
|
||||||
then do
|
then do
|
||||||
(ReadState l10n backend _) <- ask
|
(ReadState l10n backend _ symbol version) <- ask
|
||||||
let (token, _) = parseTokenAndUser mcookie
|
let (token, _) = parseTokenAndUser mcookie
|
||||||
loc = Locale
|
loc = Locale
|
||||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||||
|
@ -70,7 +70,18 @@ buyControl mcookie uid pds forceBuy =
|
||||||
)
|
)
|
||||||
0
|
0
|
||||||
ziptup
|
ziptup
|
||||||
return (buyConfirmPage l10n loc uid ziptup total forceBuy mcookie)
|
return
|
||||||
|
(buyConfirmPage
|
||||||
|
l10n
|
||||||
|
loc
|
||||||
|
uid
|
||||||
|
ziptup
|
||||||
|
total
|
||||||
|
forceBuy
|
||||||
|
version
|
||||||
|
mcookie
|
||||||
|
symbol
|
||||||
|
)
|
||||||
Left err ->
|
Left err ->
|
||||||
throwError $
|
throwError $
|
||||||
addMessage (fromString $ show err) $
|
addMessage (fromString $ show err) $
|
||||||
|
@ -176,7 +187,7 @@ cashBuyOverviewControl
|
||||||
-> Maybe MT.ProductRefine
|
-> Maybe MT.ProductRefine
|
||||||
-> UserHandler CashBuyOverviewPage
|
-> UserHandler CashBuyOverviewPage
|
||||||
cashBuyOverviewControl mcookie mrefine = do
|
cashBuyOverviewControl mcookie mrefine = do
|
||||||
(ReadState l10n backend _) <- ask
|
(ReadState l10n backend _ symbol version) <- ask
|
||||||
let loc = localeFromCookie mcookie
|
let loc = localeFromCookie mcookie
|
||||||
eproducts <- liftIO $ runClientM
|
eproducts <- liftIO $ runClientM
|
||||||
(productShortList
|
(productShortList
|
||||||
|
@ -185,7 +196,7 @@ cashBuyOverviewControl mcookie mrefine = do
|
||||||
backend
|
backend
|
||||||
case eproducts of
|
case eproducts of
|
||||||
Right prods ->
|
Right prods ->
|
||||||
return $ cashBuyOverviewPage l10n loc mcookie prods
|
return $ cashBuyOverviewPage l10n loc version mcookie prods
|
||||||
Left err ->
|
Left err ->
|
||||||
throwError $ err500
|
throwError $ err500
|
||||||
{ errBody = fromString (show err)
|
{ errBody = fromString (show err)
|
||||||
|
@ -198,6 +209,7 @@ cashBuyPurchaseControl
|
||||||
-> UserHandler UserSelectPage
|
-> UserHandler UserSelectPage
|
||||||
cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
|
cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
|
||||||
l10n <- asks rsL10n
|
l10n <- asks rsL10n
|
||||||
|
symbol <- asks rsCurrencySymbol
|
||||||
let loc = localeFromCookie mcookie
|
let loc = localeFromCookie mcookie
|
||||||
if not (null pds)
|
if not (null pds)
|
||||||
then do
|
then do
|
||||||
|
@ -226,7 +238,8 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
|
||||||
(MT.PurchaseResult (MT.PayAmount price) []) ->
|
(MT.PurchaseResult (MT.PayAmount price) []) ->
|
||||||
throwError $
|
throwError $
|
||||||
addMessage
|
addMessage
|
||||||
(translate l10n loc "Please Pay" <> ": " <> formatMoney price) $
|
(translate l10n loc "Please Pay" <>
|
||||||
|
": " <> formatMoney price <> symbol) $
|
||||||
redirect303 userSelectLink
|
redirect303 userSelectLink
|
||||||
(MT.PurchaseResult (MT.PayAmount price) miss) -> do
|
(MT.PurchaseResult (MT.PayAmount price) miss) -> do
|
||||||
eproducts <- liftIO $ runClientM
|
eproducts <- liftIO $ runClientM
|
||||||
|
@ -239,7 +252,7 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
|
||||||
Right prods ->
|
Right prods ->
|
||||||
throwError
|
throwError
|
||||||
$ addMessage (translate l10n loc "Please Pay" <> ": "
|
$ addMessage (translate l10n loc "Please Pay" <> ": "
|
||||||
<> formatMoney price
|
<> formatMoney price <> symbol
|
||||||
<> ". "
|
<> ". "
|
||||||
<> translate l10n loc
|
<> translate l10n loc
|
||||||
"But there seems to be something missing: "
|
"But there seems to be something missing: "
|
||||||
|
|
|
@ -37,7 +37,7 @@ journalControl
|
||||||
-> Maybe Word
|
-> Maybe Word
|
||||||
-> UserHandler JournalPage
|
-> UserHandler JournalPage
|
||||||
journalControl mcookie mpage = do
|
journalControl mcookie mpage = do
|
||||||
(token, muser, loc, l10n, backend) <- controlInit mcookie
|
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
|
||||||
case muser of
|
case muser of
|
||||||
Just user -> do
|
Just user -> do
|
||||||
eresult <- liftIO $ runClientM
|
eresult <- liftIO $ runClientM
|
||||||
|
@ -49,7 +49,7 @@ journalControl mcookie mpage = do
|
||||||
backend
|
backend
|
||||||
case eresult of
|
case eresult of
|
||||||
Right entries ->
|
Right entries ->
|
||||||
return (journalPage l10n loc mcookie mpage entries)
|
return (journalPage l10n loc version mcookie mpage entries)
|
||||||
Left err ->
|
Left err ->
|
||||||
case err of
|
case err of
|
||||||
FailureResponse _ resp ->
|
FailureResponse _ resp ->
|
||||||
|
@ -71,15 +71,15 @@ journalGetCheckControl
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
-> UserHandler JournalCheckPage
|
-> UserHandler JournalCheckPage
|
||||||
journalGetCheckControl mcookie = do
|
journalGetCheckControl mcookie = do
|
||||||
(token, muser, loc, l10n, _) <- controlInit mcookie
|
(token, muser, loc, l10n, _, symbol, version) <- controlInit mcookie
|
||||||
return $ journalCheckPage l10n loc mcookie
|
return $ journalCheckPage l10n loc version mcookie
|
||||||
|
|
||||||
journalPostCheckControl
|
journalPostCheckControl
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
-> CashCheck
|
-> CashCheck
|
||||||
-> UserHandler JournalPage
|
-> UserHandler JournalPage
|
||||||
journalPostCheckControl mcookie (CashCheck floatAmount) = do
|
journalPostCheckControl mcookie (CashCheck floatAmount) = do
|
||||||
(token, muser, loc, l10n, backend) <- controlInit mcookie
|
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
|
||||||
case muser of
|
case muser of
|
||||||
Just user -> do
|
Just user -> do
|
||||||
eresult <- liftIO $ runClientM
|
eresult <- liftIO $ runClientM
|
||||||
|
|
|
@ -30,17 +30,18 @@ import Hash
|
||||||
|
|
||||||
productGetPriceList
|
productGetPriceList
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
|
-> Maybe MT.ProductRefine
|
||||||
-> UserHandler ProductPriceListPage
|
-> UserHandler ProductPriceListPage
|
||||||
productGetPriceList mcookie = do
|
productGetPriceList mcookie mrefine = do
|
||||||
(token, muser, loc, l10n, backend) <- controlInit mcookie
|
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
|
||||||
elist <- liftIO $ runClientM
|
elist <- liftIO $ runClientM
|
||||||
(productShortList
|
(productShortList
|
||||||
(Just MT.AllProducts)
|
mrefine
|
||||||
)
|
)
|
||||||
backend
|
backend
|
||||||
case elist of
|
case elist of
|
||||||
Right list ->
|
Right list ->
|
||||||
return (productPriceListPage l10n loc mcookie list)
|
return (productPriceListPage l10n loc version mcookie list symbol)
|
||||||
Left err ->
|
Left err ->
|
||||||
throwError $
|
throwError $
|
||||||
addMessage (fromString $ show err) $
|
addMessage (fromString $ show err) $
|
||||||
|
@ -50,7 +51,7 @@ productGetRefill
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
-> UserHandler ProductRefillPage
|
-> UserHandler ProductRefillPage
|
||||||
productGetRefill mcookie = do
|
productGetRefill mcookie = do
|
||||||
(token, muser, loc, l10n, backend) <- controlInit mcookie
|
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
|
||||||
case muser of
|
case muser of
|
||||||
Just _ -> do
|
Just _ -> do
|
||||||
elist <- liftIO $ runClientM
|
elist <- liftIO $ runClientM
|
||||||
|
@ -58,7 +59,7 @@ productGetRefill mcookie = do
|
||||||
backend
|
backend
|
||||||
case elist of
|
case elist of
|
||||||
Right list -> do
|
Right list -> do
|
||||||
return $ productRefillPage l10n loc mcookie list
|
return $ productRefillPage l10n loc version mcookie list
|
||||||
Left err ->
|
Left err ->
|
||||||
throwError $
|
throwError $
|
||||||
addMessage (fromString $ show err) $
|
addMessage (fromString $ show err) $
|
||||||
|
@ -71,7 +72,7 @@ productPostRefill
|
||||||
-> [MT.AmountRefill]
|
-> [MT.AmountRefill]
|
||||||
-> UserHandler ProductRefillPage
|
-> UserHandler ProductRefillPage
|
||||||
productPostRefill mcookie refills = do
|
productPostRefill mcookie refills = do
|
||||||
(token, muser, loc, l10n, backend) <- controlInit mcookie
|
(token, muser, loc, l10n, backend, _, _) <- controlInit mcookie
|
||||||
case muser of
|
case muser of
|
||||||
Just _ -> do
|
Just _ -> do
|
||||||
eresult <- liftIO $ runClientM
|
eresult <- liftIO $ runClientM
|
||||||
|
@ -96,11 +97,11 @@ productGetNew
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
-> UserHandler ProductNewPage
|
-> UserHandler ProductNewPage
|
||||||
productGetNew mcookie = do
|
productGetNew mcookie = do
|
||||||
(token, muser, loc, l10n, backend) <- controlInit mcookie
|
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
|
||||||
case muser of
|
case muser of
|
||||||
Just user ->
|
Just user ->
|
||||||
-- TODO: Fetch avatars and suppliers
|
-- TODO: Fetch avatars and suppliers
|
||||||
return $ productNewPage l10n loc mcookie
|
return $ productNewPage l10n loc version mcookie symbol
|
||||||
Nothing ->
|
Nothing ->
|
||||||
redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
|
redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
|
||||||
|
|
||||||
|
@ -109,7 +110,7 @@ productPostNew
|
||||||
-> ProductSubmit
|
-> ProductSubmit
|
||||||
-> UserHandler ProductNewPage
|
-> UserHandler ProductNewPage
|
||||||
productPostNew mcookie (ProductSubmit ident flPrice ml max apc ppc artnr) = do
|
productPostNew mcookie (ProductSubmit ident flPrice ml max apc ppc artnr) = do
|
||||||
(token, muser, loc, l10n, backend) <- controlInit mcookie
|
(token, muser, loc, l10n, backend, _, _) <- controlInit mcookie
|
||||||
case muser of
|
case muser of
|
||||||
Just user -> do
|
Just user -> do
|
||||||
eresult <- liftIO $ runClientM
|
eresult <- liftIO $ runClientM
|
||||||
|
|
|
@ -38,7 +38,7 @@ import Util
|
||||||
|
|
||||||
userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage
|
userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage
|
||||||
userSelectControl mcookie = do
|
userSelectControl mcookie = do
|
||||||
(ReadState l10n backend _) <- ask
|
(ReadState l10n backend _ symbol version) <- ask
|
||||||
let loc = Locale
|
let loc = Locale
|
||||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||||
euser <- liftIO $ runClientM
|
euser <- liftIO $ runClientM
|
||||||
|
@ -46,16 +46,16 @@ userSelectControl mcookie = do
|
||||||
backend
|
backend
|
||||||
case euser of
|
case euser of
|
||||||
Right uss ->
|
Right uss ->
|
||||||
return $ userSelectPage l10n loc uss mcookie
|
return $ userSelectPage l10n loc uss version mcookie
|
||||||
Left err ->
|
Left err ->
|
||||||
error $ show err
|
error $ show err
|
||||||
|
|
||||||
userNewControl :: Maybe T.Text -> UserHandler UserNewPage
|
userNewControl :: Maybe T.Text -> UserHandler UserNewPage
|
||||||
userNewControl mcookie = do
|
userNewControl mcookie = do
|
||||||
(ReadState l10n _ _) <- ask
|
(ReadState l10n _ _ symbol version) <- ask
|
||||||
let loc = Locale
|
let loc = Locale
|
||||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||||
return $ userNewPage l10n loc mcookie
|
return $ userNewPage l10n loc version mcookie
|
||||||
|
|
||||||
userNewPostControl
|
userNewPostControl
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
|
@ -77,7 +77,7 @@ userOverviewControl
|
||||||
-> Maybe MT.ProductRefine
|
-> Maybe MT.ProductRefine
|
||||||
-> UserHandler UserOverviewPage
|
-> UserHandler UserOverviewPage
|
||||||
userOverviewControl mcookie uid mRefine = do
|
userOverviewControl mcookie uid mRefine = do
|
||||||
(ReadState l10n backend _) <- ask
|
(ReadState l10n backend _ symbol version) <- ask
|
||||||
let loc = Locale
|
let loc = Locale
|
||||||
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
|
||||||
mParsedCookie = fmap parseCookieText mcookie
|
mParsedCookie = fmap parseCookieText mcookie
|
||||||
|
@ -103,7 +103,15 @@ userOverviewControl mcookie uid mRefine = do
|
||||||
if fmap read mAuthUser == Just uid
|
if fmap read mAuthUser == Just uid
|
||||||
then
|
then
|
||||||
return $
|
return $
|
||||||
userOverviewPage l10n loc (toEnum $ read method) ud prods mcookie
|
userOverviewPage
|
||||||
|
l10n
|
||||||
|
loc
|
||||||
|
(toEnum $ read method)
|
||||||
|
ud
|
||||||
|
prods
|
||||||
|
version
|
||||||
|
mcookie
|
||||||
|
symbol
|
||||||
else
|
else
|
||||||
redirectOverAuth
|
redirectOverAuth
|
||||||
(Just uid)
|
(Just uid)
|
||||||
|
@ -139,8 +147,9 @@ userRechargeControl
|
||||||
-> UserHandler UserRechargePage
|
-> UserHandler UserRechargePage
|
||||||
userRechargeControl mcookie uid = do
|
userRechargeControl mcookie uid = do
|
||||||
l10n <- asks rsL10n
|
l10n <- asks rsL10n
|
||||||
|
(ReadState l10n backend _ symbol version) <- ask
|
||||||
let loc = localeFromCookie mcookie
|
let loc = localeFromCookie mcookie
|
||||||
return $ userRechargePage l10n loc mcookie uid
|
return $ userRechargePage l10n loc version mcookie uid symbol
|
||||||
|
|
||||||
userPostRechargeControl
|
userPostRechargeControl
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
|
@ -148,7 +157,7 @@ userPostRechargeControl
|
||||||
-> UserRecharge
|
-> UserRecharge
|
||||||
-> UserHandler UserOverviewPage
|
-> UserHandler UserOverviewPage
|
||||||
userPostRechargeControl mcookie uid (UserRecharge amount) = do
|
userPostRechargeControl mcookie uid (UserRecharge amount) = do
|
||||||
(ReadState l10n backend _) <- ask
|
(ReadState l10n backend _ _ _) <- ask
|
||||||
let loc = localeFromCookie mcookie
|
let loc = localeFromCookie mcookie
|
||||||
(token, mauthuser) = parseTokenAndUser mcookie
|
(token, mauthuser) = parseTokenAndUser mcookie
|
||||||
eresult <- liftIO $ runClientM
|
eresult <- liftIO $ runClientM
|
||||||
|
@ -177,7 +186,7 @@ userManageControl
|
||||||
-> Int
|
-> Int
|
||||||
-> UserHandler UserManagePage
|
-> UserHandler UserManagePage
|
||||||
userManageControl mcookie uid = do
|
userManageControl mcookie uid = do
|
||||||
(ReadState l10n backend _) <- ask
|
(ReadState l10n backend _ symbol version) <- ask
|
||||||
let loc = localeFromCookie mcookie
|
let loc = localeFromCookie mcookie
|
||||||
(token, mAuthUser) = parseTokenAndUser mcookie
|
(token, mAuthUser) = parseTokenAndUser mcookie
|
||||||
eUserDetails <- liftIO $
|
eUserDetails <- liftIO $
|
||||||
|
@ -192,7 +201,8 @@ userManageControl mcookie uid = do
|
||||||
(Right userDetails, Right authOverviews) ->
|
(Right userDetails, Right authOverviews) ->
|
||||||
if Just uid == fmap read mAuthUser
|
if Just uid == fmap read mAuthUser
|
||||||
then
|
then
|
||||||
return $ userManagePage l10n loc userDetails authOverviews mcookie
|
return $
|
||||||
|
userManagePage l10n loc userDetails authOverviews version mcookie
|
||||||
else
|
else
|
||||||
redirectOverAuth (Just uid) (Just $ userManageLink uid) Nothing
|
redirectOverAuth (Just uid) (Just $ userManageLink uid) Nothing
|
||||||
err -> handleErrors
|
err -> handleErrors
|
||||||
|
@ -206,7 +216,7 @@ userManageDetailsSubmitControl
|
||||||
-> MT.UserDetailsSubmit
|
-> MT.UserDetailsSubmit
|
||||||
-> UserHandler UserOverviewPage
|
-> UserHandler UserOverviewPage
|
||||||
userManageDetailsSubmitControl mcookie uid uds = do
|
userManageDetailsSubmitControl mcookie uid uds = do
|
||||||
(ReadState _ backend _) <- ask
|
(ReadState _ backend _ _ _) <- ask
|
||||||
let (token, mAuthUser) = parseTokenAndUser mcookie
|
let (token, mAuthUser) = parseTokenAndUser mcookie
|
||||||
eReturn <- liftIO $ runClientM
|
eReturn <- liftIO $ runClientM
|
||||||
(userUpdate (mkAuthenticatedRequest token authenticateReq) uds)
|
(userUpdate (mkAuthenticatedRequest token authenticateReq) uds)
|
||||||
|
@ -222,7 +232,7 @@ userManageAuthCreateControl
|
||||||
-> AuthSubmitReturn
|
-> AuthSubmitReturn
|
||||||
-> UserHandler UserOverviewPage
|
-> UserHandler UserOverviewPage
|
||||||
userManageAuthCreateControl mcookie uid (AuthSubmitReturn comment pass method) = do
|
userManageAuthCreateControl mcookie uid (AuthSubmitReturn comment pass method) = do
|
||||||
(ReadState _ backend _) <- ask
|
(ReadState _ backend _ _ _) <- ask
|
||||||
let (token, mAuthUser) = parseTokenAndUser mcookie
|
let (token, mAuthUser) = parseTokenAndUser mcookie
|
||||||
hashedPass <- hashPassword pass
|
hashedPass <- hashPassword pass
|
||||||
eReturn <- liftIO $ runClientM
|
eReturn <- liftIO $ runClientM
|
||||||
|
|
30
src/Main.hs
30
src/Main.hs
|
@ -1,5 +1,5 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE PackageImports #-}
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Servant
|
import Servant
|
||||||
|
@ -20,11 +20,16 @@ import Data.YAML
|
||||||
|
|
||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
|
|
||||||
|
-- imports from "mateamt"
|
||||||
|
|
||||||
|
import qualified "mateamt" Types as MT
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import API
|
import API
|
||||||
import Types
|
import Types
|
||||||
import Control
|
import Control
|
||||||
|
import Client
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
@ -38,23 +43,32 @@ main = do
|
||||||
Right (Configuration apiHost apiPort apiUri apiSec listenPort locs) -> do
|
Right (Configuration apiHost apiPort apiUri apiSec listenPort locs) -> do
|
||||||
mngr <- newManager defaultManagerSettings
|
mngr <- newManager defaultManagerSettings
|
||||||
(l10n, _) <- getL10n (T.unpack locs)
|
(l10n, _) <- getL10n (T.unpack locs)
|
||||||
withStdoutLogger $ \ilog -> do
|
let backend = mkClientEnv mngr
|
||||||
let settings = setPort (fromIntegral listenPort) $
|
|
||||||
setLogger ilog defaultSettings
|
|
||||||
initState = ReadState
|
|
||||||
-- { rsManager = manager
|
|
||||||
{ rsL10n = l10n
|
|
||||||
, rsBackend = mkClientEnv mngr
|
|
||||||
(BaseUrl
|
(BaseUrl
|
||||||
(if apiSec then Https else Http)
|
(if apiSec then Https else Http)
|
||||||
(T.unpack apiHost)
|
(T.unpack apiHost)
|
||||||
(fromIntegral apiPort)
|
(fromIntegral apiPort)
|
||||||
(T.unpack apiUri)
|
(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
|
, rsHashParams = recommendedHashParams
|
||||||
|
, rsCurrencySymbol = symbol
|
||||||
|
, rsBackendVersion = version
|
||||||
}
|
}
|
||||||
putStrLn "Starting up..."
|
putStrLn "Starting up..."
|
||||||
runSettings settings (userApp initState)
|
runSettings settings (userApp initState)
|
||||||
|
Left err ->
|
||||||
|
error $ "Connection with backend failed: " <> (fromString $ show err)
|
||||||
where
|
where
|
||||||
opts = info (options <**> helper)
|
opts = info (options <**> helper)
|
||||||
( fullDesc
|
( fullDesc
|
||||||
|
|
|
@ -7,6 +7,7 @@ import Servant.Client (ClientEnv)
|
||||||
|
|
||||||
import Control.Monad.Reader (ReaderT)
|
import Control.Monad.Reader (ReaderT)
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
import Data.Text.I18n
|
import Data.Text.I18n
|
||||||
|
|
||||||
import Crypto.KDF.PBKDF2
|
import Crypto.KDF.PBKDF2
|
||||||
|
@ -17,6 +18,8 @@ data ReadState = ReadState
|
||||||
{ rsL10n :: L10n
|
{ rsL10n :: L10n
|
||||||
, rsBackend :: ClientEnv
|
, rsBackend :: ClientEnv
|
||||||
, rsHashParams :: HashParams
|
, rsHashParams :: HashParams
|
||||||
|
, rsCurrencySymbol :: T.Text
|
||||||
|
, rsBackendVersion :: T.Text
|
||||||
}
|
}
|
||||||
|
|
||||||
type UserHandler = ReaderT ReadState Handler
|
type UserHandler = ReaderT ReadState Handler
|
||||||
|
|
13
src/Util.hs
13
src/Util.hs
|
@ -13,7 +13,7 @@ import Servant.Client.Core.Request
|
||||||
import qualified Text.Blaze.Html5.Attributes as HA
|
import qualified Text.Blaze.Html5.Attributes as HA
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Text.Lazy.Encoding
|
import Data.Text.Encoding
|
||||||
|
|
||||||
import Data.Text.I18n
|
import Data.Text.I18n
|
||||||
|
|
||||||
|
@ -32,7 +32,7 @@ import Text.Printf (printf)
|
||||||
|
|
||||||
import Network.HTTP.Types.Status
|
import Network.HTTP.Types.Status
|
||||||
|
|
||||||
import Control.Monad.Reader (asks)
|
import Control.Monad.Reader (ask, asks)
|
||||||
|
|
||||||
-- imports from "mateamt"
|
-- imports from "mateamt"
|
||||||
|
|
||||||
|
@ -83,7 +83,7 @@ addMessage message err =
|
||||||
{ errHeaders =
|
{ errHeaders =
|
||||||
( "Set-Cookie"
|
( "Set-Cookie"
|
||||||
, "message=" <>
|
, "message=" <>
|
||||||
fromString (T.unpack message) <>
|
encodeUtf8 message <>
|
||||||
"; Path=/; Max-Age=5"
|
"; Path=/; Max-Age=5"
|
||||||
) : errHeaders err
|
) : errHeaders err
|
||||||
}
|
}
|
||||||
|
@ -189,13 +189,12 @@ productBgStyle aid = HA.style $ mconcat
|
||||||
|
|
||||||
controlInit
|
controlInit
|
||||||
:: Maybe T.Text
|
:: Maybe T.Text
|
||||||
-> UserHandler (String, Maybe String, Locale, L10n, ClientEnv)
|
-> UserHandler (String, Maybe String, Locale, L10n, ClientEnv, T.Text, T.Text)
|
||||||
controlInit mcookie = do
|
controlInit mcookie = do
|
||||||
let (token, muser) = parseTokenAndUser mcookie
|
let (token, muser) = parseTokenAndUser mcookie
|
||||||
loc = localeFromCookie mcookie
|
loc = localeFromCookie mcookie
|
||||||
l10n <- asks rsL10n
|
(ReadState l10n backend _ symbol version) <- ask
|
||||||
backend <- asks rsBackend
|
return (token, muser, loc, l10n, backend, symbol, version)
|
||||||
return (token, muser, loc, l10n, backend)
|
|
||||||
|
|
||||||
handleClientErr err muid authTargetLink =
|
handleClientErr err muid authTargetLink =
|
||||||
case err of
|
case err of
|
||||||
|
|
|
@ -27,11 +27,13 @@ authPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> AuthPage
|
-> AuthPage
|
||||||
authPage l10n locale mDestination mcookie = scaffold
|
authPage l10n locale mDestination version mcookie = scaffold
|
||||||
l10n
|
l10n
|
||||||
locale
|
locale
|
||||||
|
version
|
||||||
mcookie
|
mcookie
|
||||||
(initPage $
|
(initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
|
|
|
@ -35,10 +35,12 @@ buyConfirmPage
|
||||||
-> [(MT.PurchaseDetail, MT.ProductShortOverview)]
|
-> [(MT.PurchaseDetail, MT.ProductShortOverview)]
|
||||||
-> Int
|
-> Int
|
||||||
-> Bool
|
-> Bool
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
|
-> T.Text
|
||||||
-> H.Html
|
-> H.Html
|
||||||
buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
|
buyConfirmPage l10n locale uid ziptups total forceBuy version mcookie symbol =
|
||||||
scaffold l10n locale mcookie (initPage $
|
scaffold l10n locale version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Home"
|
translate "Home"
|
||||||
|
@ -88,7 +90,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
|
||||||
H.label
|
H.label
|
||||||
H.! HA.for ("product-total-" <> fromString (show pid))
|
H.! HA.for ("product-total-" <> fromString (show pid))
|
||||||
$ H.toHtml $
|
$ H.toHtml $
|
||||||
" @ " <> formatMoney price <> "€" -- TODO: ask for currency symbol
|
" @ " <> formatMoney price <> symbol
|
||||||
-- H.input
|
-- H.input
|
||||||
-- H.! HA.id ("product-total-" <> fromString (show pid))
|
-- H.! HA.id ("product-total-" <> fromString (show pid))
|
||||||
-- H.! HA.class_ "form-control"
|
-- H.! HA.class_ "form-control"
|
||||||
|
@ -111,7 +113,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
|
||||||
H.! HA.type_ "text"
|
H.! HA.type_ "text"
|
||||||
H.! HA.value (fromString $ T.unpack $ formatMoney total)
|
H.! HA.value (fromString $ T.unpack $ formatMoney total)
|
||||||
H.! HA.disabled ""
|
H.! HA.disabled ""
|
||||||
-- H.toHtml ("€" :: T.Text) -- TODO: ask for currency symbol
|
H.toHtml symbol
|
||||||
H.div H.! HA.class_ "form-group optional" $
|
H.div H.! HA.class_ "form-group optional" $
|
||||||
H.button
|
H.button
|
||||||
H.! HA.class_ "btn btn-default"
|
H.! HA.class_ "btn btn-default"
|
||||||
|
@ -182,11 +184,12 @@ buyProductsForm l10n locale prods = do
|
||||||
cashBuyOverviewPage
|
cashBuyOverviewPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> [MT.ProductShortOverview]
|
-> [MT.ProductShortOverview]
|
||||||
-> CashBuyOverviewPage
|
-> CashBuyOverviewPage
|
||||||
cashBuyOverviewPage l10n loc mcookie psos =
|
cashBuyOverviewPage l10n loc version mcookie psos =
|
||||||
scaffold l10n loc mcookie (initPage $
|
scaffold l10n loc version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Buy with Cash"
|
translate "Buy with Cash"
|
||||||
|
|
|
@ -31,12 +31,13 @@ import API
|
||||||
journalPage
|
journalPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> Maybe Word
|
-> Maybe Word
|
||||||
-> [MT.JournalEntry]
|
-> [MT.JournalEntry]
|
||||||
-> JournalPage
|
-> JournalPage
|
||||||
journalPage l10n loc mcookie mpage entries =
|
journalPage l10n loc version mcookie mpage entries =
|
||||||
scaffold l10n loc mcookie (initPage $
|
scaffold l10n loc version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Journal"
|
translate "Journal"
|
||||||
|
@ -90,10 +91,11 @@ journalPage l10n loc mcookie mpage entries =
|
||||||
journalCheckPage
|
journalCheckPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> JournalCheckPage
|
-> JournalCheckPage
|
||||||
journalCheckPage l10n loc mcookie =
|
journalCheckPage l10n loc version mcookie =
|
||||||
scaffold l10n loc mcookie (initPage $
|
scaffold l10n loc version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Cash check"
|
translate "Cash check"
|
||||||
|
|
|
@ -28,11 +28,13 @@ import API
|
||||||
productPriceListPage
|
productPriceListPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> [MT.ProductShortOverview]
|
-> [MT.ProductShortOverview]
|
||||||
|
-> T.Text
|
||||||
-> ProductPriceListPage
|
-> ProductPriceListPage
|
||||||
productPriceListPage l10n loc mcookie list =
|
productPriceListPage l10n loc version mcookie list symbol =
|
||||||
scaffold l10n loc mcookie (initPage $
|
scaffold l10n loc version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Price List"
|
translate "Price List"
|
||||||
|
@ -52,7 +54,7 @@ productPriceListPage l10n loc mcookie list =
|
||||||
H.td (H.toHtml ident)
|
H.td (H.toHtml ident)
|
||||||
H.td (H.toHtml $ show amount)
|
H.td (H.toHtml $ show amount)
|
||||||
H.td (H.toHtml $ (fromString $ show ml :: T.Text) <> " ml")
|
H.td (H.toHtml $ (fromString $ show ml :: T.Text) <> " ml")
|
||||||
H.td (H.toHtml $ (formatMoney price)) -- TODO: Add Currency symbol
|
H.td (H.toHtml $ (formatMoney price) <> symbol)
|
||||||
)
|
)
|
||||||
list
|
list
|
||||||
where
|
where
|
||||||
|
@ -61,11 +63,12 @@ productPriceListPage l10n loc mcookie list =
|
||||||
productRefillPage
|
productRefillPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> [MT.ProductShortOverview]
|
-> [MT.ProductShortOverview]
|
||||||
-> ProductRefillPage
|
-> ProductRefillPage
|
||||||
productRefillPage l10n loc mcookie prodList =
|
productRefillPage l10n loc version mcookie prodList =
|
||||||
scaffold l10n loc mcookie (initPage $
|
scaffold l10n loc version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Refill stock"
|
translate "Refill stock"
|
||||||
|
@ -160,10 +163,12 @@ productRefillPage l10n loc mcookie prodList =
|
||||||
productNewPage
|
productNewPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
|
-> T.Text
|
||||||
-> ProductNewPage
|
-> ProductNewPage
|
||||||
productNewPage l10n loc mcookie =
|
productNewPage l10n loc version mcookie symbol =
|
||||||
scaffold l10n loc mcookie (initPage $
|
scaffold l10n loc version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Create new product"
|
translate "Create new product"
|
||||||
|
@ -185,7 +190,8 @@ productNewPage l10n loc mcookie =
|
||||||
H.! HA.value ""
|
H.! HA.value ""
|
||||||
H.! HA.required ""
|
H.! HA.required ""
|
||||||
H.div H.! HA.class_ "form-group required" $ do
|
H.div H.! HA.class_ "form-group required" $ do
|
||||||
H.label H.! HA.for "price" $ H.toHtml $ translate "Product price"
|
H.label H.! HA.for "price" $ H.toHtml $
|
||||||
|
translate "Product price in" <> " " <> symbol
|
||||||
H.input
|
H.input
|
||||||
H.! HA.id "price"
|
H.! HA.id "price"
|
||||||
H.! HA.class_ "form-control"
|
H.! HA.class_ "form-control"
|
||||||
|
|
|
@ -25,11 +25,12 @@ import Util
|
||||||
scaffold
|
scaffold
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> Page H.Html T.Text
|
-> Page H.Html T.Text
|
||||||
-> H.Html
|
-> H.Html
|
||||||
-> H.Html
|
-> H.Html
|
||||||
scaffold l10n locale mcookie page content = template page $ do
|
scaffold l10n locale version mcookie page content = template page $ do
|
||||||
H.header $ H.nav $ H.ul $ do
|
H.header $ H.nav $ H.ul $ do
|
||||||
H.li $ H.a H.! HA.href ("/" <> fromString (show $ linkURI userSelectLink)) $
|
H.li $ H.a H.! HA.href ("/" <> fromString (show $ linkURI userSelectLink)) $
|
||||||
H.toHtml $ translate "Home"
|
H.toHtml $ translate "Home"
|
||||||
|
@ -53,7 +54,7 @@ scaffold l10n locale mcookie page content = template page $ do
|
||||||
H.button
|
H.button
|
||||||
H.! HA.formmethod "get"
|
H.! HA.formmethod "get"
|
||||||
H.! HA.formaction ("/" <>
|
H.! HA.formaction ("/" <>
|
||||||
(fromString $ show $ linkURI productGetPriceListLink))
|
(fromString $ show $ linkURI $ productGetPriceListLink Nothing))
|
||||||
$ H.toHtml $ translate "Price List"
|
$ H.toHtml $ translate "Price List"
|
||||||
maybe
|
maybe
|
||||||
(return ())
|
(return ())
|
||||||
|
@ -65,6 +66,9 @@ scaffold l10n locale mcookie page content = template page $ do
|
||||||
$ H.toHtml $ translate "Refill stock"
|
$ H.toHtml $ translate "Refill stock"
|
||||||
)
|
)
|
||||||
(getLogin mcookie)
|
(getLogin mcookie)
|
||||||
|
H.div
|
||||||
|
H.! HA.class_ "backend-version"
|
||||||
|
$ H.toHtml $ (translate "Powered by mateamt version") <> " " <> version
|
||||||
where
|
where
|
||||||
message = lookup "message" =<< fmap parseCookieText mcookie
|
message = lookup "message" =<< fmap parseCookieText mcookie
|
||||||
translate = localize l10n locale . gettext
|
translate = localize l10n locale . gettext
|
||||||
|
|
|
@ -31,10 +31,11 @@ userSelectPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
-> [MT.UserSummary]
|
-> [MT.UserSummary]
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> UserSelectPage
|
-> UserSelectPage
|
||||||
userSelectPage l10n locale uss mcookie =
|
userSelectPage l10n locale uss version mcookie =
|
||||||
scaffold l10n locale mcookie (initPage $
|
scaffold l10n locale version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Home"
|
translate "Home"
|
||||||
|
@ -59,10 +60,12 @@ userOverviewPage
|
||||||
-> MT.AuthMethod
|
-> MT.AuthMethod
|
||||||
-> MT.UserDetails
|
-> MT.UserDetails
|
||||||
-> [MT.ProductShortOverview]
|
-> [MT.ProductShortOverview]
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
|
-> T.Text
|
||||||
-> UserOverviewPage
|
-> UserOverviewPage
|
||||||
userOverviewPage l10n locale method ud pos mcookie =
|
userOverviewPage l10n locale method ud pos version mcookie symbol =
|
||||||
scaffold l10n locale mcookie (initPage $
|
scaffold l10n locale version mcookie (initPage $
|
||||||
localize l10n locale (gettext "Matebeamter") <>
|
localize l10n locale (gettext "Matebeamter") <>
|
||||||
" - " <>
|
" - " <>
|
||||||
localize l10n locale (gettext "User Menu for ") <>
|
localize l10n locale (gettext "User Menu for ") <>
|
||||||
|
@ -73,8 +76,7 @@ userOverviewPage l10n locale method ud pos mcookie =
|
||||||
H.p H.!? (MT.userDetailsBalance ud < 0, HA.class_ "debt") $ H.toHtml $
|
H.p H.!? (MT.userDetailsBalance ud < 0, HA.class_ "debt") $ H.toHtml $
|
||||||
translate "Your current balance is" <>
|
translate "Your current balance is" <>
|
||||||
": " <>
|
": " <>
|
||||||
formatMoney (MT.userDetailsBalance ud)
|
formatMoney (MT.userDetailsBalance ud) <> symbol
|
||||||
-- TODO: Add currency symbol
|
|
||||||
H.p $ H.form
|
H.p $ H.form
|
||||||
H.! HA.method "post"
|
H.! HA.method "post"
|
||||||
H.! HA.action ("/" <> fromString (show $ linkURI authLogoutLink))
|
H.! HA.action ("/" <> fromString (show $ linkURI authLogoutLink))
|
||||||
|
@ -159,9 +161,11 @@ productList pos =
|
||||||
userNewPage
|
userNewPage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> UserNewPage
|
-> UserNewPage
|
||||||
userNewPage l10n locale mcookie = scaffold l10n locale mcookie (initPage $
|
userNewPage l10n locale version mcookie =
|
||||||
|
scaffold l10n locale version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Create new user"
|
translate "Create new user"
|
||||||
|
@ -207,11 +211,13 @@ userNewPage l10n locale mcookie = scaffold l10n locale mcookie (initPage $
|
||||||
userRechargePage
|
userRechargePage
|
||||||
:: L10n
|
:: L10n
|
||||||
-> Locale
|
-> Locale
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> Int
|
-> Int
|
||||||
|
-> T.Text
|
||||||
-> UserRechargePage
|
-> UserRechargePage
|
||||||
userRechargePage l10n locale mcookie uid =
|
userRechargePage l10n locale version mcookie uid symbol =
|
||||||
scaffold l10n locale mcookie (initPage $
|
scaffold l10n locale version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Recharge account"
|
translate "Recharge account"
|
||||||
|
@ -230,7 +236,7 @@ userRechargePage l10n locale mcookie uid =
|
||||||
H.! HA.min "0"
|
H.! HA.min "0"
|
||||||
H.! HA.step "0.01"
|
H.! HA.step "0.01"
|
||||||
H.! HA.value "0"
|
H.! HA.value "0"
|
||||||
-- H.toHtml ("€" :: T.Text) -- TODO: ask for currency symbol
|
H.toHtml symbol
|
||||||
H.div H.! HA.class_ "form-group optional" $
|
H.div H.! HA.class_ "form-group optional" $
|
||||||
H.button
|
H.button
|
||||||
H.! HA.class_ "btn btn-default"
|
H.! HA.class_ "btn btn-default"
|
||||||
|
@ -244,10 +250,11 @@ userManagePage
|
||||||
-> Locale
|
-> Locale
|
||||||
-> MT.UserDetails
|
-> MT.UserDetails
|
||||||
-> [MT.AuthOverview]
|
-> [MT.AuthOverview]
|
||||||
|
-> T.Text
|
||||||
-> Maybe T.Text
|
-> Maybe T.Text
|
||||||
-> UserManagePage
|
-> UserManagePage
|
||||||
userManagePage l10n locale userDetails authOverviews mcookie =
|
userManagePage l10n locale userDetails authOverviews version mcookie =
|
||||||
scaffold l10n locale mcookie (initPage $
|
scaffold l10n locale version mcookie (initPage $
|
||||||
translate "Matebeamter" <>
|
translate "Matebeamter" <>
|
||||||
" - " <>
|
" - " <>
|
||||||
translate "Manage user data"
|
translate "Manage user data"
|
||||||
|
|
Loading…
Reference in a new issue