Vergara_Tech/zgo-backend
Vergara_Tech
/
zgo-backend
2
1
Fork 0
Code Issues Pull Requests Packages Projects Releases 4 Wiki Activity

Implement saving of scanned txs

This commit is contained in:
Rene Vergara 2023-10-12 14:53:53 -05:00
parent ccd9e8280e
commit d7ced42d86
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
2 changed files with 38 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Owner.hs
View File

@ -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 =

49
src/ZGoBackend.hs
View File

@ -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