Order endpoints corrections

src/ZGoBackend.hs

@@ -1100,7 +1100,7 @@ routes pipe config = do
              , "orders" .= toJSON pOrders
              ])
     --Get order by id for receipts
-  get "/api/order/:id" $ do
+  get "/order/:id" $ do
     oId <- param "id"
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r oId
@@ -1119,7 +1119,7 @@ routes pipe config = do
                      [ "message" .= ("Order found!" :: String)
                      , "order" .= toJSON (pOrder :: ZGoOrder)
                      ])
-      else status noContent204
+      else status badRequest400
     --Get order by session
   get "/api/order" $ do
     sess <- param "session"
@@ -1162,8 +1162,16 @@ routes pipe config = do
   post "/api/order" $ do
     newOrder <- jsonData
     let q = payload (newOrder :: Payload ZGoOrder)
+    session <- param "session"
+    user <- liftAndCatchIO $ run (findUser session)
+    case cast' . Doc =<< user of
+      Nothing -> status unauthorized401
+      Just u -> do
+        if uaddress u == qaddress q
+          then do
             _ <- liftAndCatchIO $ run (upsertOrder q)
             status created201
+          else status forbidden403
     --Delete order
   Web.Scotty.delete "/api/order/:id" $ do
     oId <- param "id"

test/Spec.hs

@@ -326,8 +326,87 @@ main = do
                 ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` ok200
-        describe "Order endpoints" $ do
+        describe "Order endpoints" $
-          prop "upsert order" testOrderAdd
+          --prop "upsert order" testOrderAdd
+         do
+          it "adding order with bad session fails with 401" $ do
+            myTs <- liftIO getCurrentTime
+            let testOrder =
+                  ZGoOrder
+                    (Just (read "627ab3ea2b05a76be3000011"))
+                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
+                    myTs
+                    False
+                    "usd"
+                    102.0
+                    0
+                    0
+                    []
+                    False
+                    ""
+                    ""
+            req <-
+              testPostJson "/api/order" $
+              A.object ["payload" A..= A.toJSON testOrder]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-fake-adda-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` unauthorized401
+          it "adding order with mismatched session fails with 403" $ do
+            myTs <- liftIO getCurrentTime
+            let testOrder =
+                  ZGoOrder
+                    (Just (read "627ab3ea2b05a76be3000011"))
+                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
+                    myTs
+                    False
+                    "usd"
+                    102.0
+                    0
+                    0
+                    []
+                    False
+                    ""
+                    ""
+            req <-
+              testPostJson "/api/order" $
+              A.object ["payload" A..= A.toJSON testOrder]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
+                req
+            getResponseStatus res `shouldBe` forbidden403
+          it "adding order with correct session succeeds" $ do
+            myTs <- liftIO getCurrentTime
+            let testOrder =
+                  ZGoOrder
+                    (Just (read "627ab3ea2b05a76be3000011"))
+                    "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
+                    "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
+                    myTs
+                    False
+                    "usd"
+                    102.0
+                    0
+                    0
+                    []
+                    False
+                    ""
+                    ""
+            req <-
+              testPostJson "/api/order" $
+              A.object ["payload" A..= A.toJSON testOrder]
+            res <-
+              httpLBS $
+              setRequestQueryString
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                req
+            getResponseStatus res `shouldBe` created201
           it "get order by session" $ do
             req <-
               testGet
@@ -335,7 +414,7 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
-          it "get order by session fails when invalid" $ do
+          it "get order by session fails with bad session" $ do
             req <-
               testGet
                 "/api/order"
@@ -343,24 +422,15 @@ main = do
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
           it "get order by id" $ do
-            req <-
+            req <- testGet "/order/627ab3ea2b05a76be3000000" []
-              testGet
-                "/api/order/627ab3ea2b05a76be3000000"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
-          it "get order with wrong id" $ do
+          it "get order with invalid id fails with 400" $ do
-            req <-
+            req <- testGet "/order/6273hrb" []
-              testGet
-                "/api/order/6273hrb"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
             res <- httpLBS req
-            getResponseStatus res `shouldBe` noContent204
+            getResponseStatus res `shouldBe` badRequest400
-          it "get order by id fails with bad session" $ do
+          it "get order by id fails with bad token" $ do
-            req <-
+            req <- testGet "/order/627ab3ea2b05a76be3000000" []
-              testGet
-                "/api/order/627ab3ea2b05a76be3000000"
-                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
           it "get all orders for owner" $ do
@@ -397,6 +467,14 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
+          it "delete order by id fails with mismatched session" $ do
+            req <-
+              testDelete
+                "/api/order/"
+                "627ab3ea2b05a76be3000000"
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` forbidden403
         describe "Item endpoint" $ do
           it "adding item with bad session fails" $ do
             let item =