foce buy now works

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
+        throwError
-          { errBody = fromString (show err)
+          $ addMessage (fromString (show err))
-          }
+          $ redirect303 (userOverviewLink uid Nothing)
   else
     throwError
       $ addMessage (translate l10n loc "Please choose your product(s)")