Merge branch 'fix0063' into dev18

CHANGELOG.md

@@ -15,6 +15,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### Changed
 
+- Order endpoint updated to ensure orders belong to shop before adding to DB.
 - MongoDB driver updated to support MongoDB 6.
 - Full validation of Sapling addresses to parser.
 

src/ZGoBackend.hs

@@ -590,6 +590,7 @@ routes pipe config = do
   let nodeUser = c_nodeUser config
   let nodePwd = c_nodePwd config
   let nodeAddress = c_nodeAddress config
+  let dbName = c_dbName config
   middleware $
     cors $
     const $
@@ -1428,20 +1429,44 @@ routes pipe config = do
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
       Just u -> do
-        if uaddress u == qaddress q
-          then do
-            if qtoken q == ""
+        dbOrder <-
+          liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q))
+        case cast' . Doc =<< dbOrder of
+          Nothing -> do
+            if uaddress u == qaddress q
               then do
-                t <- liftIO generateToken
-                _ <-
-                  liftAndCatchIO $
-                  run (upsertOrder $ setOrderToken (T.pack t) q)
-                status created201
-              else do
-                _ <- liftAndCatchIO $ run (upsertOrder q)
-                status created201
-          else status forbidden403
-    --Delete order
+                if qtoken q == ""
+                  then do
+                    t <- liftIO generateToken
+                    _ <-
+                      liftAndCatchIO $
+                      run (upsertOrder $ setOrderToken (T.pack t) q)
+                    status created201
+                  else do
+                    _ <-
+                      liftAndCatchIO $ access pipe master dbName (upsertOrder q)
+                    status created201
+              else status forbidden403
+          Just dbO -> do
+            if qaddress q == qaddress dbO && qsession q == qsession dbO
+              then do
+                if uaddress u == qaddress q
+                  then do
+                    if qtoken q == ""
+                      then do
+                        t <- liftIO generateToken
+                        _ <-
+                          liftAndCatchIO $
+                          run (upsertOrder $ setOrderToken (T.pack t) q)
+                        status created201
+                      else do
+                        _ <-
+                          liftAndCatchIO $
+                          access pipe master dbName (upsertOrder q)
+                        status created201
+                  else status forbidden403
+              else status forbidden403
+  --Delete order
   Web.Scotty.delete "/api/order/:id" $ do
     oId <- param "id"
     session <- param "session"
@@ -1505,6 +1530,26 @@ routes pipe config = do
       Just tP -> do
         status ok200
         Web.Scotty.json $ toJSON (tP :: LangComponent)
+  where
+    saveOrder :: Pipe -> T.Text -> User -> ZGoOrder -> ActionM ()
+    saveOrder pipe dbName u q = do
+      if uaddress u == qaddress q
+        then do
+          if qtoken q == ""
+            then do
+              t <- liftIO generateToken
+              _ <-
+                liftAndCatchIO $
+                access
+                  pipe
+                  master
+                  dbName
+                  (upsertOrder $ setOrderToken (T.pack t) q)
+              status created201
+            else do
+              _ <- liftAndCatchIO $ access pipe master dbName (upsertOrder q)
+              status created201
+        else status forbidden403
   {-post "/api/setlang" $ do-}
     {-langComp <- jsonData-}
     {-_ <--}