Add Item and API endpoints

src/Item.hs

@@ -0,0 +1,97 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Item where
+
+import Data.Aeson
+import qualified Data.Bson as B
+import Data.Maybe
+import qualified Data.Text as T
+import Data.Time.Clock
+import Database.MongoDB
+import GHC.Generics
+import Test.QuickCheck
+
+-- | Type to represent a ZGo item
+data Item =
+  Item
+    { i_id :: Maybe ObjectId
+    , iname :: T.Text
+    , idescription :: T.Text
+    , iowner :: T.Text
+    , icost :: Double
+    }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Item where
+  toJSON (Item i n d o c) =
+    case i of
+      Just oid ->
+        object
+          [ "_id" .= show oid
+          , "name" .= n
+          , "description" .= d
+          , "owner" .= o
+          , "cost" .= c
+          ]
+      Nothing ->
+        object
+          [ "_id" .= ("" :: String)
+          , "name" .= n
+          , "description" .= d
+          , "owner" .= o
+          , "cost" .= c
+          ]
+
+instance FromJSON Item where
+  parseJSON =
+    withObject "Item" $ \obj -> do
+      i <- obj .: "_id"
+      n <- obj .: "name"
+      d <- obj .: "description"
+      o <- obj .: "owner"
+      c <- obj .: "cost"
+      pure $
+        Item
+          (if not (null i)
+             then Just (read i)
+             else Nothing)
+          n
+          d
+          o
+          c
+
+instance Val Item where
+  val (Item i n d o c) =
+    if isJust i
+      then Doc
+             [ "_id" =: i
+             , "name" =: n
+             , "description" =: d
+             , "owner" =: o
+             , "cost" =: c
+             ]
+      else Doc ["name" =: n, "description" =: d, "owner" =: o, "cost" =: c]
+  cast' (Doc d) = do
+    i <- B.lookup "_id" d
+    n <- B.lookup "name" d
+    d' <- B.lookup "description" d
+    o <- B.lookup "owner" d
+    c <- B.lookup "cost" d
+    Just (Item i n d' o c)
+  cast' _ = Nothing
+
+-- Database actions
+findItems :: T.Text -> Action IO [Document]
+findItems a = rest =<< find (select ["owner" =: a] "items")
+
+upsertItem :: Item -> Action IO ()
+upsertItem i = do
+  let item = val i
+  case item of
+    Doc d -> upsert (select ["_id" =: i_id i] "items") d
+    _ -> return ()
+
+deleteItem :: String -> Action IO ()
+deleteItem i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "items")

src/Order.hs

@@ -188,5 +188,8 @@ findOrder s = findOne (select ["session" =: s] "orders")
 findOrderById :: String -> Action IO (Maybe Document)
 findOrderById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "orders")
 
+findAllOrders :: T.Text -> Action IO [Document]
+findAllOrders a = rest =<< find (select ["address" =: a] "orders")
+
 deleteOrder :: String -> Action IO ()
 deleteOrder i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "orders")

src/ZGoBackend.hs

@@ -25,6 +25,7 @@ import Data.Word
 import Database.MongoDB
 import Debug.Trace
 import GHC.Generics
+import Item
 import Network.HTTP.Simple
 import Network.HTTP.Types.Status
 import Network.Wai.Middleware.HttpAuth
@@ -403,11 +404,29 @@ app pipe db passkey nodeAddress = do
       _ <- liftIO $ run (upsertOwner o)
       status created201
     --Get items associated with the given address
-    get "/api/items" $ do text "Here are your items"
+    get "/api/items" $ do
+      addr <- param "address"
+      items <- liftIO $ run (findItems addr)
+      case items of
+        [] -> status noContent204
+        _ -> do
+          let pItems = map (cast' . Doc) items :: [Maybe Item]
+          status ok200
+          Web.Scotty.json
+            (object
+               [ "message" .= ("Items found!" :: String)
+               , "items" .= toJSON pItems
+               ])
     --Upsert item
-    post "/api/item" $ do text "I upserted the item for you"
+    post "/api/item" $ do
+      i <- jsonData
+      _ <- liftIO $ run (upsertItem i)
+      status created201
     --Delete item
-    Web.Scotty.delete "/api/item/:id" $ do text "Deleted that pesky item"
+    Web.Scotty.delete "/api/item/:id" $ do
+      oId <- param "id"
+      liftIO $ run (deleteItem oId)
+      status ok200
     --Get price for Zcash
     get "/api/price" $ do
       curr <- param "currency"
@@ -423,7 +442,19 @@ app pipe db passkey nodeAddress = do
                , "price" .= toJSON (parseZGoPrice p)
                ])
     --Get all closed orders for the address
-    get "/api/allorders" $ do text "Here are the orders"
+    get "/api/allorders" $ do
+      addr <- param "address"
+      myOrders <- liftIO $ run (findAllOrders addr)
+      case myOrders of
+        [] -> status noContent204
+        _ -> do
+          let pOrders = map (cast' . Doc) myOrders :: [Maybe ZGoOrder]
+          status ok200
+          Web.Scotty.json
+            (object
+               [ "message" .= ("Orders found!" :: String)
+               , "orders" .= toJSON pOrders
+               ])
     --Get order by id for receipts
     get "/api/order/:id" $ do
       oId <- param "id"

test/Spec.hs

@@ -156,11 +156,18 @@ main =
             req <- testGet "/api/order/627ab3ea2b05a76be3000000" []
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
-          it "get all orders for owner" $ do pending
+          it "get all orders for owner" $ do
+            req <- testGet "/api/allorders" [("address", Just "Zaddy")]
+            res <- httpJSON req
+            getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "delete order by id" $ do
             req <- testDelete "/api/order/" "627ab3ea2b05a76be3000000"
             res <- httpLBS req
             getResponseStatus res `shouldBe` ok200
+        describe "Item endpoint" $ do
+          it "add item" $ do pending
+          it "get item" $ do pending
+          it "delete item" $ do pending
     around handleDb $
       describe "Database actions" $ do
         describe "authentication" $ do
@@ -252,7 +259,7 @@ main =
                 case s of
                   Nothing -> True `shouldBe` False
                   Just z -> confirmations z `shouldSatisfy` (> 0)
-          it "login txs are converted to users" $ \p -> do
+          xit "login txs are converted to users" $ \p -> do
             let myTx =
                   ZGoTx
                     ""

zgo-backend.cabal

@@ -25,6 +25,7 @@ source-repository head
 
 library
   exposed-modules:
+      Item
       Order
       Owner
       User