mateamt/src/Control/Buy.hs

65 lines
1.4 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Control.Buy where
import Control.Monad (void, foldM)
import Control.Monad.Reader (asks)
-- internal imports
import Control.User
import Types
import Model
buy
:: Maybe (Int, AuthMethod)
-> [PurchaseDetail]
-> MateHandler PurchaseResult
buy auth pds = do
conn <- asks rsConnection
(missing, real) <- foldM (\(ms, rs) pd -> do
mmiss <- checkProductAvailability pd conn
case mmiss of
Just miss -> return
( (pd {purchaseDetailAmount = miss}):ms
, pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs
)
Nothing -> return
( ms
, pd:rs
)
)
([], [])
pds
mapM_ (`postBuyProductAmountUpdate` conn) real
price <- foldM
(\total pd ->
fmap (+ total) (getLatestTotalPrice pd conn)
)
0
real
case auth of
Just (auid, _) -> do
void $ addToUserBalance auid (-price) conn
newBalance <- userBalanceSelect conn auid
userUpdateTimestamp auth
let result = PurchaseResult
( if newBalance < 0
then PurchaseDebtful
else PurchaseOK
)
missing
userNotify auth real result
return result
Nothing -> do
void $ insertNewJournalEntry
(JournalSubmit
Nothing
BuyCash
price
)
conn
return $ PurchaseResult
(PayAmount price)
missing