{-# LANGUAGE OverloadedStrings #-} module Control.Product where import Servant import Control.Monad import Control.Monad.Reader (asks) import Control.Monad.Extra (anyM, allM) import Data.Maybe (fromMaybe, isJust) -- internal imports import Types import Model import Util productNew :: Maybe (Int, AuthMethod) -> ProductSubmit -> MateHandler Int productNew (Just (uid, auth)) bevsub = do mayAddProduct <- checkCapability uid roleCanManageProducts unless mayAddProduct throwUnauthAccess if auth `elem` [PrimaryPass, ChallengeResponse] then do conn <- asks rsConnection bevid <- insertProduct bevsub conn void $ insertNewEmptyAmount bevid bevsub conn return bevid else throwWrongAuth productNew Nothing _ = throwMissingAuth productOverview :: Int -> MateHandler ProductOverview productOverview pid = do conn <- asks rsConnection productOverviewSelectSingle pid conn productStockRefill :: Maybe (Int, AuthMethod) -> [AmountRefill] -> MateHandler NoContent productStockRefill (Just (uid, auth)) amorefs = do mayRefill <- anyM (checkCapability uid) [ roleCanRefillStock, roleCanManageProducts ] unless mayRefill throwUnauthAccess if auth `elem` [PrimaryPass, ChallengeResponse] then do conn <- asks rsConnection let prods = map (\refill -> productSelectSingle (amountRefillProductId refill) conn) amorefs allProdsExist <- allM (fmap isJust) prods if allProdsExist then if all (\refill -> (>= 0) (amountRefillAmountSingles refill) && (>= 0) (amountRefillAmountCrates refill) ) amorefs then do void $ manualProductAmountRefill amorefs conn return NoContent else throwError $ err400 { errBody = "Amounts less than 0 are not acceptable." } else throwError $ err400 { errBody = "Non-existent Products are non-refillable." } else throwUnauthAccess productStockRefill Nothing _ = throwMissingAuth productStockUpdate :: Maybe (Int, AuthMethod) -> [AmountUpdate] -> MateHandler NoContent productStockUpdate (Just (uid, method)) amoups = do mayUpdateStock <- checkCapability uid roleCanManageProducts unless mayUpdateStock throwUnauthAccess if method `elem` [PrimaryPass, ChallengeResponse] then if all ((>= 0) . amountUpdateRealAmount) amoups then do conn <- asks rsConnection void $ manualProductAmountUpdate amoups conn return NoContent else throwError $ err400 { errBody = "Amounts less than 0 are not acceptable." } else throwWrongAuth productStockUpdate Nothing _ = throwMissingAuth productList :: Maybe ProductRefine -> MateHandler [ProductOverview] productList mrefine = do conn <- asks rsConnection productOverviewSelect (fromMaybe AvailableProducts mrefine) conn productShortList :: Maybe ProductRefine -> MateHandler [ProductShortOverview] productShortList mrefine = do conn <- asks rsConnection productShortOverviewSelect (fromMaybe AvailableProducts mrefine) conn