Add createSnack call

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
+    { from   :: InventoryItemId
-    , to     :: Int32
+    , 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)
+                params.from
-                (mkInventoryItemId params.to)
+                params.to
                 params.amount
             pure NoContent
         
-        updateSnack params = do
+        createSnack params = do
-            liftIO $ Queries.runFunction conn $ Queries.snackUpdate
+            liftIO $ Queries.runFunction conn $ Queries.snackCreate
-                (mkSnackId params.snack)
                 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]