diff --git a/src/Owner.hs b/src/Owner.hs index 7985fc7..803fb65 100644 --- a/src/Owner.hs +++ b/src/Owner.hs @@ -420,8 +420,7 @@ findExpiringOwners now = findWithKeys :: Action IO [Document] findWithKeys = - rest =<< - find (select ["paid" =: True, "invoices" =: True, "payconf" =: True] "owners") + rest =<< find (select ["paid" =: True, "payconf" =: True] "owners") removePro :: T.Text -> Action IO () removePro o = diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 3fe24b3..d82a89c 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -1890,10 +1890,13 @@ getBlockInfo nodeUser nodePwd bh = do print $ err content return Nothing -scanTxNative :: Pipe -> T.Text -> BS.ByteString -> BS.ByteString -> IO () -scanTxNative pipe db nodeUser nodePwd = do +scanTxNative :: Config -> Pipe -> IO () +scanTxNative config pipe = do + let db = c_dbName config keyOwnerList <- access pipe master db findWithKeys unless (null keyOwnerList) $ do + let nodeUser = c_nodeUser config + let nodePwd = c_nodePwd config let ownerList = cast' . Doc <$> keyOwnerList let keyList = map (maybe "" oviewkey) ownerList print keyList @@ -1919,9 +1922,23 @@ scanTxNative pipe db nodeUser nodePwd = do let filteredTxList = map fromJust $ filter filterTx txList print "checking txs against keys..." mapM_ (checkTx filteredTxList) keyList + access pipe master (c_dbName config) $ upsertBlock lB Just lastBlock -> do - let blockList' = [(bl_height lastBlock + 1) .. (bl_height lB)] - print blockList' + blockList' <- + mapM + (getBlockInfo nodeUser nodePwd . T.pack . show) + [(bl_height lastBlock + 1) .. (bl_height lB)] + print "filtering blocks..." + let filteredBlockList = filter filterBlock blockList' + print "extracting txs from blocks..." + let txIdList = concatMap extractTxs filteredBlockList + print "getting tx data from node..." + txList <- mapM (getTxData nodeUser nodePwd) txIdList + print "filtering txs..." + let filteredTxList = map fromJust $ filter filterTx txList + print "checking txs against keys..." + mapM_ (checkTx filteredTxList) keyList + access pipe master (c_dbName config) $ upsertBlock lB where filterBlock :: Maybe BlockResponse -> Bool filterBlock b = maybe 0 bl_confirmations b >= 5 @@ -1953,25 +1970,33 @@ scanTxNative pipe db nodeUser nodePwd = do then do print "decoding Sapling tx" let decodedSapList' = concatMap (decodeSaplingTx k) txList' - print $ filter isJust decodedSapList' + let zList = catMaybes decodedSapList' + mapM_ (zToZGoTx' config pipe) zList else do let vk = decodeUfvk $ E.encodeUtf8 k case vk of Nothing -> print "Not a valid key" Just v -> do - let decodedSapList = map (decodeSaplingOutput (s_key v)) sOutList - print decodedSapList - let decodedOrchList = - map - (decryptOrchardAction v) - (concatMap rt_orchardActions txList') - print decodedOrchList + let decodedSapList = + concatMap (decodeUnifiedSaplingTx (s_key v)) txList' + let zList' = catMaybes decodedSapList + mapM_ (zToZGoTx' config pipe) zList' + let decodedOrchList = concatMap (decodeUnifiedOrchardTx v) txList' + let oList = catMaybes decodedOrchList + mapM_ (zToZGoTx' config pipe) oList decodeSaplingTx :: T.Text -> RawTxResponse -> [Maybe ZcashTx] decodeSaplingTx k t = map (buildZcashTx t . decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k))) (rt_shieldedOutputs t) + decodeUnifiedSaplingTx :: BS.ByteString -> RawTxResponse -> [Maybe ZcashTx] + decodeUnifiedSaplingTx k t = + map (buildZcashTx t . decodeSaplingOutput k) (rt_shieldedOutputs t) + decodeUnifiedOrchardTx :: + UnifiedFullViewingKey -> RawTxResponse -> [Maybe ZcashTx] + decodeUnifiedOrchardTx k t = + map (buildZcashTx t . decryptOrchardAction k) (rt_orchardActions t) buildZcashTx :: RawTxResponse -> Maybe DecodedNote -> Maybe ZcashTx buildZcashTx t n = case n of