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 :: Action IO [Document]
findWithKeys = findWithKeys =
rest =<< rest =<< find (select ["paid" =: True, "payconf" =: True] "owners")
find (select ["paid" =: True, "invoices" =: True, "payconf" =: True] "owners")
removePro :: T.Text -> Action IO () removePro :: T.Text -> Action IO ()
removePro o = removePro o =

49
src/ZGoBackend.hs
View File

@ -1890,10 +1890,13 @@ getBlockInfo nodeUser nodePwd bh = do
print $ err content print $ err content
return Nothing return Nothing
scanTxNative :: Pipe -> T.Text -> BS.ByteString -> BS.ByteString -> IO () scanTxNative :: Config -> Pipe -> IO ()
scanTxNative pipe db nodeUser nodePwd = do scanTxNative config pipe = do
let db = c_dbName config
keyOwnerList <- access pipe master db findWithKeys keyOwnerList <- access pipe master db findWithKeys
unless (null keyOwnerList) $ do unless (null keyOwnerList) $ do
let nodeUser = c_nodeUser config
let nodePwd = c_nodePwd config
let ownerList = cast' . Doc <$> keyOwnerList let ownerList = cast' . Doc <$> keyOwnerList
let keyList = map (maybe "" oviewkey) ownerList let keyList = map (maybe "" oviewkey) ownerList
print keyList print keyList
@ -1919,9 +1922,23 @@ scanTxNative pipe db nodeUser nodePwd = do
let filteredTxList = map fromJust $ filter filterTx txList let filteredTxList = map fromJust $ filter filterTx txList
print "checking txs against keys..." print "checking txs against keys..."
mapM_ (checkTx filteredTxList) keyList mapM_ (checkTx filteredTxList) keyList
access pipe master (c_dbName config) $ upsertBlock lB
Just lastBlock -> do Just lastBlock -> do
let blockList' = [(bl_height lastBlock + 1) .. (bl_height lB)] blockList' <-
print 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 where
filterBlock :: Maybe BlockResponse -> Bool filterBlock :: Maybe BlockResponse -> Bool
filterBlock b = maybe 0 bl_confirmations b >= 5 filterBlock b = maybe 0 bl_confirmations b >= 5
@ -1953,25 +1970,33 @@ scanTxNative pipe db nodeUser nodePwd = do
then do then do
print "decoding Sapling tx" print "decoding Sapling tx"
let decodedSapList' = concatMap (decodeSaplingTx k) txList' let decodedSapList' = concatMap (decodeSaplingTx k) txList'
print $ filter isJust decodedSapList' let zList = catMaybes decodedSapList'
mapM_ (zToZGoTx' config pipe) zList
else do else do
let vk = decodeUfvk $ E.encodeUtf8 k let vk = decodeUfvk $ E.encodeUtf8 k
case vk of case vk of
Nothing -> print "Not a valid key" Nothing -> print "Not a valid key"
Just v -> do Just v -> do
let decodedSapList = map (decodeSaplingOutput (s_key v)) sOutList let decodedSapList =
print decodedSapList concatMap (decodeUnifiedSaplingTx (s_key v)) txList'
let decodedOrchList = let zList' = catMaybes decodedSapList
map mapM_ (zToZGoTx' config pipe) zList'
(decryptOrchardAction v) let decodedOrchList = concatMap (decodeUnifiedOrchardTx v) txList'
(concatMap rt_orchardActions txList') let oList = catMaybes decodedOrchList
print decodedOrchList mapM_ (zToZGoTx' config pipe) oList
decodeSaplingTx :: T.Text -> RawTxResponse -> [Maybe ZcashTx] decodeSaplingTx :: T.Text -> RawTxResponse -> [Maybe ZcashTx]
decodeSaplingTx k t = decodeSaplingTx k t =
map map
(buildZcashTx t . (buildZcashTx t .
decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k))) decodeSaplingOutput (bytes (decodeBech32 $ E.encodeUtf8 k)))
(rt_shieldedOutputs t) (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 :: RawTxResponse -> Maybe DecodedNote -> Maybe ZcashTx
buildZcashTx t n = buildZcashTx t n =
case n of case n of