This commit is contained in:
nek0 2019-12-12 03:41:22 +01:00
parent 28b98a6f9b
commit eed646a2f3
8 changed files with 32 additions and 28 deletions

View file

@ -66,7 +66,7 @@ buyControl mcookie uid pds forceBuy =
(\acc (\acc
( MT.PurchaseDetail _ amount ( MT.PurchaseDetail _ amount
, MT.ProductShortOverview _ _ price _ _ _) -> , MT.ProductShortOverview _ _ price _ _ _) ->
acc + (max 0 amount) * price acc + max 0 amount * price
) )
0 0
ziptup ziptup
@ -154,7 +154,7 @@ purchaseControl mcookie uid pds forceBuy = do
else else
throwError throwError
$ addMessage (translate l10n loc "Please choose your product(s)") $ addMessage (translate l10n loc "Please choose your product(s)")
$ (redirect303 $ userOverviewLink uid Nothing) (redirect303 $ userOverviewLink uid Nothing)
where where
logoutAndRedirectHome message backend token = do logoutAndRedirectHome message backend token = do
void $ liftIO $ runClientM void $ liftIO $ runClientM
@ -238,10 +238,10 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
<> formatMoney price <> formatMoney price
<> ". " <> ". "
<> translate l10n loc <> translate l10n loc
("But there seems to be something missing: ") "But there seems to be something missing: "
<> mconcat (reverse $ foldl <> mconcat (reverse $ foldl
(\acc (MT.ProductShortOverview psoid ident _ _ _ _) -> (\acc (MT.ProductShortOverview psoid ident _ _ _ _) ->
if psoid `elem` fst (unzip missIds) if psoid `elem` map fst missIds
then then
(fromString (show $ fromJust $ lookup psoid missIds) (fromString (show $ fromJust $ lookup psoid missIds)
<> " x " <> " x "
@ -259,6 +259,6 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
else else
throwError throwError
$ addMessage (translate l10n loc "Please choose your product(s)") $ addMessage (translate l10n loc "Please choose your product(s)")
$ (redirect303 $ cashBuyLink Nothing) (redirect303 $ cashBuyLink Nothing)
where where
translate l10n locale = localize l10n locale . gettext translate l10n locale = localize l10n locale . gettext

View file

@ -15,7 +15,7 @@ import Data.String
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.I18n import Data.Text.I18n
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, maybe)
import Network.HTTP.Types.Status (Status(..)) import Network.HTTP.Types.Status (Status(..))
@ -37,17 +37,14 @@ journalControl
-> Maybe Word -> Maybe Word
-> UserHandler JournalPage -> UserHandler JournalPage
journalControl mcookie mpage = do journalControl mcookie mpage = do
let (token, muser) = parseTokenAndUser mcookie (token, muser, loc, l10n, backend) <- controlInit mcookie
loc = localeFromCookie mcookie
l10n <- asks rsL10n
backend <- asks rsBackend
case muser of case muser of
Just user -> do Just user -> do
eresult <- liftIO $ runClientM eresult <- liftIO $ runClientM
(journalShow (journalShow
(mkAuthenticatedRequest token authenticateReq) (mkAuthenticatedRequest token authenticateReq)
(Just 50) (Just 50)
(Just $ 50 * fromMaybe 0 (fromIntegral <$> mpage)) (Just $ 50 * maybe 0 fromIntegral mpage)
) )
backend backend
case eresult of case eresult of
@ -74,9 +71,7 @@ journalGetCheckControl
:: Maybe T.Text :: Maybe T.Text
-> UserHandler JournalCheckPage -> UserHandler JournalCheckPage
journalGetCheckControl mcookie = do journalGetCheckControl mcookie = do
let (token, muser) = parseTokenAndUser mcookie (token, muser, loc, l10n, _) <- controlInit mcookie
loc = localeFromCookie mcookie
l10n <- asks rsL10n
return $ journalCheckPage l10n loc mcookie return $ journalCheckPage l10n loc mcookie
journalPostCheckControl journalPostCheckControl
@ -84,10 +79,7 @@ journalPostCheckControl
-> CashCheck -> CashCheck
-> UserHandler JournalPage -> UserHandler JournalPage
journalPostCheckControl mcookie (CashCheck floatAmount) = do journalPostCheckControl mcookie (CashCheck floatAmount) = do
let (token, muser) = parseTokenAndUser mcookie (token, muser, loc, l10n, backend) <- controlInit mcookie
loc = localeFromCookie mcookie
l10n <- asks rsL10n
backend <- asks rsBackend
case muser of case muser of
Just user -> do Just user -> do
eresult <- liftIO $ runClientM eresult <- liftIO $ runClientM
@ -105,7 +97,7 @@ journalPostCheckControl mcookie (CashCheck floatAmount) = do
FailureResponse _ resp -> FailureResponse _ resp ->
if statusCode (responseStatusCode resp) == 401 if statusCode (responseStatusCode resp) == 401
then then
redirectOverAuth Nothing (Just $ journalGetCheckLink) Nothing redirectOverAuth Nothing (Just journalGetCheckLink) Nothing
else else
throwError $ throwError $
addMessage (fromString $ show err) $ addMessage (fromString $ show err) $

View file

@ -91,7 +91,7 @@ userOverviewControl mcookie uid mRefine = do
runClientM runClientM
(userGet (mkAuthenticatedRequest token authenticateReq)) (userGet (mkAuthenticatedRequest token authenticateReq))
backend backend
eproducts <- case fmap toEnum (fmap read mMethod) of eproducts <- case fmap (toEnum . read) mMethod of
Just MT.PrimaryPass -> return (Right []) Just MT.PrimaryPass -> return (Right [])
Just MT.SecondaryPass -> getProducts Just MT.SecondaryPass -> getProducts
Just MT.ChallengeResponse -> getProducts Just MT.ChallengeResponse -> getProducts
@ -161,10 +161,10 @@ userPostRechargeControl mcookie uid (UserRecharge amount) = do
then then
case eresult of case eresult of
Right _ -> throwError $ Right _ -> throwError $
(addMessage $ translate l10n loc "Recharge Successful") $ addMessage (translate l10n loc "Recharge Successful") $
redirect303 (userOverviewLink uid Nothing) redirect303 (userOverviewLink uid Nothing)
Left err -> throwError $ Left err -> throwError $
(addMessage $ translate l10n loc ("An error occured. " <> addMessage (translate l10n loc ("An error occured. " <>
fromString (show err))) $ fromString (show err))) $
redirect303 (userRechargeLink uid) redirect303 (userRechargeLink uid)
else else

View file

@ -26,7 +26,7 @@ instance MimeUnrender HTML [MT.PurchaseDetail]
instance FromForm [MT.PurchaseDetail] where instance FromForm [MT.PurchaseDetail] where
fromForm form = fromForm form =
let kvs = toListStable form let kvs = toListStable form
ks = fst (unzip kvs) ks = map fst kvs
kpids = filter ("productSelect" `T.isPrefixOf`) ks kpids = filter ("productSelect" `T.isPrefixOf`) ks
prods = filter ((`notElem` kpids) . fst) kvs prods = filter ((`notElem` kpids) . fst) kvs
stripPid = snd . T.breakOnEnd "-" stripPid = snd . T.breakOnEnd "-"

View file

@ -32,6 +32,8 @@ import Text.Printf (printf)
import Network.HTTP.Types.Status import Network.HTTP.Types.Status
import Control.Monad.Reader (asks)
-- imports from "mateamt" -- imports from "mateamt"
import qualified "mateamt" Types as MT import qualified "mateamt" Types as MT
@ -50,7 +52,7 @@ formatMoney amount = pre <> t <> "," <> c
t = fromString $ reverse (intercalate "." $ chunksOf 3 $ reverse $ fst sp) t = fromString $ reverse (intercalate "." $ chunksOf 3 $ reverse $ fst sp)
c = fromString $ snd sp c = fromString $ snd sp
sp = tail <$> sp = tail <$>
break (== '.') (printf "%.2f" (abs $ (fromIntegral amount / 100) :: Float)) break (== '.') (printf "%.2f" (abs (fromIntegral amount / 100) :: Float))
redirect303 redirect303
:: Link :: Link
@ -183,3 +185,13 @@ productBgStyle aid = HA.style $ mconcat
, " 1px 0 1px black," , " 1px 0 1px black,"
, " 0 -1px 1px black;" , " 0 -1px 1px black;"
] ]
controlInit
:: Maybe T.Text
-> UserHandler (String, Maybe String, Locale, L10n, ClientEnv)
controlInit mcookie = do
let (token, muser) = parseTokenAndUser mcookie
loc = localeFromCookie mcookie
l10n <- asks rsL10n
backend <- asks rsBackend
return (token, muser, loc, l10n, backend)

View file

@ -77,7 +77,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
) )
H.toHtml ident H.toHtml ident
H.input H.input
H.! HA.id ("product-amount-" <> (fromString (show pid))) H.! HA.id ("product-amount-" <> fromString (show pid))
H.! HA.class_ "form-control" H.! HA.class_ "form-control"
H.! HA.name ("productAmount-" <> fromString (show pid)) H.! HA.name ("productAmount-" <> fromString (show pid))
H.! HA.type_ "number" H.! HA.type_ "number"
@ -90,7 +90,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
$ H.toHtml $ $ H.toHtml $
" @ " <> formatMoney price <> "" -- TODO: ask for currency symbol " @ " <> formatMoney price <> "" -- TODO: ask for currency 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"
H.! HA.name ("productTotal-" <> fromString (show pid)) H.! HA.name ("productTotal-" <> fromString (show pid))
H.! HA.type_ "text" H.! HA.type_ "text"

View file

@ -82,7 +82,7 @@ journalPage l10n loc mcookie mpage entries =
H.! HA.type_ "submit" H.! HA.type_ "submit"
H.! HA.formmethod "get" H.! HA.formmethod "get"
H.! HA.formaction H.! HA.formaction
("/" <> fromString (show $ linkURI $ journalGetCheckLink)) ("/" <> fromString (show $ linkURI journalGetCheckLink))
$ H.toHtml $ translate "Perform cash check" $ H.toHtml $ translate "Perform cash check"
where where
translate = localize l10n loc . gettext translate = localize l10n loc . gettext

View file

@ -105,7 +105,7 @@ userOverviewPage l10n locale method ud pos mcookie =
$ H.toHtml $ translate "Recharge Credit" $ H.toHtml $ translate "Recharge Credit"
H.form H.form
H.! HA.method "post" H.! HA.method "post"
H.! HA.action ("/" <> (fromString $ show $ linkURI $ H.! HA.action ("/" <> fromString (show $ linkURI $
buyLink (MT.userDetailsId ud) False) buyLink (MT.userDetailsId ud) False)
) )
H.! HA.enctype "application/x-www-form-urlencoded" $ H.! HA.enctype "application/x-www-form-urlencoded" $