Add a few calls

src/Jon/Garfield/Queries.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
@@ -69,6 +70,12 @@ locations = all_ garfieldDb.locations
 
 -- Inserts
 
+runIns
+    :: Connection
+    -> SqlInsert Postgres table
+    -> IO ()
+runIns conn i = runBeamPostgresDebug putStrLn conn $ runInsert i
+
 transfer
     :: InventoryItemId -- ^ to
     -> InventoryItemId -- ^ from
@@ -94,6 +101,9 @@ transfer from to amount
 
 type SqlFunction a = Connection -> IO a
 
+runFunction :: Connection -> SqlFunction a -> IO a
+runFunction conn f = f conn
+
 snackDelete :: SnackId -> SqlFunction ()
 snackDelete snack conn = do
     [Only ()] <- query conn "SELECT garfield.snack_delete(?)" (Only $ snack.unSnackId)
@@ -105,6 +115,18 @@ snackCreate name barcode price taxGroup location conn = do
         (name, barcode, price, taxGroup.unTaxGroupId, location.unLocationId)
     pure $ mkSnackId rawSnackId
 
+snackUpdate
+    :: SnackId
+    -> Text -- Name
+    -> Text -- Barcode
+    -> Scientific
+    -> TaxGroupId
+    -> SqlFunction SnackId
+snackUpdate snack name barcode price taxGroup conn = do
+    [Only rawSnackId] <- query conn "SELECT garfield.snack_update(?, ?, ?, ?, ?)"
+        (snack.unSnackId, name, barcode, price, taxGroup.unTaxGroupId)
+    pure $ mkSnackId rawSnackId
+
 inventoryMapSnack :: SnackId -> InventoryItemId -> SqlFunction ()
 inventoryMapSnack snack item conn = do
     [Only ()] <- query conn "SELECT garfield.inventory_map_snack(?, ?)" (snack.unSnackId, item.unInventoryItemId)

src/Jon/Main.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Jon.Main
     ( main
@@ -12,7 +14,6 @@ import Control.Exception (bracket)
 import Database.Beam
 import Database.Beam.Postgres
 import Servant
-import Servant.Swagger
 import Servant.Swagger.UI
 import System.Environment
 import Network.Wai.Handler.Warp (run)
@@ -28,6 +29,7 @@ main = withGarfieldConn $ \conn ->
         p :: Proxy (JonAPI :<|> SwaggerSchemaUI "swagger" "swagger.json")
         p = Proxy
 
+withGarfieldConn :: (Connection -> IO a) -> IO a
 withGarfieldConn = bracket
     (do pass <- getEnv "JON_PASS"
         connectPostgreSQL $ BS8.pack $ "host=localhost dbname=garfield password=" ++ pass)

src/Jon/Server.hs

@@ -1,9 +1,15 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Jon.Server (JonAPI, jonSwaggerDoc, server) where
@@ -12,7 +18,8 @@ import Control.Lens
 import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (FromJSON, ToJSON(toJSON))
 import Data.Text (Text)
-import Data.Int (Int32)
+import Data.Int (Int32, Int64)
+import Data.Scientific (Scientific)
 import Data.Swagger
 import Database.PostgreSQL.Simple (Connection)
 import GHC.Generics (Generic)
@@ -27,13 +34,24 @@ import qualified Jon.Garfield.Queries as Queries
 
 type JonAPI =
     "rpc" :>
-        (    "getUnsoundBarcodes"   :> ReqBody '[JSON] GetUnsoundBarcodesP
+        (    "getUnsoundBarcodes"   :> Summary "Get information on barcodes with at least two items"
+                                    :> ReqBody '[JSON] GetUnsoundBarcodesP
                                     :> Post '[JSON] [UnsoundBarcodeDTO]
-        :<|> "getOverviewItems"     :> ReqBody '[JSON] GetOverviewItemsP
+        :<|> "getOverviewItems"     :> Summary "Get overview of all active items"
+                                    :> ReqBody '[JSON] GetOverviewItemsP
                                     :> Post '[JSON] [OverviewItemDTO]
-        :<|> "getActiveItems"       :> ReqBody '[JSON] GetActiveItemsP
+        :<|> "getActiveItems"       :> Summary "Get currently active items for a barcode"
+                                    :> ReqBody '[JSON] GetActiveItemsP
                                     :> Post '[JSON] [OverviewItemDTO]
-        :<|> "getLocations"         :> Post '[JSON] [Location]
+        :<|> "getLocations"         :> Summary "Get a list of all locations"
+                                    :> Post '[JSON] [Location]
+        :<|> "transferInventory"    :> Summary "Transfer inventory between items"
+                                    :> Description "If `amount` is negative, its absolute value is transferred in the opposite direction."
+                                    :> ReqBody '[JSON] TransferInventoryP
+                                    :> PostNoContent
+        :<|> "updateSnack"          :> Summary "Update a snack"
+                                    :> ReqBody '[JSON] UpdateSnackP
+                                    :> Post '[JSON] SnackId
         )
 
 data GetUnsoundBarcodesP = GetUnsoundBarcodesP
@@ -63,7 +81,22 @@ data GetActiveItemsP = GetActiveItemsP
     , location :: Int32
     } deriving (Generic, FromJSON, ToSchema)
 
+data TransferInventoryP = TransferInventoryP
+    { from   :: Int32
+    , to     :: Int32
+    , amount :: Int64
+    } deriving (Generic, FromJSON, ToSchema)
+
+data UpdateSnackP = UpdateSnackP
+    { snack    :: Int32
+    , name     :: Text
+    , barcode  :: Text
+    , price    :: Scientific
+    , taxGroup :: Int32
+    } deriving (Generic, FromJSON, ToSchema)
+
 -- Orphan instances for database types
+-- needed for serialization and swagger doc
 
 instance ToJSON InventoryItemId where
     toJSON = toJSON . (.unInventoryItemId)
@@ -85,6 +118,11 @@ instance ToJSON LocationId where
 instance ToSchema LocationId where
     declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)
 
+instance ToJSON SnackId where
+    toJSON = toJSON . (.unSnackId)
+instance ToSchema SnackId where
+    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)
+
 deriving instance ToJSON Overview
 deriving instance ToSchema Overview
 
@@ -97,7 +135,7 @@ deriving instance ToSchema Location
 -- server
 
 server :: Connection -> Server JonAPI
-server conn = getUnsoundBarcodes :<|> getOverviewItems :<|> getActiveItems :<|> getLocations
+server conn = getUnsoundBarcodes :<|> getOverviewItems :<|> getActiveItems :<|> getLocations :<|> transferInventory :<|> updateSnack
     where
         getUnsoundBarcodes :: GetUnsoundBarcodesP -> Handler [UnsoundBarcodeDTO]
         getUnsoundBarcodes params = do
@@ -120,5 +158,23 @@ server conn = getUnsoundBarcodes :<|> getOverviewItems :<|> getActiveItems :<|>
         getLocations = do
             liftIO $ Queries.runSelect conn Queries.locations
         
+        transferInventory params = do
+            liftIO $ Queries.runIns conn $ Queries.transfer
+                (mkInventoryItemId params.from)
+                (mkInventoryItemId params.to)
+                params.amount
+            pure NoContent
+        
+        updateSnack params = do
+            liftIO $ Queries.runFunction conn $ Queries.snackUpdate
+                (mkSnackId params.snack)
+                params.name
+                params.barcode
+                params.price
+                (mkTaxGroupId params.taxGroup)
+
+jonSwaggerDoc :: Swagger
 jonSwaggerDoc = toSwagger (Proxy :: Proxy JonAPI)
-    & info . title .~ "jon API"
+    & info . title   .~ "jon API"
+    & info . version .~ "0.1.1"
+    & applyTags [Tag "jon RPC" (Just "Crudely improvised Garfield API") Nothing]