Compare commits
9 commits
c75316ddd7
...
f1daf576cc
Author | SHA1 | Date | |
---|---|---|---|
f1daf576cc | |||
2f3362e900 | |||
935ad1d691 | |||
c4a879b09b | |||
213afdadd9 | |||
e02551c9ff | |||
cf2f77e510 | |||
25b6a097c7 | |||
398f4f1dcf |
8 changed files with 495 additions and 63 deletions
|
@ -66,6 +66,7 @@ import Control.Monad (forever, unless, void, when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
( LoggingT
|
( LoggingT
|
||||||
|
, NoLoggingT
|
||||||
, logDebugN
|
, logDebugN
|
||||||
, runFileLoggingT
|
, runFileLoggingT
|
||||||
, runNoLoggingT
|
, runNoLoggingT
|
||||||
|
@ -88,7 +89,11 @@ import System.Hclip
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
import ZcashHaskell.Orchard
|
||||||
|
( getSaplingFromUA
|
||||||
|
, isValidUnifiedAddress
|
||||||
|
, parseAddress
|
||||||
|
)
|
||||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||||
|
@ -100,7 +105,10 @@ import Zenith.Types
|
||||||
, HexStringDB(..)
|
, HexStringDB(..)
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
, PrivacyPolicy(..)
|
, PrivacyPolicy(..)
|
||||||
|
, ProposedNote(..)
|
||||||
|
, ShieldDeshieldOp(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
|
, ValidAddressAPI(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
, ZenithStatus(..)
|
, ZenithStatus(..)
|
||||||
)
|
)
|
||||||
|
@ -108,6 +116,7 @@ import Zenith.Utils
|
||||||
( displayTaz
|
( displayTaz
|
||||||
, displayZec
|
, displayZec
|
||||||
, isRecipientValid
|
, isRecipientValid
|
||||||
|
, isRecipientValidGUI
|
||||||
, jsonNumber
|
, jsonNumber
|
||||||
, parseAddressUA
|
, parseAddressUA
|
||||||
, showAddress
|
, showAddress
|
||||||
|
@ -132,6 +141,10 @@ data Name
|
||||||
| PrivacyLowField
|
| PrivacyLowField
|
||||||
| PrivacyMediumField
|
| PrivacyMediumField
|
||||||
| PrivacyFullField
|
| PrivacyFullField
|
||||||
|
| ShieldField
|
||||||
|
| DeshieldField
|
||||||
|
| TotalTranspField
|
||||||
|
| TotalShieldedField
|
||||||
deriving (Eq, Show, Ord)
|
deriving (Eq, Show, Ord)
|
||||||
|
|
||||||
data DialogInput = DialogInput
|
data DialogInput = DialogInput
|
||||||
|
@ -156,6 +169,15 @@ data AdrBookEntry = AdrBookEntry
|
||||||
|
|
||||||
makeLenses ''AdrBookEntry
|
makeLenses ''AdrBookEntry
|
||||||
|
|
||||||
|
data ShDshEntry = ShDshEntry
|
||||||
|
{ _totalTransparent :: !Float
|
||||||
|
, _totalShielded :: !Float
|
||||||
|
, _shieldOp :: !ShieldDeshieldOp
|
||||||
|
, _shAmt :: !Float
|
||||||
|
} deriving (Show)
|
||||||
|
|
||||||
|
makeLenses ''ShDshEntry
|
||||||
|
|
||||||
data DialogType
|
data DialogType
|
||||||
= WName
|
= WName
|
||||||
| AName
|
| AName
|
||||||
|
@ -168,6 +190,7 @@ data DialogType
|
||||||
| AdrBookForm
|
| AdrBookForm
|
||||||
| AdrBookUpdForm
|
| AdrBookUpdForm
|
||||||
| AdrBookDelForm
|
| AdrBookDelForm
|
||||||
|
| ShieldDeshieldForm
|
||||||
|
|
||||||
data DisplayType
|
data DisplayType
|
||||||
= AddrDisplay
|
= AddrDisplay
|
||||||
|
@ -216,6 +239,7 @@ data State = State
|
||||||
, _abCurAdrs :: !T.Text -- used for address book CRUD operations
|
, _abCurAdrs :: !T.Text -- used for address book CRUD operations
|
||||||
, _sentTx :: !(Maybe HexString)
|
, _sentTx :: !(Maybe HexString)
|
||||||
, _unconfBalance :: !Integer
|
, _unconfBalance :: !Integer
|
||||||
|
, _shdshForm :: !(Form ShDshEntry () Name)
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''State
|
makeLenses ''State
|
||||||
|
@ -263,17 +287,23 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
(C.hCenter
|
(C.hCenter
|
||||||
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
|
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
|
||||||
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
|
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
|
||||||
C.hCenter
|
(vBox
|
||||||
(hBox
|
[ C.hCenter
|
||||||
[ capCommand "W" "allets"
|
(hBox
|
||||||
, capCommand "A" "ccounts"
|
[ capCommand "W" "allets"
|
||||||
, capCommand "V" "iew address"
|
, capCommand "A" "ccounts"
|
||||||
, capCommand "S" "end Tx"
|
, capCommand "V" "iew address"
|
||||||
, capCommand2 "Address " "B" "ook"
|
, capCommand3 "" "S" "end Tx"
|
||||||
, capCommand "Q" "uit"
|
])
|
||||||
, capCommand "?" " Help"
|
, C.hCenter
|
||||||
, str $ show (st ^. timer)
|
(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 :: Show e => String -> L.List Name e -> Widget Name
|
||||||
listBox titleLabel l =
|
listBox titleLabel l =
|
||||||
C.vCenter $
|
C.vCenter $
|
||||||
|
@ -339,7 +369,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
else emptyWidget
|
else emptyWidget
|
||||||
where
|
where
|
||||||
keyList =
|
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 =
|
actionList =
|
||||||
map
|
map
|
||||||
(hLimit 40 . str)
|
(hLimit 40 . str)
|
||||||
|
@ -350,6 +380,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
, "View address"
|
, "View address"
|
||||||
, "Send Tx"
|
, "Send Tx"
|
||||||
, "Address Book"
|
, "Address Book"
|
||||||
|
, "Shield/De-Shield"
|
||||||
, "Quit"
|
, "Quit"
|
||||||
]
|
]
|
||||||
inputDialog :: State -> Widget Name
|
inputDialog :: State -> Widget Name
|
||||||
|
@ -396,6 +427,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
(renderForm (st ^. txForm) <=>
|
(renderForm (st ^. txForm) <=>
|
||||||
C.hCenter
|
C.hCenter
|
||||||
(hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
|
(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
|
Blank -> emptyWidget
|
||||||
-- Address Book List
|
-- Address Book List
|
||||||
AdrBook ->
|
AdrBook ->
|
||||||
|
@ -639,6 +676,34 @@ mkSendForm bal =
|
||||||
label s w =
|
label s w =
|
||||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> 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 :: AdrBookEntry -> Form AdrBookEntry e Name
|
||||||
mkNewABForm =
|
mkNewABForm =
|
||||||
newForm
|
newForm
|
||||||
|
@ -747,7 +812,7 @@ scanZebra ::
|
||||||
-> Int
|
-> Int
|
||||||
-> BC.BChan Tick
|
-> BC.BChan Tick
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> LoggingT IO ()
|
-> NoLoggingT IO ()
|
||||||
scanZebra dbP zHost zPort b eChan znet = do
|
scanZebra dbP zHost zPort b eChan znet = do
|
||||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
||||||
|
@ -779,7 +844,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
||||||
_ <- liftIO $ startSync pool
|
_ <- liftIO $ startSync pool
|
||||||
mapM_ (liftIO . processBlock pool step) bList
|
mapM_ (liftIO . processBlock pool step) bList
|
||||||
confUp <-
|
confUp <-
|
||||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
|
||||||
IO
|
IO
|
||||||
(Either IOError ())
|
(Either IOError ())
|
||||||
case confUp of
|
case confUp of
|
||||||
|
@ -874,7 +939,7 @@ appEvent (BT.AppEvent t) = do
|
||||||
Just (_k, w) -> return w
|
Just (_k, w) -> return w
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
runFileLoggingT "zenith.log" $
|
runNoLoggingT $
|
||||||
syncWallet
|
syncWallet
|
||||||
(Config
|
(Config
|
||||||
(s ^. dbPath)
|
(s ^. dbPath)
|
||||||
|
@ -902,6 +967,7 @@ appEvent (BT.AppEvent t) = do
|
||||||
AdrBookForm -> return ()
|
AdrBookForm -> return ()
|
||||||
AdrBookUpdForm -> return ()
|
AdrBookUpdForm -> return ()
|
||||||
AdrBookDelForm -> return ()
|
AdrBookDelForm -> return ()
|
||||||
|
ShieldDeshieldForm -> return ()
|
||||||
Blank -> do
|
Blank -> do
|
||||||
if s ^. timer == 90
|
if s ^. timer == 90
|
||||||
then do
|
then do
|
||||||
|
@ -911,7 +977,7 @@ appEvent (BT.AppEvent t) = do
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
forkIO $
|
forkIO $
|
||||||
runFileLoggingT "zenith.log" $
|
runNoLoggingT $
|
||||||
scanZebra
|
scanZebra
|
||||||
(s ^. dbPath)
|
(s ^. dbPath)
|
||||||
(s ^. zebraHost)
|
(s ^. zebraHost)
|
||||||
|
@ -1135,6 +1201,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
(fs1 ^. sendAmt)
|
(fs1 ^. sendAmt)
|
||||||
(fs1 ^. sendTo)
|
(fs1 ^. sendTo)
|
||||||
(fs1 ^. sendMemo)
|
(fs1 ^. sendMemo)
|
||||||
|
(fs1 ^. policyField)
|
||||||
BT.modify $ set msg "Preparing transaction..."
|
BT.modify $ set msg "Preparing transaction..."
|
||||||
BT.modify $ set displayBox SendDisplay
|
BT.modify $ set displayBox SendDisplay
|
||||||
BT.modify $ set dialogBox Blank
|
BT.modify $ set dialogBox Blank
|
||||||
|
@ -1148,8 +1215,15 @@ appEvent (BT.VtyEvent e) = do
|
||||||
fs <- BT.gets formState
|
fs <- BT.gets formState
|
||||||
BT.modify $
|
BT.modify $
|
||||||
setFieldValid
|
setFieldValid
|
||||||
(isRecipientValid (fs ^. sendTo))
|
(isRecipientValidGUI
|
||||||
|
(fs ^. policyField)
|
||||||
|
(fs ^. sendTo))
|
||||||
RecField
|
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
|
AdrBook -> do
|
||||||
case e of
|
case e of
|
||||||
V.EvKey (V.KChar 'x') [] ->
|
V.EvKey (V.KChar 'x') [] ->
|
||||||
|
@ -1167,7 +1241,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
"Address copied to Clipboard from >>\n" ++
|
"Address copied to Clipboard from >>\n" ++
|
||||||
T.unpack (addressBookAbdescrip (entityVal a))
|
T.unpack (addressBookAbdescrip (entityVal a))
|
||||||
BT.modify $ set displayBox MsgDisplay
|
BT.modify $ set displayBox MsgDisplay
|
||||||
_ -> do
|
_any -> do
|
||||||
BT.modify $
|
BT.modify $
|
||||||
set msg "Error while copying the address!!"
|
set msg "Error while copying the address!!"
|
||||||
BT.modify $ set displayBox MsgDisplay
|
BT.modify $ set displayBox MsgDisplay
|
||||||
|
@ -1359,6 +1433,22 @@ appEvent (BT.VtyEvent e) = do
|
||||||
BT.modify $ set dialogBox SendTx
|
BT.modify $ set dialogBox SendTx
|
||||||
V.EvKey (V.KChar 'b') [] ->
|
V.EvKey (V.KChar 'b') [] ->
|
||||||
BT.modify $ set dialogBox AdrBook
|
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 ->
|
ev ->
|
||||||
case r of
|
case r of
|
||||||
Just AList ->
|
Just AList ->
|
||||||
|
@ -1373,6 +1463,8 @@ appEvent (BT.VtyEvent e) = do
|
||||||
printMsg s = BT.modify $ updateMsg s
|
printMsg s = BT.modify $ updateMsg s
|
||||||
updateMsg :: String -> State -> State
|
updateMsg :: String -> State -> State
|
||||||
updateMsg = set msg
|
updateMsg = set msg
|
||||||
|
-- fs <- BT.gets formState
|
||||||
|
-- ev -> BT.zoom shdshForm $ L.handleListEvent ev
|
||||||
appEvent _ = return ()
|
appEvent _ = return ()
|
||||||
|
|
||||||
theMap :: A.AttrMap
|
theMap :: A.AttrMap
|
||||||
|
@ -1497,6 +1589,7 @@ runZenithTUI config = do
|
||||||
""
|
""
|
||||||
Nothing
|
Nothing
|
||||||
uBal
|
uBal
|
||||||
|
(mkshieldDeshieldForm 0 (ShDshEntry 0 0 Shield 0.0))
|
||||||
Left _e -> do
|
Left _e -> do
|
||||||
print $
|
print $
|
||||||
"No Zebra node available on port " <>
|
"No Zebra node available on port " <>
|
||||||
|
@ -1710,15 +1803,30 @@ sendTransaction ::
|
||||||
-> Float
|
-> Float
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> T.Text
|
-> T.Text
|
||||||
|
-> PrivacyPolicy
|
||||||
-> IO ()
|
-> 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..."
|
BC.writeBChan chan $ TickMsg "Preparing transaction..."
|
||||||
case parseAddressUA ua znet of
|
case parseAddress (E.encodeUtf8 ua) of
|
||||||
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
||||||
Just outUA -> do
|
Just outUA -> do
|
||||||
res <-
|
res <-
|
||||||
runFileLoggingT "zenith.log" $
|
runNoLoggingT $
|
||||||
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
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..."
|
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||||
case res of
|
case res of
|
||||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||||
|
|
|
@ -727,6 +727,123 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
||||||
getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
||||||
else Nothing
|
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
|
-- | Prepare a transaction for sending
|
||||||
prepareTxV2 ::
|
prepareTxV2 ::
|
||||||
ConnectionPool
|
ConnectionPool
|
||||||
|
@ -934,6 +1051,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
-> IO (Either TxError [OutgoingNote])
|
-> IO (Either TxError [OutgoingNote])
|
||||||
makeOutgoing acc recvs chg pol = do
|
makeOutgoing acc recvs chg pol = do
|
||||||
let k = map (\(x, _, _, _) -> x) recvs
|
let k = map (\(x, _, _, _) -> x) recvs
|
||||||
|
let j = map (\(_, _, x, _) -> x) recvs
|
||||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||||
case pol of
|
case pol of
|
||||||
|
@ -947,7 +1065,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
then return $
|
then return $
|
||||||
Left $
|
Left $
|
||||||
PrivacyPolicyError
|
PrivacyPolicyError
|
||||||
"Multiple shielded pulls not allowed for Full privacy"
|
"Multiple shielded pools not allowed for Full privacy"
|
||||||
else if 3 `elem` k
|
else if 3 `elem` k
|
||||||
then do
|
then do
|
||||||
let chgRcvr =
|
let chgRcvr =
|
||||||
|
@ -1143,7 +1261,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
syncWallet ::
|
syncWallet ::
|
||||||
Config -- ^ configuration parameters
|
Config -- ^ configuration parameters
|
||||||
-> Entity ZcashWallet
|
-> Entity ZcashWallet
|
||||||
-> LoggingT IO ()
|
-> NoLoggingT IO ()
|
||||||
syncWallet config w = do
|
syncWallet config w = do
|
||||||
startTime <- liftIO getCurrentTime
|
startTime <- liftIO getCurrentTime
|
||||||
let walletDb = c_dbPath config
|
let walletDb = c_dbPath config
|
||||||
|
|
259
src/Zenith/DB.hs
259
src/Zenith/DB.hs
|
@ -1191,6 +1191,61 @@ getTrNotes pool tr = do
|
||||||
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
||||||
pure tnotes
|
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 :: ConnectionPool -> SaplingReceiver -> IO [Entity WalletSapNote]
|
||||||
getSapNotes pool sr = do
|
getSapNotes pool sr = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
|
@ -1201,6 +1256,57 @@ getSapNotes pool sr = do
|
||||||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
|
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
|
||||||
pure snotes
|
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 :: ConnectionPool -> OrchardReceiver -> IO [Entity WalletOrchNote]
|
||||||
getOrchNotes pool o = do
|
getOrchNotes pool o = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
|
@ -1211,6 +1317,57 @@ getOrchNotes pool o = do
|
||||||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
|
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
|
||||||
pure onotes
|
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 ::
|
getWalletNotes ::
|
||||||
ConnectionPool -- ^ database path
|
ConnectionPool -- ^ database path
|
||||||
-> Entity WalletAddress
|
-> Entity WalletAddress
|
||||||
|
@ -1255,47 +1412,66 @@ getWalletTransactions pool w = do
|
||||||
case tReceiver of
|
case tReceiver of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
Just tR -> liftIO $ getTrNotes pool tR
|
Just tR -> liftIO $ getTrNotes pool tR
|
||||||
trChgNotes <-
|
sapNotes <-
|
||||||
case ctReceiver of
|
case sReceiver of
|
||||||
Nothing -> return []
|
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 <-
|
trSpends <-
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
trSpends <- from $ table @WalletTrSpend
|
trSpends <- from $ table @WalletTrSpend
|
||||||
where_
|
where_
|
||||||
(trSpends ^. WalletTrSpendNote `in_`
|
(trSpends ^. WalletTrSpendNote `in_` valList (map entityKey trNotes))
|
||||||
valList (map entityKey (trNotes <> trChgNotes)))
|
|
||||||
pure trSpends
|
pure trSpends
|
||||||
sapNotes <-
|
sapSpends <- mapM (getSapSpends . entityKey) sapNotes
|
||||||
case sReceiver of
|
orchSpends <- mapM (getOrchSpends . entityKey) orchNotes
|
||||||
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
|
|
||||||
mapM_ subTSpend trSpends
|
mapM_ subTSpend trSpends
|
||||||
mapM_ subSSpend $ catMaybes sapSpends
|
mapM_ subSSpend $ catMaybes sapSpends
|
||||||
mapM_ subOSpend $ catMaybes orchSpends
|
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
|
where
|
||||||
clearUserTx :: WalletAddressId -> NoLoggingT IO ()
|
clearUserTx :: WalletAddressId -> NoLoggingT IO ()
|
||||||
clearUserTx waId = do
|
clearUserTx waId = do
|
||||||
|
@ -1305,6 +1481,16 @@ getWalletTransactions pool w = do
|
||||||
u <- from $ table @UserTx
|
u <- from $ table @UserTx
|
||||||
where_ (u ^. UserTxAddress ==. val waId)
|
where_ (u ^. UserTxAddress ==. val waId)
|
||||||
return ()
|
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 ::
|
getSapSpends ::
|
||||||
WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend))
|
WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend))
|
||||||
getSapSpends n = do
|
getSapSpends n = do
|
||||||
|
@ -2244,6 +2430,19 @@ saveConfs pool b c = do
|
||||||
set bl [ZcashBlockConf =. val c]
|
set bl [ZcashBlockConf =. val c]
|
||||||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
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
|
-- | Helper function to extract a Unified Address from the database
|
||||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||||
readUnifiedAddressDB =
|
readUnifiedAddressDB =
|
||||||
|
|
|
@ -1257,8 +1257,7 @@ handleEvent wenv node model evt =
|
||||||
case currentWallet of
|
case currentWallet of
|
||||||
Nothing -> return $ ShowError "No wallet available"
|
Nothing -> return $ ShowError "No wallet available"
|
||||||
Just cW -> do
|
Just cW -> do
|
||||||
runFileLoggingT "zenith.log" $
|
runNoLoggingT $ syncWallet (model ^. configuration) cW
|
||||||
syncWallet (model ^. configuration) cW
|
|
||||||
pool <-
|
pool <-
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
initPool $ c_dbPath $ model ^. configuration
|
initPool $ c_dbPath $ model ^. configuration
|
||||||
|
@ -1579,7 +1578,13 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
|
||||||
znet
|
znet
|
||||||
accId
|
accId
|
||||||
bl
|
bl
|
||||||
[ProposedNote (ValidAddressAPI addr) amt (Just memo)]
|
[ ProposedNote
|
||||||
|
(ValidAddressAPI addr)
|
||||||
|
amt
|
||||||
|
(if memo == ""
|
||||||
|
then Nothing
|
||||||
|
else Just memo)
|
||||||
|
]
|
||||||
policy
|
policy
|
||||||
case res of
|
case res of
|
||||||
Left e -> sendMsg $ ShowError $ T.pack $ show e
|
Left e -> sendMsg $ ShowError $ T.pack $ show e
|
||||||
|
|
|
@ -98,7 +98,6 @@ import Zenith.Types
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
, PrivacyPolicy(..)
|
, PrivacyPolicy(..)
|
||||||
, ProposedNote(..)
|
, ProposedNote(..)
|
||||||
, ValidAddressAPI(..)
|
|
||||||
, ZcashAccountAPI(..)
|
, ZcashAccountAPI(..)
|
||||||
, ZcashAddressAPI(..)
|
, ZcashAddressAPI(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
|
@ -910,7 +909,7 @@ scanZebra dbPath zHost zPort net = do
|
||||||
return ()
|
return ()
|
||||||
Right _ -> do
|
Right _ -> do
|
||||||
wals <- getWallets pool net
|
wals <- getWallets pool net
|
||||||
runStderrLoggingT $
|
runNoLoggingT $
|
||||||
mapM_
|
mapM_
|
||||||
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
|
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
|
||||||
wals
|
wals
|
||||||
|
|
|
@ -238,7 +238,7 @@ clearSync config = do
|
||||||
w <- getWallets pool $ zgb_net chainInfo
|
w <- getWallets pool $ zgb_net chainInfo
|
||||||
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||||
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
|
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
|
||||||
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
|
r <- runNoLoggingT $ mapM (syncWallet config) w'
|
||||||
liftIO $ print r
|
liftIO $ print r
|
||||||
|
|
||||||
-- | Detect chain re-orgs
|
-- | Detect chain re-orgs
|
||||||
|
|
|
@ -262,6 +262,11 @@ instance ToJSON ProposedNote where
|
||||||
toJSON (ProposedNote a n m) =
|
toJSON (ProposedNote a n m) =
|
||||||
object ["address" .= a, "amount" .= n, "memo" .= m]
|
object ["address" .= a, "amount" .= n, "memo" .= m]
|
||||||
|
|
||||||
|
data ShieldDeshieldOp
|
||||||
|
= Shield
|
||||||
|
| Deshield
|
||||||
|
deriving (Eq, Show, Read, Ord)
|
||||||
|
|
||||||
-- ** `zebrad`
|
-- ** `zebrad`
|
||||||
-- | Type for modeling the tree state response
|
-- | Type for modeling the tree state response
|
||||||
data ZebraTreeInfo = ZebraTreeInfo
|
data ZebraTreeInfo = ZebraTreeInfo
|
||||||
|
|
|
@ -170,10 +170,8 @@ isRecipientValidGUI p a = do
|
||||||
Unified ua -> True
|
Unified ua -> True
|
||||||
Sapling sa -> True
|
Sapling sa -> True
|
||||||
Transparent ta -> True
|
Transparent ta -> True
|
||||||
Exchange ea -> True
|
|
||||||
_ -> False
|
_ -> False
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
|
|
||||||
None -> case adr of
|
None -> case adr of
|
||||||
Just a ->
|
Just a ->
|
||||||
case a of
|
case a of
|
||||||
|
|
Loading…
Reference in a new issue