Milestone 3: RPC server, ZIP-320 #104
4 changed files with 226 additions and 29 deletions
204
src/Zenith/DB.hs
204
src/Zenith/DB.hs
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
24
zenith.cabal
24
zenith.cabal
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue