diff --git a/src/Control/Product.hs b/src/Control/Product.hs index 542d782..084b1f2 100644 --- a/src/Control/Product.hs +++ b/src/Control/Product.hs @@ -37,14 +37,29 @@ productStockRefill :: Maybe (Int, AuthMethod) -> [AmountRefill] -> MateHandler () -productStockRefill (Just _) amorefs = - if all ((>= 0) . amountRefillAmount) amorefs - then do - conn <- asks rsConnection - void $ manualProductAmountRefill amorefs conn +productStockRefill (Just _) amorefs = do + conn <- asks rsConnection + prods <- mapM + (\refill -> productSelectSingle (amountRefillProductId refill) conn) + amorefs + if all (not . null) prods + then + if + all + (\refill -> + (>= 0) (amountRefillAmountSingles refill) && + (>= 0) (amountRefillAmountCrates refill) + ) + amorefs + then do + void $ manualProductAmountRefill amorefs conn + else + throwError $ err400 + { errBody = "Amounts less than 0 are not acceptable." + } else throwError $ err400 - { errBody = "Amounts less than 0 are not acceptable." + { errBody = "Non-existent Products are non-refillable." } productStockRefill Nothing _ = throwError $ err401 diff --git a/src/Model/Amount.hs b/src/Model/Amount.hs index 086ab01..691d621 100644 --- a/src/Model/Amount.hs +++ b/src/Model/Amount.hs @@ -193,36 +193,6 @@ manualProductAmountUpdate aups conn = aups -manualProductAmountRefill - :: [AmountRefill] - -> PGS.Connection - -> MateHandler [Int] -manualProductAmountRefill aups conn = - mapM - (\(AmountRefill pid amount) -> do - oldamount <- getLatestAmountByProductId pid conn - oldprice <- getLatestPriceByProductId pid conn - head <$> liftIO (do - now <- getCurrentTime - runInsert_ conn $ Insert - { iTable = amountTable - , iRows = - [ - ( C.constant pid - , C.constant now - , C.constant (oldamount + amount) - , C.constant oldprice - , C.constant False - ) - ] - , iReturning = rReturning (\(id_, _, _, _, _) -> id_) - , iOnConflict = Nothing - } - ) - ) - aups - - postBuyProductAmountUpdate :: PurchaseDetail -> PGS.Connection diff --git a/src/Model/Product.hs b/src/Model/Product.hs index 9686ce2..efd28aa 100644 --- a/src/Model/Product.hs +++ b/src/Model/Product.hs @@ -5,6 +5,7 @@ module Model.Product where import Data.Text as T hiding (head, foldl) +import Data.Time (getCurrentTime) import Data.Time.Clock (UTCTime) import Data.Profunctor.Product (p9) @@ -100,6 +101,35 @@ productSelect conn = do prods +productSelectSingle + :: Int + -> PGS.Connection + -> MateHandler [Product] +productSelectSingle pid conn = do + prods <- liftIO $ runSelect conn + ( limit 1 + (keepWhen ( + \(id_, _, _, _, _, _, _, _, _) -> id_ .== C.constant pid + ) <<< queryTable productTable) + ) :: MateHandler + [ ( Int + , T.Text + , Int + , Maybe Int + , Maybe Int + , Int + , Int + , Maybe Int + , Maybe T.Text + ) + ] + mapM + (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> return $ + Product i1 i2 i3 i4 i5 i6 i7 i8 i9 + ) + prods + + productOverviewSelect :: ProductRefine -> PGS.Connection @@ -281,3 +311,34 @@ insertProduct (ProductSubmit ident _ ml ava sup maxi apc ppc artnr) conn = , iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _) -> id_) , iOnConflict = Nothing } + +manualProductAmountRefill + :: [AmountRefill] + -> PGS.Connection + -> MateHandler [Int] +manualProductAmountRefill aups conn = + mapM + (\(AmountRefill pid amountSingles amountCrates) -> do + oldamount <- getLatestAmountByProductId pid conn + oldprice <- getLatestPriceByProductId pid conn + perCrate <- (productAmountPerCrate . head) <$> + productSelectSingle pid conn + head <$> liftIO (do + now <- getCurrentTime + runInsert_ conn $ Insert + { iTable = amountTable + , iRows = + [ + ( C.constant pid + , C.constant now + , C.constant (oldamount + amountSingles + perCrate * amountCrates) + , C.constant oldprice + , C.constant False + ) + ] + , iReturning = rReturning (\(id_, _, _, _, _) -> id_) + , iOnConflict = Nothing + } + ) + ) + aups diff --git a/src/Types/Amount.hs b/src/Types/Amount.hs index 841711f..3bdb49e 100644 --- a/src/Types/Amount.hs +++ b/src/Types/Amount.hs @@ -18,8 +18,9 @@ instance FromJSON AmountUpdate data AmountRefill = AmountRefill - { amountRefillProductId :: Int - , amountRefillAmount :: Int + { amountRefillProductId :: Int + , amountRefillAmountSingles :: Int + , amountRefillAmountCrates :: Int } deriving (Show, Generic)