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