foce buy now works

This commit is contained in:
nek0 2019-10-24 20:30:58 +02:00
parent 96304fe665
commit 80b3cfa07e
1 changed files with 25 additions and 5 deletions

View File

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