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] () :> Capture "id" Int :> ReqBody '[JSON] UserDetailsSubmit :> Post '[JSON] ()
) )
:<|> "product" :> :<|> "product" :>
( "list" :> Get '[JSON] [ProductShortOverview] ( "list" :> Get '[JSON] [ProductOverview]
:<|> "list" :> AuthProtect "header-auth" :> Get '[JSON] [ProductOverview]
:<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] ProductSubmit :<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] ProductSubmit
:> Post '[JSON] Int :> Post '[JSON] Int
:<|> "update" :> AuthProtect "header-auth" :<|> "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] :<|> "buy" :> AuthProtect "header-auth" :> ReqBody '[JSON] [PurchaseDetail]
:> Post '[JSON] PurchaseResult :> Post '[JSON] PurchaseResult

View file

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

View file

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

View file

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