Compare commits

..

9 commits

Author SHA1 Message Date
f1daf576cc
feat: shield notes by address 2024-10-10 09:56:04 -05:00
2f3362e900
feat: remove debug logging 2024-10-10 09:05:10 -05:00
935ad1d691
fix: correct sorting of user transactions 2024-10-10 09:03:26 -05:00
c4a879b09b
Merge branch 'rvv001' into rav001 2024-10-08 10:07:22 -05:00
213afdadd9
feat(core): shielding and deshielding 2024-10-08 10:01:55 -05:00
e02551c9ff rvv001 - Shield / Deshield form
Fields to display Total transparent funts and total Shielded Funds
	 added.
	 A funtion to update the latest total values has to be included
2024-10-07 19:47:28 -04:00
cf2f77e510 rvv001 -TUI - Form to process Shielding and De-Shielding zec has been implemented
The functionality to do the process is pending.
2024-10-04 21:01:13 -04:00
25b6a097c7 rvv001 - Address Validation for PrivacyPolicy = Low
Transparent, Sapling, Orchard -> Accepted
	    Exchange -> rejected
2024-10-02 20:29:51 -04:00
398f4f1dcf rvv001 - Privacy Policy control addedin TUI's send transaction form
This feature is similar to GUI's implementation.
2024-10-01 20:47:45 -04:00
8 changed files with 495 additions and 63 deletions

View file

@ -66,6 +66,7 @@ import Control.Monad (forever, unless, void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
( LoggingT
, NoLoggingT
, logDebugN
, runFileLoggingT
, runNoLoggingT
@ -88,7 +89,11 @@ import System.Hclip
import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Orchard
( getSaplingFromUA
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
@ -100,7 +105,10 @@ import Zenith.Types
, HexStringDB(..)
, PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ShieldDeshieldOp(..)
, UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..)
, ZenithStatus(..)
)
@ -108,6 +116,7 @@ import Zenith.Utils
( displayTaz
, displayZec
, isRecipientValid
, isRecipientValidGUI
, jsonNumber
, parseAddressUA
, showAddress
@ -132,6 +141,10 @@ data Name
| PrivacyLowField
| PrivacyMediumField
| PrivacyFullField
| ShieldField
| DeshieldField
| TotalTranspField
| TotalShieldedField
deriving (Eq, Show, Ord)
data DialogInput = DialogInput
@ -156,6 +169,15 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry
data ShDshEntry = ShDshEntry
{ _totalTransparent :: !Float
, _totalShielded :: !Float
, _shieldOp :: !ShieldDeshieldOp
, _shAmt :: !Float
} deriving (Show)
makeLenses ''ShDshEntry
data DialogType
= WName
| AName
@ -168,6 +190,7 @@ data DialogType
| AdrBookForm
| AdrBookUpdForm
| AdrBookDelForm
| ShieldDeshieldForm
data DisplayType
= AddrDisplay
@ -216,6 +239,7 @@ data State = State
, _abCurAdrs :: !T.Text -- used for address book CRUD operations
, _sentTx :: !(Maybe HexString)
, _unconfBalance :: !Integer
, _shdshForm :: !(Form ShDshEntry () Name)
}
makeLenses ''State
@ -263,17 +287,23 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(C.hCenter
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
C.hCenter
(hBox
[ capCommand "W" "allets"
, capCommand "A" "ccounts"
, capCommand "V" "iew address"
, capCommand "S" "end Tx"
, capCommand2 "Address " "B" "ook"
, capCommand "Q" "uit"
, capCommand "?" " Help"
, str $ show (st ^. timer)
])
(vBox
[ C.hCenter
(hBox
[ capCommand "W" "allets"
, capCommand "A" "ccounts"
, capCommand "V" "iew address"
, capCommand3 "" "S" "end Tx"
])
, C.hCenter
(hBox
[ capCommand2 "Address " "B" "ook"
, capCommand2 "Shield/" "D" "eshield"
, capCommand "Q" "uit"
, capCommand "?" " Help"
, str $ show (st ^. timer)
])
])
listBox :: Show e => String -> L.List Name e -> Widget Name
listBox titleLabel l =
C.vCenter $
@ -339,7 +369,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
else emptyWidget
where
keyList =
map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"]
map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "d", "q"]
actionList =
map
(hLimit 40 . str)
@ -350,6 +380,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, "View address"
, "Send Tx"
, "Address Book"
, "Shield/De-Shield"
, "Quit"
]
inputDialog :: State -> Widget Name
@ -396,6 +427,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(renderForm (st ^. txForm) <=>
C.hCenter
(hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"]))
ShieldDeshieldForm ->
D.renderDialog
(D.dialog (Just (str " Shield / De-Shield ")) Nothing 50)
(renderForm (st ^. shdshForm) <=>
C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
Blank -> emptyWidget
-- Address Book List
AdrBook ->
@ -639,6 +676,34 @@ mkSendForm bal =
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
mkshieldDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
mkshieldDeshieldForm bal =
newForm
[ label "Total Transp. : " @@=
editShowableFieldWithValidate
totalTransparent
TotalTranspField
(isAmountValid bal)
, label "Total Shielded : " @@=
editShowableFieldWithValidate
totalShielded
TotalShieldedField
(isAmountValid bal)
, label "Select :" @@=
radioField
shieldOp
[ (Shield, ShieldField, "Shield")
, (Deshield, DeshieldField, "De-Shield")
]
, label "Amount: " @@=
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
]
where
isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name
mkNewABForm =
newForm
@ -747,7 +812,7 @@ scanZebra ::
-> Int
-> BC.BChan Tick
-> ZcashNet
-> LoggingT IO ()
-> NoLoggingT IO ()
scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbP
@ -779,7 +844,7 @@ scanZebra dbP zHost zPort b eChan znet = do
_ <- liftIO $ startSync pool
mapM_ (liftIO . processBlock pool step) bList
confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
IO
(Either IOError ())
case confUp of
@ -874,7 +939,7 @@ appEvent (BT.AppEvent t) = do
Just (_k, w) -> return w
_ <-
liftIO $
runFileLoggingT "zenith.log" $
runNoLoggingT $
syncWallet
(Config
(s ^. dbPath)
@ -902,6 +967,7 @@ appEvent (BT.AppEvent t) = do
AdrBookForm -> return ()
AdrBookUpdForm -> return ()
AdrBookDelForm -> return ()
ShieldDeshieldForm -> return ()
Blank -> do
if s ^. timer == 90
then do
@ -911,7 +977,7 @@ appEvent (BT.AppEvent t) = do
_ <-
liftIO $
forkIO $
runFileLoggingT "zenith.log" $
runNoLoggingT $
scanZebra
(s ^. dbPath)
(s ^. zebraHost)
@ -1135,6 +1201,7 @@ appEvent (BT.VtyEvent e) = do
(fs1 ^. sendAmt)
(fs1 ^. sendTo)
(fs1 ^. sendMemo)
(fs1 ^. policyField)
BT.modify $ set msg "Preparing transaction..."
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
@ -1148,8 +1215,15 @@ appEvent (BT.VtyEvent e) = do
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. sendTo))
(isRecipientValidGUI
(fs ^. policyField)
(fs ^. sendTo))
RecField
ShieldDeshieldForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
ev ->
BT.zoom shdshForm $ do handleFormEvent (BT.VtyEvent ev)
AdrBook -> do
case e of
V.EvKey (V.KChar 'x') [] ->
@ -1167,7 +1241,7 @@ appEvent (BT.VtyEvent e) = do
"Address copied to Clipboard from >>\n" ++
T.unpack (addressBookAbdescrip (entityVal a))
BT.modify $ set displayBox MsgDisplay
_ -> do
_any -> do
BT.modify $
set msg "Error while copying the address!!"
BT.modify $ set displayBox MsgDisplay
@ -1359,6 +1433,22 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set dialogBox SendTx
V.EvKey (V.KChar 'b') [] ->
BT.modify $ set dialogBox AdrBook
V.EvKey (V.KChar 'd') [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selAcc <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. accounts
case fAcc of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
c <- liftIO $ getPoolBalance pool $ entityKey selAcc
BT.modify $ set dialogBox ShieldDeshieldForm
ev ->
case r of
Just AList ->
@ -1373,6 +1463,8 @@ appEvent (BT.VtyEvent e) = do
printMsg s = BT.modify $ updateMsg s
updateMsg :: String -> State -> State
updateMsg = set msg
-- fs <- BT.gets formState
-- ev -> BT.zoom shdshForm $ L.handleListEvent ev
appEvent _ = return ()
theMap :: A.AttrMap
@ -1497,6 +1589,7 @@ runZenithTUI config = do
""
Nothing
uBal
(mkshieldDeshieldForm 0 (ShDshEntry 0 0 Shield 0.0))
Left _e -> do
print $
"No Zebra node available on port " <>
@ -1710,15 +1803,30 @@ sendTransaction ::
-> Float
-> T.Text
-> T.Text
-> PrivacyPolicy
-> IO ()
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
BC.writeBChan chan $ TickMsg "Preparing transaction..."
case parseAddressUA ua znet of
case parseAddress (E.encodeUtf8 ua) of
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do
res <-
runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo
runNoLoggingT $
prepareTxV2
pool
zHost
zPort
znet
accId
bl
[ ProposedNote
(ValidAddressAPI outUA)
amt
(if memo == ""
then Nothing
else Just memo)
]
policy
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e

View file

@ -727,6 +727,123 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
getHex $ walletOrchNoteWitness $ entityVal $ head notes
else Nothing
deshieldNotes ::
ConnectionPool
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> ProposedNote
-> NoLoggingT IO (Either TxError HexString)
deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
bal <- liftIO $ getShieldedBalance pool za
let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8)
if bal > (20000 + zats)
then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low
else return $ Left InsufficientFunds
shieldTransparentNotes ::
ConnectionPool
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> NoLoggingT IO [Either TxError HexString]
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
accRead <- liftIO $ getAccountById pool za
logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of
Nothing -> do
logErrorN "Can't find Account"
return [Left ZHError]
Just acc -> do
trNotes' <- liftIO $ getWalletUnspentTrNotes pool za
dRecvs <- liftIO $ getReceivers pool trNotes'
let fNotes =
map
(\x ->
filter (\y -> walletTrNoteAddress (entityVal y) == x) trNotes')
dRecvs
forM fNotes $ \trNotes -> do
let noteTotal = getTotalAmount (trNotes, [], [])
let fee = calculateTxFee (trNotes, [], []) 4
tSpends <-
liftIO $
prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
trNotes
chgAddr <- getInternalAddresses pool $ entityKey acc
let internalUA =
getUA $ walletAddressUAddress $ entityVal $ head chgAddr
let oRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let snote =
OutgoingNote
4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes oRcvr)
(fromIntegral $ noteTotal - fee)
""
True
let tx =
createTransaction
(Just sT)
(Just oT)
tSpends
[]
[]
[snote]
znet
(bh + 3)
True
logDebugN $ T.pack $ show tx
return tx
where
getTotalAmount ::
( [Entity WalletTrNote]
, [Entity WalletSapNote]
, [Entity WalletOrchNote])
-> Integer
getTotalAmount (t, s, o) =
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
prepTSpends ::
TransparentSpendingKey
-> [Entity WalletTrNote]
-> IO [TransparentTxSpend]
prepTSpends sk notes = do
forM notes $ \n -> do
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
case tAddRead of
Nothing -> throwIO $ userError "Couldn't read t-address"
Just tAdd -> do
(XPrvKey _ _ _ _ (SecKey xp_key)) <-
genTransparentSecretKey
(walletAddressIndex $ entityVal tAdd)
(getScope $ walletAddressScope $ entityVal tAdd)
sk
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
case mReverseTxId of
Nothing -> throwIO $ userError "failed to get tx ID"
Just (ESQ.Value reverseTxId) -> do
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
return $
TransparentTxSpend
xp_key
(RawOutPoint
flipTxId
(fromIntegral $ walletTrNotePosition $ entityVal n))
(RawTxOut
(fromIntegral $ walletTrNoteValue $ entityVal n)
(walletTrNoteScript $ entityVal n))
-- | Prepare a transaction for sending
prepareTxV2 ::
ConnectionPool
@ -934,6 +1051,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
-> IO (Either TxError [OutgoingNote])
makeOutgoing acc recvs chg pol = do
let k = map (\(x, _, _, _) -> x) recvs
let j = map (\(_, _, x, _) -> x) recvs
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
case pol of
@ -947,7 +1065,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
then return $
Left $
PrivacyPolicyError
"Multiple shielded pulls not allowed for Full privacy"
"Multiple shielded pools not allowed for Full privacy"
else if 3 `elem` k
then do
let chgRcvr =
@ -1143,7 +1261,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
syncWallet ::
Config -- ^ configuration parameters
-> Entity ZcashWallet
-> LoggingT IO ()
-> NoLoggingT IO ()
syncWallet config w = do
startTime <- liftIO getCurrentTime
let walletDb = c_dbPath config

View file

@ -1191,6 +1191,61 @@ getTrNotes pool tr = do
where_ (tnotes ^. WalletTrNoteScript ==. val s)
pure tnotes
getTrFilteredNotes ::
ConnectionPool
-> [HexStringDB]
-> TransparentReceiver
-> IO [Entity WalletTrNote]
getTrFilteredNotes pool txs 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
(wt :& tnotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on`
(\(wt :& tnotes) ->
wt ^. WalletTransactionId ==. tnotes ^. WalletTrNoteTx)
where_ (tnotes ^. WalletTrNoteScript ==. val s)
where_ (wt ^. WalletTransactionTxId `in_` valList txs)
pure tnotes
traceTrDag :: ConnectionPool -> Entity WalletTrNote -> IO [Entity WalletTrNote]
traceTrDag pool note = do
trSpend <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
trSpends <- from $ table @WalletTrSpend
where_ (trSpends ^. WalletTrSpendNote ==. val (entityKey note))
pure trSpends
case trSpend of
Nothing -> return []
Just tnote -> do
nxtChg <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
nts <- from $ table @WalletTrNote
where_
(nts ^. WalletTrNoteTx ==. val (walletTrSpendTx $ entityVal tnote) &&.
nts ^.
WalletTrNoteChange ==.
val True)
pure nts
case nxtChg of
Nothing -> return []
Just nxt -> do
nxtSearch <- traceTrDag pool nxt
return $ nxt : nxtSearch
getSapNotes :: ConnectionPool -> SaplingReceiver -> IO [Entity WalletSapNote]
getSapNotes pool sr = do
runNoLoggingT $
@ -1201,6 +1256,57 @@ getSapNotes pool sr = do
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
pure snotes
getSapFilteredNotes ::
ConnectionPool
-> [HexStringDB]
-> SaplingReceiver
-> IO [Entity WalletSapNote]
getSapFilteredNotes pool txs sr = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
(wt :& snotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on`
(\(wt :& snotes) ->
wt ^. WalletTransactionId ==. snotes ^. WalletSapNoteTx)
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
where_ (wt ^. WalletTransactionTxId `in_` valList txs)
pure snotes
traceSapDag ::
ConnectionPool -> Entity WalletSapNote -> IO [Entity WalletSapNote]
traceSapDag pool note = do
sapSpend <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
sapSpends <- from $ table @WalletSapSpend
where_ (sapSpends ^. WalletSapSpendNote ==. val (entityKey note))
pure sapSpends
case sapSpend of
Nothing -> return []
Just snote -> do
nxtChg <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
nts <- from $ table @WalletSapNote
where_
(nts ^. WalletSapNoteTx ==.
val (walletSapSpendTx $ entityVal snote) &&.
nts ^.
WalletSapNoteChange ==.
val True)
pure nts
case nxtChg of
Nothing -> return []
Just nxt -> do
nxtSearch <- traceSapDag pool nxt
return $ nxt : nxtSearch
getOrchNotes :: ConnectionPool -> OrchardReceiver -> IO [Entity WalletOrchNote]
getOrchNotes pool o = do
runNoLoggingT $
@ -1211,6 +1317,57 @@ getOrchNotes pool o = do
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
pure onotes
getOrchFilteredNotes ::
ConnectionPool
-> [HexStringDB]
-> OrchardReceiver
-> IO [Entity WalletOrchNote]
getOrchFilteredNotes pool txs o = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
(wt :& onotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on`
(\(wt :& onotes) ->
wt ^. WalletTransactionId ==. onotes ^. WalletOrchNoteTx)
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
where_ (wt ^. WalletTransactionTxId `in_` valList txs)
pure onotes
traceOrchDag ::
ConnectionPool -> Entity WalletOrchNote -> IO [Entity WalletOrchNote]
traceOrchDag pool note = do
orchSpend <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
orchSpends <- from $ table @WalletOrchSpend
where_ (orchSpends ^. WalletOrchSpendNote ==. val (entityKey note))
pure orchSpends
case orchSpend of
Nothing -> return []
Just onote -> do
nxtChg <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
nts <- from $ table @WalletOrchNote
where_
(nts ^. WalletOrchNoteTx ==.
val (walletOrchSpendTx $ entityVal onote) &&.
nts ^.
WalletOrchNoteChange ==.
val True)
pure nts
case nxtChg of
Nothing -> return []
Just nxt -> do
nxtSearch <- traceOrchDag pool nxt
return $ nxt : nxtSearch
getWalletNotes ::
ConnectionPool -- ^ database path
-> Entity WalletAddress
@ -1255,47 +1412,66 @@ getWalletTransactions pool w = do
case tReceiver of
Nothing -> return []
Just tR -> liftIO $ getTrNotes pool tR
trChgNotes <-
case ctReceiver of
sapNotes <-
case sReceiver of
Nothing -> return []
Just tR -> liftIO $ getTrNotes pool tR
Just sR -> liftIO $ getSapNotes pool sR
orchNotes <-
case oReceiver of
Nothing -> return []
Just oR -> liftIO $ getOrchNotes pool oR
clearUserTx (entityKey w)
mapM_ addTr trNotes
mapM_ addSap sapNotes
mapM_ addOrch orchNotes
trSpends <-
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
trSpends <- from $ table @WalletTrSpend
where_
(trSpends ^. WalletTrSpendNote `in_`
valList (map entityKey (trNotes <> trChgNotes)))
(trSpends ^. WalletTrSpendNote `in_` valList (map entityKey trNotes))
pure trSpends
sapNotes <-
case sReceiver of
Nothing -> return []
Just sR -> liftIO $ getSapNotes pool sR
sapChgNotes <-
case csReceiver of
Nothing -> return []
Just sR -> liftIO $ getSapNotes pool sR
sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes)
orchNotes <-
case oReceiver of
Nothing -> return []
Just oR -> liftIO $ getOrchNotes pool oR
orchChgNotes <-
case coReceiver of
Nothing -> return []
Just oR -> liftIO $ getOrchNotes pool oR
orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
clearUserTx (entityKey w)
mapM_ addTr trNotes
mapM_ addTr trChgNotes
mapM_ addSap sapNotes
mapM_ addSap sapChgNotes
mapM_ addOrch orchNotes
mapM_ addOrch orchChgNotes
sapSpends <- mapM (getSapSpends . entityKey) sapNotes
orchSpends <- mapM (getOrchSpends . entityKey) orchNotes
mapM_ subTSpend trSpends
mapM_ subSSpend $ catMaybes sapSpends
mapM_ subOSpend $ catMaybes orchSpends
foundTxs <- getTxs $ entityKey w
trChgNotes <-
case ctReceiver of
Nothing -> return []
Just tR -> liftIO $ getTrFilteredNotes pool foundTxs tR
trChgNotes' <- liftIO $ mapM (traceTrDag pool) trChgNotes
trChgSpends <-
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
trS <- from $ table @WalletTrSpend
where_
(trS ^. WalletTrSpendNote `in_`
valList (map entityKey (trChgNotes <> concat trChgNotes')))
pure trS
sapChgNotes <-
case csReceiver of
Nothing -> return []
Just sR -> liftIO $ getSapFilteredNotes pool foundTxs sR
sapChgNotes' <- liftIO $ mapM (traceSapDag pool) sapChgNotes
sapChgSpends <-
mapM (getSapSpends . entityKey) (sapChgNotes <> concat sapChgNotes')
orchChgNotes <-
case coReceiver of
Nothing -> return []
Just oR -> liftIO $ getOrchFilteredNotes pool foundTxs oR
orchChgNotes' <- liftIO $ mapM (traceOrchDag pool) orchChgNotes
orchChgSpends <-
mapM (getOrchSpends . entityKey) (orchChgNotes <> concat orchChgNotes')
mapM_ addTr (trChgNotes <> concat trChgNotes')
mapM_ addSap (sapChgNotes <> concat sapChgNotes')
mapM_ addOrch (orchChgNotes <> concat orchChgNotes')
mapM_ subTSpend trChgSpends
mapM_ subSSpend $ catMaybes sapChgSpends
mapM_ subOSpend $ catMaybes orchChgSpends
where
clearUserTx :: WalletAddressId -> NoLoggingT IO ()
clearUserTx waId = do
@ -1305,6 +1481,16 @@ getWalletTransactions pool w = do
u <- from $ table @UserTx
where_ (u ^. UserTxAddress ==. val waId)
return ()
getTxs :: WalletAddressId -> NoLoggingT IO [HexStringDB]
getTxs waId = do
res <-
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
t <- from $ table @UserTx
where_ (t ^. UserTxAddress ==. val waId)
return (t ^. UserTxHex)
return $ map (\(Value x) -> x) res
getSapSpends ::
WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend))
getSapSpends n = do
@ -2244,6 +2430,19 @@ saveConfs pool b c = do
set bl [ZcashBlockConf =. val c]
where_ $ bl ^. ZcashBlockHeight ==. val b
getReceivers :: ConnectionPool -> [Entity WalletTrNote] -> IO [WalletAddressId]
getReceivers pool ns = do
r <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $
distinct $ do
t <- from $ table @WalletTrNote
where_ (t ^. WalletTrNoteId `in_` valList (map entityKey ns))
return (t ^. WalletTrNoteAddress)
return $ map (\(Value x) -> x) r
-- | Helper function to extract a Unified Address from the database
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
readUnifiedAddressDB =

View file

@ -1257,8 +1257,7 @@ handleEvent wenv node model evt =
case currentWallet of
Nothing -> return $ ShowError "No wallet available"
Just cW -> do
runFileLoggingT "zenith.log" $
syncWallet (model ^. configuration) cW
runNoLoggingT $ syncWallet (model ^. configuration) cW
pool <-
runNoLoggingT $
initPool $ c_dbPath $ model ^. configuration
@ -1579,7 +1578,13 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
znet
accId
bl
[ProposedNote (ValidAddressAPI addr) amt (Just memo)]
[ ProposedNote
(ValidAddressAPI addr)
amt
(if memo == ""
then Nothing
else Just memo)
]
policy
case res of
Left e -> sendMsg $ ShowError $ T.pack $ show e

View file

@ -98,7 +98,6 @@ import Zenith.Types
, PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ValidAddressAPI(..)
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashNetDB(..)
@ -910,7 +909,7 @@ scanZebra dbPath zHost zPort net = do
return ()
Right _ -> do
wals <- getWallets pool net
runStderrLoggingT $
runNoLoggingT $
mapM_
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
wals

View file

@ -238,7 +238,7 @@ clearSync config = do
w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
r <- runNoLoggingT $ mapM (syncWallet config) w'
liftIO $ print r
-- | Detect chain re-orgs

View file

@ -262,6 +262,11 @@ instance ToJSON ProposedNote where
toJSON (ProposedNote a n m) =
object ["address" .= a, "amount" .= n, "memo" .= m]
data ShieldDeshieldOp
= Shield
| Deshield
deriving (Eq, Show, Read, Ord)
-- ** `zebrad`
-- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo

View file

@ -170,10 +170,8 @@ isRecipientValidGUI p a = do
Unified ua -> True
Sapling sa -> True
Transparent ta -> True
Exchange ea -> True
_ -> False
Nothing -> False
None -> case adr of
Just a ->
case a of