Implement note search by address ID

This commit is contained in:
Rene Vergara 2024-08-12 15:35:00 -05:00
parent 14cf97d473
commit b75ed16a3e
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
4 changed files with 226 additions and 29 deletions

View file

@ -24,6 +24,7 @@ import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import qualified Data.ByteString as BS
import Data.HexString
import Data.Int
import Data.List (group, sort)
import Data.Maybe (catMaybes, fromJust, isJust)
import Data.Pool (Pool)
@ -72,6 +73,7 @@ import Zenith.Types
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashNetDB(..)
, ZcashNoteAPI(..)
, ZcashPool(..)
, ZcashWalletAPI(..)
)
@ -126,24 +128,24 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
address WalletAddressId OnDeleteCascade OnUpdateCascade
value Word64
value Int64
spent Bool
script BS.ByteString
change Bool
position Word64
position Int
UniqueTNote tx script
deriving Show Eq
WalletTrSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletTrNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64
value Int64
UniqueTrSpend tx accId
deriving Show Eq
WalletSapNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64
value Int64
recipient BS.ByteString
memo T.Text
spent Bool
@ -159,18 +161,18 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletSapNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64
value Int64
UniqueSapSepnd tx accId
deriving Show Eq
WalletOrchNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64
value Int64
recipient BS.ByteString
memo T.Text
spent Bool
nullifier HexStringDB
position Word64
position Int64
witness HexStringDB
change Bool
witPos OrchActionId OnDeleteIgnore OnUpdateIgnore
@ -182,7 +184,7 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletOrchNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64
value Int64
UniqueOrchSpend tx accId
deriving Show Eq
ZcashTransaction
@ -195,7 +197,7 @@ share
deriving Show Eq
TransparentNote
tx ZcashTransactionId
value Word64
value Int64
script BS.ByteString
position Int
UniqueTNPos tx position
@ -301,6 +303,68 @@ toZcashAddressAPI a =
(isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal a)))
-- | @WalletTrNote@
trToZcashNoteAPI :: ConnectionPool -> Entity WalletTrNote -> IO ZcashNoteAPI
trToZcashNoteAPI pool n = do
t <- getWalletTransaction pool $ walletTrNoteTx $ entityVal n
case t of
Nothing -> throwIO $ userError "Unable to find transaction"
Just t' -> do
return $
ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Transparent -- pool
(fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
(walletTrNoteValue $ entityVal n) -- zats
"" -- memo
(walletTransactionConf (entityVal t') >= 10) -- confirmed
(walletTransactionBlock $ entityVal t') -- blockheight
(walletTransactionTime $ entityVal t') -- blocktime
(walletTrNotePosition $ entityVal n) -- outindex
(walletTrNoteChange $ entityVal n) -- change
-- | @WalletSapNote@
sapToZcashNoteAPI :: ConnectionPool -> Entity WalletSapNote -> IO ZcashNoteAPI
sapToZcashNoteAPI pool n = do
t <- getWalletTransaction pool $ walletSapNoteTx $ entityVal n
oi <- getSaplingOutIndex pool $ walletSapNoteWitPos $ entityVal n
case t of
Nothing -> throwIO $ userError "Unable to find transaction"
Just t' -> do
return $
ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Sapling -- pool
(fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
(walletSapNoteValue $ entityVal n) -- zats
(walletSapNoteMemo $ entityVal n) -- memo
(walletTransactionConf (entityVal t') >= 10) -- confirmed
(walletTransactionBlock $ entityVal t') -- blockheight
(walletTransactionTime $ entityVal t') -- blocktime
oi -- outindex
(walletSapNoteChange $ entityVal n) -- change
-- | @WalletOrchNote@
orchToZcashNoteAPI :: ConnectionPool -> Entity WalletOrchNote -> IO ZcashNoteAPI
orchToZcashNoteAPI pool n = do
t <- getWalletTransaction pool $ walletOrchNoteTx $ entityVal n
oi <- getOrchardOutIndex pool $ walletOrchNoteWitPos $ entityVal n
case t of
Nothing -> throwIO $ userError "Unable to find transaction"
Just t' -> do
return $
ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Sapling -- pool
(fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
(walletOrchNoteValue $ entityVal n) -- zats
(walletOrchNoteMemo $ entityVal n) -- memo
(walletTransactionConf (entityVal t') >= 10) -- confirmed
(walletTransactionBlock $ entityVal t') -- blockheight
(walletTransactionTime $ entityVal t') -- blocktime
oi -- outindex
(walletOrchNoteChange $ entityVal n) -- change
-- * Database functions
-- | Initializes the database
initDb ::
@ -376,6 +440,26 @@ getWallets pool n =
where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
pure wallets
getNetwork :: ConnectionPool -> WalletAddressId -> IO ZcashNet
getNetwork pool a = do
n <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
(wallet :& acc :& addr) <-
from $ table @ZcashWallet `innerJoin` table @ZcashAccount `on`
(\(wallet :& acc) ->
wallet ^. ZcashWalletId ==. acc ^. ZcashAccountWalletId) `innerJoin`
table @WalletAddress `on`
(\(_ :& acc :& addr) ->
acc ^. ZcashAccountId ==. addr ^. WalletAddressAccId)
where_ (addr ^. WalletAddressId ==. val a)
pure $ wallet ^. ZcashWalletNetwork
case n of
Nothing -> throwIO $ userError "Failed to find wallet"
Just (Value n') -> return $ getNet n'
-- | Save a new wallet to the database
saveWallet ::
ConnectionPool -- ^ The database path to use
@ -954,6 +1038,59 @@ getOrchardActions pool b net =
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
pure (txs, oActions)
getWalletNotes ::
ConnectionPool -- ^ database path
-> Entity WalletAddress
-> IO [ZcashNoteAPI]
getWalletNotes pool w = do
let w' = entityVal w
let tReceiver = t_rec =<< readUnifiedAddressDB w'
let sReceiver = s_rec =<< readUnifiedAddressDB w'
let oReceiver = o_rec =<< readUnifiedAddressDB w'
trNotes <-
case tReceiver of
Nothing -> return []
Just tR -> do
let s =
BS.concat
[ BS.pack [0x76, 0xA9, 0x14]
, (toBytes . tr_bytes) tR
, BS.pack [0x88, 0xAC]
]
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s)
pure tnotes
sapNotes <-
case sReceiver of
Nothing -> return []
Just sR -> do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
snotes <- from $ table @WalletSapNote
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
pure snotes
orchNotes <-
case oReceiver of
Nothing -> return []
Just oR -> do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
onotes <- from $ table @WalletOrchNote
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
pure onotes
trNotes' <- mapM (trToZcashNoteAPI pool) trNotes
sapNotes' <- mapM (sapToZcashNoteAPI pool) sapNotes
orchNotes' <- mapM (orchToZcashNoteAPI pool) orchNotes
return $ trNotes' <> sapNotes' <> orchNotes'
-- | Get the transactions belonging to the given address
getWalletTransactions ::
ConnectionPool -- ^ database path
@ -1182,6 +1319,19 @@ getWalletTransactions pool w = do
where_ (t ^. UserTxId ==. val (entityKey uTx))
return ()
getWalletTransaction ::
ConnectionPool
-> WalletTransactionId
-> IO (Maybe (Entity WalletTransaction))
getWalletTransaction pool i =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
trs <- from $ table @WalletTransaction
where_ (trs ^. WalletTransactionId ==. val i)
pure trs
getUserTx :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx]
getUserTx pool aId = do
runNoLoggingT $
@ -1241,7 +1391,7 @@ findTransparentSpends pool za = do
(trSpends ^. TransparentSpendOutPointHash ==. val flipTxId)
where_
(trSpends ^. TransparentSpendOutPointIndex ==.
val (walletTrNotePosition $ entityVal n))
val (fromIntegral $ walletTrNotePosition $ entityVal n))
pure (tx, trSpends)
if null s
then return ()
@ -1478,6 +1628,34 @@ upsertWalTx zt za =
(zcashTransactionTime zt))
[]
getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int
getSaplingOutIndex pool i = do
o <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
sout <- from $ table @ShieldOutput
where_ (sout ^. ShieldOutputId ==. val i)
pure $ sout ^. ShieldOutputPosition
case o of
Nothing -> throwIO $ userError "couldn't find shielded output"
Just (Value o') -> return o'
getOrchardOutIndex :: ConnectionPool -> OrchActionId -> IO Int
getOrchardOutIndex pool i = do
o <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
sout <- from $ table @OrchAction
where_ (sout ^. OrchActionId ==. val i)
pure $ sout ^. OrchActionPosition
case o of
Nothing -> throwIO $ userError "couldn't find orchard action"
Just (Value o') -> return o'
getBalance :: ConnectionPool -> ZcashAccountId -> IO Integer
getBalance pool za = do
trNotes <- getWalletUnspentTrNotes pool za
@ -1731,7 +1909,7 @@ selectUnspentNotes pool za amt = do
else return (tList, [], [])
where
checkTransparent ::
Word64 -> [Entity WalletTrNote] -> (Word64, [Entity WalletTrNote])
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
checkTransparent x [] = (x, [])
checkTransparent x (n:ns) =
if walletTrNoteValue (entityVal n) < x
@ -1740,7 +1918,7 @@ selectUnspentNotes pool za amt = do
snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
else (0, [n])
checkSapling ::
Word64 -> [Entity WalletSapNote] -> (Word64, [Entity WalletSapNote])
Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote])
checkSapling x [] = (x, [])
checkSapling x (n:ns) =
if walletSapNoteValue (entityVal n) < x
@ -1748,7 +1926,7 @@ selectUnspentNotes pool za amt = do
, n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
else (0, [n])
checkOrchard ::
Word64 -> [Entity WalletOrchNote] -> (Word64, [Entity WalletOrchNote])
Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote])
checkOrchard x [] = (x, [])
checkOrchard x (n:ns) =
if walletOrchNoteValue (entityVal n) < x

View file

@ -15,10 +15,12 @@ import Control.Exception (try)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson
import Data.Int
import qualified Data.Text as T
import qualified Data.Vector as V
import Database.Esqueleto.Experimental (toSqlKey)
import Servant
import Text.Read (readMaybe)
import ZcashHaskell.Types
( RpcError(..)
, ZcashNet(..)
@ -28,9 +30,10 @@ import ZcashHaskell.Types
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB
( getAccounts
, getAddressById
, getAddresses
, getWalletNotes
, getWallets
, initDb
, initPool
, toZcashAccountAPI
, toZcashAddressAPI
@ -358,7 +361,23 @@ zenithServer config = getinfo :<|> handleRPC
return $ ErrorResponse (callId req) (-32602) "Invalid params"
ListReceived ->
case parameters req of
NotesParams x -> undefined
NotesParams x -> do
case (readMaybe (T.unpack x) :: Maybe Int64) of
Just x' -> do
let dbPath = c_dbPath config
pool <- liftIO $ runNoLoggingT $ initPool dbPath
a <- liftIO $ getAddressById pool $ toSqlKey x'
case a of
Just a' -> do
nList <- liftIO $ getWalletNotes pool a'
return $ NoteListResponse (callId req) nList
Nothing ->
return $
ErrorResponse
(callId req)
(-32004)
"Address does not belong to the wallet"
Nothing -> undefined -- search by address
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"

View file

@ -167,8 +167,8 @@ data ZcashNoteAPI = ZcashNoteAPI
, zn_amountZats :: !Int64
, zn_memo :: !T.Text
, zn_confirmed :: !Bool
, zn_blockheight :: !Int64
, zn_blocktime :: !Int64
, zn_blockheight :: !Int
, zn_blocktime :: !Int
, zn_outindex :: !Int
, zn_change :: !Bool
} deriving (Eq, Prelude.Show)

View file

@ -40,55 +40,55 @@ library
src
build-depends:
Clipboard
, Hclip
, JuicyPixels
, aeson
, array
, async
, ascii-progress
, async
, base >=4.12 && <5
, base64-bytestring
, binary
, brick
, bytestring
, configurator
, data-default
, directory
, filepath
, esqueleto
, resource-pool
, binary
, exceptions
, monad-logger
, vty-crossplatform
, secp256k1-haskell >= 1
, pureMD5
, filepath
, ghc
, haskoin-core
, hexstring
, http-client
, http-conduit
, http-types
, JuicyPixels
, qrcode-core
, qrcode-juicypixels
, microlens
, microlens-mtl
, microlens-th
, monad-logger
, monomer
, mtl
, persistent
, Hclip
, persistent-sqlite
, persistent-template
, process
, pureMD5
, qrcode-core
, qrcode-juicypixels
, regex-base
, regex-compat
, regex-posix
, resource-pool
, scientific
, secp256k1-haskell >= 1
, servant-server
, text
, text-show
, time
, vector
, vty
, vty-crossplatform
, word-wrap
, zcash-haskell
--pkgconfig-depends: rustzcash_wrapper