diff --git a/src/Item.hs b/src/Item.hs new file mode 100644 index 0000000..2699169 --- /dev/null +++ b/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") diff --git a/src/Order.hs b/src/Order.hs index 1def81e..27274b9 100644 --- a/src/Order.hs +++ b/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") diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 58339f8..dc823ac 100644 --- a/src/ZGoBackend.hs +++ b/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" diff --git a/test/Spec.hs b/test/Spec.hs index 9a40eb2..4ae1234 100644 --- a/test/Spec.hs +++ b/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 "" diff --git a/zgo-backend.cabal b/zgo-backend.cabal index 3232ebb..ee70c97 100644 --- a/zgo-backend.cabal +++ b/zgo-backend.cabal @@ -25,6 +25,7 @@ source-repository head library exposed-modules: + Item Order Owner User