Unified Address support #8
2 changed files with 38 additions and 14 deletions
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue