Compare commits

...

19 commits

Author SHA1 Message Date
d3a5c36e6b rvv001- zcash-haskell updated 2024-10-18 10:14:19 -04:00
f309864671
fix: chain rewind on data store 2024-10-16 16:01:45 -05:00
13c24ca528
feat(tui): implement shielding command 2024-10-16 08:48:54 -05:00
6be3630fbc
fix: chain re-org detection 2024-10-16 08:48:22 -05:00
cd4054e052
Merge branch 'rvv001' into rav001 2024-10-15 14:45:58 -05:00
57ab57554b
libs: update zcash-haskell 2024-10-15 10:36:36 -05:00
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
c75316ddd7
feat(rpc): background wallet sync 2024-10-08 08:20:52 -05:00
7410eed991
docs(rpc): add new error type 2024-10-07 14:26:49 -05:00
e487a67e36
docs: remote draft tag from sendmany 2024-10-06 08:27:53 -05:00
f75faa33c6
docs: update sendmany RPC spec 2024-10-06 08:23:08 -05:00
acba134de2
feat(rpc): add sendmany method 2024-10-06 08:19:21 -05:00
a0b9d4178a
feat(core): support for multiple outputs per transaction 2024-10-04 12:46:44 -05:00
86b881e752
docs: correct typo in RPC spec 2024-10-01 13:24:41 -05:00
12a707e4cb
docs: update sendmany RPC spec 2024-10-01 13:11:04 -05:00
12 changed files with 1845 additions and 556 deletions

View file

@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- `getnewaccount` RPC method
- `getnewaddress` RPC method
- `getoperationstatus` RPC method
- `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy`
### Changed
@ -27,6 +28,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Detection of changes in database schema for automatic re-scan
- Block tracking for chain re-org detection
- Refactored `ZcashPool`
- Preventing write operations to occur during wallet sync
## [0.6.0.0-beta]

View file

@ -2,15 +2,22 @@
module Server where
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throwIO, try)
import Control.Monad (when)
import Control.Monad (forever, when)
import Data.Configurator
import Network.Wai.Handler.Warp (run)
import Servant
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (initDb)
import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
import Zenith.RPC
( State(..)
, ZenithRPC(..)
, authenticate
, scanZebra
, zenithServer
)
import Zenith.Scanner (rescanZebra)
import Zenith.Types (Config(..))
@ -39,6 +46,12 @@ main = do
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra zebraHost zebraPort dbFilePath
_ <-
forkIO $
forever $ do
_ <-
scanZebra dbFilePath zebraHost zebraPort (zgb_net chainInfo)
threadDelay 90000000
let myState =
State
(zgb_net chainInfo)

View file

@ -2,6 +2,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Zenith.CLI where
@ -62,13 +63,14 @@ import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throw, throwIO, try)
import Control.Monad (forever, unless, void, when)
import Control.Monad (forM_, forever, unless, void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
( LoggingT
, NoLoggingT
, logDebugN
, runFileLoggingT
, runNoLoggingT
, runStderrLoggingT
)
import Data.Aeson
import Data.HexString (HexString(..), toText)
@ -88,8 +90,15 @@ import System.Hclip
import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Orchard
( getSaplingFromUA
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Transparent
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
@ -100,9 +109,12 @@ import Zenith.Types
, HexStringDB(..)
, PhraseDB(..)
, PrivacyPolicy(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
, ProposedNote(..)
, ShieldDeshieldOp(..)
, UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..)
, ZenithStatus(..)
)
import Zenith.Utils
( displayTaz
@ -161,10 +173,8 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry
data ShDshEntry = ShDshEntry
{ _totalTransparent :: !Float
, _totalShielded :: !Float
, _shAmt :: !Float
newtype ShDshEntry = ShDshEntry
{ _shAmt :: Float
} deriving (Show)
makeLenses ''ShDshEntry
@ -232,7 +242,8 @@ data State = State
, _sentTx :: !(Maybe HexString)
, _unconfBalance :: !Integer
, _deshieldForm :: !(Form ShDshEntry () Name)
, _shieldForm :: !(Form ShDshEntry () Name)
, _tBalance :: !Integer
, _sBalance :: !Integer
}
makeLenses ''State
@ -249,11 +260,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(" Zenith - " <>
show (st ^. network) <>
" - " <>
(T.unpack
T.unpack
(maybe
"(None)"
(\(_, w) -> zcashWalletName $ entityVal w)
(L.listSelectedElement (st ^. wallets)))) ++
(L.listSelectedElement (st ^. wallets))) ++
" "))
(C.hCenter
(str
@ -281,14 +292,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
(vBox
[C.hCenter
[ C.hCenter
(hBox
[ capCommand "W" "allets"
, capCommand "A" "ccounts"
, capCommand "V" "iew address"
, capCommand3 "" "S" "end Tx"
])
,C.hCenter
, C.hCenter
(hBox
[ capCommand2 "Address " "B" "ook"
, capCommand2 "s" "H" "ield"
@ -297,8 +308,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, capCommand "?" " Help"
, str $ show (st ^. timer)
])
]
)
])
listBox :: Show e => String -> L.List Name e -> Widget Name
listBox titleLabel l =
C.vCenter $
@ -424,14 +434,33 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"]))
DeshieldForm ->
D.renderDialog
(D.dialog (Just (str " De-Shield Zec ")) Nothing 50)
(renderForm (st ^. deshieldForm) <=>
(D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
(C.hCenter
(padAll 1 $
vBox
[ str $
"Transparent Bal.: " ++
if st ^. network == MainNet
then displayZec (st ^. tBalance)
else displayTaz (st ^. tBalance)
, str $
"Shielded Bal.: " ++
if st ^. network == MainNet
then displayZec (st ^. sBalance)
else displayTaz (st ^. sBalance)
]) <=>
renderForm (st ^. deshieldForm) <=>
C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
ShieldForm ->
D.renderDialog
(D.dialog (Just (str " Shield Zec ")) Nothing 50)
(renderForm (st ^. shieldForm) <=>
(D.dialog (Just (str " Shield ZEC ")) Nothing 50)
(C.hCenter
(str $
"Shield " ++
if st ^. network == MainNet
then displayZec (st ^. tBalance)
else displayTaz (st ^. tBalance) ++ "?") <=>
C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
Blank -> emptyWidget
@ -678,26 +707,10 @@ mkSendForm bal =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
mkDeshieldForm bal =
mkDeshieldForm tbal =
newForm
[ label "Total Transp. : " @@=
editShowableFieldWithValidate totalTransparent TotalTranspField (isAmountValid bal)
, label "Total Shielded : " @@=
editShowableFieldWithValidate totalShielded TotalShieldedField (isAmountValid bal)
, 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
mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
mkShieldForm bal =
newForm
[ label "Amount to Shield: " @@=
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
[ label "Amount: " @@=
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
]
where
isAmountValid :: Integer -> Float -> Bool
@ -819,6 +832,10 @@ scanZebra dbP zHost zPort b eChan znet = do
pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
syncChk <- liftIO $ isSyncing pool
if syncChk
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
else do
logDebugN $
"dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
@ -829,24 +846,31 @@ scanZebra dbP zHost zPort b eChan znet = do
else max chkBlock b
if sb > zgb_blocks bStatus || sb < 1
then do
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
liftIO $
BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
if not (null bList)
then do
let step =
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
(1.0 :: Float) /
fromIntegral (zgb_blocks bStatus - (sb + 1))
_ <- liftIO $ startSync pool
mapM_ (liftIO . processBlock pool step) bList
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
IO
(Either IOError ())
case confUp of
Left _e0 ->
Left _e0 -> do
_ <- liftIO $ completeSync pool Failed
liftIO $
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
Right _ -> return ()
BC.writeBChan eChan $
TickMsg "Failed to update unconfirmed transactions"
Right _ -> do
_ <- liftIO $ completeSync pool Successful
return ()
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
where
processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do
@ -858,7 +882,9 @@ scanZebra dbP zHost zPort b eChan znet = do
"getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
case r of
Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1
Left e1 -> do
_ <- liftIO $ completeSync pool Failed
liftIO $ BC.writeBChan eChan $ TickMsg e1
Right blk -> do
r2 <-
liftIO $
@ -868,7 +894,9 @@ scanZebra dbP zHost zPort b eChan znet = do
"getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
case r2 of
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
Left e2 -> do
_ <- liftIO $ completeSync pool Failed
liftIO $ BC.writeBChan eChan $ TickMsg e2
Right hb -> do
let blockTime = getBlockTime hb
bi <-
@ -925,7 +953,7 @@ appEvent (BT.AppEvent t) = do
Just (_k, w) -> return w
_ <-
liftIO $
runFileLoggingT "zenith.log" $
runNoLoggingT $
syncWallet
(Config
(s ^. dbPath)
@ -935,11 +963,11 @@ appEvent (BT.AppEvent t) = do
"pwd"
8080)
selWallet
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
updatedState <- BT.get
ns <- liftIO $ refreshWallet updatedState
BT.put ns
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
BlankDisplay -> do
case s ^. dialogBox of
@ -964,7 +992,7 @@ appEvent (BT.AppEvent t) = do
_ <-
liftIO $
forkIO $
runFileLoggingT "zenith.log" $
runStderrLoggingT $
scanZebra
(s ^. dbPath)
(s ^. zebraHost)
@ -1188,6 +1216,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
@ -1201,16 +1230,102 @@ appEvent (BT.VtyEvent e) = do
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValidGUI (fs ^. policyField) (fs ^. sendTo))
(isRecipientValidGUI
(fs ^. policyField)
(fs ^. sendTo))
RecField
DeshieldForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'p') [] -> do
if allFieldsValid (s ^. deshieldForm)
then do
pool <-
liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selWal <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
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
selAddr <-
do case L.listSelectedElement $ s ^. addresses of
Nothing -> do
let fAddr =
L.listSelectedElement $
L.listMoveToBeginning $
s ^. addresses
case fAddr of
Nothing ->
throw $
userError "Failed to select address"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
fs1 <- BT.zoom deshieldForm $ BT.gets formState
let tAddrMaybe =
Transparent <$>
((decodeTransparentAddress .
E.encodeUtf8 .
encodeTransparentReceiver (s ^. network)) =<<
(t_rec =<<
(isValidUnifiedAddress .
E.encodeUtf8 .
getUA . walletAddressUAddress)
(entityVal selAddr)))
bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal
case tAddrMaybe of
Nothing -> do
BT.modify $
set
msg
"Failed to obtain transparent address"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
Just tAddr -> do
_ <-
liftIO $
forkIO $
deshieldTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
(ProposedNote
(ValidAddressAPI tAddr)
(fs1 ^. shAmt)
Nothing)
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
else do
BT.modify $ set msg "Invalid inputs"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
ev ->
BT.zoom deshieldForm $ do
handleFormEvent (BT.VtyEvent ev)
-- fs <- BT.gets formState
-- ev -> BT.zoom deshieldForm $ L.handleListEvent ev
AdrBook -> do
case e of
V.EvKey (V.KChar 'x') [] ->
@ -1228,7 +1343,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
@ -1394,6 +1509,53 @@ appEvent (BT.VtyEvent e) = do
BT.put s'
BT.modify $ set dialogBox AdrBook
ev -> BT.modify $ set dialogBox AdrBookDelForm
ShieldForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'p') [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selWal <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
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 account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
bl <- liftIO $ getLastSyncBlock pool $ entityKey selWal
_ <-
liftIO $
forkIO $
shieldTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
BT.modify $ set msg "Preparing transaction..."
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
ev ->
BT.zoom deshieldForm $ do
handleFormEvent (BT.VtyEvent ev)
-- Process any other event
Blank -> do
case e of
@ -1420,10 +1582,57 @@ 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') [] ->
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 account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
tBal <-
liftIO $
getTransparentBalance pool $ entityKey selAcc
sBal <-
liftIO $ getShieldedBalance pool $ entityKey selAcc
BT.modify $ set tBalance tBal
BT.modify $ set sBalance sBal
BT.modify $
set deshieldForm $
mkDeshieldForm sBal (ShDshEntry 0.0)
BT.modify $ set dialogBox DeshieldForm
V.EvKey (V.KChar 'h') [] ->
BT.modify $ set dialogBox ShieldForm
V.EvKey (V.KChar 'h') [] -> 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 account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
tBal <-
liftIO $
getTransparentBalance pool $ entityKey selAcc
BT.modify $ set tBalance tBal
if tBal > 20000
then BT.modify $ set dialogBox ShieldForm
else do
BT.modify $
set
msg
"Not enough transparent funds in this account"
BT.modify $ set displayBox MsgDisplay
ev ->
case r of
Just AList ->
@ -1438,6 +1647,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
@ -1520,6 +1731,14 @@ runZenithTUI config = do
if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0
tBal <-
if not (null accList)
then getTransparentBalance pool $ entityKey $ head accList
else return 0
sBal <-
if not (null accList)
then getShieldedBalance pool $ entityKey $ head accList
else return 0
eventChan <- BC.newBChan 10
_ <-
forkIO $
@ -1533,7 +1752,7 @@ runZenithTUI config = do
State
(zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1)
(L.list AcList (Vec.fromList accList) 0)
(L.list AcList (Vec.fromList accList) 1)
(L.list AList (Vec.fromList addrList) 1)
(L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++
@ -1562,8 +1781,9 @@ runZenithTUI config = do
""
Nothing
uBal
(mkDeshieldForm 0 (ShDshEntry 0 0 0.0 ))
(mkShieldForm 0 (ShDshEntry 0 0 0.0 ))
(mkDeshieldForm 0 (ShDshEntry 0.0))
tBal
sBal
Left _e -> do
print $
"No Zebra node available on port " <>
@ -1583,7 +1803,7 @@ refreshWallet s = do
Just (j, w1) -> return (j, w1)
Just (k, w) -> return (k, w)
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
let bl = zcashWalletLastSync $ entityVal selWallet
let bl = zcashWalletLastSync $ entityVal $ walList !! ix
addrL <-
if not (null aL)
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
@ -1777,15 +1997,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
@ -1799,3 +2034,56 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId
shieldTransaction ::
ConnectionPool
-> BC.BChan Tick
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> IO ()
shieldTransaction pool chan zHost zPort znet accId bl = do
BC.writeBChan chan $ TickMsg "Preparing shielding transaction..."
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
forM_ res $ \case
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId
deshieldTransaction ::
ConnectionPool
-> BC.BChan Tick
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> ProposedNote
-> IO ()
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
BC.writeBChan chan $ TickMsg "Deshielding funds..."
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId

View file

@ -26,7 +26,7 @@ import qualified Data.ByteString.Lazy as LBS
import Data.Digest.Pure.MD5
import Data.HexString (HexString, hexString, toBytes, toText)
import Data.List
import Data.Maybe (fromJust)
import Data.Maybe (fromJust, fromMaybe)
import Data.Pool (Pool)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
@ -34,7 +34,11 @@ import Data.Time
import qualified Database.Esqueleto.Experimental as ESQ
import Database.Persist
import Database.Persist.Sqlite
import GHC.Float.RealFracMethods (floorFloatInteger)
import GHC.Float.RealFracMethods
( ceilingFloatInteger
, floorFloatInt
, floorFloatInteger
)
import Haskoin.Crypto.Keys (XPrvKey(..))
import Lens.Micro ((&), (.~), (^.), set)
import Network.HTTP.Client
@ -75,11 +79,13 @@ import Zenith.Types
, OrchardSpendingKeyDB(..)
, PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, RseedDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..)
, ZebraTreeInfo(..)
)
@ -541,7 +547,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
return $ Left ZHError
Just acc -> do
logDebugN $ T.pack $ show acc
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
let zats = floorFloatInteger $ amt * (10 ^ 8)
logDebugN $ T.pack $ show zats
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient
@ -721,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
@ -729,38 +852,13 @@ prepareTxV2 ::
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> ValidAddress
-> T.Text
-> [ProposedNote]
-> PrivacyPolicy
-> LoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
-> NoLoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
accRead <- liftIO $ getAccountById pool za
let recipient =
case va of
Unified ua ->
case o_rec ua of
Nothing ->
case s_rec ua of
Nothing ->
case t_rec ua of
Nothing -> (0, "")
Just r3 ->
case tr_type r3 of
P2PKH -> (1, toBytes $ tr_bytes r3)
P2SH -> (2, toBytes $ tr_bytes r3)
Just r2 -> (3, getBytes r2)
Just r1 -> (4, getBytes r1)
Sapling sa -> (3, getBytes $ sa_receiver sa)
Transparent ta ->
case tr_type (ta_receiver ta) of
P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
Exchange ea ->
case tr_type (ex_address ea) of
P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
logDebugN $ T.pack $ show recipient
let recipients = map extractReceiver pnotes
logDebugN $ T.pack $ show recipients
logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees
@ -771,14 +869,21 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
return $ Left ZHError
Just acc -> do
logDebugN $ T.pack $ show acc
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
logDebugN $ T.pack $ show zats
let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
let zats = ceilingFloatInteger $ amt * (10 ^ 8)
logDebugN $ "amt: " <> T.pack (show amt)
logDebugN $ "zats: " <> T.pack (show zats)
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient
--logDebugN $ T.pack $ "calculated fee " ++ show fee
notePlan <-
liftIO $
selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
selectUnspentNotesV2
pool
za
(zats + 10000)
(map (\(x, _, _, _) -> x) recipients)
policy
case notePlan of
Right (tList, sList, oList) -> do
logDebugN "selected notes"
@ -786,6 +891,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
let noteTotal = getTotalAmount (tList, sList, oList)
logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
tSpends <-
liftIO $
prepTSpends
@ -806,7 +912,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
--print oSpends
dummy' <-
liftIO $
makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
case dummy' of
Left e -> return $ Left e
Right dummy -> do
@ -834,7 +940,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
pool
za
(zats + feeAmt)
(fst recipient)
(map (\(x, _, _, _) -> x) recipients)
policy
case finalNotePlan of
Right (tList1, sList1, oList1) -> do
@ -863,8 +969,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
liftIO $
makeOutgoing
acc
recipient
zats
recipients
(noteTotal1 - feeAmt - zats)
policy
logDebugN $ T.pack $ show outgoing'
@ -889,141 +994,186 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
logErrorN $ T.pack $ show e
return $ Left e
where
extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text)
extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
in case va of
Unified ua ->
case o_rec ua of
Nothing ->
case s_rec ua of
Nothing ->
case t_rec ua of
Nothing -> (0, "", 0, "")
Just r3 ->
case tr_type r3 of
P2PKH ->
(1, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
P2SH ->
(2, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
Transparent ta ->
case tr_type (ta_receiver ta) of
P2PKH ->
(1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
P2SH ->
(2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
Exchange ea ->
case tr_type (ex_address ea) of
P2PKH ->
(5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
P2SH ->
(6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
prepareOutgoingNote ::
ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote
prepareOutgoingNote zac (k, r, a, m) =
OutgoingNote
(if k == 5
then 1
else if k == 6
then 2
else fromIntegral k)
(case k of
4 -> getBytes $ getOrchSK $ zcashAccountOrchSpendKey zac
3 -> getBytes $ getSapSK $ zcashAccountSapSpendKey zac
_anyOther -> BS.empty)
r
(fromIntegral a)
(E.encodeUtf8 m)
False
makeOutgoing ::
Entity ZcashAccount
-> (Int, BS.ByteString)
-> Integer
-> [(Int, BS.ByteString, Int, T.Text)]
-> Integer
-> PrivacyPolicy
-> IO (Either TxError [OutgoingNote])
makeOutgoing acc (k, recvr) zats chg policy = do
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 k of
4 ->
case policy of
None ->
return $
case pol of
Full ->
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
then return $
Left $
PrivacyPolicyError "Receiver not compatible with privacy policy"
_anyOther -> do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
3 ->
case policy of
None ->
return $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else if elem 3 k && elem 4 k
then return $
Left $
PrivacyPolicyError "Receiver not compatible with privacy policy"
Full -> do
let chgRcvr =
fromJust $
s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
3
(getBytes $
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
3
(getBytes $
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
_anyOther -> do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
3
(getBytes $
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
2 ->
if policy <= Low
PrivacyPolicyError
"Multiple shielded pools not allowed for Full privacy"
else if 3 `elem` k
then do
let chgRcvr =
fromJust $
s_rec =<<
isValidUnifiedAddress
(E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
3
(getBytes $
getSapSK $
zcashAccountSapSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes =
map
(prepareOutgoingNote (entityVal acc))
recvs
return $ Right $ cnote : onotes
else if 4 `elem` k
then do
let chgRcvr =
fromJust $
o_rec =<<
isValidUnifiedAddress
(E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $
zcashAccountOrchSpendKey $
entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes =
map
(prepareOutgoingNote (entityVal acc))
recvs
return $ Right $ cnote : onotes
else return $ Left ZHError
Medium ->
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
return $ Right $ cnote : onotes
Low ->
if elem 5 k || elem 6 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
return $ Right $ cnote : onotes
None ->
if elem 3 k || elem 4 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else do
let chgRcvr =
fromJust $
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
let cnote =
OutgoingNote
1
BS.empty
(toBytes $ tr_bytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
]
else return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
1 ->
if policy <= Low
then do
let chgRcvr =
fromJust $
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
1
BS.empty
(toBytes $ tr_bytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
]
else return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
_anyOther -> return $ Left ZHError
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
return $ Right $ cnote : onotes
getTotalAmount ::
( [Entity WalletTrNote]
, [Entity WalletSapNote]
@ -1111,7 +1261,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo 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

@ -291,6 +291,13 @@ share
result T.Text Maybe
UniqueOp uuid
deriving Show Eq
ChainSync
name T.Text
start UTCTime
end UTCTime Maybe
status ZenithStatus
UniqueSync name
deriving Show Eq
|]
-- ** Type conversions
@ -1184,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 $
@ -1194,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 $
@ -1204,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
@ -1248,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
@ -1298,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
@ -1837,6 +2030,51 @@ getUnconfPoolBalance pool za = do
let oBal = sum oAmts
return $ AccountBalance tBal sBal oBal
rewindWalletTransactions :: ConnectionPool -> Int -> IO ()
rewindWalletTransactions pool b = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
delete $ do
_ <- from $ table @UserTx
return ()
oldTxs <-
select $ do
txs <- from $ table @WalletTransaction
where_ $ txs ^. WalletTransactionBlock >. val b
pure txs
let oldKeys = map entityKey oldTxs
delete $ do
x <- from $ table @WalletOrchSpend
where_ $ x ^. WalletOrchSpendTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletOrchNote
where_ $ x ^. WalletOrchNoteTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletSapNote
where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletSapSpend
where_ $ x ^. WalletSapSpendTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletTrNote
where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletTrSpend
where_ $ x ^. WalletTrSpendTx `in_` valList oldKeys
return ()
delete $ do
txs <- from $ table @WalletTransaction
where_ $ txs ^. WalletTransactionBlock >. val b
return ()
update $ \w -> do
set w [ZcashWalletLastSync =. val b]
clearWalletTransactions :: ConnectionPool -> IO ()
clearWalletTransactions pool = do
runNoLoggingT $
@ -2080,7 +2318,7 @@ selectUnspentNotesV2 ::
ConnectionPool
-> ZcashAccountId
-> Integer
-> Int
-> [Int]
-> PrivacyPolicy
-> IO
(Either
@ -2091,27 +2329,40 @@ selectUnspentNotesV2 ::
selectUnspentNotesV2 pool za amt recv policy = do
case policy of
Full ->
case recv of
4 -> do
if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
then return $
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
else if elem 4 recv && elem 3 recv
then return $
Left $
PrivacyPolicyError
"Combination of receivers not allowed for Full privacy"
else if 4 `elem` recv
then do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
let (a1, oList) =
checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
then return $
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
Left $
PrivacyPolicyError
"Not enough notes for Full privacy"
else return $ Right ([], [], oList)
3 -> do
else do
sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
let (a2, sList) =
checkSapling (fromIntegral amt) sapNotes
if a2 > 0
then return $
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
Left $
PrivacyPolicyError
"Not enough notes for Full privacy"
else return $ Right ([], sList, [])
_anyOther ->
return $
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
Medium ->
if recv > 2
then do
if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
then return $
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
else do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
@ -2124,40 +2375,16 @@ selectUnspentNotesV2 pool za amt recv policy = do
PrivacyPolicyError "Not enough notes for Medium privacy"
else return $ Right ([], sList, oList)
else return $ Right ([], [], oList)
else return $
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
Low ->
if recv == 0
if 0 `elem` recv
then return $ Left ZHError
else do
case recv of
3 -> do
sapNotes <- getWalletUnspentSapNotes pool za
let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
if a1 > 0
then do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a2, oList) = checkOrchard a1 orchNotes
if a2 > 0
if elem 5 recv || elem 6 recv
then return $
Left $
PrivacyPolicyError "Not enough notes for Low privacy"
else return $ Right ([], sList, oList)
else return $ Right ([], sList, [])
_anyOther -> do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
then do
sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = checkSapling a1 sapNotes
if a2 > 0
then return $
Left $
PrivacyPolicyError "Not enough notes for Low privacy"
else return $ Right ([], sList, oList)
else return $ Right ([], [], oList)
None -> do
PrivacyPolicyError
"Exchange addresses not supported with Low privacy"
else do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
@ -2173,6 +2400,19 @@ selectUnspentNotesV2 pool za amt recv policy = do
else return $ Right (tList, sList, oList)
else return $ Right ([], sList, oList)
else return $ Right ([], [], oList)
None -> do
if elem 3 recv || elem 4 recv
then return $
Left $
PrivacyPolicyError
"Shielded recipients not compatible with privacy policy."
else do
trNotes <- getWalletUnspentTrNotes pool za
let (a3, tList) = checkTransparent (fromIntegral amt) trNotes
if a3 > 0
then return $
Left $ PrivacyPolicyError "Insufficient transparent funds"
else return $ Right (tList, [], [])
where
checkTransparent ::
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
@ -2235,6 +2475,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 =
@ -2327,13 +2580,83 @@ finalizeOperation pool op status result = do
]
where_ (ops ^. OperationId ==. val op)
-- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> IO ()
rewindWalletData pool b = do
-- * Chain sync
-- | Check if the wallet is currently running a sync
isSyncing :: ConnectionPool -> IO Bool
isSyncing pool = do
s <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $
selectOne $ do
r <- from $ table @ChainSync
where_ $ r ^. ChainSyncStatus ==. val Processing
pure r
case s of
Nothing -> return False
Just _ -> return True
-- | Record the start of a sync
startSync :: ConnectionPool -> IO ()
startSync pool = do
start <- getCurrentTime
_ <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $
upsert (ChainSync "Internal" start Nothing Processing) []
return ()
-- | Complete a sync
completeSync :: ConnectionPool -> ZenithStatus -> IO ()
completeSync pool st = do
end <- getCurrentTime
_ <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $
update $ \s -> do
set s [ChainSyncEnd =. val (Just end), ChainSyncStatus =. val st]
where_ (s ^. ChainSyncName ==. val "Internal")
return ()
-- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> IO ()
rewindWalletData pool b = do
rewindWalletTransactions pool b
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
select $ do
txs <- from $ table @ZcashTransaction
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
pure txs
let oldTxKeys = map entityKey oldTxs
delete $ do
x <- from $ table @TransparentNote
where_ $ x ^. TransparentNoteTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @TransparentSpend
where_ $ x ^. TransparentSpendTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ShieldOutput
where_ $ x ^. ShieldOutputTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ShieldSpend
where_ $ x ^. ShieldSpendTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @OrchAction
where_ $ x ^. OrchActionTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ZcashTransaction
where_ $ x ^. ZcashTransactionId `in_` valList oldTxKeys
delete $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >=. val b
clearWalletTransactions pool
where_ $ blk ^. ZcashBlockHeight >. val b

View file

@ -1391,8 +1391,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
@ -1613,7 +1612,6 @@ handleEvent wenv node model evt =
res <- liftIO $ updateAdrsInAdrBook pool d a a
return $ ShowMessage "Address Book entry updated!!"
-- model & recipientValid .~ ((model ^. privacyChoice) == Low) ]
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
scanZebra dbPath zHost zPort net sendMsg = do
bStatus <- liftIO $ checkBlockChain zHost zPort
@ -1621,6 +1619,10 @@ scanZebra dbPath zHost zPort net sendMsg = do
b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
syncChk <- isSyncing pool
if syncChk
then sendMsg (ShowError "Sync already in progress")
else do
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
let sb =
if chkBlock == dbBlock
@ -1633,12 +1635,19 @@ scanZebra dbPath zHost zPort net sendMsg = do
if not (null bList)
then do
let step = (1.0 :: Float) / fromIntegral (length bList)
_ <- startSync pool
mapM_ (processBlock pool step) bList
else sendMsg (SyncVal 1.0)
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
confUp <-
try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
Right _ -> return ()
Left _e0 -> do
_ <- completeSync pool Failed
sendMsg
(ShowError "Failed to update unconfirmed transactions")
Right _ -> do
_ <- completeSync pool Successful
return ()
else sendMsg (SyncVal 1.0)
where
processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do
@ -1650,7 +1659,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
"getblock"
[Data.Aeson.String $ showt bl, jsonNumber 1]
case r of
Left e1 -> sendMsg (ShowError $ showt e1)
Left e1 -> do
_ <- completeSync pool Failed
sendMsg (ShowError $ showt e1)
Right blk -> do
r2 <-
liftIO $
@ -1660,7 +1671,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
"getblock"
[Data.Aeson.String $ showt bl, jsonNumber 0]
case r2 of
Left e2 -> sendMsg (ShowError $ showt e2)
Left e2 -> do
_ <- completeSync pool Failed
sendMsg (ShowError $ showt e2)
Right hb -> do
let blockTime = getBlockTime hb
bi <-
@ -1695,8 +1708,22 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath
res <-
runFileLoggingT "zenith.log" $
prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
runNoLoggingT $
prepareTxV2
pool
zHost
zPort
znet
accId
bl
[ ProposedNote
(ValidAddressAPI addr)
amt
(if memo == ""
then Nothing
else Just memo)
]
policy
case res of
Left e -> sendMsg $ ShowError $ T.pack $ show e
Right rawTx -> do

View file

@ -8,21 +8,28 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
module Zenith.RPC where
import Control.Concurrent (forkIO)
import Control.Exception (try)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
import Data.Aeson
import qualified Data.HexString as H
import Data.Int
import Data.Scientific (floatingOrInteger)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock (getCurrentTime)
import qualified Data.UUID as U
import Data.UUID.V4 (nextRandom)
import qualified Data.Vector as V
import Database.Esqueleto.Experimental
( entityKey
( ConnectionPool
, entityKey
, entityVal
, fromSqlKey
, toSqlKey
@ -31,43 +38,72 @@ import Servant
import Text.Read (readMaybe)
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (parseAddress)
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
import Zenith.Core (createCustomWalletAddress, createZcashAccount)
import ZcashHaskell.Types
( BlockResponse(..)
, RpcError(..)
, Scope(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..)
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
( checkBlockChain
, createCustomWalletAddress
, createZcashAccount
, prepareTxV2
, syncWallet
)
import Zenith.DB
( Operation(..)
, ZcashAccount(..)
, ZcashBlock(..)
, ZcashWallet(..)
, completeSync
, finalizeOperation
, findNotesByAddress
, getAccountById
, getAccounts
, getAddressById
, getAddresses
, getExternalAddresses
, getLastSyncBlock
, getMaxAccount
, getMaxAddress
, getMaxBlock
, getMinBirthdayHeight
, getOperation
, getPoolBalance
, getUnconfPoolBalance
, getWalletNotes
, getWallets
, initPool
, isSyncing
, rewindWalletData
, saveAccount
, saveAddress
, saveBlock
, saveOperation
, saveWallet
, startSync
, toZcashAccountAPI
, toZcashAddressAPI
, toZcashWalletAPI
, walletExists
)
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
import Zenith.Types
( AccountBalance(..)
, Config(..)
, HexStringDB(..)
, PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashNetDB(..)
, ZcashNoteAPI(..)
, ZcashWalletAPI(..)
, ZenithStatus(..)
, ZenithUuid(..)
)
import Zenith.Utils (jsonNumber)
@ -83,6 +119,7 @@ data ZenithMethod
| GetNewAccount
| GetNewAddress
| GetOperationStatus
| SendMany
| UnknownMethod
deriving (Eq, Prelude.Show)
@ -97,6 +134,7 @@ instance ToJSON ZenithMethod where
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
toJSON SendMany = Data.Aeson.String "sendmany"
toJSON UnknownMethod = Data.Aeson.Null
instance FromJSON ZenithMethod where
@ -112,6 +150,7 @@ instance FromJSON ZenithMethod where
"getnewaccount" -> pure GetNewAccount
"getnewaddress" -> pure GetNewAddress
"getoperationstatus" -> pure GetOperationStatus
"sendmany" -> pure SendMany
_ -> pure UnknownMethod
data ZenithParams
@ -125,6 +164,7 @@ data ZenithParams
| NameIdParams !T.Text !Int
| NewAddrParams !Int !T.Text !Bool !Bool
| OpParams !ZenithUuid
| SendParams !Int ![ProposedNote] !PrivacyPolicy
| TestParams !T.Text
deriving (Eq, Prelude.Show)
@ -148,6 +188,8 @@ instance ToJSON ZenithParams where
[Data.Aeson.String "ExcludeTransparent" | t]
toJSON (OpParams i) =
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
toJSON (SendParams i ns p) =
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
data ZenithResponse
= InfoResponse !T.Text !ZenithInfo
@ -159,6 +201,7 @@ data ZenithResponse
| NewItemResponse !T.Text !Int64
| NewAddrResponse !T.Text !ZcashAddressAPI
| OpResponse !T.Text !Operation
| SendResponse !T.Text !U.UUID
| ErrorResponse !T.Text !Double !T.Text
deriving (Eq, Prelude.Show)
@ -179,6 +222,7 @@ instance ToJSON ZenithResponse where
toJSON (NewItemResponse i ix) = packRpcResponse i ix
toJSON (NewAddrResponse i a) = packRpcResponse i a
toJSON (OpResponse i u) = packRpcResponse i u
toJSON (SendResponse i o) = packRpcResponse i o
instance FromJSON ZenithResponse where
parseJSON =
@ -258,6 +302,10 @@ instance FromJSON ZenithResponse where
case floatingOrInteger k of
Left _e -> fail "Unknown value"
Right k' -> pure $ NewItemResponse i k'
String s -> do
case U.fromText s of
Nothing -> fail "Unknown value"
Just u -> pure $ SendResponse i u
_anyOther -> fail "Malformed JSON"
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
@ -416,6 +464,30 @@ instance FromJSON RpcCall where
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
else pure $ RpcCall v i GetOperationStatus BadParams
_anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
SendMany -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a >= 2
then do
acc <- parseJSON $ a V.! 0
x <- parseJSON $ a V.! 1
case x of
String _ -> do
x' <- parseJSON $ a V.! 1
y <- parseJSON $ a V.! 2
if not (null y)
then pure $ RpcCall v i SendMany (SendParams acc y x')
else pure $ RpcCall v i SendMany BadParams
Array _ -> do
x' <- parseJSON $ a V.! 1
if not (null x')
then pure $
RpcCall v i SendMany (SendParams acc x' Full)
else pure $ RpcCall v i SendMany BadParams
_anyOther -> pure $ RpcCall v i SendMany BadParams
else pure $ RpcCall v i SendMany BadParams
_anyOther -> pure $ RpcCall v i SendMany BadParams
type ZenithRPC
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@ -573,8 +645,16 @@ zenithServer state = getinfo :<|> handleRPC
case parameters req of
NameParams t -> do
let dbPath = w_dbPath state
sP <- liftIO generateWalletSeedPhrase
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
sP <- liftIO generateWalletSeedPhrase
r <-
liftIO $
saveWallet pool $
@ -601,6 +681,14 @@ zenithServer state = getinfo :<|> handleRPC
NameIdParams t i -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
w <- liftIO $ walletExists pool i
case w of
Just w' -> do
@ -628,7 +716,10 @@ zenithServer state = getinfo :<|> handleRPC
fromSqlKey $ entityKey x
Nothing ->
return $
ErrorResponse (callId req) (-32008) "Wallet does not exist."
ErrorResponse
(callId req)
(-32008)
"Wallet does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAddress ->
@ -637,7 +728,16 @@ zenithServer state = getinfo :<|> handleRPC
let dbPath = w_dbPath state
let net = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
acc <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
case acc of
Just acc' -> do
maxAddr <-
@ -656,7 +756,9 @@ zenithServer state = getinfo :<|> handleRPC
case dbAddr of
Just nAddr -> do
return $
NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
NewAddrResponse
(callId req)
(toZcashAddressAPI nAddr)
Nothing ->
return $
ErrorResponse
@ -665,7 +767,10 @@ zenithServer state = getinfo :<|> handleRPC
"Entity with that name already exists."
Nothing ->
return $
ErrorResponse (callId req) (-32006) "Account does not exist."
ErrorResponse
(callId req)
(-32006)
"Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetOperationStatus ->
@ -682,6 +787,89 @@ zenithServer state = getinfo :<|> handleRPC
ErrorResponse (callId req) (-32009) "Operation ID not found"
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
SendMany ->
case parameters req of
SendParams a ns p -> do
let dbPath = w_dbPath state
let zHost = w_host state
let zPort = w_port state
let znet = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
opid <- liftIO nextRandom
startTime <- liftIO getCurrentTime
opkey <-
liftIO $
saveOperation pool $
Operation
(ZenithUuid opid)
startTime
Nothing
Processing
Nothing
case opkey of
Nothing ->
return $
ErrorResponse (callId req) (-32010) "Internal Error"
Just opkey' -> do
acc <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
case acc of
Just acc' -> do
bl <-
liftIO $
getLastSyncBlock
pool
(zcashAccountWalletId $ entityVal acc')
_ <-
liftIO $
forkIO $ do
res <-
liftIO $
runNoLoggingT $
prepareTxV2
pool
zHost
zPort
znet
(entityKey acc')
bl
ns
p
case res of
Left e ->
finalizeOperation pool opkey' Failed $
T.pack $ show e
Right rawTx -> do
zebraRes <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ H.toText rawTx]
case zebraRes of
Left e1 ->
finalizeOperation pool opkey' Failed $
T.pack $ show e1
Right txId ->
finalizeOperation pool opkey' Successful $
"Tx ID: " <> H.toText txId
return $ SendResponse (callId req) opid
Nothing ->
return $
ErrorResponse
(callId req)
(-32006)
"Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
authenticate :: Config -> BasicAuthCheck Bool
authenticate config = BasicAuthCheck check
@ -694,3 +882,67 @@ authenticate config = BasicAuthCheck check
packRpcResponse :: ToJSON a => T.Text -> a -> Value
packRpcResponse i x =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
scanZebra dbPath zHost zPort net = do
bStatus <- checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbPath
b <- getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
syncChk <- isSyncing pool
unless syncChk $ do
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do
_ <- startSync pool
mapM_ (processBlock pool) bList
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 -> do
_ <- completeSync pool Failed
return ()
Right _ -> do
wals <- getWallets pool net
runNoLoggingT $
mapM_
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
wals
_ <- completeSync pool Successful
return ()
where
processBlock :: ConnectionPool -> Int -> IO ()
processBlock pool bl = do
r <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
case r of
Left _ -> completeSync pool Failed
Right blk -> do
r2 <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack (show bl), jsonNumber 0]
case r2 of
Left _ -> completeSync pool Failed
Right hb -> do
let blockTime = getBlockTime hb
bi <-
saveBlock pool $
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
(ZcashNetDB net)
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk

View file

@ -37,6 +37,7 @@ import Zenith.DB
, ZcashBlockId
, clearWalletData
, clearWalletTransactions
, completeSync
, getBlock
, getMaxBlock
, getMinBirthdayHeight
@ -47,10 +48,16 @@ import Zenith.DB
, saveBlock
, saveConfs
, saveTransaction
, startSync
, updateWalletSync
, upgradeQrTable
)
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
import Zenith.Types
( Config(..)
, HexStringDB(..)
, ZcashNetDB(..)
, ZenithStatus(..)
)
import Zenith.Utils (jsonNumber)
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
@ -74,6 +81,7 @@ rescanZebra host port dbFilePath = do
upgradeQrTable pool1
clearWalletTransactions pool1
clearWalletData pool1
_ <- startSync pool1
dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight pool1
let sb = max dbBlock b
@ -99,6 +107,7 @@ rescanZebra host port dbFilePath = do
{-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
print "Please wait..."
_ <- completeSync pool1 Successful
print "Rescan complete"
-- | Function to process a raw block and extract the transaction information
@ -119,7 +128,9 @@ processBlock host port pool pg net b = do
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> liftIO $ throwIO $ userError e
Left e -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right blk -> do
r2 <-
liftIO $
@ -129,7 +140,9 @@ processBlock host port pool pg net b = do
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
case r2 of
Left e2 -> liftIO $ throwIO $ userError e2
Left e2 -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e2
Right hb -> do
let blockTime = getBlockTime hb
bi <-
@ -160,7 +173,9 @@ processTx host port bt pool t = do
"getrawtransaction"
[Data.Aeson.String $ toText t, jsonNumber 1]
case r of
Left e -> liftIO $ throwIO $ userError e
Left e -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right rawTx -> do
case readZebraTransaction (ztr_hex rawTx) of
Nothing -> return ()
@ -223,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

@ -23,13 +23,23 @@ import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.UUID as U
import Database.Persist.TH
import GHC.Generics
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
import ZcashHaskell.Sapling (encodeSaplingAddress)
import ZcashHaskell.Transparent
( encodeExchangeAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types
( OrchardSpendingKey(..)
( ExchangeAddress(..)
, OrchardSpendingKey(..)
, Phrase(..)
, Rseed(..)
, SaplingAddress(..)
, SaplingSpendingKey(..)
, Scope(..)
, TransparentAddress(..)
, TransparentSpendingKey
, ValidAddress(..)
, ZcashNet(..)
)
@ -207,6 +217,51 @@ data PrivacyPolicy
$(deriveJSON defaultOptions ''PrivacyPolicy)
newtype ValidAddressAPI = ValidAddressAPI
{ getVA :: ValidAddress
} deriving newtype (Eq, Show)
instance ToJSON ValidAddressAPI where
toJSON (ValidAddressAPI va) =
case va of
Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
Sapling sa ->
maybe
Data.Aeson.Null
Data.Aeson.String
(encodeSaplingAddress (net_type sa) (sa_receiver sa))
Transparent ta ->
Data.Aeson.String $
encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
Exchange ea ->
maybe
Data.Aeson.Null
Data.Aeson.String
(encodeExchangeAddress (ex_network ea) (ex_address ea))
data ProposedNote = ProposedNote
{ pn_addr :: !ValidAddressAPI
, pn_amt :: !Float
, pn_memo :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show)
instance FromJSON ProposedNote where
parseJSON =
withObject "ProposedNote" $ \obj -> do
a <- obj .: "address"
n <- obj .: "amount"
m <- obj .:? "memo"
case parseAddress (E.encodeUtf8 a) of
Nothing -> fail "Invalid address"
Just a' ->
if n > 0 && n < 21000000
then pure $ ProposedNote (ValidAddressAPI a') n m
else fail "Invalid amount"
instance ToJSON ProposedNote where
toJSON (ProposedNote a n m) =
object ["address" .= a, "amount" .= n, "memo" .= m]
data ShieldDeshieldOp
= Shield
| Deshield

View file

@ -7,7 +7,7 @@ import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson
import qualified Data.ByteString as BS
import Data.Configurator
import Data.Maybe (fromMaybe)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock (getCurrentTime)
@ -18,7 +18,7 @@ import Servant
import System.Directory
import Test.HUnit hiding (State)
import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
import ZcashHaskell.Types
( ZcashNet(..)
, ZebraGetBlockChainInfo(..)
@ -39,6 +39,9 @@ import Zenith.RPC
)
import Zenith.Types
( Config(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ValidAddressAPI(..)
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashWalletAPI(..)
@ -572,6 +575,107 @@ main = do
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
Right _ -> assertFailure "unexpected response"
describe "Send tx" $ do
describe "sendmany" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
SendMany
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "invalid account" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
17
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(Just "A cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
it "valid account, empty notes" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams 1 [] Full)
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
it "valid account, single output" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
1
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
5.0
(Just "A cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (SendResponse i o) -> o `shouldNotBe` U.nil
it "valid account, multiple outputs" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
let uaRead2 =
parseAddress
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
1
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
5.0
(Just "A cool memo")
, ProposedNote
(ValidAddressAPI $ fromJust uaRead2)
1.0
(Just "Not so cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (SendResponse i o) -> o `shouldNotBe` U.nil
startAPI :: Config -> IO ()
startAPI config = do

View file

@ -123,55 +123,6 @@ main = do
let ua =
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
isValidUnifiedAddress ua `shouldNotBe` Nothing
describe "Function tests" $ do
describe "Sapling Decoding" $ do
let sk =
SaplingSpendingKey
"\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB"
let tree =
SaplingCommitmentTree $
hexString
"01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
let nextTree =
SaplingCommitmentTree $
hexString
"01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
it "Sapling is decoded correctly" $ do
so <-
runSqlite "zenith.db" $
selectList [ShieldOutputTx ==. toSqlKey 38318] []
let cmus = map (getHex . shieldOutputCmu . entityVal) so
let pos =
getSaplingNotePosition <$>
(getSaplingWitness =<<
updateSaplingCommitmentTree tree (head cmus))
let pos1 = getSaplingNotePosition <$> getSaplingWitness tree
let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree
case pos of
Nothing -> assertFailure "couldn't get note position"
Just p -> do
print p
print pos1
print pos2
let dn =
decodeSaplingOutputEsk
sk
(ShieldedOutput
(getHex $ shieldOutputCv $ entityVal $ head so)
(getHex $ shieldOutputCmu $ entityVal $ head so)
(getHex $ shieldOutputEphKey $ entityVal $ head so)
(getHex $ shieldOutputEncCipher $ entityVal $ head so)
(getHex $ shieldOutputOutCipher $ entityVal $ head so)
(getHex $ shieldOutputProof $ entityVal $ head so))
TestNet
External
p
case dn of
Nothing -> assertFailure "couldn't decode Sap output"
Just d ->
a_nullifier d `shouldBe`
hexString
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
describe "Note selection for Tx" $ do
it "Value less than balance" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
@ -181,10 +132,6 @@ main = do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
res `shouldThrow` anyIOException
it "Fee calculation" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
calculateTxFee res 3 `shouldBe` 20000
describe "Testing validation" $ do
it "Unified" $ do
let a =
@ -267,9 +214,11 @@ main = do
TestNet
(toSqlKey 1)
3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
"Sending memo to orchard"
(Just "Sending memo to orchard")
]
Full
case tx of
Left e -> assertFailure $ show e
@ -291,9 +240,11 @@ main = do
TestNet
(toSqlKey 4)
3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
"Sending memo to sapling"
(Just "Sending memo to sapling")
]
Full
case tx of
Left e -> assertFailure $ show e
@ -313,13 +264,49 @@ main = do
TestNet
(toSqlKey 4)
3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
""
Nothing
]
Full
tx `shouldBe`
Left
(PrivacyPolicyError "Receiver not capable of Full privacy")
it "To mixed shielded receivers" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
let uaRead2 =
parseAddress
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
case uaRead of
Nothing -> assertFailure "wrong address"
Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <-
runFileLoggingT "zenith.log" $
prepareTxV2
pool
"localhost"
18232
TestNet
(toSqlKey 1)
3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(Just "Sending memo to orchard")
, ProposedNote
(ValidAddressAPI $ fromJust uaRead2)
0.004
Nothing
]
Full
tx `shouldBe`
Left
(PrivacyPolicyError
"Combination of receivers not allowed for Full privacy")
describe "Medium" $ do
it "To Orchard" $ do
let uaRead =
@ -338,9 +325,11 @@ main = do
TestNet
(toSqlKey 1)
3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
"Sending memo to orchard"
(Just "Sending memo to orchard")
]
Medium
case tx of
Left e -> assertFailure $ show e
@ -362,9 +351,11 @@ main = do
TestNet
(toSqlKey 1)
3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
"Sending memo to orchard"
(Just "Sending memo to sapling")
]
Medium
case tx of
Left e -> assertFailure $ show e
@ -384,13 +375,48 @@ main = do
TestNet
(toSqlKey 4)
3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
""
Nothing
]
Medium
tx `shouldBe`
Left
(PrivacyPolicyError "Receiver not capable of Medium privacy")
it "To mixed shielded receivers" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
let uaRead2 =
parseAddress
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
case uaRead of
Nothing -> assertFailure "wrong address"
Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <-
runFileLoggingT "zenith.log" $
prepareTxV2
pool
"localhost"
18232
TestNet
(toSqlKey 1)
3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(Just "Sending memo to orchard")
, ProposedNote
(ValidAddressAPI $ fromJust uaRead2)
0.004
Nothing
]
Medium
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")
describe "Low" $ do
it "To Orchard" $ do
let uaRead =
@ -409,9 +435,11 @@ main = do
TestNet
(toSqlKey 1)
3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
"Sending memo to orchard"
Nothing
]
Low
case tx of
Left e -> assertFailure $ show e
@ -433,9 +461,11 @@ main = do
TestNet
(toSqlKey 1)
3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
"Sending memo to orchard"
Nothing
]
Low
case tx of
Left e -> assertFailure $ show e
@ -455,9 +485,11 @@ main = do
TestNet
(toSqlKey 1)
3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
""
Nothing
]
Low
case tx of
Left e -> assertFailure $ show e
@ -480,14 +512,16 @@ main = do
TestNet
(toSqlKey 1)
3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
"Sending memo to orchard"
Nothing
]
None
tx `shouldBe`
Left
(PrivacyPolicyError
"Receiver not compatible with privacy policy")
"Shielded recipients not compatible with privacy policy.")
it "To Sapling" $ do
let uaRead =
parseAddress
@ -505,14 +539,16 @@ main = do
TestNet
(toSqlKey 1)
3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
"Sending memo to orchard"
Nothing
]
None
tx `shouldBe`
Left
(PrivacyPolicyError
"Receiver not compatible with privacy policy")
"Shielded recipients not compatible with privacy policy.")
it "To Transparent" $ do
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
case uaRead of
@ -528,9 +564,11 @@ main = do
TestNet
(toSqlKey 1)
3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(fromJust uaRead)
""
Nothing
]
None
case tx of
Left e -> assertFailure $ show e

View file

@ -132,6 +132,7 @@
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" }
]
},
@ -228,6 +229,7 @@
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/DuplicateName" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidWallet" }
]
},
@ -444,6 +446,7 @@
],
"errors": [
{ "$ref": "#/components/errors/InvalidAccount" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" }
]
},
@ -593,10 +596,11 @@
{
"name": "sendmany",
"summary": "Send transaction(s)",
"description": "Send one or more transactions by specifying the source account, the recipient address, the amount, the shielded memo (optional) and the privacy policy (optional).",
"tags": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}],
"description": "Send one transaction by specifying the source account, the privacy policy (optional, default 'Full') and an array of proposed outputs. Each output needs a recipient address, an amount and an optional shielded memo.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/AccountId"},
{ "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
{ "$ref": "#/components/contentDescriptors/TxRequestArray"}
],
"paramStructure": "by-position",
@ -610,14 +614,19 @@
"examples": [
{
"name": "Send a transaction",
"summary": "Send one transaction",
"description": "Send a single transaction",
"summary": "Send a transaction",
"description": "Send a transaction with one output",
"params": [
{
"name": "Account index",
"summary": "The index for the account to use",
"value": "1"
},
{
"name": "Privacy Policy",
"summary": "The selected privacy policy",
"value": "Full"
},
{
"name": "Transaction request",
"summary": "The transaction to attempt",
@ -640,7 +649,7 @@
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/InvalidRecipient" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidAccount" }
]
},
@ -736,6 +745,16 @@
"type": "array",
"items": { "$ref": "#/components/schemas/TxRequest"}
}
},
"PrivacyPolicy": {
"name": "Privacy Policy",
"summary": "The chosen privacy policy to use for the transaction",
"description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.",
"required": false,
"schema": {
"type": "string",
"enum": ["None", "Low", "Medium", "Full"]
}
}
},
"schemas": {
@ -814,8 +833,7 @@
"properties": {
"address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
"amount": { "type": "number", "description": "The amount to send in ZEC"},
"memo": { "type": "string", "description": "The shielded memo to include, if applicable"},
"privacy": { "type": "string", "enum": ["None", "Low", "Medium", "Full"], "description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools and deshielding transactions. `Low` allows to spend transparent funds into shielded pools. `None` allows for transparent funds to be spent to transparent addresses."}
"memo": { "type": "string", "description": "The shielded memo to include, if applicable"}
}
}
},
@ -872,6 +890,10 @@
"InvalidRecipient": {
"code": -32011,
"message": "The provided recipient address is not valid."
},
"ZenithBusy": {
"code": -32012,
"message": "The Zenith server is syncing, please try again later."
}
}
}