Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

Publish Zenith beta version #80

Merged
pitmutt merged 90 commits from dev041 into master 2024-05-09 19:15:41 +00:00
Conversation 0 Commits 90 Files changed 28 +420 -159
5 changed files with 420 additions and 159 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit 52ac50e30c - Show all commits

3
app/Main.hs
View file

@ -18,7 +18,7 @@ import System.IO
import Text.Read (readMaybe) import Text.Read (readMaybe)
import ZcashHaskell.Types import ZcashHaskell.Types
import Zenith.CLI import Zenith.CLI
import Zenith.Core (testSync) import Zenith.Core (clearSync, testSync)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils import Zenith.Utils
import Zenith.Zcashd import Zenith.Zcashd
@ -222,6 +222,7 @@ main = do
(root nodeUser nodePwd) (root nodeUser nodePwd)
"cli" -> runZenithCLI myConfig "cli" -> runZenithCLI myConfig
"sync" -> testSync myConfig "sync" -> testSync myConfig
"rescan" -> clearSync myConfig
_ -> printUsage _ -> printUsage
else printUsage else printUsage

76
src/Zenith/CLI.hs
View file

@ -71,7 +71,6 @@ import Zenith.Types
( Config(..) ( Config(..)
, PhraseDB(..) , PhraseDB(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, UserTx(..)
, ZcashNetDB(..) , ZcashNetDB(..)
) )
import Zenith.Utils (displayTaz, displayZec, showAddress) import Zenith.Utils (displayTaz, displayZec, showAddress)
@ -111,7 +110,7 @@ data State = State
, _wallets :: !(L.List Name (Entity ZcashWallet)) , _wallets :: !(L.List Name (Entity ZcashWallet))
, _accounts :: !(L.List Name (Entity ZcashAccount)) , _accounts :: !(L.List Name (Entity ZcashAccount))
, _addresses :: !(L.List Name (Entity WalletAddress)) , _addresses :: !(L.List Name (Entity WalletAddress))
, _transactions :: !(L.List Name UserTx) , _transactions :: !(L.List Name (Entity UserTx))
, _msg :: !String , _msg :: !String
, _helpBox :: !Bool , _helpBox :: !Bool
, _dialogBox :: !DialogType , _dialogBox :: !DialogType
@ -196,7 +195,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, str " " , str " "
, C.hCenter $ str "Use arrows to select" , C.hCenter $ str "Use arrows to select"
] ]
listTxBox :: String -> L.List Name UserTx -> Widget Name listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
listTxBox titleLabel tx = listTxBox titleLabel tx =
C.vCenter $ C.vCenter $
vBox vBox
@ -342,14 +341,18 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
1 1
(str (str
("Date: " ++ ("Date: " ++
show (posixSecondsToUTCTime (fromInteger (ut_time tx)))) <=> show
str ("Tx ID: " ++ show (ut_txid tx)) <=> (posixSecondsToUTCTime
(fromIntegral (userTxTime $ entityVal tx)))) <=>
str ("Tx ID: " ++ show (userTxHex $ entityVal tx)) <=>
str str
("Amount: " ++ ("Amount: " ++
if st ^. network == MainNet if st ^. network == MainNet
then displayZec (ut_value tx) then displayZec
else displayTaz (ut_value tx)) <=> (fromIntegral $ userTxAmount $ entityVal tx)
txt ("Memo: " <> ut_memo tx))) else displayTaz
(fromIntegral $ userTxAmount $ entityVal tx)) <=>
txt ("Memo: " <> userTxMemo (entityVal tx))))
BlankDisplay -> emptyWidget BlankDisplay -> emptyWidget
mkInputForm :: DialogInput -> Form DialogInput e Name mkInputForm :: DialogInput -> Form DialogInput e Name
@ -395,13 +398,14 @@ listDrawAddress sel w =
walletAddressName (entityVal w) <> walletAddressName (entityVal w) <>
": " <> showAddress (walletAddressUAddress (entityVal w)) ": " <> showAddress (walletAddressUAddress (entityVal w))
listDrawTx :: Bool -> UserTx -> Widget Name listDrawTx :: Bool -> Entity UserTx -> Widget Name
listDrawTx sel tx = listDrawTx sel tx =
selStr $ selStr $
T.pack (show $ posixSecondsToUTCTime (fromInteger (ut_time tx))) <> T.pack
(show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
" " <> fmtAmt " " <> fmtAmt
where where
amt = fromIntegral (ut_value tx) / 100000000 amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000
fmtAmt = fmtAmt =
if amt > 0 if amt > 0
then "↘" <> T.pack (show amt) <> " " then "↘" <> T.pack (show amt) <> " "
@ -601,8 +605,7 @@ runZenithCLI config = do
else return [] else return []
txList <- txList <-
if not (null addrList) if not (null addrList)
then getUserTx dbFilePath =<< then getUserTx dbFilePath $ entityKey $ head addrList
getWalletTransactions dbFilePath (entityVal $ head addrList)
else return [] else return []
block <- getMaxWalletBlock dbFilePath block <- getMaxWalletBlock dbFilePath
void $ void $
@ -649,8 +652,7 @@ refreshWallet s = do
else return [] else return []
txL <- txL <-
if not (null addrL) if not (null addrL)
then getUserTx (s ^. dbPath) =<< then getUserTx (s ^. dbPath) $ entityKey $ head addrL
getWalletTransactions (s ^. dbPath) (entityVal $ head addrL)
else return [] else return []
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses) let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
@ -667,7 +669,7 @@ addNewWallet n s = do
let netName = s ^. network let netName = s ^. network
r <- r <-
saveWallet (s ^. dbPath) $ saveWallet (s ^. dbPath) $
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
case r of case r of
Nothing -> do Nothing -> do
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
@ -725,17 +727,20 @@ refreshAccount s = do
do case L.listSelectedElement aL' of do case L.listSelectedElement aL' of
Nothing -> do Nothing -> do
let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL' let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL'
case fAdd of return fAdd
Nothing -> throw $ userError "Failed to select address" Just a2 -> return $ Just a2
Just (_x, a1) -> return a1 case selAddress of
Just (_y, a2) -> return a2 Nothing ->
tList <- return $
getUserTx (s ^. dbPath) =<< s & addresses .~ aL' & msg .~ "Switched to account: " ++
getWalletTransactions (s ^. dbPath) (entityVal selAddress) T.unpack (zcashAccountName $ entityVal selAccount)
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) Just (_i, a) -> do
return $ tList <- getUserTx (s ^. dbPath) $ entityKey a
s & addresses .~ aL' & transactions .~ tL' & msg .~ "Switched to account: " ++ let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
T.unpack (zcashAccountName $ entityVal selAccount) return $
s & addresses .~ aL' & transactions .~ tL' & msg .~
"Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
refreshTxs :: State -> IO State refreshTxs :: State -> IO State
refreshTxs s = do refreshTxs s = do
@ -744,15 +749,14 @@ refreshTxs s = do
Nothing -> do Nothing -> do
let fAdd = let fAdd =
L.listSelectedElement $ L.listMoveToBeginning $ s ^. addresses L.listSelectedElement $ L.listMoveToBeginning $ s ^. addresses
case fAdd of return fAdd
Nothing -> throw $ userError "Failed to select address" Just a2 -> return $ Just a2
Just (_x, a1) -> return a1 case selAddress of
Just (_y, a2) -> return a2 Nothing -> return s
tList <- Just (_i, a) -> do
getUserTx (s ^. dbPath) =<< tList <- getUserTx (s ^. dbPath) $ entityKey a
getWalletTransactions (s ^. dbPath) (entityVal selAddress) let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) return $ s & transactions .~ tL'
return $ s & transactions .~ tL'
addNewAddress :: T.Text -> Scope -> State -> IO State addNewAddress :: T.Text -> Scope -> State -> IO State
addNewAddress n scope s = do addNewAddress n scope s = do

78
src/Zenith/Core.hs
View file

@ -195,9 +195,9 @@ findSaplingOutputs ::
Config -- ^ the configuration parameters Config -- ^ the configuration parameters
-> Int -- ^ the starting block -> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network -> ZcashNetDB -- ^ The network
-> SaplingSpendingKeyDB -- ^ The spending key to trial decrypt -> Entity ZcashAccount -- ^ The account to use
-> IO () -> IO ()
findSaplingOutputs config b znet sk = do findSaplingOutputs config b znet za = do
let dbPath = c_dbPath config let dbPath = c_dbPath config
let zebraHost = c_zebraHost config let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config let zebraPort = c_zebraPort config
@ -206,7 +206,11 @@ findSaplingOutputs config b znet sk = do
trees <- getCommitmentTrees zebraHost zebraPort (b - 1) trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = SaplingCommitmentTree $ ztiSapling trees let sT = SaplingCommitmentTree $ ztiSapling trees
decryptNotes sT zn tList decryptNotes sT zn tList
sapNotes <- getWalletSapNotes dbPath (entityKey za)
findSapSpends dbPath (entityKey za) sapNotes
where where
sk :: SaplingSpendingKeyDB
sk = zcashAccountSapSpendKey $ entityVal za
decryptNotes :: decryptNotes ::
SaplingCommitmentTree SaplingCommitmentTree
-> ZcashNet -> ZcashNet
@ -233,24 +237,31 @@ findSaplingOutputs config b znet sk = do
decryptNotes uT n txs decryptNotes uT n txs
Just dn1 -> do Just dn1 -> do
print dn1 print dn1
wId <- saveWalletTransaction (c_dbPath config) zt wId <-
saveWalletTransaction
(c_dbPath config)
(entityKey za)
zt
saveWalletSapNote saveWalletSapNote
(c_dbPath config) (c_dbPath config)
wId wId
nP nP
(fromJust noteWitness) (fromJust noteWitness)
True True
(entityKey za)
dn1 dn1
decryptNotes uT n txs decryptNotes uT n txs
Just dn0 -> do Just dn0 -> do
print dn0 print dn0
wId <- saveWalletTransaction (c_dbPath config) zt wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletSapNote saveWalletSapNote
(c_dbPath config) (c_dbPath config)
wId wId
nP nP
(fromJust noteWitness) (fromJust noteWitness)
False False
(entityKey za)
dn0 dn0
decryptNotes uT n txs decryptNotes uT n txs
decodeShOut :: decodeShOut ::
@ -278,9 +289,9 @@ findOrchardActions ::
Config -- ^ the configuration parameters Config -- ^ the configuration parameters
-> Int -- ^ the starting block -> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network -> ZcashNetDB -- ^ The network
-> OrchardSpendingKeyDB -- ^ The spending key to trial decrypt -> Entity ZcashAccount -- ^ The account to use
-> IO () -> IO ()
findOrchardActions config b znet sk = do findOrchardActions config b znet za = do
let dbPath = c_dbPath config let dbPath = c_dbPath config
let zebraHost = c_zebraHost config let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config let zebraPort = c_zebraPort config
@ -289,6 +300,8 @@ findOrchardActions config b znet sk = do
trees <- getCommitmentTrees zebraHost zebraPort (b - 1) trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = OrchardCommitmentTree $ ztiOrchard trees let sT = OrchardCommitmentTree $ ztiOrchard trees
decryptNotes sT zn tList decryptNotes sT zn tList
orchNotes <- getWalletOrchNotes dbPath (entityKey za)
findOrchSpends dbPath (entityKey za) orchNotes
where where
decryptNotes :: decryptNotes ::
OrchardCommitmentTree OrchardCommitmentTree
@ -315,26 +328,35 @@ findOrchardActions config b znet sk = do
Nothing -> decryptNotes uT n txs Nothing -> decryptNotes uT n txs
Just dn1 -> do Just dn1 -> do
print dn1 print dn1
wId <- saveWalletTransaction (c_dbPath config) zt wId <-
saveWalletTransaction
(c_dbPath config)
(entityKey za)
zt
saveWalletOrchNote saveWalletOrchNote
(c_dbPath config) (c_dbPath config)
wId wId
nP nP
(fromJust noteWitness) (fromJust noteWitness)
True True
(entityKey za)
dn1 dn1
decryptNotes uT n txs decryptNotes uT n txs
Just dn -> do Just dn -> do
print dn print dn
wId <- saveWalletTransaction (c_dbPath config) zt wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletOrchNote saveWalletOrchNote
(c_dbPath config) (c_dbPath config)
wId wId
nP nP
(fromJust noteWitness) (fromJust noteWitness)
False False
(entityKey za)
dn dn
decryptNotes uT n txs decryptNotes uT n txs
sk :: OrchardSpendingKeyDB
sk = zcashAccountOrchSpendKey $ entityVal za
decodeOrchAction :: decodeOrchAction ::
Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
decodeOrchAction scope pos o = decodeOrchAction scope pos o =
@ -359,34 +381,42 @@ syncWallet config w = do
accs <- getAccounts walletDb $ entityKey w accs <- getAccounts walletDb $ entityKey w
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
lastBlock <- getMaxWalletBlock walletDb chainTip <- getMaxBlock walletDb
let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else zcashWalletBirthdayHeight $ entityVal w else zcashWalletBirthdayHeight $ entityVal w
trNotes <- mapM (findTransparentNotes walletDb startBlock . entityVal) addrs mapM_ (findTransparentNotes walletDb startBlock) addrs
mapM_ (saveWalletTrNote walletDb External) $ concat trNotes mapM_ (findTransparentNotes walletDb startBlock) intAddrs
trChNotes <- mapM_ (findTransparentSpends walletDb . entityKey) accs
mapM (findTransparentNotes walletDb startBlock . entityVal) intAddrs
mapM_ (saveWalletTrNote walletDb Internal) $ concat trChNotes
sapNotes <- sapNotes <-
mapM mapM
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) . (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
zcashAccountSapSpendKey . entityVal)
accs accs
orchNotes <- orchNotes <-
mapM mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w) . (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
zcashAccountOrchSpendKey . entityVal)
accs accs
updateWalletSync walletDb chainTip (entityKey w)
mapM_ (getWalletTransactions walletDb) addrs
return "Testing" return "Testing"
testSync :: Config -> IO () testSync :: Config -> IO ()
testSync config = do testSync config = do
let dbPath = c_dbPath config let dbPath = c_dbPath config
w <- runSqlite dbPath $ selectFirst [ZcashWalletName ==. "Main"] [] _ <- initDb dbPath
case w of w <- getWallets dbPath TestNet
Nothing -> print "No wallet" r <- mapM (syncWallet config) w
Just w' -> do print r
r <- syncWallet config w'
print r clearSync :: Config -> IO ()
clearSync config = do
let dbPath = c_dbPath config
_ <- initDb dbPath
_ <- clearWalletTransactions dbPath
w <- getWallets dbPath TestNet
mapM_ (updateWalletSync dbPath 0 . entityKey) w
w' <- getWallets dbPath TestNet
r <- mapM (syncWallet config) w'
print r

415
src/Zenith/DB.hs
View file

@ -18,11 +18,13 @@
module Zenith.DB where module Zenith.DB where
import Control.Monad (when) import Control.Exception (throwIO)
import Control.Monad (forM_, when)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Data.Bifunctor import Data.Bifunctor
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString import Data.HexString
import Data.List (group, sort)
import Data.Maybe (fromJust, isJust) import Data.Maybe (fromJust, isJust)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
@ -70,7 +72,6 @@ import Zenith.Types
, ScopeDB(..) , ScopeDB(..)
, TransparentSpendingKeyDB , TransparentSpendingKeyDB
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, UserTx(..)
, ZcashNetDB(..) , ZcashNetDB(..)
) )
@ -82,6 +83,7 @@ share
network ZcashNetDB network ZcashNetDB
seedPhrase PhraseDB seedPhrase PhraseDB
birthdayHeight Int birthdayHeight Int
lastSync Int default=0
UniqueWallet name network UniqueWallet name network
deriving Show Eq deriving Show Eq
ZcashAccount ZcashAccount
@ -105,26 +107,39 @@ share
deriving Show Eq deriving Show Eq
WalletTransaction WalletTransaction
txId HexStringDB txId HexStringDB
accId ZcashAccountId
block Int block Int
conf Int conf Int
time Int time Int
UniqueWTx txId UniqueWTx txId accId
deriving Show Eq
UserTx
hex HexStringDB
address WalletAddressId
time Int
amount Int
memo T.Text
UniqueUTx hex address
deriving Show Eq deriving Show Eq
WalletTrNote WalletTrNote
tx WalletTransactionId tx WalletTransactionId
accId ZcashAccountId
value Word64 value Word64
spent Bool spent Bool
script BS.ByteString script BS.ByteString
change Bool change Bool
position Word64
UniqueTNote tx script UniqueTNote tx script
deriving Show Eq deriving Show Eq
WalletTrSpend WalletTrSpend
tx WalletTransactionId tx WalletTransactionId
note WalletTrNoteId note WalletTrNoteId
accId ZcashAccountId
value Word64 value Word64
deriving Show Eq deriving Show Eq
WalletSapNote WalletSapNote
tx WalletTransactionId tx WalletTransactionId
accId ZcashAccountId
value Word64 value Word64
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
@ -138,10 +153,12 @@ share
WalletSapSpend WalletSapSpend
tx WalletTransactionId tx WalletTransactionId
note WalletSapNoteId note WalletSapNoteId
accId ZcashAccountId
value Word64 value Word64
deriving Show Eq deriving Show Eq
WalletOrchNote WalletOrchNote
tx WalletTransactionId tx WalletTransactionId
accId ZcashAccountId
value Word64 value Word64
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
@ -155,6 +172,7 @@ share
WalletOrchSpend WalletOrchSpend
tx WalletTransactionId tx WalletTransactionId
note WalletOrchNoteId note WalletOrchNoteId
accId ZcashAccountId
value Word64 value Word64
deriving Show Eq deriving Show Eq
ZcashTransaction ZcashTransaction
@ -174,9 +192,9 @@ share
TransparentSpend TransparentSpend
tx ZcashTransactionId tx ZcashTransactionId
outPointHash HexStringDB outPointHash HexStringDB
outPointIndex Int outPointIndex Word64
script BS.ByteString script BS.ByteString
seq Int seq Word64
position Int position Int
UniqueTSPos tx position UniqueTSPos tx position
deriving Show Eq deriving Show Eq
@ -225,6 +243,13 @@ initDb ::
initDb dbName = do initDb dbName = do
PS.runSqlite dbName $ do runMigration migrateAll PS.runSqlite dbName $ do runMigration migrateAll
-- | Upgrade the database
upgradeDb ::
T.Text -- ^ database path
-> IO ()
upgradeDb dbName = do
PS.runSqlite dbName $ do runMigrationUnsafe migrateAll
-- | Get existing wallets from database -- | Get existing wallets from database
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet] getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
getWallets dbFp n = getWallets dbFp n =
@ -241,6 +266,14 @@ saveWallet ::
-> IO (Maybe (Entity ZcashWallet)) -> IO (Maybe (Entity ZcashWallet))
saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
-- | Update the last sync block for the wallet
updateWalletSync :: T.Text -> Int -> ZcashWalletId -> IO ()
updateWalletSync dbPath b i = do
PS.runSqlite dbPath $ do
update $ \w -> do
set w [ZcashWalletLastSync =. val b]
where_ $ w ^. ZcashWalletId ==. val i
-- | Returns a list of accounts associated with the given wallet -- | Returns a list of accounts associated with the given wallet
getAccounts :: getAccounts ::
T.Text -- ^ The database path T.Text -- ^ The database path
@ -473,14 +506,18 @@ getMaxWalletBlock dbPath = do
-- | Save a @WalletTransaction@ -- | Save a @WalletTransaction@
saveWalletTransaction :: saveWalletTransaction ::
T.Text -> Entity ZcashTransaction -> IO WalletTransactionId T.Text
saveWalletTransaction dbPath zt = do -> ZcashAccountId
-> Entity ZcashTransaction
-> IO WalletTransactionId
saveWalletTransaction dbPath za zt = do
let zT' = entityVal zt let zT' = entityVal zt
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
t <- t <-
upsert upsert
(WalletTransaction (WalletTransaction
(zcashTransactionTxId zT') (zcashTransactionTxId zT')
za
(zcashTransactionBlock zT') (zcashTransactionBlock zT')
(zcashTransactionConf zT') (zcashTransactionConf zT')
(zcashTransactionTime zT')) (zcashTransactionTime zT'))
@ -494,14 +531,16 @@ saveWalletSapNote ::
-> Integer -- ^ note position -> Integer -- ^ note position
-> SaplingWitness -- ^ the Sapling incremental witness -> SaplingWitness -- ^ the Sapling incremental witness
-> Bool -- ^ change flag -> Bool -- ^ change flag
-> ZcashAccountId
-> DecodedNote -- The decoded Sapling note -> DecodedNote -- The decoded Sapling note
-> IO () -> IO ()
saveWalletSapNote dbPath wId pos wit ch dn = do saveWalletSapNote dbPath wId pos wit ch za dn = do
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
_ <- _ <-
upsert upsert
(WalletSapNote (WalletSapNote
wId wId
za
(fromIntegral $ a_value dn) (fromIntegral $ a_value dn)
(a_recipient dn) (a_recipient dn)
(T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn) (T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
@ -520,14 +559,16 @@ saveWalletOrchNote ::
-> Integer -> Integer
-> OrchardWitness -> OrchardWitness
-> Bool -> Bool
-> ZcashAccountId
-> DecodedNote -> DecodedNote
-> IO () -> IO ()
saveWalletOrchNote dbPath wId pos wit ch dn = do saveWalletOrchNote dbPath wId pos wit ch za dn = do
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
_ <- _ <-
upsert upsert
(WalletOrchNote (WalletOrchNote
wId wId
za
(fromIntegral $ a_value dn) (fromIntegral $ a_value dn)
(a_recipient dn) (a_recipient dn)
(T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn) (T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
@ -543,10 +584,10 @@ saveWalletOrchNote dbPath wId pos wit ch dn = do
findTransparentNotes :: findTransparentNotes ::
T.Text -- ^ The database path T.Text -- ^ The database path
-> Int -- ^ Starting block -> Int -- ^ Starting block
-> WalletAddress -> Entity WalletAddress
-> IO [(Entity ZcashTransaction, Entity TransparentNote)] -> IO ()
findTransparentNotes dbPath b t = do findTransparentNotes dbPath b t = do
let tReceiver = t_rec =<< readUnifiedAddressDB t let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
case tReceiver of case tReceiver of
Just tR -> do Just tR -> do
let s = let s =
@ -555,7 +596,8 @@ findTransparentNotes dbPath b t = do
, (toBytes . tr_bytes) tR , (toBytes . tr_bytes) tR
, BS.pack [0x88, 0xAC] , BS.pack [0x88, 0xAC]
] ]
PS.runSqlite dbPath $ tN <-
PS.runSqlite dbPath $
select $ do select $ do
(txs :& tNotes) <- (txs :& tNotes) <-
from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on` from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
@ -564,21 +606,29 @@ findTransparentNotes dbPath b t = do
where_ (txs ^. ZcashTransactionBlock >. val b) where_ (txs ^. ZcashTransactionBlock >. val b)
where_ (tNotes ^. TransparentNoteScript ==. val s) where_ (tNotes ^. TransparentNoteScript ==. val s)
pure (txs, tNotes) pure (txs, tNotes)
Nothing -> return [] mapM_
(saveWalletTrNote
dbPath
(getScope $ walletAddressScope $ entityVal t)
(walletAddressAccId $ entityVal t))
tN
Nothing -> return ()
-- | Add the transparent notes to the wallet -- | Add the transparent notes to the wallet
saveWalletTrNote :: saveWalletTrNote ::
T.Text -- ^ the database path T.Text -- ^ the database path
-> Scope -> Scope
-> ZcashAccountId
-> (Entity ZcashTransaction, Entity TransparentNote) -> (Entity ZcashTransaction, Entity TransparentNote)
-> IO () -> IO ()
saveWalletTrNote dbPath ch (zt, tn) = do saveWalletTrNote dbPath ch za (zt, tn) = do
let zT' = entityVal zt let zT' = entityVal zt
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
t <- t <-
upsert upsert
(WalletTransaction (WalletTransaction
(zcashTransactionTxId zT') (zcashTransactionTxId zT')
za
(zcashTransactionBlock zT') (zcashTransactionBlock zT')
(zcashTransactionConf zT') (zcashTransactionConf zT')
(zcashTransactionTime zT')) (zcashTransactionTime zT'))
@ -586,10 +636,12 @@ saveWalletTrNote dbPath ch (zt, tn) = do
insert_ $ insert_ $
WalletTrNote WalletTrNote
(entityKey t) (entityKey t)
za
(transparentNoteValue $ entityVal tn) (transparentNoteValue $ entityVal tn)
False False
(transparentNoteScript $ entityVal tn) (transparentNoteScript $ entityVal tn)
(ch == Internal) (ch == Internal)
(fromIntegral $ transparentNotePosition $ entityVal tn)
-- | Save a Sapling note to the wallet database -- | Save a Sapling note to the wallet database
saveSapNote :: T.Text -> WalletSapNote -> IO () saveSapNote :: T.Text -> WalletSapNote -> IO ()
@ -634,12 +686,15 @@ getOrchardActions dbPath b =
-- | Get the transactions belonging to the given address -- | Get the transactions belonging to the given address
getWalletTransactions :: getWalletTransactions ::
T.Text -- ^ database path T.Text -- ^ database path
-> WalletAddress -> Entity WalletAddress
-> IO [WalletTransactionId] -> IO ()
getWalletTransactions dbPath w = do getWalletTransactions dbPath w = do
let tReceiver = t_rec =<< readUnifiedAddressDB w let w' = entityVal w
let sReceiver = s_rec =<< readUnifiedAddressDB w chgAddr <- getInternalAddresses dbPath $ walletAddressAccId $ entityVal w
let oReceiver = o_rec =<< readUnifiedAddressDB w let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
let tReceiver = t_rec =<< readUnifiedAddressDB w'
let sReceiver = s_rec =<< readUnifiedAddressDB w'
let oReceiver = o_rec =<< readUnifiedAddressDB w'
trNotes <- trNotes <-
case tReceiver of case tReceiver of
Nothing -> return [] Nothing -> return []
@ -655,6 +710,28 @@ getWalletTransactions dbPath w = do
tnotes <- from $ table @WalletTrNote tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s) where_ (tnotes ^. WalletTrNoteScript ==. val s)
pure tnotes pure tnotes
trChgNotes <-
case ctReceiver of
Nothing -> return []
Just tR -> do
let s1 =
BS.concat
[ BS.pack [0x76, 0xA9, 0x14]
, (toBytes . tr_bytes) tR
, BS.pack [0x88, 0xAC]
]
PS.runSqlite dbPath $ do
select $ do
tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s1)
pure tnotes
trSpends <-
PS.runSqlite dbPath $ do
select $ do
trSpends <- from $ table @WalletTrSpend
where_
(trSpends ^. WalletTrSpendNote `in_` valList (map entityKey trNotes))
pure trSpends
sapNotes <- sapNotes <-
case sReceiver of case sReceiver of
Nothing -> return [] Nothing -> return []
@ -664,6 +741,14 @@ getWalletTransactions dbPath w = do
snotes <- from $ table @WalletSapNote snotes <- from $ table @WalletSapNote
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR)) where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
pure snotes pure snotes
sapSpends <-
PS.runSqlite dbPath $ do
select $ do
sapSpends <- from $ table @WalletSapSpend
where_
(sapSpends ^. WalletSapSpendNote `in_`
valList (map entityKey sapNotes))
pure sapSpends
orchNotes <- orchNotes <-
case oReceiver of case oReceiver of
Nothing -> return [] Nothing -> return []
@ -673,78 +758,185 @@ getWalletTransactions dbPath w = do
onotes <- from $ table @WalletOrchNote onotes <- from $ table @WalletOrchNote
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR)) where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
pure onotes pure onotes
let addrTx = orchSpends <-
map (walletTrNoteTx . entityVal) trNotes <> PS.runSqlite dbPath $ do
map (walletSapNoteTx . entityVal) sapNotes <> select $ do
map (walletOrchNoteTx . entityVal) orchNotes orchSpends <- from $ table @WalletOrchSpend
return addrTx where_
(orchSpends ^. WalletOrchSpendNote `in_`
getUserTx :: T.Text -> [WalletTransactionId] -> IO [UserTx] valList (map entityKey orchNotes))
getUserTx dbPath addrTx = do pure orchSpends
mapM convertUserTx addrTx mapM_ addTr trNotes
mapM_ addTr trChgNotes
mapM_ addSap sapNotes
mapM_ addOrch orchNotes
mapM_ subTSpend trSpends
mapM_ subSSpend sapSpends
mapM_ subOSpend orchSpends
where where
convertUserTx :: WalletTransactionId -> IO UserTx addTr :: Entity WalletTrNote -> IO ()
convertUserTx tId = do addTr n =
upsertUserTx
(walletTrNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletTrNoteValue $ entityVal n)
""
addSap :: Entity WalletSapNote -> IO ()
addSap n =
upsertUserTx
(walletSapNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletSapNoteValue $ entityVal n)
(walletSapNoteMemo $ entityVal n)
addOrch :: Entity WalletOrchNote -> IO ()
addOrch n =
upsertUserTx
(walletOrchNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletOrchNoteValue $ entityVal n)
(walletOrchNoteMemo $ entityVal n)
subTSpend :: Entity WalletTrSpend -> IO ()
subTSpend n =
upsertUserTx
(walletTrSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletTrSpendValue $ entityVal n))
""
subSSpend :: Entity WalletSapSpend -> IO ()
subSSpend n =
upsertUserTx
(walletSapSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletSapSpendValue $ entityVal n))
""
subOSpend :: Entity WalletOrchSpend -> IO ()
subOSpend n =
upsertUserTx
(walletOrchSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletOrchSpendValue $ entityVal n))
""
upsertUserTx ::
WalletTransactionId -> WalletAddressId -> Int -> T.Text -> IO ()
upsertUserTx tId wId amt memo = do
tr <- tr <-
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
select $ do select $ do
tx <- from $ table @WalletTransaction tx <- from $ table @WalletTransaction
where_ (tx ^. WalletTransactionId ==. val tId) where_ (tx ^. WalletTransactionId ==. val tId)
pure tx pure tx
trNotes <- existingUtx <-
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
select $ do selectOne $ do
trNotes <- from $ table @WalletTrNote ut <- from $ table @UserTx
where_ (trNotes ^. WalletTrNoteTx ==. val tId) where_
pure trNotes (ut ^. UserTxHex ==.
trSpends <- val (walletTransactionTxId $ entityVal $ head tr))
where_ (ut ^. UserTxAddress ==. val wId)
pure ut
case existingUtx of
Nothing -> do
_ <-
PS.runSqlite dbPath $ do
upsert
(UserTx
(walletTransactionTxId $ entityVal $ head tr)
wId
(walletTransactionTime $ entityVal $ head tr)
amt
memo)
[]
return ()
Just uTx -> do
_ <-
PS.runSqlite dbPath $ do
upsert
(UserTx
(walletTransactionTxId $ entityVal $ head tr)
wId
(walletTransactionTime $ entityVal $ head tr)
(amt + userTxAmount (entityVal uTx))
(memo <> " " <> userTxMemo (entityVal uTx)))
[]
return ()
getUserTx :: T.Text -> WalletAddressId -> IO [Entity UserTx]
getUserTx dbPath aId = do
PS.runSqlite dbPath $ do
select $ do
uTxs <- from $ table @UserTx
where_ (uTxs ^. UserTxAddress ==. val aId)
return uTxs
-- | Get wallet transparent notes by account
getWalletTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote]
getWalletTrNotes dbPath za = do
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletTrNote
where_ (n ^. WalletTrNoteAccId ==. val za)
pure n
-- | find Transparent spends
findTransparentSpends :: T.Text -> ZcashAccountId -> IO ()
findTransparentSpends dbPath za = do
notes <- getWalletTrNotes dbPath za
mapM_ findOneTrSpend notes
where
findOneTrSpend :: Entity WalletTrNote -> IO ()
findOneTrSpend n = do
mReverseTxId <-
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
select $ do selectOne $ do
trSpends <- from $ table @WalletTrSpend wtx <- from $ table @WalletTransaction
where_ (trSpends ^. WalletTrSpendTx ==. val tId) where_
pure trSpends (wtx ^. WalletTransactionId ==. val (walletTrNoteTx $ entityVal n))
sapNotes <- pure $ wtx ^. WalletTransactionTxId
PS.runSqlite dbPath $ do case mReverseTxId of
select $ do Nothing -> throwIO $ userError "failed to get tx ID"
sapNotes <- from $ table @WalletSapNote Just (Value reverseTxId) -> do
where_ (sapNotes ^. WalletSapNoteTx ==. val tId) s <-
pure sapNotes PS.runSqlite dbPath $ do
sapSpends <- select $ do
PS.runSqlite dbPath $ do (tx :& trSpends) <-
select $ do from $
sapSpends <- from $ table @WalletSapSpend table @ZcashTransaction `innerJoin` table @TransparentSpend `on`
where_ (sapSpends ^. WalletSapSpendTx ==. val tId) (\(tx :& trSpends) ->
pure sapSpends tx ^. ZcashTransactionId ==. trSpends ^. TransparentSpendTx)
orchNotes <- where_
PS.runSqlite dbPath $ do (trSpends ^. TransparentSpendOutPointHash ==. val reverseTxId)
select $ do where_
orchNotes <- from $ table @WalletOrchNote (trSpends ^. TransparentSpendOutPointIndex ==.
where_ (orchNotes ^. WalletOrchNoteTx ==. val tId) val (walletTrNotePosition $ entityVal n))
pure orchNotes pure (tx, trSpends)
orchSpends <- if null s
PS.runSqlite dbPath $ do then return ()
select $ do else do
orchSpends <- from $ table @WalletOrchSpend PS.runSqlite dbPath $ do
where_ (orchSpends ^. WalletOrchSpendTx ==. val tId) _ <-
pure orchSpends update $ \w -> do
return $ set w [WalletTrNoteSpent =. val True]
UserTx where_ $ w ^. WalletTrNoteId ==. val (entityKey n)
(getHex $ walletTransactionTxId $ entityVal $ head tr) t' <- upsertWalTx (entityVal $ fst $ head s) za
(fromIntegral $ walletTransactionTime $ entityVal $ head tr) insert_ $
(sum (map (fromIntegral . walletTrNoteValue . entityVal) trNotes) + WalletTrSpend
sum (map (fromIntegral . walletSapNoteValue . entityVal) sapNotes) + (entityKey t')
sum (map (fromIntegral . walletOrchNoteValue . entityVal) orchNotes) - (entityKey n)
sum (map (fromIntegral . walletTrSpendValue . entityVal) trSpends) - za
sum (map (fromIntegral . walletSapSpendValue . entityVal) sapSpends) - (walletTrNoteValue $ entityVal n)
sum
(map (fromIntegral . walletOrchSpendValue . entityVal) orchSpends)) getWalletSapNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletSapNote]
(T.concat (map (walletSapNoteMemo . entityVal) sapNotes) <> getWalletSapNotes dbPath za = do
T.concat (map (walletOrchNoteMemo . entityVal) orchNotes)) PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletSapNote
where_ (n ^. WalletSapNoteAccId ==. val za)
pure n
-- | Sapling DAG-aware spend tracking -- | Sapling DAG-aware spend tracking
findSapSpends :: T.Text -> SaplingSpendingKey -> [Entity WalletSapNote] -> IO () findSapSpends :: T.Text -> ZcashAccountId -> [Entity WalletSapNote] -> IO ()
findSapSpends _ _ [] = return () findSapSpends _ _ [] = return ()
findSapSpends dbPath sk (n:notes) = do findSapSpends dbPath za (n:notes) = do
s <- s <-
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
select $ do select $ do
@ -757,25 +949,33 @@ findSapSpends dbPath sk (n:notes) = do
val (walletSapNoteNullifier (entityVal n))) val (walletSapNoteNullifier (entityVal n)))
pure (tx, sapSpends) pure (tx, sapSpends)
if null s if null s
then findSapSpends dbPath sk notes then findSapSpends dbPath za notes
else do else do
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
_ <- _ <-
update $ \w -> do update $ \w -> do
set w [WalletSapNoteSpent =. val True] set w [WalletSapNoteSpent =. val True]
where_ $ w ^. WalletSapNoteId ==. val (entityKey n) where_ $ w ^. WalletSapNoteId ==. val (entityKey n)
t' <- upsertWalTx $ entityVal $ fst $ head s t' <- upsertWalTx (entityVal $ fst $ head s) za
insert_ $ insert_ $
WalletSapSpend WalletSapSpend
(entityKey t') (entityKey t')
(entityKey n) (entityKey n)
za
(walletSapNoteValue $ entityVal n) (walletSapNoteValue $ entityVal n)
findSapSpends dbPath sk notes findSapSpends dbPath za notes
findOrchSpends :: getWalletOrchNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote]
T.Text -> OrchardSpendingKey -> [Entity WalletOrchNote] -> IO () getWalletOrchNotes dbPath za = do
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletOrchNote
where_ (n ^. WalletOrchNoteAccId ==. val za)
pure n
findOrchSpends :: T.Text -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
findOrchSpends _ _ [] = return () findOrchSpends _ _ [] = return ()
findOrchSpends dbPath sk (n:notes) = do findOrchSpends dbPath za (n:notes) = do
s <- s <-
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
select $ do select $ do
@ -788,33 +988,66 @@ findOrchSpends dbPath sk (n:notes) = do
val (walletOrchNoteNullifier (entityVal n))) val (walletOrchNoteNullifier (entityVal n)))
pure (tx, orchSpends) pure (tx, orchSpends)
if null s if null s
then findOrchSpends dbPath sk notes then findOrchSpends dbPath za notes
else do else do
PS.runSqlite dbPath $ do PS.runSqlite dbPath $ do
_ <- _ <-
update $ \w -> do update $ \w -> do
set w [WalletOrchNoteSpent =. val True] set w [WalletOrchNoteSpent =. val True]
where_ $ w ^. WalletOrchNoteId ==. val (entityKey n) where_ $ w ^. WalletOrchNoteId ==. val (entityKey n)
t' <- upsertWalTx $ entityVal $ fst $ head s t' <- upsertWalTx (entityVal $ fst $ head s) za
insert_ $ insert_ $
WalletOrchSpend WalletOrchSpend
(entityKey t') (entityKey t')
(entityKey n) (entityKey n)
za
(walletOrchNoteValue $ entityVal n) (walletOrchNoteValue $ entityVal n)
findOrchSpends dbPath sk notes findOrchSpends dbPath za notes
upsertWalTx :: upsertWalTx ::
MonadIO m => ZcashTransaction -> SqlPersistT m (Entity WalletTransaction) MonadIO m
upsertWalTx zt = => ZcashTransaction
-> ZcashAccountId
-> SqlPersistT m (Entity WalletTransaction)
upsertWalTx zt za =
upsert upsert
(WalletTransaction (WalletTransaction
(zcashTransactionTxId zt) (zcashTransactionTxId zt)
za
(zcashTransactionBlock zt) (zcashTransactionBlock zt)
(zcashTransactionConf zt) (zcashTransactionConf zt)
(zcashTransactionTime zt)) (zcashTransactionTime zt))
[] []
clearWalletTransactions :: T.Text -> IO ()
clearWalletTransactions dbPath = do
PS.runSqlite dbPath $ do
delete $ do
_ <- from $ table @WalletOrchNote
return ()
delete $ do
_ <- from $ table @WalletOrchSpend
return ()
delete $ do
_ <- from $ table @WalletSapNote
return ()
delete $ do
_ <- from $ table @WalletSapSpend
return ()
delete $ do
_ <- from $ table @WalletTrNote
return ()
delete $ do
_ <- from $ table @WalletTrSpend
return ()
delete $ do
_ <- from $ table @WalletTransaction
return ()
-- | Helper function to extract a Unified Address from the database -- | Helper function to extract a Unified Address from the database
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
readUnifiedAddressDB = readUnifiedAddressDB =
isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress
rmdups :: Ord a => [a] -> [a]
rmdups = map head . group . sort

7
src/Zenith/Types.hs
View file

@ -30,13 +30,6 @@ import ZcashHaskell.Types
) )
-- * UI -- * UI
data UserTx = UserTx
{ ut_txid :: !HexString
, ut_time :: !Integer
, ut_value :: !Integer
, ut_memo :: !T.Text
} deriving (Eq, Show, Read)
-- * Database field type wrappers -- * Database field type wrappers
newtype HexStringDB = HexStringDB newtype HexStringDB = HexStringDB
{ getHex :: HexString { getHex :: HexString