diff --git a/mateamt.cabal b/mateamt.cabal index 87ce21c..ae02135 100644 --- a/mateamt.cabal +++ b/mateamt.cabal @@ -23,6 +23,9 @@ flag develop executable mateamt main-is: Main.hs other-modules: API + , Control + , Control.Buy + , Control.Journal , Model , Model.User , Model.Product diff --git a/src/Control.hs b/src/Control.hs new file mode 100644 index 0000000..5891a47 --- /dev/null +++ b/src/Control.hs @@ -0,0 +1,6 @@ +module Control + ( module C + ) where + +import Control.Buy as C +import Control.Journal as C diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs new file mode 100644 index 0000000..816499f --- /dev/null +++ b/src/Control/Buy.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} +module Control.Buy where + +import Servant + +import Control.Monad (void, foldM) + +import Control.Monad.Reader (ask) + +-- internal imports + +import Types +import Model + +buy + :: Maybe Int + -> [PurchaseDetail] + -> MateHandler PurchaseResult +buy (Just auid) pds = do + conn <- rsConnection <$> ask + (missing, real) <- foldM (\acc@(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 + void $ mapM_ (\pd -> postBuyProductAmountUpdate pd conn) real + price <- foldM + (\total pd -> + fmap (+ total) (getLatestTotalPrice pd conn) + ) + 0 + real + addToUserBalance auid (-price) conn + newBalance <- userBalanceSelect conn auid + return $ PurchaseResult + ( if newBalance < 0 + then PurchaseDebtful + else PurchaseOK + ) + missing +buy Nothing pds = do + conn <- rsConnection <$> ask + (missing, real) <- foldM (\acc@(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 + void $ mapM_ + (\pd -> postBuyProductAmountUpdate pd conn) + real + price <- foldM + (\total pd -> + fmap (+ total) (getLatestTotalPrice pd conn) + ) + 0 + real + void $ insertNewJournalEntry (JournalSubmit "Cash purchase" price) conn + return $ PurchaseResult + (PayAmount price) + missing diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs new file mode 100644 index 0000000..72ee286 --- /dev/null +++ b/src/Control/Journal.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +module Control.Journal where + +import Servant + +import Control.Monad.Reader (ask) + +-- internal imports + +import Types +import Model.Journal + +journalShow + :: Maybe Int + -> Maybe Int + -> Maybe Int + -> MateHandler [JournalEntry] +journalShow (Just _) mlimit moffset = do + conn <- rsConnection <$> ask + selectJournalEntries mlimit moffset conn +journalShow Nothing _ _ = + throwError $ err403 + { errBody = "No Authentication present" + } diff --git a/src/Main.hs b/src/Main.hs index 2e0ce12..2e39d95 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -39,6 +39,7 @@ import API import Model as M import Types +import Control main :: IO () main = do @@ -229,64 +230,3 @@ productList :: MateHandler [ProductOverview] productList = do conn <- rsConnection <$> ask productOverviewSelect conn - - -buy (Just auid) pds = do - conn <- rsConnection <$> ask - (missing, real) <- foldM (\acc@(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 - void $ mapM_ (\pd -> postBuyProductAmountUpdate pd conn) real - price <- foldM - (\total pd -> - fmap (+ total) (getLatestTotalPrice pd conn) - ) - 0 - real - addToUserBalance auid (-price) conn - newBalance <- userBalanceSelect conn auid - return $ PurchaseResult - ( if newBalance < 0 - then PurchaseDebtful - else PurchaseOK - ) - missing -buy Nothing pds = do - conn <- rsConnection <$> ask - (missing, real) <- foldM (\acc@(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 - void $ mapM_ - (\pd -> postBuyProductAmountUpdate pd conn) - real - price <- foldM - (\total pd -> - fmap (+ total) (getLatestTotalPrice pd conn) - ) - 0 - real - return $ PurchaseResult - (PayAmount price) - missing