alter/add api endpoints for update/refill

This commit is contained in:
nek0 2019-08-05 18:10:21 +02:00
parent 340ccdc275
commit 9b210ef61b
4 changed files with 129 additions and 41 deletions

View File

@ -32,12 +32,13 @@ type UserAPI =
:> Capture "id" Int :> ReqBody '[JSON] UserDetailsSubmit :> Post '[JSON] ()
)
:<|> "product" :>
( "list" :> Get '[JSON] [ProductShortOverview]
:<|> "list" :> AuthProtect "header-auth" :> Get '[JSON] [ProductOverview]
( "list" :> Get '[JSON] [ProductOverview]
:<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] ProductSubmit
:> Post '[JSON] Int
:<|> "update" :> AuthProtect "header-auth"
:> ReqBody '[JSON] AmountUpdate :> Post '[JSON] ()
:> ReqBody '[JSON] [AmountUpdate] :> Post '[JSON] ()
:<|> "refill" :> AuthProtect "header-auth"
:> ReqBody '[JSON] [AmountRefill] :> Post '[JSON] ()
)
:<|> "buy" :> AuthProtect "header-auth" :> ReqBody '[JSON] [PurchaseDetail]
:> Post '[JSON] PurchaseResult

View File

@ -149,22 +149,15 @@ users =
}
products =
listShort :<|>
listLong :<|>
new :<|>
update
stockUpdate :<|>
stockRefill
where
listShort :: MateHandler [ProductShortOverview]
listShort = do
conn <- rsConnection <$> ask
productShortOverviewSelect conn
listLong :: Maybe Int -> MateHandler [ProductOverview]
listLong (Just _) = do
listLong :: MateHandler [ProductOverview]
listLong = do
conn <- rsConnection <$> ask
productOverviewSelect conn
listLong Nothing =
throwError $ err403
new :: Maybe Int -> ProductSubmit -> MateHandler Int
new (Just _) bevsub = do
@ -176,14 +169,36 @@ products =
new Nothing _ =
throwError $ err403
update :: Maybe Int -> AmountUpdate -> MateHandler ()
update (Just _) amosub@(AmountUpdate pid amount) = do
conn <- rsConnection <$> ask
now <- liftIO $ getCurrentTime
oldprice <- getLatestPriceByProductId pid conn
void $ manualProductAmountUpdate amosub now oldprice conn
update Nothing _ =
stockUpdate :: Maybe Int -> [AmountUpdate] -> MateHandler ()
stockUpdate (Just _) amoups = do
if all ((>= 0) . amountUpdateRealAmount) amoups
then do
conn <- rsConnection <$> ask
void $ manualProductAmountUpdate amoups conn
else
throwError $ err406
{ errBody = "Amounts less than 0 are not acceptable"
}
stockUpdate Nothing _ =
throwError $ err403
{ errBody = "No Authentication present"
}
stockRefill :: Maybe Int -> [AmountRefill] -> MateHandler ()
stockRefill (Just _) amorefs = do
if all ((>= 0) . amountRefillAmount) amorefs
then do
conn <- rsConnection <$> ask
void $ manualProductAmountRefill amorefs conn
else
throwError $ err406
{ errBody = "Amounts less than 0 are not acceptable"
}
stockRefill Nothing _ =
throwError $ err403
{ errBody = "No Authentication present"
}
buy :: Maybe Int -> [PurchaseDetail] -> MateHandler PurchaseResult
buy (Just auid) pds = do

View File

@ -96,6 +96,27 @@ getLatestPriceByProductId pid conn = do
(\(_, _, _, price, _) -> return price)
amounts
getLatestAmountByProductId
:: Int -- The associated Product ID
-> PGS.Connection
-> MateHandler Int -- The amount
getLatestAmountByProductId pid conn = do
amounts <- liftIO $ runSelect conn $
orderBy (desc (\(_, ts, _, _, _) -> ts))
(keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<< queryTable amountTable)
:: MateHandler
[ ( Int
, UTCTime
, Int
, Int
, Bool
)
]
head <$> return ( map
(\(_, _, amount, _, _) -> amount)
amounts
)
getLatestTotalPrice
:: PurchaseDetail -- The associated PurchaseDetail
-> PGS.Connection
@ -113,9 +134,10 @@ getLatestTotalPrice (PurchaseDetail pid amount) conn = do
, Bool
)
]
(amount *) <$> head <$> mapM
(\(_, _, _, price, _) -> return price)
(amount *) <$> head <$> return (map
(\(_, _, _, price, _) -> price)
amounts
)
checkProductAvailability
:: PurchaseDetail
@ -140,27 +162,65 @@ checkProductAvailability (PurchaseDetail pid amount) conn = do
then return (Just $ amount - realamount)
else return Nothing
manualProductAmountUpdate
:: AmountUpdate
-> UTCTime -- Current time
-> Int -- Old BeveragePrice
:: [AmountUpdate]
-> PGS.Connection
-> MateHandler Int
manualProductAmountUpdate (AmountUpdate pid amount) now oldprice conn =
fmap head $ liftIO $ runInsert_ conn $ Insert
{ iTable = amountTable
, iRows =
[
( C.constant pid
, C.constant now
, C.constant amount
, C.constant oldprice
, C.constant True
-> MateHandler [Int]
manualProductAmountUpdate aups conn =
mapM
(\(AmountUpdate pid amount) -> do
oldprice <- getLatestPriceByProductId pid conn
head <$> (liftIO $ do
now <- getCurrentTime
runInsert_ conn $ Insert
{ iTable = amountTable
, iRows =
[
( C.constant pid
, C.constant now
, C.constant amount
, C.constant oldprice
, C.constant True
)
]
, iReturning = rReturning (\(id_, _, _, _, _) -> id_)
, iOnConflict = Nothing
}
)
)
]
, iReturning = rReturning (\(id_, _, _, _, _) -> id_)
, iOnConflict = Nothing
}
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

View File

@ -15,3 +15,15 @@ instance ToJSON AmountUpdate where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AmountUpdate
data AmountRefill = AmountRefill
{ amountRefillProductId :: Int
, amountRefillAmount :: Int
}
deriving (Show, Generic)
instance ToJSON AmountRefill where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AmountRefill