RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
4 changed files with 226 additions and 29 deletions
Showing only changes of commit b75ed16a3e - Show all commits

View file

@ -24,6 +24,7 @@ import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT) import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString import Data.HexString
import Data.Int
import Data.List (group, sort) import Data.List (group, sort)
import Data.Maybe (catMaybes, fromJust, isJust) import Data.Maybe (catMaybes, fromJust, isJust)
import Data.Pool (Pool) import Data.Pool (Pool)
@ -72,6 +73,7 @@ import Zenith.Types
, ZcashAccountAPI(..) , ZcashAccountAPI(..)
, ZcashAddressAPI(..) , ZcashAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZcashNoteAPI(..)
, ZcashPool(..) , ZcashPool(..)
, ZcashWalletAPI(..) , ZcashWalletAPI(..)
) )
@ -126,24 +128,24 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
address WalletAddressId OnDeleteCascade OnUpdateCascade address WalletAddressId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
spent Bool spent Bool
script BS.ByteString script BS.ByteString
change Bool change Bool
position Word64 position Int
UniqueTNote tx script UniqueTNote tx script
deriving Show Eq deriving Show Eq
WalletTrSpend WalletTrSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletTrNoteId OnDeleteCascade OnUpdateCascade note WalletTrNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
UniqueTrSpend tx accId UniqueTrSpend tx accId
deriving Show Eq deriving Show Eq
WalletSapNote WalletSapNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
spent Bool spent Bool
@ -159,18 +161,18 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletSapNoteId OnDeleteCascade OnUpdateCascade note WalletSapNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
UniqueSapSepnd tx accId UniqueSapSepnd tx accId
deriving Show Eq deriving Show Eq
WalletOrchNote WalletOrchNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
spent Bool spent Bool
nullifier HexStringDB nullifier HexStringDB
position Word64 position Int64
witness HexStringDB witness HexStringDB
change Bool change Bool
witPos OrchActionId OnDeleteIgnore OnUpdateIgnore witPos OrchActionId OnDeleteIgnore OnUpdateIgnore
@ -182,7 +184,7 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletOrchNoteId OnDeleteCascade OnUpdateCascade note WalletOrchNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
UniqueOrchSpend tx accId UniqueOrchSpend tx accId
deriving Show Eq deriving Show Eq
ZcashTransaction ZcashTransaction
@ -195,7 +197,7 @@ share
deriving Show Eq deriving Show Eq
TransparentNote TransparentNote
tx ZcashTransactionId tx ZcashTransactionId
value Word64 value Int64
script BS.ByteString script BS.ByteString
position Int position Int
UniqueTNPos tx position UniqueTNPos tx position
@ -301,6 +303,68 @@ toZcashAddressAPI a =
(isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress) (isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal a))) (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 -- * Database functions
-- | Initializes the database -- | Initializes the database
initDb :: initDb ::
@ -376,6 +440,26 @@ getWallets pool n =
where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n)) where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
pure wallets 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 -- | Save a new wallet to the database
saveWallet :: saveWallet ::
ConnectionPool -- ^ The database path to use ConnectionPool -- ^ The database path to use
@ -954,6 +1038,59 @@ getOrchardActions pool b net =
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
pure (txs, oActions) 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 -- | Get the transactions belonging to the given address
getWalletTransactions :: getWalletTransactions ::
ConnectionPool -- ^ database path ConnectionPool -- ^ database path
@ -1182,6 +1319,19 @@ getWalletTransactions pool w = do
where_ (t ^. UserTxId ==. val (entityKey uTx)) where_ (t ^. UserTxId ==. val (entityKey uTx))
return () 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 :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx]
getUserTx pool aId = do getUserTx pool aId = do
runNoLoggingT $ runNoLoggingT $
@ -1241,7 +1391,7 @@ findTransparentSpends pool za = do
(trSpends ^. TransparentSpendOutPointHash ==. val flipTxId) (trSpends ^. TransparentSpendOutPointHash ==. val flipTxId)
where_ where_
(trSpends ^. TransparentSpendOutPointIndex ==. (trSpends ^. TransparentSpendOutPointIndex ==.
val (walletTrNotePosition $ entityVal n)) val (fromIntegral $ walletTrNotePosition $ entityVal n))
pure (tx, trSpends) pure (tx, trSpends)
if null s if null s
then return () then return ()
@ -1478,6 +1628,34 @@ upsertWalTx zt za =
(zcashTransactionTime zt)) (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 :: ConnectionPool -> ZcashAccountId -> IO Integer
getBalance pool za = do getBalance pool za = do
trNotes <- getWalletUnspentTrNotes pool za trNotes <- getWalletUnspentTrNotes pool za
@ -1731,7 +1909,7 @@ selectUnspentNotes pool za amt = do
else return (tList, [], []) else return (tList, [], [])
where where
checkTransparent :: checkTransparent ::
Word64 -> [Entity WalletTrNote] -> (Word64, [Entity WalletTrNote]) Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
checkTransparent x [] = (x, []) checkTransparent x [] = (x, [])
checkTransparent x (n:ns) = checkTransparent x (n:ns) =
if walletTrNoteValue (entityVal n) < x if walletTrNoteValue (entityVal n) < x
@ -1740,7 +1918,7 @@ selectUnspentNotes pool za amt = do
snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)) snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
else (0, [n]) else (0, [n])
checkSapling :: checkSapling ::
Word64 -> [Entity WalletSapNote] -> (Word64, [Entity WalletSapNote]) Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote])
checkSapling x [] = (x, []) checkSapling x [] = (x, [])
checkSapling x (n:ns) = checkSapling x (n:ns) =
if walletSapNoteValue (entityVal n) < x if walletSapNoteValue (entityVal n) < x
@ -1748,7 +1926,7 @@ selectUnspentNotes pool za amt = do
, n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns)) , n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
else (0, [n]) else (0, [n])
checkOrchard :: checkOrchard ::
Word64 -> [Entity WalletOrchNote] -> (Word64, [Entity WalletOrchNote]) Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote])
checkOrchard x [] = (x, []) checkOrchard x [] = (x, [])
checkOrchard x (n:ns) = checkOrchard x (n:ns) =
if walletOrchNoteValue (entityVal n) < x if walletOrchNoteValue (entityVal n) < x

View file

@ -15,10 +15,12 @@ import Control.Exception (try)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT) import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson import Data.Aeson
import Data.Int
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Vector as V import qualified Data.Vector as V
import Database.Esqueleto.Experimental (toSqlKey) import Database.Esqueleto.Experimental (toSqlKey)
import Servant import Servant
import Text.Read (readMaybe)
import ZcashHaskell.Types import ZcashHaskell.Types
( RpcError(..) ( RpcError(..)
, ZcashNet(..) , ZcashNet(..)
@ -28,9 +30,10 @@ import ZcashHaskell.Types
import Zenith.Core (checkBlockChain, checkZebra) import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB import Zenith.DB
( getAccounts ( getAccounts
, getAddressById
, getAddresses , getAddresses
, getWalletNotes
, getWallets , getWallets
, initDb
, initPool , initPool
, toZcashAccountAPI , toZcashAccountAPI
, toZcashAddressAPI , toZcashAddressAPI
@ -358,7 +361,23 @@ zenithServer config = getinfo :<|> handleRPC
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
ListReceived -> ListReceived ->
case parameters req of 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 -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"

View file

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

View file

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