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
|
||||
:> Post '[HTML] JournalPage
|
||||
:<|> "product" :> "list"
|
||||
:> QueryParam "refine" MT.ProductRefine
|
||||
:> Get '[HTML] ProductPriceListPage
|
||||
:<|> "product" :> "refill"
|
||||
:> Get '[HTML] ProductRefillPage
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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,7 +238,8 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
|
|||
(MT.PurchaseResult (MT.PayAmount price) []) ->
|
||||
throwError $
|
||||
addMessage
|
||||
(translate l10n loc "Please Pay" <> ": " <> formatMoney price) $
|
||||
(translate l10n loc "Please Pay" <>
|
||||
": " <> formatMoney price <> symbol) $
|
||||
redirect303 userSelectLink
|
||||
(MT.PurchaseResult (MT.PayAmount price) miss) -> do
|
||||
eproducts <- liftIO $ runClientM
|
||||
|
@ -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: "
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
30
src/Main.hs
30
src/Main.hs
|
@ -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
|
||||
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
|
||||
|
|
|
@ -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
|
||||
|
@ -17,6 +18,8 @@ data ReadState = ReadState
|
|||
{ rsL10n :: L10n
|
||||
, rsBackend :: ClientEnv
|
||||
, rsHashParams :: HashParams
|
||||
, rsCurrencySymbol :: T.Text
|
||||
, rsBackendVersion :: T.Text
|
||||
}
|
||||
|
||||
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 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
|
||||
|
|
|
@ -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" <>
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,9 +161,11 @@ productList pos =
|
|||
userNewPage
|
||||
:: L10n
|
||||
-> Locale
|
||||
-> T.Text
|
||||
-> Maybe T.Text
|
||||
-> UserNewPage
|
||||
userNewPage l10n locale mcookie = scaffold l10n locale mcookie (initPage $
|
||||
userNewPage l10n locale version mcookie =
|
||||
scaffold l10n locale version mcookie (initPage $
|
||||
translate "Matebeamter" <>
|
||||
" - " <>
|
||||
translate "Create new user"
|
||||
|
@ -207,11 +211,13 @@ userNewPage l10n locale mcookie = scaffold l10n locale mcookie (initPage $
|
|||
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"
|
||||
|
|
Loading…
Reference in a new issue