From 4be962a6fb01f97b936572d7ae4dc0be6d8c27b2 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Wed, 7 Dec 2022 14:17:47 +0100 Subject: [PATCH] Add createSnack call --- src/Jon/Server.hs | 78 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 58 insertions(+), 20 deletions(-) diff --git a/src/Jon/Server.hs b/src/Jon/Server.hs index 67c09ec..151f4bd 100644 --- a/src/Jon/Server.hs +++ b/src/Jon/Server.hs @@ -16,7 +16,7 @@ module Jon.Server (JonAPI, jonSwaggerDoc, server) where import Control.Lens import Control.Monad.IO.Class (liftIO) -import Data.Aeson (FromJSON, ToJSON(toJSON)) +import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON)) import Data.Text (Text) import Data.Int (Int32, Int64) import Data.Scientific (Scientific) @@ -49,13 +49,19 @@ type JonAPI = :> Description "If `amount` is negative, its absolute value is transferred in the opposite direction." :> ReqBody '[JSON] TransferInventoryP :> PostNoContent + :<|> SnackAPI + ) + +type SnackAPI = + "createSnack" :> Summary "Create a snack" + :> ReqBody '[JSON] CreateSnackP + :> Post '[JSON] SnackId :<|> "updateSnack" :> Summary "Update a snack" :> ReqBody '[JSON] UpdateSnackP :> Post '[JSON] SnackId - ) data GetUnsoundBarcodesP = GetUnsoundBarcodesP - { location :: Int32 + { location :: LocationId } deriving (Generic, FromJSON, ToSchema) data UnsoundBarcodeDTO = UnsoundBarcodeDTO @@ -66,7 +72,7 @@ data UnsoundBarcodeDTO = UnsoundBarcodeDTO } deriving (Generic, ToJSON, ToSchema) data GetOverviewItemsP = GetOverviewItemsP - { location :: Int32 + { location :: LocationId } deriving (Generic, FromJSON, ToSchema) data OverviewItemDTO = OverviewItemDTO @@ -78,21 +84,29 @@ mkOverviewItemDTO = uncurry OverviewItemDTO data GetActiveItemsP = GetActiveItemsP { barcode :: Text - , location :: Int32 + , location :: LocationId } deriving (Generic, FromJSON, ToSchema) data TransferInventoryP = TransferInventoryP - { from :: Int32 - , to :: Int32 + { from :: InventoryItemId + , to :: InventoryItemId , amount :: Int64 } deriving (Generic, FromJSON, ToSchema) +data CreateSnackP = CreateSnackP + { name :: Text + , barcode :: Text + , price :: Scientific + , taxGroup :: TaxGroupId + , location :: LocationId + } deriving (Generic, FromJSON, ToSchema) + data UpdateSnackP = UpdateSnackP - { snack :: Int32 + { snack :: SnackId , name :: Text , barcode :: Text , price :: Scientific - , taxGroup :: Int32 + , taxGroup :: TaxGroupId } deriving (Generic, FromJSON, ToSchema) -- Orphan instances for database types @@ -100,6 +114,8 @@ data UpdateSnackP = UpdateSnackP instance ToJSON InventoryItemId where toJSON = toJSON . (.unInventoryItemId) +instance FromJSON InventoryItemId where + parseJSON = fmap mkInventoryItemId . parseJSON instance ToSchema InventoryItemId where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32) @@ -110,16 +126,22 @@ instance ToSchema InventoryItemGroupId where instance ToJSON TaxGroupId where toJSON = toJSON . (.unTaxGroupId) +instance FromJSON TaxGroupId where + parseJSON = fmap mkTaxGroupId . parseJSON instance ToSchema TaxGroupId where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32) instance ToJSON LocationId where toJSON = toJSON . (.unLocationId) +instance FromJSON LocationId where + parseJSON = fmap mkLocationId . parseJSON instance ToSchema LocationId where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32) instance ToJSON SnackId where toJSON = toJSON . (.unSnackId) +instance FromJSON SnackId where + parseJSON = fmap mkSnackId . parseJSON instance ToSchema SnackId where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32) @@ -135,23 +157,30 @@ deriving instance ToSchema Location -- server server :: Connection -> Server JonAPI -server conn = getUnsoundBarcodes :<|> getOverviewItems :<|> getActiveItems :<|> getLocations :<|> transferInventory :<|> updateSnack +server conn = + getUnsoundBarcodes + :<|> getOverviewItems + :<|> getActiveItems + :<|> getLocations + :<|> transferInventory + :<|> createSnack + :<|> updateSnack where getUnsoundBarcodes :: GetUnsoundBarcodesP -> Handler [UnsoundBarcodeDTO] getUnsoundBarcodes params = do - rows <- liftIO $ Queries.runSelect conn $ Queries.unsoundBarcodes $ mkLocationId params.location + rows <- liftIO $ Queries.runSelect conn $ Queries.unsoundBarcodes params.location pure $ map mkUnsoundBarcodeDTO rows where mkUnsoundBarcodeDTO (a, b, c, d) = UnsoundBarcodeDTO a b (fromIntegral c) (fromIntegral d) getOverviewItems :: GetOverviewItemsP -> Handler [OverviewItemDTO] getOverviewItems params = do - rows <- liftIO $ Queries.runSelect conn $ Queries.overviewItemsByLocation $ mkLocationId params.location + rows <- liftIO $ Queries.runSelect conn $ Queries.overviewItemsByLocation params.location pure $ map mkOverviewItemDTO rows getActiveItems :: GetActiveItemsP -> Handler [OverviewItemDTO] getActiveItems params = do - rows <- liftIO $ Queries.runSelect conn $ Queries.activeItems params.barcode $ mkLocationId params.location + rows <- liftIO $ Queries.runSelect conn $ Queries.activeItems params.barcode params.location pure $ map mkOverviewItemDTO rows getLocations :: Handler [Location] @@ -160,21 +189,30 @@ server conn = getUnsoundBarcodes :<|> getOverviewItems :<|> getActiveItems :<|> transferInventory params = do liftIO $ Queries.runIns conn $ Queries.transfer - (mkInventoryItemId params.from) - (mkInventoryItemId params.to) + params.from + params.to params.amount pure NoContent - updateSnack params = do - liftIO $ Queries.runFunction conn $ Queries.snackUpdate - (mkSnackId params.snack) + createSnack params = do + liftIO $ Queries.runFunction conn $ Queries.snackCreate params.name params.barcode params.price - (mkTaxGroupId params.taxGroup) + params.taxGroup + params.location + + updateSnack params = do + liftIO $ Queries.runFunction conn $ Queries.snackUpdate + params.snack + params.name + params.barcode + params.price + params.taxGroup jonSwaggerDoc :: Swagger jonSwaggerDoc = toSwagger (Proxy :: Proxy JonAPI) & info . title .~ "jon API" & info . version .~ "0.1.1" - & applyTags [Tag "jon RPC" (Just "Crudely improvised Garfield API") Nothing] +-- & applyTags [Tag "jon RPC" (Just "Crudely improvised Garfield API") Nothing] + & applyTagsFor (operationsOf $ toSwagger (Proxy :: Proxy SnackAPI)) [Tag "Snacks" Nothing Nothing]