From e80cc6820423d25fb9227fda5a41c9049a4f3096 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 20 Dec 2019 08:49:06 +0100 Subject: [PATCH] fetch and incorporate provided meta information --- src/API.hs | 1 + src/Client.hs | 6 ++- src/Control/Auth.hs | 10 ++-- src/Control/Buy.hs | 27 +++++++--- src/Control/Journal.hs | 10 ++-- src/Control/Product.hs | 21 ++++---- src/Control/User.hs | 34 ++++++++----- src/Main.hs | 50 +++++++++++------- src/Types/Reader.hs | 9 ++-- src/Util.hs | 13 +++-- src/View/Auth.hs | 4 +- src/View/Buy.hs | 15 +++--- src/View/Journal.hs | 10 ++-- src/View/Product.hs | 22 +++++--- src/View/Scaffold.hs | 8 ++- src/View/User.hs | 113 ++++++++++++++++++++++------------------- 16 files changed, 211 insertions(+), 142 deletions(-) diff --git a/src/API.hs b/src/API.hs index 7b255db..d754aec 100644 --- a/src/API.hs +++ b/src/API.hs @@ -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 diff --git a/src/Client.hs b/src/Client.hs index 6ead7ed..f56d603 100644 --- a/src/Client.hs +++ b/src/Client.hs @@ -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 diff --git a/src/Control/Auth.hs b/src/Control/Auth.hs index a46616e..e12de30 100644 --- a/src/Control/Auth.hs +++ b/src/Control/Auth.hs @@ -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) diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs index 616b726..c3c5ca0 100644 --- a/src/Control/Buy.hs +++ b/src/Control/Buy.hs @@ -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: " diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs index 0ee622a..c06b7af 100644 --- a/src/Control/Journal.hs +++ b/src/Control/Journal.hs @@ -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 diff --git a/src/Control/Product.hs b/src/Control/Product.hs index db00c92..d93d1ba 100644 --- a/src/Control/Product.hs +++ b/src/Control/Product.hs @@ -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 diff --git a/src/Control/User.hs b/src/Control/User.hs index 7733d1c..59014a9 100644 --- a/src/Control/User.hs +++ b/src/Control/User.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 3f40b69..312d953 100644 --- a/src/Main.hs +++ b/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 - (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 diff --git a/src/Types/Reader.hs b/src/Types/Reader.hs index 05bc257..f1440e5 100644 --- a/src/Types/Reader.hs +++ b/src/Types/Reader.hs @@ -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 diff --git a/src/Util.hs b/src/Util.hs index 754af9e..73a2697 100644 --- a/src/Util.hs +++ b/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 diff --git a/src/View/Auth.hs b/src/View/Auth.hs index 2fbce7a..b84c9ef 100644 --- a/src/View/Auth.hs +++ b/src/View/Auth.hs @@ -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" <> diff --git a/src/View/Buy.hs b/src/View/Buy.hs index fd65366..e959744 100644 --- a/src/View/Buy.hs +++ b/src/View/Buy.hs @@ -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" diff --git a/src/View/Journal.hs b/src/View/Journal.hs index 1d0f396..3909a47 100644 --- a/src/View/Journal.hs +++ b/src/View/Journal.hs @@ -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" diff --git a/src/View/Product.hs b/src/View/Product.hs index 90a3a1c..47f4895 100644 --- a/src/View/Product.hs +++ b/src/View/Product.hs @@ -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" diff --git a/src/View/Scaffold.hs b/src/View/Scaffold.hs index 03fc538..a001f96 100644 --- a/src/View/Scaffold.hs +++ b/src/View/Scaffold.hs @@ -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 diff --git a/src/View/User.hs b/src/View/User.hs index aeeece7..c2c9dae 100644 --- a/src/View/User.hs +++ b/src/View/User.hs @@ -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"