Enhance payment confirmation logic

CHANGELOG.md

@@ -12,6 +12,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### Changed
 
+- Modified the process of scanning for payments to only scan addresses that have an active ZGo session and have enabled payment confirmations
 - Modified the process to mark paid orders to ensure only payments to the shop's wallet get marked as paid
 - Modified the `items` endpoint to use the login session to identify records
 

src/Owner.hs

@@ -407,6 +407,10 @@ findOwnerById :: T.Text -> Action IO (Maybe Document)
 findOwnerById i =
   findOne (select ["_id" =: (read (T.unpack i) :: ObjectId)] "owners")
 
+findActiveOwners :: Action IO [Document]
+findActiveOwners =
+  rest =<< find (select ["paid" =: True, "payconf" =: True] "owners")
+
 -- | Function to find Owners about to expire
 findExpiringOwners :: UTCTime -> Action IO [Document]
 findExpiringOwners now =

src/ZGoBackend.hs

@@ -1386,12 +1386,16 @@ scanZcash' config pipe = do
 -- | Function to scan loaded viewing keys for payments
 scanPayments :: Config -> Pipe -> IO ()
 scanPayments config pipe = do
-  shops <- listAddresses (c_nodeUser config) (c_nodePwd config)
-  mapM_ (findPaidOrders config pipe) shops
-  where
-    findPaidOrders :: Config -> Pipe -> ZcashAddress -> IO ()
+  shopRecords <- access pipe master (c_dbName config) findActiveOwners
+  case shopRecords of
+    [] -> return ()
+    _ -> do
+      let shops = cast' . Doc <$> shopRecords :: [Maybe Owner]
+      let validShopAddresses = map (maybe "" oaddress) $ filter isJust shops
+      mapM_ (findPaidOrders config pipe) validShopAddresses
+      where findPaidOrders :: Config -> Pipe -> T.Text -> IO ()
             findPaidOrders c p z = do
-      paidTxs <- listTxs (c_nodeUser c) (c_nodePwd c) (addy z) 5
+              paidTxs <- listTxs (c_nodeUser c) (c_nodePwd c) z 5
               case paidTxs of
                 Right txs -> do
                   let r = mkRegex ".*ZGo Order::([0-9a-fA-F]{24}).*"
@@ -1405,7 +1409,8 @@ scanPayments config pipe = do
               if not (null reg)
                 then (fst $ head reg ! 1, zamount t)
                 else ("", 0)
-    recordPayment :: Pipe -> T.Text -> ZcashAddress -> (String, Double) -> IO ()
+            recordPayment ::
+                 Pipe -> T.Text -> T.Text -> (String, Double) -> IO ()
             recordPayment p dbName z x = do
               o <- access p master dbName $ findOrderById (fst x)
               let xOrder = o >>= (cast' . Doc)
@@ -1415,7 +1420,7 @@ scanPayments config pipe = do
                   when
                     (not (qpaid xO) &&
                      qexternalInvoice xO /= "" &&
-             qtotalZec xO == snd x && addy z == qaddress xO) $ do
+                     qtotalZec xO == snd x && z == qaddress xO) $ do
                     let sReg = mkRegex "(.*)-([a-fA-f0-9]{24})"
                     let sResult = matchAllText sReg (T.unpack $ qsession xO)
                     if not (null sResult)
@@ -1426,7 +1431,12 @@ scanPayments config pipe = do
                                case xC of
                                  Nothing -> error "Failed to read Xero config"
                                  Just xConf -> do
-                           requestXeroToken p dbName xConf "" (qaddress xO)
+                                   requestXeroToken
+                                     p
+                                     dbName
+                                     xConf
+                                     ""
+                                     (qaddress xO)
                                    payXeroInvoice
                                      p
                                      dbName
@@ -1434,7 +1444,8 @@ scanPayments config pipe = do
                                      (qaddress xO)
                                      (qtotal xO)
                                      (qtotalZec xO)
-                           liftIO $ access p master dbName $ markOrderPaid x
+                                   liftIO $
+                                     access p master dbName $ markOrderPaid x
                              "WC" -> do
                                let wOwner = fst $ head sResult ! 2
                                wooT <-
@@ -1442,7 +1453,8 @@ scanPayments config pipe = do
                                  findWooToken $ Just (read wOwner)
                                let wT = wooT >>= (cast' . Doc)
                                case wT of
-                         Nothing -> error "Failed to read WooCommerce token"
+                                 Nothing ->
+                                   error "Failed to read WooCommerce token"
                                  Just wt -> do
                                    let iReg = mkRegex "(.*)-(.*)-.*"
                                    let iResult =
@@ -1463,7 +1475,9 @@ scanPayments config pipe = do
                                          (C.pack . T.unpack $ w_token wt)
                                          (C.pack . show $ qprice xO)
                                          (C.pack . show $ qtotalZec xO)
-                               liftIO $ access p master dbName $ markOrderPaid x
+                                       liftIO $
+                                         access p master dbName $
+                                         markOrderPaid x
                                      else error
                                             "Couldn't parse externalInvoice for WooCommerce"
                              _ -> putStrLn "Not an integration order"