From 7ad83791252ff20cebe9c00876eb60b332c22152 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 15 Dec 2019 10:34:38 +0100 Subject: [PATCH] handle refills --- src/Control/Buy.hs | 2 +- src/Control/Journal.hs | 15 +-------------- src/Control/Product.hs | 29 +++++++++++++++++++++++++++++ src/Util.hs | 4 ++-- src/View/Scaffold.hs | 12 +++++++++++- 5 files changed, 44 insertions(+), 18 deletions(-) diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs index 924c950..616b726 100644 --- a/src/Control/Buy.hs +++ b/src/Control/Buy.hs @@ -261,7 +261,7 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do { errBody = fromString (show err) } Left err -> - handleClientErr err (Just userSelectLink) + handleClientErr err Nothing (Just userSelectLink) else throwError $ addMessage (translate l10n loc "Please choose your product(s)") diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs index 2afe22b..0ee622a 100644 --- a/src/Control/Journal.hs +++ b/src/Control/Journal.hs @@ -93,20 +93,7 @@ journalPostCheckControl mcookie (CashCheck floatAmount) = do addMessage (translate l10n loc "Cash check received and processed") $ redirect303 (journalLink Nothing) Left err -> - handleClientErr err (Just journalGetCheckLink) - -- case err of - -- FailureResponse _ resp -> - -- if statusCode (responseStatusCode resp) == 401 - -- then - -- redirectOverAuth Nothing (Just journalGetCheckLink) Nothing - -- else - -- throwError $ - -- addMessage (fromString $ show err) $ - -- redirect303 userSelectLink - -- otherErr -> - -- throwError $ - -- addMessage (fromString $ show otherErr) $ - -- redirect303 userSelectLink + handleClientErr err (read <$> muser) (Just journalGetCheckLink) Nothing -> redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing where diff --git a/src/Control/Product.hs b/src/Control/Product.hs index 09178c3..4a7170d 100644 --- a/src/Control/Product.hs +++ b/src/Control/Product.hs @@ -4,11 +4,14 @@ module Control.Product where import Servant import Servant.Client +import Servant.Client.Core.Auth (mkAuthenticatedRequest) import Data.String (fromString) import qualified Data.Text as T +import Data.Text.I18n + import Control.Monad.IO.Class (liftIO) -- imports from "mateamt" @@ -62,3 +65,29 @@ productGetRefill mcookie = do redirect303 userSelectLink Nothing -> redirectOverAuth Nothing (Just productGetRefillLink) Nothing + +productPostRefill + :: Maybe T.Text + -> [MT.AmountRefill] + -> UserHandler ProductRefillPage +productPostRefill mcookie refills = do + (token, muser, loc, l10n, backend) <- controlInit mcookie + case muser of + Just _ -> do + eresult <- liftIO $ runClientM + (productStockRefill + (mkAuthenticatedRequest token authenticateReq) + refills + ) + backend + case eresult of + Right _ -> + throwError $ + addMessage (translate l10n loc "Refill successfull") $ + redirect303 productGetRefillLink + Left err -> + handleClientErr err (read <$> muser) (Just productGetRefillLink) + Nothing -> + redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing + where + translate l10n loc = localize l10n loc . gettext diff --git a/src/Util.hs b/src/Util.hs index de0814b..754af9e 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -197,12 +197,12 @@ controlInit mcookie = do backend <- asks rsBackend return (token, muser, loc, l10n, backend) -handleClientErr err authTargetLink = +handleClientErr err muid authTargetLink = case err of FailureResponse _ resp -> if statusCode (responseStatusCode resp) == 401 then - redirectOverAuth Nothing authTargetLink Nothing + redirectOverAuth muid authTargetLink Nothing else throwError $ addMessage (fromString $ show err) $ diff --git a/src/View/Scaffold.hs b/src/View/Scaffold.hs index 1ff73c4..03fc538 100644 --- a/src/View/Scaffold.hs +++ b/src/View/Scaffold.hs @@ -49,12 +49,22 @@ scaffold l10n locale mcookie page content = template page $ do H.div H.! HA.id "main" H.! HA.role "main" $ content H.hr - H.footer $ H.form $ + H.footer $ H.form $ do H.button H.! HA.formmethod "get" H.! HA.formaction ("/" <> (fromString $ show $ linkURI productGetPriceListLink)) $ H.toHtml $ translate "Price List" + maybe + (return ()) + (\_ -> + H.button + H.! HA.formmethod "get" + H.! HA.formaction ("/" <> + (fromString $ show $ linkURI $ productGetRefillLink)) + $ H.toHtml $ translate "Refill stock" + ) + (getLogin mcookie) where message = lookup "message" =<< fmap parseCookieText mcookie translate = localize l10n locale . gettext