nek0/matebeamter
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

fetch and incorporate provided meta information

Browse source
This commit is contained in:
nek0 2019-12-20 08:49:06 +01:00
parent 31f6665fee
commit e80cc68204
16 changed files with 211 additions and 142 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
src/API.hs
View file

@ -71,6 +71,7 @@ type UserAPI =
:> ReqBody '[FormUrlEncoded] CashCheck
:> Post '[HTML] JournalPage
:<|> "product" :> "list"
:> QueryParam "refine" MT.ProductRefine
:> Get '[HTML] ProductPriceListPage
:<|> "product" :> "refill"
:> Get '[HTML] ProductRefillPage

6
src/Client.hs
View file

@ -96,6 +96,8 @@ avatarUpdate
-> ClientM ()
avatarList :: ClientM [MT.Avatar]
metaGet :: ClientM MT.MetaInformation
( authGet :<|>
authSend :<|>
authLogout :<|>
@ -126,7 +128,9 @@ avatarList :: ClientM [MT.Avatar]
avatarGet :<|>
avatarInsert :<|>
avatarUpdate :<|>
avatarList
avatarList :<|>
metaGet
) = client mateApi
getClients clientEnv = hoistClient

10
src/Control/Auth.hs
View file

@ -64,7 +64,7 @@ authControl mcookie mDestination = do
Nothing
)
(Just authUser, Nothing) -> do
(ReadState _ backend _) <- ask
(ReadState _ backend _ _ _) <- ask
let trs = map
(MT.TicketRequest
(read (T.unpack authUser) :: Int))
@ -99,7 +99,7 @@ authControl mcookie mDestination = do
]
AuthPage)
digestAuthInfo tupAuthInfos = do
(ReadState l10n _ _) <- ask
(ReadState l10n _ _ _ version) <- ask
let loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
ticketHeaders = map
@ -110,7 +110,7 @@ authControl mcookie mDestination = do
return $
addHeader (head ticketHeaders) $
addHeader (ticketHeaders !! 1) $
authPage l10n loc mDestination mcookie
authPage l10n loc mDestination version mcookie
authPostControl
:: Maybe T.Text
@ -122,7 +122,7 @@ authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
parseCookieText cookies
case mticket of
Just ticket -> do
(ReadState _ backend _) <- ask
(ReadState _ backend _ _ _) <- ask
hashedPass <- hashPassword pass
etoken <- liftIO $ runClientM
(authSend
@ -175,7 +175,7 @@ authLogoutControl
:: Maybe T.Text
-> UserHandler UserOverviewPage
authLogoutControl mcookie = do
(ReadState _ backend _) <- ask
(ReadState _ backend _ _ _) <- ask
let mParsedCookie = fmap parseCookieText mcookie
token = T.unpack $ fromMaybe "secret"
(lookup "x-token" =<< mParsedCookie)

27
src/Control/Buy.hs
View file

@ -45,7 +45,7 @@ buyControl
buyControl mcookie uid pds forceBuy =
if not (null pds)
then do
(ReadState l10n backend _) <- ask
(ReadState l10n backend _ symbol version) <- ask
let (token, _) = parseTokenAndUser mcookie
loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
@ -70,7 +70,18 @@ buyControl mcookie uid pds forceBuy =
)
0
ziptup
return (buyConfirmPage l10n loc uid ziptup total forceBuy mcookie)
return
(buyConfirmPage
l10n
loc
uid
ziptup
total
forceBuy
version
mcookie
symbol
)
Left err ->
throwError $
addMessage (fromString $ show err) $
@ -176,7 +187,7 @@ cashBuyOverviewControl
-> Maybe MT.ProductRefine
-> UserHandler CashBuyOverviewPage
cashBuyOverviewControl mcookie mrefine = do
(ReadState l10n backend _) <- ask
(ReadState l10n backend _ symbol version) <- ask
let loc = localeFromCookie mcookie
eproducts <- liftIO $ runClientM
(productShortList
@ -185,7 +196,7 @@ cashBuyOverviewControl mcookie mrefine = do
backend
case eproducts of
Right prods ->
return $ cashBuyOverviewPage l10n loc mcookie prods
return $ cashBuyOverviewPage l10n loc version mcookie prods
Left err ->
throwError $ err500
{ errBody = fromString (show err)
@ -198,6 +209,7 @@ cashBuyPurchaseControl
-> UserHandler UserSelectPage
cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
l10n <- asks rsL10n
symbol <- asks rsCurrencySymbol
let loc = localeFromCookie mcookie
if not (null pds)
then do
@ -226,8 +238,9 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
(MT.PurchaseResult (MT.PayAmount price) []) ->
throwError $
addMessage
(translate l10n loc "Please Pay" <> ": " <> formatMoney price) $
redirect303 userSelectLink
(translate l10n loc "Please Pay" <>
": " <> formatMoney price <> symbol) $
redirect303 userSelectLink
(MT.PurchaseResult (MT.PayAmount price) miss) -> do
eproducts <- liftIO $ runClientM
(productShortList
@ -239,7 +252,7 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
Right prods ->
throwError
$ addMessage (translate l10n loc "Please Pay" <> ": "
<> formatMoney price
<> formatMoney price <> symbol
<> ". "
<> translate l10n loc
"But there seems to be something missing: "

10
src/Control/Journal.hs
View file

@ -37,7 +37,7 @@ journalControl
-> Maybe Word
-> UserHandler JournalPage
journalControl mcookie mpage = do
(token, muser, loc, l10n, backend) <- controlInit mcookie
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
case muser of
Just user -> do
eresult <- liftIO $ runClientM
@ -49,7 +49,7 @@ journalControl mcookie mpage = do
backend
case eresult of
Right entries ->
return (journalPage l10n loc mcookie mpage entries)
return (journalPage l10n loc version mcookie mpage entries)
Left err ->
case err of
FailureResponse _ resp ->
@ -71,15 +71,15 @@ journalGetCheckControl
:: Maybe T.Text
-> UserHandler JournalCheckPage
journalGetCheckControl mcookie = do
(token, muser, loc, l10n, _) <- controlInit mcookie
return $ journalCheckPage l10n loc mcookie
(token, muser, loc, l10n, _, symbol, version) <- controlInit mcookie
return $ journalCheckPage l10n loc version mcookie
journalPostCheckControl
:: Maybe T.Text
-> CashCheck
-> UserHandler JournalPage
journalPostCheckControl mcookie (CashCheck floatAmount) = do
(token, muser, loc, l10n, backend) <- controlInit mcookie
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
case muser of
Just user -> do
eresult <- liftIO $ runClientM

21
src/Control/Product.hs
View file

@ -30,17 +30,18 @@ import Hash
productGetPriceList
:: Maybe T.Text
-> Maybe MT.ProductRefine
-> UserHandler ProductPriceListPage
productGetPriceList mcookie = do
(token, muser, loc, l10n, backend) <- controlInit mcookie
productGetPriceList mcookie mrefine = do
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
elist <- liftIO $ runClientM
(productShortList
(Just MT.AllProducts)
mrefine
)
backend
case elist of
Right list ->
return (productPriceListPage l10n loc mcookie list)
return (productPriceListPage l10n loc version mcookie list symbol)
Left err ->
throwError $
addMessage (fromString $ show err) $
@ -50,7 +51,7 @@ productGetRefill
:: Maybe T.Text
-> UserHandler ProductRefillPage
productGetRefill mcookie = do
(token, muser, loc, l10n, backend) <- controlInit mcookie
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
case muser of
Just _ -> do
elist <- liftIO $ runClientM
@ -58,7 +59,7 @@ productGetRefill mcookie = do
backend
case elist of
Right list -> do
return $ productRefillPage l10n loc mcookie list
return $ productRefillPage l10n loc version mcookie list
Left err ->
throwError $
addMessage (fromString $ show err) $
@ -71,7 +72,7 @@ productPostRefill
-> [MT.AmountRefill]
-> UserHandler ProductRefillPage
productPostRefill mcookie refills = do
(token, muser, loc, l10n, backend) <- controlInit mcookie
(token, muser, loc, l10n, backend, _, _) <- controlInit mcookie
case muser of
Just _ -> do
eresult <- liftIO $ runClientM
@ -96,11 +97,11 @@ productGetNew
:: Maybe T.Text
-> UserHandler ProductNewPage
productGetNew mcookie = do
(token, muser, loc, l10n, backend) <- controlInit mcookie
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
case muser of
Just user ->
-- TODO: Fetch avatars and suppliers
return $ productNewPage l10n loc mcookie
return $ productNewPage l10n loc version mcookie symbol
Nothing ->
redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
@ -109,7 +110,7 @@ productPostNew
-> ProductSubmit
-> UserHandler ProductNewPage
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
Just user -> do
eresult <- liftIO $ runClientM

34
src/Control/User.hs
View file

@ -38,7 +38,7 @@ import Util
userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage
userSelectControl mcookie = do
(ReadState l10n backend _) <- ask
(ReadState l10n backend _ symbol version) <- ask
let loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
euser <- liftIO $ runClientM
@ -46,16 +46,16 @@ userSelectControl mcookie = do
backend
case euser of
Right uss ->
return $ userSelectPage l10n loc uss mcookie
return $ userSelectPage l10n loc uss version mcookie
Left err ->
error $ show err
userNewControl :: Maybe T.Text -> UserHandler UserNewPage
userNewControl mcookie = do
(ReadState l10n _ _) <- ask
(ReadState l10n _ _ symbol version) <- ask
let loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
return $ userNewPage l10n loc mcookie
return $ userNewPage l10n loc version mcookie
userNewPostControl
:: Maybe T.Text
@ -77,7 +77,7 @@ userOverviewControl
-> Maybe MT.ProductRefine
-> UserHandler UserOverviewPage
userOverviewControl mcookie uid mRefine = do
(ReadState l10n backend _) <- ask
(ReadState l10n backend _ symbol version) <- ask
let loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
mParsedCookie = fmap parseCookieText mcookie
@ -103,7 +103,15 @@ userOverviewControl mcookie uid mRefine = do
if fmap read mAuthUser == Just uid
then
return $
userOverviewPage l10n loc (toEnum $ read method) ud prods mcookie
userOverviewPage
l10n
loc
(toEnum $ read method)
ud
prods
version
mcookie
symbol
else
redirectOverAuth
(Just uid)
@ -139,8 +147,9 @@ userRechargeControl
-> UserHandler UserRechargePage
userRechargeControl mcookie uid = do
l10n <- asks rsL10n
(ReadState l10n backend _ symbol version) <- ask
let loc = localeFromCookie mcookie
return $ userRechargePage l10n loc mcookie uid
return $ userRechargePage l10n loc version mcookie uid symbol
userPostRechargeControl
:: Maybe T.Text
@ -148,7 +157,7 @@ userPostRechargeControl
-> UserRecharge
-> UserHandler UserOverviewPage
userPostRechargeControl mcookie uid (UserRecharge amount) = do
(ReadState l10n backend _) <- ask
(ReadState l10n backend _ _ _) <- ask
let loc = localeFromCookie mcookie
(token, mauthuser) = parseTokenAndUser mcookie
eresult <- liftIO $ runClientM
@ -177,7 +186,7 @@ userManageControl
-> Int
-> UserHandler UserManagePage
userManageControl mcookie uid = do
(ReadState l10n backend _) <- ask
(ReadState l10n backend _ symbol version) <- ask
let loc = localeFromCookie mcookie
(token, mAuthUser) = parseTokenAndUser mcookie
eUserDetails <- liftIO $
@ -192,7 +201,8 @@ userManageControl mcookie uid = do
(Right userDetails, Right authOverviews) ->
if Just uid == fmap read mAuthUser
then
return $ userManagePage l10n loc userDetails authOverviews mcookie
return $
userManagePage l10n loc userDetails authOverviews version mcookie
else
redirectOverAuth (Just uid) (Just $ userManageLink uid) Nothing
err -> handleErrors
@ -206,7 +216,7 @@ userManageDetailsSubmitControl
-> MT.UserDetailsSubmit
-> UserHandler UserOverviewPage
userManageDetailsSubmitControl mcookie uid uds = do
(ReadState _ backend _) <- ask
(ReadState _ backend _ _ _) <- ask
let (token, mAuthUser) = parseTokenAndUser mcookie
eReturn <- liftIO $ runClientM
(userUpdate (mkAuthenticatedRequest token authenticateReq) uds)
@ -222,7 +232,7 @@ userManageAuthCreateControl
-> AuthSubmitReturn
-> UserHandler UserOverviewPage
userManageAuthCreateControl mcookie uid (AuthSubmitReturn comment pass method) = do
(ReadState _ backend _) <- ask
(ReadState _ backend _ _ _) <- ask
let (token, mAuthUser) = parseTokenAndUser mcookie
hashedPass <- hashPassword pass
eReturn <- liftIO $ runClientM

50
src/Main.hs
View file

@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
module Main where
import Servant
@ -20,11 +20,16 @@ import Data.YAML
import Options.Applicative
-- imports from "mateamt"
import qualified "mateamt" Types as MT
-- internal imports
import API
import Types
import Control
import Client
main :: IO ()
main = do
@ -38,23 +43,32 @@ main = do
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)
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

9
src/Types/Reader.hs
View file

@ -7,6 +7,7 @@ import Servant.Client (ClientEnv)
import Control.Monad.Reader (ReaderT)
import qualified Data.Text as T
import Data.Text.I18n
import Crypto.KDF.PBKDF2
@ -14,9 +15,11 @@ import Crypto.Hash.Algorithms
data ReadState = ReadState
-- { rsManager :: Manager
{ rsL10n :: L10n
, rsBackend :: ClientEnv
, rsHashParams :: HashParams
{ rsL10n :: L10n
, rsBackend :: ClientEnv
, rsHashParams :: HashParams
, rsCurrencySymbol :: T.Text
, rsBackendVersion :: T.Text
}
type UserHandler = ReaderT ReadState Handler

13
src/Util.hs
View file

@ -13,7 +13,7 @@ import Servant.Client.Core.Request
import qualified Text.Blaze.Html5.Attributes as HA
import qualified Data.Text as T
import Data.Text.Lazy.Encoding
import Data.Text.Encoding
import Data.Text.I18n
@ -32,7 +32,7 @@ import Text.Printf (printf)
import Network.HTTP.Types.Status
import Control.Monad.Reader (asks)
import Control.Monad.Reader (ask, asks)
-- imports from "mateamt"
@ -83,7 +83,7 @@ addMessage message err =
{ errHeaders =
( "Set-Cookie"
, "message=" <>
fromString (T.unpack message) <>
encodeUtf8 message <>
"; Path=/; Max-Age=5"
) : errHeaders err
}
@ -189,13 +189,12 @@ productBgStyle aid = HA.style $ mconcat
controlInit
:: Maybe T.Text
-> UserHandler (String, Maybe String, Locale, L10n, ClientEnv)
-> UserHandler (String, Maybe String, Locale, L10n, ClientEnv, T.Text, T.Text)
controlInit mcookie = do
let (token, muser) = parseTokenAndUser mcookie
loc = localeFromCookie mcookie
l10n <- asks rsL10n
backend <- asks rsBackend
return (token, muser, loc, l10n, backend)
(ReadState l10n backend _ symbol version) <- ask
return (token, muser, loc, l10n, backend, symbol, version)
handleClientErr err muid authTargetLink =
case err of

4
src/View/Auth.hs
View file

@ -27,11 +27,13 @@ authPage
:: L10n
-> Locale
-> Maybe T.Text
-> T.Text
-> Maybe T.Text
-> AuthPage
authPage l10n locale mDestination mcookie = scaffold
authPage l10n locale mDestination version mcookie = scaffold
l10n
locale
version
mcookie
(initPage $
translate "Matebeamter" <>

15
src/View/Buy.hs
View file

@ -35,10 +35,12 @@ buyConfirmPage
-> [(MT.PurchaseDetail, MT.ProductShortOverview)]
-> Int
-> Bool
-> T.Text
-> Maybe T.Text
-> T.Text
-> H.Html
buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
scaffold l10n locale mcookie (initPage $
buyConfirmPage l10n locale uid ziptups total forceBuy version mcookie symbol =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Home"
@ -88,7 +90,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
H.label
H.! HA.for ("product-total-" <> fromString (show pid))
$ H.toHtml $
" @ " <> formatMoney price <> "€" -- TODO: ask for currency symbol
" @ " <> formatMoney price <> symbol
-- H.input
-- H.! HA.id ("product-total-" <> fromString (show pid))
-- H.! HA.class_ "form-control"
@ -111,7 +113,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
H.! HA.type_ "text"
H.! HA.value (fromString $ T.unpack $ formatMoney total)
H.! HA.disabled ""
-- H.toHtml ("€" :: T.Text) -- TODO: ask for currency symbol
H.toHtml symbol
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
@ -182,11 +184,12 @@ buyProductsForm l10n locale prods = do
cashBuyOverviewPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> [MT.ProductShortOverview]
-> CashBuyOverviewPage
cashBuyOverviewPage l10n loc mcookie psos =
scaffold l10n loc mcookie (initPage $
cashBuyOverviewPage l10n loc version mcookie psos =
scaffold l10n loc version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Buy with Cash"

10
src/View/Journal.hs
View file

@ -31,12 +31,13 @@ import API
journalPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> Maybe Word
-> [MT.JournalEntry]
-> JournalPage
journalPage l10n loc mcookie mpage entries =
scaffold l10n loc mcookie (initPage $
journalPage l10n loc version mcookie mpage entries =
scaffold l10n loc version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Journal"
@ -90,10 +91,11 @@ journalPage l10n loc mcookie mpage entries =
journalCheckPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> JournalCheckPage
journalCheckPage l10n loc mcookie =
scaffold l10n loc mcookie (initPage $
journalCheckPage l10n loc version mcookie =
scaffold l10n loc version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Cash check"

22
src/View/Product.hs
View file

@ -28,11 +28,13 @@ import API
productPriceListPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> [MT.ProductShortOverview]
-> T.Text
-> ProductPriceListPage
productPriceListPage l10n loc mcookie list =
scaffold l10n loc mcookie (initPage $
productPriceListPage l10n loc version mcookie list symbol =
scaffold l10n loc version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Price List"
@ -52,7 +54,7 @@ productPriceListPage l10n loc mcookie list =
H.td (H.toHtml ident)
H.td (H.toHtml $ show amount)
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
where
@ -61,11 +63,12 @@ productPriceListPage l10n loc mcookie list =
productRefillPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> [MT.ProductShortOverview]
-> ProductRefillPage
productRefillPage l10n loc mcookie prodList =
scaffold l10n loc mcookie (initPage $
productRefillPage l10n loc version mcookie prodList =
scaffold l10n loc version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Refill stock"
@ -160,10 +163,12 @@ productRefillPage l10n loc mcookie prodList =
productNewPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> T.Text
-> ProductNewPage
productNewPage l10n loc mcookie =
scaffold l10n loc mcookie (initPage $
productNewPage l10n loc version mcookie symbol =
scaffold l10n loc version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Create new product"
@ -185,7 +190,8 @@ productNewPage l10n loc mcookie =
H.! HA.value ""
H.! HA.required ""
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.! HA.id "price"
H.! HA.class_ "form-control"

8
src/View/Scaffold.hs
View file

@ -25,11 +25,12 @@ import Util
scaffold
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> Page H.Html T.Text
-> 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.li $ H.a H.! HA.href ("/" <> fromString (show $ linkURI userSelectLink)) $
H.toHtml $ translate "Home"
@ -53,7 +54,7 @@ scaffold l10n locale mcookie page content = template page $ do
H.button
H.! HA.formmethod "get"
H.! HA.formaction ("/" <>
(fromString $ show $ linkURI productGetPriceListLink))
(fromString $ show $ linkURI $ productGetPriceListLink Nothing))
$ H.toHtml $ translate "Price List"
maybe
(return ())
@ -65,6 +66,9 @@ scaffold l10n locale mcookie page content = template page $ do
$ H.toHtml $ translate "Refill stock"
)
(getLogin mcookie)
H.div
H.! HA.class_ "backend-version"
$ H.toHtml $ (translate "Powered by mateamt version") <> " " <> version
where
message = lookup "message" =<< fmap parseCookieText mcookie
translate = localize l10n locale . gettext

113
src/View/User.hs
View file

@ -31,10 +31,11 @@ userSelectPage
:: L10n
-> Locale
-> [MT.UserSummary]
-> T.Text
-> Maybe T.Text
-> UserSelectPage
userSelectPage l10n locale uss mcookie =
scaffold l10n locale mcookie (initPage $
userSelectPage l10n locale uss version mcookie =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Home"
@ -59,10 +60,12 @@ userOverviewPage
-> MT.AuthMethod
-> MT.UserDetails
-> [MT.ProductShortOverview]
-> T.Text
-> Maybe T.Text
-> T.Text
-> UserOverviewPage
userOverviewPage l10n locale method ud pos mcookie =
scaffold l10n locale mcookie (initPage $
userOverviewPage l10n locale method ud pos version mcookie symbol =
scaffold l10n locale version mcookie (initPage $
localize l10n locale (gettext "Matebeamter") <>
" - " <>
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 $
translate "Your current balance is" <>
": " <>
formatMoney (MT.userDetailsBalance ud)
-- TODO: Add currency symbol
formatMoney (MT.userDetailsBalance ud) <> symbol
H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString (show $ linkURI authLogoutLink))
@ -159,59 +161,63 @@ productList pos =
userNewPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> UserNewPage
userNewPage l10n locale mcookie = scaffold l10n locale mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Create new user"
) $ H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString (show $ linkURI userNewPostLink))
H.! HA.enctype "application/x-www-form-urlencoded" $ do
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
H.input
H.! HA.id "username"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitIdent"
H.! HA.type_ "text"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group optional" $ do
H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
H.input
H.! HA.id "useremail"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitEmail"
H.! HA.type_ "email"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "userpass" $ H.toHtml $ translate "Password"
H.input
H.! HA.id "userpass"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitPassHash"
H.! HA.type_ "password"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
where
translate = localize l10n locale . gettext
userNewPage l10n locale version mcookie =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Create new user"
) $ H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString (show $ linkURI userNewPostLink))
H.! HA.enctype "application/x-www-form-urlencoded" $ do
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
H.input
H.! HA.id "username"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitIdent"
H.! HA.type_ "text"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group optional" $ do
H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
H.input
H.! HA.id "useremail"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitEmail"
H.! HA.type_ "email"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "userpass" $ H.toHtml $ translate "Password"
H.input
H.! HA.id "userpass"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitPassHash"
H.! HA.type_ "password"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
where
translate = localize l10n locale . gettext
userRechargePage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> Int
-> T.Text
-> UserRechargePage
userRechargePage l10n locale mcookie uid =
scaffold l10n locale mcookie (initPage $
userRechargePage l10n locale version mcookie uid symbol =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Recharge account"
@ -230,7 +236,7 @@ userRechargePage l10n locale mcookie uid =
H.! HA.min "0"
H.! HA.step "0.01"
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.button
H.! HA.class_ "btn btn-default"
@ -244,10 +250,11 @@ userManagePage
-> Locale
-> MT.UserDetails
-> [MT.AuthOverview]
-> T.Text
-> Maybe T.Text
-> UserManagePage
userManagePage l10n locale userDetails authOverviews mcookie =
scaffold l10n locale mcookie (initPage $
userManagePage l10n locale userDetails authOverviews version mcookie =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Manage user data"