From 2b2c3ba70e62a0c21a0f940f0f5adec01d28788e Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Mon, 16 Oct 2023 14:57:24 -0500
Subject: [PATCH] Update order endpoint for improved security

---
 CHANGELOG.md      |  1 +
 src/ZGoBackend.hs | 71 ++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 59 insertions(+), 13 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 2712b8b..cccc5c4 100644
--- a/CHANGELOG.md
+++ b/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.
 
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 763c512..7673ea1 100644
--- a/src/ZGoBackend.hs
+++ b/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-}
     {-_ <--}