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