Fix payment scan

CHANGELOG.md

@@ -6,8 +6,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+### Added
+
+- New `Config` type to house the configuration parameters
+
 ### Changed
 
+- Refactored code to use new `Config` type
 - Enhance `decodeHexText` to support Unicode
 - Enhance `encodeHexText` to support Unicode
 - Update tests for encode/decode of memos
@@ -15,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 ### Fixed
 
 - Fixed test for looking for an order with incorrect ID
+- Fixed payment scan to focus only on new transactions
 
 ## [0.1.0.2] - 2022-05-25
 

src/Owner.hs

@@ -37,11 +37,12 @@ data Owner =
     , ozats :: Bool
     , oinvoices :: Bool
     , oexpiration :: UTCTime
+    , oviewkey :: T.Text
     }
   deriving (Eq, Show, Generic, Typeable)
 
 instance ToJSON Owner where
-  toJSON (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv eTs) =
+  toJSON (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv eTs vk) =
     case i of
       Just oid ->
         object
@@ -67,6 +68,7 @@ instance ToJSON Owner where
           , "zats" .= zats
           , "invoices" .= inv
           , "expiration" .= eTs
+          , "viewKey" .= vk
           ]
       Nothing ->
         object
@@ -92,6 +94,7 @@ instance ToJSON Owner where
           , "zats" .= zats
           , "invoices" .= inv
           , "expiration" .= eTs
+          , "viewKey" .= vk
           ]
 
 instance FromJSON Owner where
@@ -119,6 +122,7 @@ instance FromJSON Owner where
       zats <- obj .: "zats"
       inv <- obj .: "invoices"
       ets <- obj .: "expiration"
+      vk <- obj .: "viewKey"
       pure $
         Owner
           (if not (null i)
@@ -145,6 +149,7 @@ instance FromJSON Owner where
           zats
           inv
           ets
+          vk
 
 instance Val Owner where
   cast' (Doc d) = do
@@ -170,9 +175,10 @@ instance Val Owner where
     zats <- B.lookup "zats" d
     inv <- B.lookup "invoices" d
     ets <- B.lookup "expiration" d
-    Just (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets)
+    vk <- B.lookup "viewKey" d
+    Just (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets vk)
   cast' _ = Nothing
-  val (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets) =
+  val (Owner i a n c t tV v vV f l e s ct st p ph w co paid zats inv ets vk) =
     case i of
       Just oid ->
         Doc
@@ -198,6 +204,7 @@ instance Val Owner where
           , "zats" =: zats
           , "invoices" =: inv
           , "expiration" =: ets
+          , "viewKey" =: vk
           ]
       Nothing ->
         Doc
@@ -222,6 +229,7 @@ instance Val Owner where
           , "zats" =: zats
           , "invoices" =: inv
           , "expiration" =: ets
+          , "viewKey" =: vk
           ]
 
 -- Database actions

src/ZGoBackend.hs

@@ -583,10 +583,15 @@ scanZcash config pipe = do
   let p =
         mkRegex
           ".*ZGOp::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*"
-  let k = map zToZGoTx (filter (matchTest r . T.unpack . zmemo) txs)
+  let k = map zToZGoTx (filter (isRelevant r) txs)
   mapM_ (access pipe master (c_dbName config) . upsertZGoTx "txs") k
-  let j = map zToZGoTx (filter (matchTest p . T.unpack . zmemo) txs)
+  let j = map zToZGoTx (filter (isRelevant p) txs)
   mapM_ (access pipe master (c_dbName config) . upsertPayment) j
+  where
+    isRelevant :: Text.Regex.Regex -> ZcashTx -> Bool
+    isRelevant re t
+      | zconfirmations t < 10 && (matchTest re . T.unpack . zmemo) t = True
+      | otherwise = False
 
 -- | Function to generate users from login txs
 updateLogins :: Pipe -> Config -> IO ()