From 80b3cfa07e112a7fe1341286b0b3ce6907555f94 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 24 Oct 2019 20:30:58 +0200 Subject: [PATCH] foce buy now works --- src/Control/Buy.hs | 30 +++++++++++++++++++++++++----- 1 file changed, 25 insertions(+), 5 deletions(-) diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs index 3aecaae..929bbb8 100644 --- a/src/Control/Buy.hs +++ b/src/Control/Buy.hs @@ -15,11 +15,11 @@ import Data.Text.I18n import Data.String (fromString) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, fromJust, isJust) import Data.List (sortOn) -import Control.Monad (void) +import Control.Monad (void, when) import Control.Monad.Reader (ask, asks) import Control.Monad.IO.Class (liftIO) @@ -88,6 +88,26 @@ purchaseControl mcookie uid pds forceBuy = do then do backend <- asks rsBackend let (token, _) = parseTokenAndUser mcookie + erefres <- if (isJust forceBuy && fromJust forceBuy) + then do + let refills = map + (\(MT.PurchaseDetail pid amount) -> MT.AmountRefill pid amount) + pds + liftIO $ runClientM + (productStockRefill + (mkAuthenticatedRequest token authenticateReq) + refills + ) + backend + else + return $ Right () + case erefres of + Right _ -> + return () + Left err -> + throwError + $ addMessage (fromString $ show err) + $ redirect303 (userOverviewLink uid Nothing) eresult <- liftIO $ runClientM (buy (mkAuthenticatedRequest token authenticateReq) @@ -124,9 +144,9 @@ purchaseControl mcookie uid pds forceBuy = do $ addMessage (translate l10n loc "Purchase partly successful.") $ redirect307 (buyLink uid (Just True)) Left err -> - throwError $ err500 - { errBody = fromString (show err) - } + throwError + $ addMessage (fromString (show err)) + $ redirect303 (userOverviewLink uid Nothing) else throwError $ addMessage (translate l10n loc "Please choose your product(s)")