Add tests for Item endpoints

src/Item.hs

@@ -88,6 +88,9 @@ findItems :: T.Text -> Action IO [Document]
 findItems a =
   rest =<< find (select ["owner" =: a] "items") {sort = ["name" =: (1 :: Int)]}
 
+findItemById :: String -> Action IO (Maybe Document)
+findItemById i = findOne (select ["_id" =: (read i :: ObjectId)] "items")
+
 upsertItem :: Item -> Action IO ()
 upsertItem i = do
   let item = val i

src/ZGoBackend.hs

@@ -1028,7 +1028,7 @@ routes pipe config = do
     session <- param "session"
     user <- liftAndCatchIO $ run (findUser session)
     case cast' . Doc =<< user of
-      Nothing -> status unauthorized401
+      Nothing -> status forbidden403
       Just u -> do
         items <- liftAndCatchIO $ run (findItems $ uaddress u)
         case items of
@@ -1044,18 +1044,34 @@ routes pipe config = do
     --Upsert item
   post "/api/item" $ do
     i <- jsonData
-    let q = payload (i :: Payload Item)
-    _ <- liftAndCatchIO $ run (upsertItem q)
-    status created201
+    session <- param "session"
+    user <- liftAndCatchIO $ run (findUser session)
+    case cast' . Doc =<< user of
+      Nothing -> status forbidden403
+      Just u -> do
+        let q = payload (i :: Payload Item)
+        if uaddress u == iowner q
+          then do
+            _ <- liftAndCatchIO $ run (upsertItem q)
+            status created201
+          else status forbidden403
     --Delete item
   Web.Scotty.delete "/api/item/:id" $ do
+    session <- param "session"
     oId <- param "id"
-    let r = mkRegex "^[a-f0-9]{24}$"
-    if matchTest r oId
-      then do
-        liftAndCatchIO $ run (deleteItem oId)
-        status ok200
-      else status noContent204
+    u' <- liftAndCatchIO $ checkUser run session
+    case u' of
+      Nothing -> status forbidden403
+      Just u -> do
+        i <- liftAndCatchIO $ run (findItemById oId)
+        case cast' . Doc =<< i of
+          Nothing -> status badRequest400
+          Just i' -> do
+            if iowner i' == uaddress u
+              then do
+                liftAndCatchIO $ run (deleteItem oId)
+                status ok200
+              else status forbidden403
     --Get price for Zcash
   get "/price" $ do
     curr <- param "currency"
@@ -1553,4 +1569,12 @@ expireProSessions pipe db = do
           access pipe master db $ removePro (psaddress z)
           access pipe master db $ closeProSession z
 
+checkUser ::
+     (Action IO (Maybe Document) -> IO (Maybe Document))
+  -> T.Text
+  -> IO (Maybe User)
+checkUser run s = do
+  user <- run (findUser s)
+  return $ cast' . Doc =<< user
+
 debug = flip trace

test/Spec.hs

@@ -398,24 +398,77 @@ main = do
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
         describe "Item endpoint" $ do
-          prop "add item" testItemAdd
-          it "get items" $ do
+          it "adding item with bad session fails" $ do
+            let item =
+                  Item
+                    Nothing
+                    "Table"
+                    "Oak"
+                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    499.99
+            req <-
+              testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` unauthorized401
+          it "adding item with good session succeeds" $ do
+            let item =
+                  Item
+                    (Just (read "627d7ba92b05a76be3000013"))
+                    "Table"
+                    "Oak"
+                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    499.99
+            req <-
+              testPostJson "/api/item" $ A.object ["payload" A..= A.toJSON item]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` created201
+          it "get items with valid session succeeds" $ do
             req <-
               testGet
                 "/api/items"
-                [ ("address", Just "Zaddy")
-                , ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
-                ]
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
-          it "delete item" $ do
+          it "get items with invalid session returns 401" $ do
             req <-
-              testDelete
-                "/api/item/"
-                "627d7ba92b05a76be3000003"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+              testGet
+                "/api/items"
+                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
             res <- httpLBS req
-            getResponseStatus res `shouldBe` ok200
+            getResponseStatus res `shouldBe` unauthorized401
+          describe "delete item" $ do
+            it "returns 401 with invalid session and item ID" $ do
+              req <-
+                testDelete
+                  "/api/item/"
+                  "627d7ba92b05a76be3000003"
+                  [("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
+              res <- httpLBS req
+              getResponseStatus res `shouldBe` unauthorized401
+            it "returns 403 when item ID doesn't belong to session" $ do
+              req <-
+                testDelete
+                  "/api/item/"
+                  "627d7ba92b05a76be3000003"
+                  [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+              res <- httpLBS req
+              getResponseStatus res `shouldBe` forbidden403
+            it "succeeds with valid session and item ID" $ do
+              req <-
+                testDelete
+                  "/api/item/"
+                  "627d7ba92b05a76be3000013"
+                  [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+              res <- httpLBS req
+              getResponseStatus res `shouldBe` ok200
         describe "WooCommerce endpoints" $ do
           it "generate token" $ do
             req <-
@@ -841,7 +894,7 @@ testMemoParser t1 t2 t3 =
           " zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e " <>
           t2 <> " ZGO::5d3d4494-51c0-432d-8495-050419957aea " <> t3
     case res of
-      Left e -> assert False `debug` (errorBundlePretty e)
+      Left e -> assert False `debug` errorBundlePretty e
       Right zm ->
         assert $
         U.fromString "5d3d4494-51c0-432d-8495-050419957aea" == m_session zm &&
@@ -944,34 +997,6 @@ startAPI config = do
   let userList =
         map unwrapDoc $ filter filterDocs $ val <$> [myUser, myUser1, myUser2]
   _ <- access pipe master "test" (insertAll_ "users" userList)
-  --_ <-
-    --access
-      --pipe
-      --master
-      --"test"
-      --(insert_
-         --"users"
-         --[ "address" =: uaddress myUser
-         --, "_id" =: u_id myUser
-         --, "session" =: usession myUser
-         --, "blocktime" =: ublocktime myUser
-         --, "pin" =: upin myUser
-         --, "validated" =: uvalidated myUser
-         --])
-  --_ <-
-    --access
-      --pipe
-      --master
-      --"test"
-      --(insert_
-         --"users"
-         --[ "address" =: uaddress myUser1
-         --, "_id" =: u_id myUser1
-         --, "session" =: usession myUser1
-         --, "blocktime" =: ublocktime myUser1
-         --, "pin" =: upin myUser1
-         --, "validated" =: uvalidated myUser1
-         --])
   let myOwner =
         Owner
           (Just (read "627ad3492b05a76be3000001"))