handle refills

This commit is contained in:
nek0 2019-12-15 10:34:38 +01:00
parent 9cbc638a62
commit 7ad8379125
5 changed files with 44 additions and 18 deletions

View File

@ -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)")

View File

@ -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

View File

@ -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

View File

@ -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) $

View File

@ -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