From 63d372c2d580ab89613895add4161e3d8dc09ab9 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 14 Mar 2023 10:17:31 -0500
Subject: [PATCH] Change Zcash scan to use parser

---
 CHANGELOG.md      |  2 ++
 app/Server.hs     | 15 ++++++++-------
 app/Tasks.hs      |  3 +--
 src/ZGoBackend.hs | 45 ++++++++++++++++++++++++++++++---------------
 4 files changed, 41 insertions(+), 24 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 5fe8488..ce4161a 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -11,12 +11,14 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - New type to handle UI translation objects
 - New endpoints for API to get/set translation
 - Tests for translation endpoints
+- Formal parser of ZGo-related tokens in memos
 
 ### Changed
 
 - Remove old code for PIN generation
 - Xero reference field to include the amount of ZEC received
 - Separate periodic tasks from API server
+- Zcash transaction monitoring changed to use memo parser
 
 ## [1.2.5] - 2023-02-01
 
diff --git a/app/Server.hs b/app/Server.hs
index 5c6ee4f..229ebc6 100644
--- a/app/Server.hs
+++ b/app/Server.hs
@@ -3,7 +3,8 @@
 module Server where
 
 import Config
-import Control.Concurrent (forkIO)
+
+--import Control.Concurrent (forkIO)
 import Database.MongoDB
 import Network.Wai.Handler.Warp (defaultSettings, setPort)
 import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
@@ -30,12 +31,12 @@ main = do
   if j
     then putStrLn "Connected to MongoDB!"
     else fail "MongoDB connection failed!"
-  _ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig)))
-  _ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe))
-  _ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe))
-  _ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))
-  _ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))
-  _ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))
+  {-_ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe))-}
+  {-_ <- forkIO (setInterval 90 (scanPayments loadedConfig pipe))-}
+  {-_ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))-}
+  {-_ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))-}
   let appRoutes = routes pipe loadedConfig
   case myTlsSettings of
     Nothing -> scotty (c_port loadedConfig) appRoutes
diff --git a/app/Tasks.hs b/app/Tasks.hs
index 90833a7..c3360a8 100644
--- a/app/Tasks.hs
+++ b/app/Tasks.hs
@@ -4,7 +4,6 @@ module Tasks where
 
 import Config
 import Database.MongoDB
-import Text.Megaparsec hiding (State)
 import ZGoBackend
 
 main :: IO ()
@@ -23,7 +22,7 @@ main = do
     then do
       putStrLn "Connected to MongoDB!"
       checkZcashPrices pipe (c_dbName loadedConfig)
-      scanZcash loadedConfig pipe
+      scanZcash' loadedConfig pipe
       scanPayments loadedConfig pipe
       checkPayments pipe (c_dbName loadedConfig)
       expireOwners pipe (c_dbName loadedConfig)
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 48792e4..17bb653 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -357,21 +357,26 @@ zToZGoTx (ZcashTx t a aZ bh bt c conf m) = do
               ZGoTx Nothing nAddy sess conf bt a t m
             else ZGoTx Nothing "" "" conf bt a t m
 
-zToZGoTx' :: ZcashTx -> ZGoTx
-zToZGoTx' (ZcashTx t a aZ bh bt c conf m) = do
-  let zM = runParser pZGoMemo (T.unpack t) m
-  case zM of
-    Right zM' ->
-      ZGoTx
-        Nothing
-        (fromMaybe "" $ m_address zM')
-        (maybe "" U.toText $ m_session zM')
-        conf
-        bt
-        a
-        t
-        m
-    Left e -> error "Failed to parse ZGo memo"
+zToZGoTx' :: Config -> Pipe -> ZcashTx -> IO ()
+zToZGoTx' config pipe (ZcashTx t a aZ bh bt c conf m) = do
+  when (conf < 100) $ do
+    let zM = runParser pZGoMemo (T.unpack t) m
+    case zM of
+      Right zM' -> do
+        let tx =
+              ZGoTx
+                Nothing
+                (fromMaybe "" $ m_address zM')
+                (maybe "" U.toText $ m_session zM')
+                conf
+                bt
+                a
+                t
+                m
+        if m_payment zM'
+          then upsertPayment pipe (c_dbName config) tx
+          else access pipe master (c_dbName config) $ upsertZGoTx "txs" tx
+      Left e -> error "Failed to parse ZGo memo"
 
 -- |Type to model a price in the ZGo database
 data ZGoPrice =
@@ -1160,6 +1165,16 @@ isRelevant re t
   | zconfirmations t < 100 && (matchTest re . T.unpack . zmemo) t = True
   | otherwise = False
 
+-- | New function to scan transactions with parser
+scanZcash' :: Config -> Pipe -> IO ()
+scanZcash' config pipe = do
+  myTxs <-
+    listTxs (c_nodeUser config) (c_nodePwd config) (c_nodeAddress config) 1
+  case myTxs of
+    Right txs -> mapM_ (zToZGoTx' config pipe) txs
+    Left e -> do
+      putStrLn $ "Error scanning node transactions: " ++ T.unpack e
+
 -- | Function to scan loaded viewing keys for payments
 scanPayments :: Config -> Pipe -> IO ()
 scanPayments config pipe = do