Change Zcash scan to use parser

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
 

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

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)

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