Correct order endpoints

src/ZGoBackend.hs

@@ -1090,8 +1090,12 @@ routes pipe config = do
              ])
     --Get all closed orders for the address
   get "/api/allorders" $ do
-    addr <- param "address"
+    session <- param "session"
-    myOrders <- liftAndCatchIO $ run (findAllOrders addr)
+    user <- liftAndCatchIO $ run (findUser session)
+    case cast' . Doc =<< user of
+      Nothing -> status unauthorized401
+      Just u -> do
+        myOrders <- liftAndCatchIO $ run (findAllOrders $ uaddress u)
         case myOrders of
           [] -> status noContent204
           _ -> do
@@ -1105,23 +1109,23 @@ routes pipe config = do
     --Get order by id for receipts
   get "/order/:id" $ do
     oId <- param "id"
+    token <- param "token"
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r oId
       then do
         myOrder <- liftAndCatchIO $ run (findOrderById oId)
-        case myOrder of
+        case cast' . Doc =<< myOrder of
           Nothing -> status noContent204
-          Just o -> do
-            let o' = cast' (Doc o)
-            case o' of
-              Nothing -> status internalServerError500
           Just pOrder -> do
+            if qtoken pOrder == token
+              then do
                 status ok200
                 Web.Scotty.json
                   (object
                      [ "message" .= ("Order found!" :: String)
                      , "order" .= toJSON (pOrder :: ZGoOrder)
                      ])
+              else status forbidden403
       else status badRequest400
     --Get order by session
   get "/api/order" $ do
@@ -1186,8 +1190,16 @@ routes pipe config = do
     --Delete order
   Web.Scotty.delete "/api/order/:id" $ do
     oId <- param "id"
+    session <- param "session"
+    o <- liftAndCatchIO $ run (findOrderById oId)
+    case cast' . Doc =<< o of
+      Nothing -> status badRequest400
+      Just order -> do
+        if qsession order == session
+          then do
             liftAndCatchIO $ run (deleteOrder oId)
             status ok200
+          else status forbidden403
   -- Get language for component
   get "/getmainlang" $ do
     lang <- param "lang"
@@ -1599,6 +1611,6 @@ checkUser run s = do
 generateToken :: IO String
 generateToken = do
   rngState <- newCryptoRNGState
-  runCryptoRNGT rngState $ randomString 16 "abcdef0123456789"
+  runCryptoRNGT rngState $ randomString 24 "abcdef0123456789"
 
 debug = flip trace

stack.yaml.lock

@@ -31,7 +31,7 @@ packages:
     hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
 snapshots:
 - completed:
-    sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64
+    sha256: 4c972e067bae16b95961dbfdd12e07f1ee6c8fffabbfa05c3d65100b03f548b7
-    size: 649618
+    size: 650253
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/23.yaml
-  original: lts-20.19
+  original: lts-20.23

test/Spec.hs

@@ -346,6 +346,7 @@ main = do
                     False
                     ""
                     ""
+                    "testToken4321"
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -372,6 +373,7 @@ main = do
                     False
                     ""
                     ""
+                    "testToken4321"
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -398,6 +400,7 @@ main = do
                     False
                     ""
                     ""
+                    "testToken4321"
             req <-
               testPostJson "/api/order" $
               A.object ["payload" A..= A.toJSON testOrder]
@@ -422,48 +425,34 @@ main = do
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
           it "get order by id" $ do
-            req <- testGet "/order/627ab3ea2b05a76be3000000" []
+            req <-
+              testGet
+                "/order/627ab3ea2b05a76be3000000"
+                [("token", Just "testToken1234")]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "get order with invalid id fails with 400" $ do
-            req <- testGet "/order/6273hrb" []
+            req <- testGet "/order/6273hrb" [("token", Just "testToken1234")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` badRequest400
           it "get order by id fails with bad token" $ do
-            req <- testGet "/order/627ab3ea2b05a76be3000000" []
+            req <-
+              testGet
+                "/order/627ab3ea2b05a76be3000000"
+                [("token", Just "wrongToken1234")]
             res <- httpLBS req
-            getResponseStatus res `shouldBe` unauthorized401
+            getResponseStatus res `shouldBe` forbidden403
           it "get all orders for owner" $ do
             req <-
               testGet
                 "/api/allorders"
-                [ ("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 "get all orders for owner fails with bad session" $ do
             req <-
               testGet
                 "/api/allorders"
-                [ ("address", Just "Zaddy")
-                , ("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")
-                ]
-            res <- httpLBS req
-            getResponseStatus res `shouldBe` unauthorized401
-          it "delete order by id" $ do
-            req <-
-              testDelete
-                "/api/order/"
-                "627ab3ea2b05a76be3000000"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
-            res <- httpLBS req
-            getResponseStatus res `shouldBe` ok200
-          it "delete order by id fails with bad session" $ do
-            req <-
-              testDelete
-                "/api/order/"
-                "627ab3ea2b05a76be3000000"
                 [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` unauthorized401
@@ -475,6 +464,22 @@ main = do
                 [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dfake")]
             res <- httpLBS req
             getResponseStatus res `shouldBe` forbidden403
+          it "delete order by id fails with bad session" $ do
+            req <-
+              testDelete
+                "/api/order/"
+                "627ab3ea2b05a76be3000000"
+                [("session", Just "35bfb9c2-9ad2-4fe5-fake-99d63b8dcdcd")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` unauthorized401
+          it "delete order by id" $ do
+            req <-
+              testDelete
+                "/api/order/"
+                "627ab3ea2b05a76be3000000"
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` ok200
         describe "Item endpoint" $ do
           it "adding item with bad session fails" $ do
             let item =
@@ -748,6 +753,7 @@ main = do
                     False
                     ""
                     ""
+                    "testToken1234"
             let ordTest = val myOrder
             case ordTest of
               Doc oT -> access p master "test" (insert_ "orders" oT)
@@ -1112,7 +1118,7 @@ startAPI config = do
   let myOrder =
         ZGoOrder
           (Just (read "627ab3ea2b05a76be3000000"))
-          "Zaddy"
+          "zs1w6nkameazc5gujm69350syl5w8tgvyaphums3pw8eytzy5ym08x7dvskmykkatmwrucmgv3er8e"
           "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd"
           myTs
           False
@@ -1124,6 +1130,7 @@ startAPI config = do
           False
           ""
           ""
+          "testToken1234"
   let ordTest = val myOrder
   case ordTest of
     Doc oT -> access pipe master "test" (insert_ "orders" oT)
@@ -1177,7 +1184,8 @@ instance Arbitrary ZGoOrder where
     l <- arbitrary
     pd <- arbitrary
     eI <- arbitrary
-    ZGoOrder i a s ts c cur p t tZ l pd eI <$> arbitrary
+    sc <- arbitrary
+    ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary
 
 instance Arbitrary LineItem where
   arbitrary = do