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 - `getnewaccount` RPC method
- `getnewaddress` RPC method - `getnewaddress` RPC method
- `getoperationstatus` RPC method - `getoperationstatus` RPC method
- `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy` - Function `prepareTxV2` implementing `PrivacyPolicy`
### Changed ### 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 - Detection of changes in database schema for automatic re-scan
- Block tracking for chain re-org detection - Block tracking for chain re-org detection
- Refactored `ZcashPool` - Refactored `ZcashPool`
- Preventing write operations to occur during wallet sync
## [0.6.0.0-beta] ## [0.6.0.0-beta]

View file

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

View file

@ -2,6 +2,7 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Zenith.CLI where module Zenith.CLI where
@ -62,13 +63,14 @@ import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.ProgressBar as P import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throw, throwIO, try) 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.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger
( LoggingT ( LoggingT
, NoLoggingT
, logDebugN , logDebugN
, runFileLoggingT
, runNoLoggingT , runNoLoggingT
, runStderrLoggingT
) )
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
@ -88,8 +90,15 @@ 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
import ZcashHaskell.Transparent (encodeTransparentReceiver) ( getSaplingFromUA
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Transparent
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
@ -100,9 +109,12 @@ import Zenith.Types
, HexStringDB(..) , HexStringDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..) , PrivacyPolicy(..)
, UnifiedAddressDB(..) , ProposedNote(..)
, ZcashNetDB(..)
, ShieldDeshieldOp(..) , ShieldDeshieldOp(..)
, UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..)
, ZenithStatus(..)
) )
import Zenith.Utils import Zenith.Utils
( displayTaz ( displayTaz
@ -133,7 +145,7 @@ data Name
| PrivacyLowField | PrivacyLowField
| PrivacyMediumField | PrivacyMediumField
| PrivacyFullField | PrivacyFullField
| ShieldField | ShieldField
| DeshieldField | DeshieldField
| TotalTranspField | TotalTranspField
| TotalShieldedField | TotalShieldedField
@ -161,11 +173,9 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry makeLenses ''AdrBookEntry
data ShDshEntry = ShDshEntry newtype ShDshEntry = ShDshEntry
{ _totalTransparent :: !Float { _shAmt :: Float
, _totalShielded :: !Float } deriving (Show)
, _shAmt :: !Float
} deriving (Show)
makeLenses ''ShDshEntry makeLenses ''ShDshEntry
@ -181,7 +191,7 @@ data DialogType
| AdrBookForm | AdrBookForm
| AdrBookUpdForm | AdrBookUpdForm
| AdrBookDelForm | AdrBookDelForm
| DeshieldForm | DeshieldForm
| ShieldForm | ShieldForm
data DisplayType data DisplayType
@ -232,7 +242,8 @@ data State = State
, _sentTx :: !(Maybe HexString) , _sentTx :: !(Maybe HexString)
, _unconfBalance :: !Integer , _unconfBalance :: !Integer
, _deshieldForm :: !(Form ShDshEntry () Name) , _deshieldForm :: !(Form ShDshEntry () Name)
, _shieldForm :: !(Form ShDshEntry () Name) , _tBalance :: !Integer
, _sBalance :: !Integer
} }
makeLenses ''State makeLenses ''State
@ -249,11 +260,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(" Zenith - " <> (" Zenith - " <>
show (st ^. network) <> show (st ^. network) <>
" - " <> " - " <>
(T.unpack T.unpack
(maybe (maybe
"(None)" "(None)"
(\(_, w) -> zcashWalletName $ entityVal w) (\(_, w) -> zcashWalletName $ entityVal w)
(L.listSelectedElement (st ^. wallets)))) ++ (L.listSelectedElement (st ^. wallets))) ++
" ")) " "))
(C.hCenter (C.hCenter
(str (str
@ -280,25 +291,24 @@ 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))) <=>
(vBox (vBox
[C.hCenter [ C.hCenter
(hBox (hBox
[ capCommand "W" "allets" [ capCommand "W" "allets"
, capCommand "A" "ccounts" , capCommand "A" "ccounts"
, capCommand "V" "iew address" , capCommand "V" "iew address"
, capCommand3 "" "S" "end Tx" , capCommand3 "" "S" "end Tx"
]) ])
,C.hCenter , C.hCenter
(hBox (hBox
[ capCommand2 "Address " "B" "ook" [ capCommand2 "Address " "B" "ook"
, capCommand2 "s" "H" "ield" , capCommand2 "s" "H" "ield"
, capCommand "D" "e-shield" , capCommand "D" "e-shield"
, capCommand "Q" "uit" , capCommand "Q" "uit"
, capCommand "?" " Help" , capCommand "?" " Help"
, str $ show (st ^. timer) , 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 $
@ -424,14 +434,33 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"])) (hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"]))
DeshieldForm -> DeshieldForm ->
D.renderDialog D.renderDialog
(D.dialog (Just (str " De-Shield Zec ")) Nothing 50) (D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
(renderForm (st ^. deshieldForm) <=> (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 C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"])) (hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
ShieldForm -> ShieldForm ->
D.renderDialog D.renderDialog
(D.dialog (Just (str " Shield Zec ")) Nothing 50) (D.dialog (Just (str " Shield ZEC ")) Nothing 50)
(renderForm (st ^. shieldForm) <=> (C.hCenter
(str $
"Shield " ++
if st ^. network == MainNet
then displayZec (st ^. tBalance)
else displayTaz (st ^. tBalance) ++ "?") <=>
C.hCenter C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"])) (hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
Blank -> emptyWidget Blank -> emptyWidget
@ -678,26 +707,10 @@ mkSendForm bal =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
mkDeshieldForm bal = mkDeshieldForm tbal =
newForm newForm
[ label "Total Transp. : " @@= [ label "Amount: " @@=
editShowableFieldWithValidate totalTransparent TotalTranspField (isAmountValid bal) editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
, 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)
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Float -> Bool
@ -819,34 +832,45 @@ scanZebra dbP zHost zPort b eChan znet = do
pool <- liftIO $ runNoLoggingT $ initPool dbP pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1 chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
logDebugN $ syncChk <- liftIO $ isSyncing pool
"dbBlock: " <> if syncChk
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
if sb > zgb_blocks bStatus || sb < 1
then do
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
else do else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] logDebugN $
if not (null bList) "dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
if sb > zgb_blocks bStatus || sb < 1
then do then do
let step = liftIO $
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
mapM_ (liftIO . processBlock pool step) bList else do
else liftIO $ BC.writeBChan eChan $ TickVal 1.0 let bList = [(sb + 1) .. (zgb_blocks bStatus)]
confUp <- if not (null bList)
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT then do
IO let step =
(Either IOError ()) (1.0 :: Float) /
case confUp of fromIntegral (zgb_blocks bStatus - (sb + 1))
Left _e0 -> _ <- liftIO $ startSync pool
liftIO $ mapM_ (liftIO . processBlock pool step) bList
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions" confUp <-
Right _ -> return () liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
IO
(Either IOError ())
case confUp of
Left _e0 -> do
_ <- liftIO $ completeSync pool Failed
liftIO $
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 where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do processBlock pool step bl = do
@ -858,7 +882,9 @@ scanZebra dbP zHost zPort b eChan znet = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1] [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
case r of 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 Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -868,7 +894,9 @@ scanZebra dbP zHost zPort b eChan znet = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0] [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
case r2 of 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 Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- bi <-
@ -925,7 +953,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)
@ -935,11 +963,11 @@ appEvent (BT.AppEvent t) = do
"pwd" "pwd"
8080) 8080)
selWallet selWallet
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
updatedState <- BT.get updatedState <- BT.get
ns <- liftIO $ refreshWallet updatedState ns <- liftIO $ refreshWallet updatedState
BT.put ns BT.put ns
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue) else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
BlankDisplay -> do BlankDisplay -> do
case s ^. dialogBox of case s ^. dialogBox of
@ -964,7 +992,7 @@ appEvent (BT.AppEvent t) = do
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
runFileLoggingT "zenith.log" $ runStderrLoggingT $
scanZebra scanZebra
(s ^. dbPath) (s ^. dbPath)
(s ^. zebraHost) (s ^. zebraHost)
@ -1188,6 +1216,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
@ -1201,16 +1230,102 @@ appEvent (BT.VtyEvent e) = do
fs <- BT.gets formState fs <- BT.gets formState
BT.modify $ BT.modify $
setFieldValid setFieldValid
(isRecipientValidGUI (fs ^. policyField) (fs ^. sendTo)) (isRecipientValidGUI
(fs ^. policyField)
(fs ^. sendTo))
RecField RecField
DeshieldForm -> do DeshieldForm -> do
case e of case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
ev -> V.EvKey (V.KChar 'p') [] -> do
BT.zoom deshieldForm $ do if allFieldsValid (s ^. deshieldForm)
handleFormEvent (BT.VtyEvent ev) then do
-- fs <- BT.gets formState pool <-
-- ev -> BT.zoom deshieldForm $ L.handleListEvent ev 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)
AdrBook -> do AdrBook -> do
case e of case e of
V.EvKey (V.KChar 'x') [] -> V.EvKey (V.KChar 'x') [] ->
@ -1228,7 +1343,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
@ -1394,6 +1509,53 @@ appEvent (BT.VtyEvent e) = do
BT.put s' BT.put s'
BT.modify $ set dialogBox AdrBook BT.modify $ set dialogBox AdrBook
ev -> BT.modify $ set dialogBox AdrBookDelForm 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 -- Process any other event
Blank -> do Blank -> do
case e of case e of
@ -1420,10 +1582,57 @@ 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') [] -> 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 BT.modify $ set dialogBox DeshieldForm
V.EvKey (V.KChar 'h') [] -> V.EvKey (V.KChar 'h') [] -> do
BT.modify $ set dialogBox ShieldForm 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 -> ev ->
case r of case r of
Just AList -> Just AList ->
@ -1438,6 +1647,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
@ -1520,6 +1731,14 @@ runZenithTUI config = do
if not (null accList) if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0 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 eventChan <- BC.newBChan 10
_ <- _ <-
forkIO $ forkIO $
@ -1533,7 +1752,7 @@ runZenithTUI config = do
State State
(zgb_net chainInfo) (zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1) (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 AList (Vec.fromList addrList) 1)
(L.list TList (Vec.fromList txList) 1) (L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++ ("Start up Ok! Connected to Zebra " ++
@ -1562,8 +1781,9 @@ runZenithTUI config = do
"" ""
Nothing Nothing
uBal uBal
(mkDeshieldForm 0 (ShDshEntry 0 0 0.0 )) (mkDeshieldForm 0 (ShDshEntry 0.0))
(mkShieldForm 0 (ShDshEntry 0 0 0.0 )) tBal
sBal
Left _e -> do Left _e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
@ -1583,7 +1803,7 @@ refreshWallet s = do
Just (j, w1) -> return (j, w1) Just (j, w1) -> return (j, w1)
Just (k, w) -> return (k, w) Just (k, w) -> return (k, w)
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
let bl = zcashWalletLastSync $ entityVal selWallet let bl = zcashWalletLastSync $ entityVal $ walList !! ix
addrL <- addrL <-
if not (null aL) if not (null aL)
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
@ -1777,15 +1997,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
@ -1799,3 +2034,56 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
case resp of case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1 Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId 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.Digest.Pure.MD5
import Data.HexString (HexString, hexString, toBytes, toText) import Data.HexString (HexString, hexString, toBytes, toText)
import Data.List import Data.List
import Data.Maybe (fromJust) import Data.Maybe (fromJust, fromMaybe)
import Data.Pool (Pool) import Data.Pool (Pool)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@ -34,7 +34,11 @@ import Data.Time
import qualified Database.Esqueleto.Experimental as ESQ import qualified Database.Esqueleto.Experimental as ESQ
import Database.Persist import Database.Persist
import Database.Persist.Sqlite import Database.Persist.Sqlite
import GHC.Float.RealFracMethods (floorFloatInteger) import GHC.Float.RealFracMethods
( ceilingFloatInteger
, floorFloatInt
, floorFloatInteger
)
import Haskoin.Crypto.Keys (XPrvKey(..)) import Haskoin.Crypto.Keys (XPrvKey(..))
import Lens.Micro ((&), (.~), (^.), set) import Lens.Micro ((&), (.~), (^.), set)
import Network.HTTP.Client import Network.HTTP.Client
@ -75,11 +79,13 @@ import Zenith.Types
, OrchardSpendingKeyDB(..) , OrchardSpendingKeyDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..) , PrivacyPolicy(..)
, ProposedNote(..)
, RseedDB(..) , RseedDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, ScopeDB(..) , ScopeDB(..)
, TransparentSpendingKeyDB(..) , TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZebraTreeInfo(..) , ZebraTreeInfo(..)
) )
@ -541,7 +547,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
return $ Left ZHError return $ Left ZHError
Just acc -> do Just acc -> do
logDebugN $ T.pack $ show acc logDebugN $ T.pack $ show acc
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) let zats = floorFloatInteger $ amt * (10 ^ 8)
logDebugN $ T.pack $ show zats logDebugN $ T.pack $ show zats
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient --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 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
@ -729,38 +852,13 @@ prepareTxV2 ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Float -> [ProposedNote]
-> ValidAddress
-> T.Text
-> PrivacyPolicy -> PrivacyPolicy
-> LoggingT IO (Either TxError HexString) -> NoLoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
accRead <- liftIO $ getAccountById pool za accRead <- liftIO $ getAccountById pool za
let recipient = let recipients = map extractReceiver pnotes
case va of logDebugN $ T.pack $ show recipients
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
logDebugN $ T.pack $ "Target block: " ++ show bh logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees let sT = SaplingCommitmentTree $ ztiSapling trees
@ -771,14 +869,21 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
return $ Left ZHError return $ Left ZHError
Just acc -> do Just acc -> do
logDebugN $ T.pack $ show acc logDebugN $ T.pack $ show acc
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
logDebugN $ T.pack $ show zats let zats = ceilingFloatInteger $ amt * (10 ^ 8)
logDebugN $ "amt: " <> T.pack (show amt)
logDebugN $ "zats: " <> T.pack (show zats)
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient --let fee = calculateTxFee firstPass $ fst recipient
--logDebugN $ T.pack $ "calculated fee " ++ show fee --logDebugN $ T.pack $ "calculated fee " ++ show fee
notePlan <- notePlan <-
liftIO $ liftIO $
selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy selectUnspentNotesV2
pool
za
(zats + 10000)
(map (\(x, _, _, _) -> x) recipients)
policy
case notePlan of case notePlan of
Right (tList, sList, oList) -> do Right (tList, sList, oList) -> do
logDebugN "selected notes" 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 sList
logDebugN $ T.pack $ show oList logDebugN $ T.pack $ show oList
let noteTotal = getTotalAmount (tList, sList, oList) let noteTotal = getTotalAmount (tList, sList, oList)
logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
tSpends <- tSpends <-
liftIO $ liftIO $
prepTSpends prepTSpends
@ -806,7 +912,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
--print oSpends --print oSpends
dummy' <- dummy' <-
liftIO $ liftIO $
makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
case dummy' of case dummy' of
Left e -> return $ Left e Left e -> return $ Left e
Right dummy -> do Right dummy -> do
@ -834,7 +940,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
pool pool
za za
(zats + feeAmt) (zats + feeAmt)
(fst recipient) (map (\(x, _, _, _) -> x) recipients)
policy policy
case finalNotePlan of case finalNotePlan of
Right (tList1, sList1, oList1) -> do Right (tList1, sList1, oList1) -> do
@ -863,8 +969,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
liftIO $ liftIO $
makeOutgoing makeOutgoing
acc acc
recipient recipients
zats
(noteTotal1 - feeAmt - zats) (noteTotal1 - feeAmt - zats)
policy policy
logDebugN $ T.pack $ show outgoing' logDebugN $ T.pack $ show outgoing'
@ -889,30 +994,136 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
logErrorN $ T.pack $ show e logErrorN $ T.pack $ show e
return $ Left e return $ Left e
where 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 :: makeOutgoing ::
Entity ZcashAccount Entity ZcashAccount
-> (Int, BS.ByteString) -> [(Int, BS.ByteString, Int, T.Text)]
-> Integer
-> Integer -> Integer
-> PrivacyPolicy -> PrivacyPolicy
-> IO (Either TxError [OutgoingNote]) -> 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 chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
case k of case pol of
4 -> Full ->
case policy of if elem 1 k || elem 2 k || elem 5 k || elem 6 k
None -> then return $
return $ Left $
Left $ PrivacyPolicyError
PrivacyPolicyError "Receiver not compatible with privacy policy" "Receiver not compatible with privacy policy"
_anyOther -> do else if elem 3 k && elem 4 k
then return $
Left $
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 = let chgRcvr =
fromJust $ fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $ let cnote =
Right OutgoingNote
[ OutgoingNote
4 4
(getBytes $ (getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
@ -920,51 +1131,20 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
(fromIntegral chg) (fromIntegral chg)
"" ""
True True
, OutgoingNote let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
4 return $ Right $ cnote : onotes
(getBytes $ Low ->
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) if elem 5 k || elem 6 k
recvr then return $
(fromIntegral zats) Left $
(E.encodeUtf8 memo) PrivacyPolicyError
False "Receiver not compatible with privacy policy"
] else do
3 ->
case policy of
None ->
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 = let chgRcvr =
fromJust $ fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $ let cnote =
Right OutgoingNote
[ OutgoingNote
4 4
(getBytes $ (getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
@ -972,58 +1152,28 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
(fromIntegral chg) (fromIntegral chg)
"" ""
True True
, OutgoingNote let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
3 return $ Right $ cnote : onotes
(getBytes $ None ->
getSapSK $ zcashAccountSapSpendKey $ entityVal acc) if elem 3 k || elem 4 k
recvr then return $
(fromIntegral zats) Left $
(E.encodeUtf8 memo) PrivacyPolicyError
False "Receiver not compatible with privacy policy"
] else do
2 ->
if policy <= Low
then do
let chgRcvr = let chgRcvr =
fromJust $ fromJust $
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $ let cnote =
Right OutgoingNote
[ OutgoingNote
1 1
BS.empty BS.empty
(toBytes $ tr_bytes chgRcvr) (toBytes $ tr_bytes chgRcvr)
(fromIntegral chg) (fromIntegral chg)
"" ""
True True
, OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
] return $ Right $ cnote : onotes
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
getTotalAmount :: getTotalAmount ::
( [Entity WalletTrNote] ( [Entity WalletTrNote]
, [Entity WalletSapNote] , [Entity WalletSapNote]
@ -1111,7 +1261,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo 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

View file

@ -291,6 +291,13 @@ share
result T.Text Maybe result T.Text Maybe
UniqueOp uuid UniqueOp uuid
deriving Show Eq deriving Show Eq
ChainSync
name T.Text
start UTCTime
end UTCTime Maybe
status ZenithStatus
UniqueSync name
deriving Show Eq
|] |]
-- ** Type conversions -- ** Type conversions
@ -1184,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 $
@ -1194,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 $
@ -1204,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
@ -1248,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
@ -1298,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
@ -1837,6 +2030,51 @@ getUnconfPoolBalance pool za = do
let oBal = sum oAmts let oBal = sum oAmts
return $ AccountBalance tBal sBal oBal 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 :: ConnectionPool -> IO ()
clearWalletTransactions pool = do clearWalletTransactions pool = do
runNoLoggingT $ runNoLoggingT $
@ -2080,7 +2318,7 @@ selectUnspentNotesV2 ::
ConnectionPool ConnectionPool
-> ZcashAccountId -> ZcashAccountId
-> Integer -> Integer
-> Int -> [Int]
-> PrivacyPolicy -> PrivacyPolicy
-> IO -> IO
(Either (Either
@ -2091,27 +2329,40 @@ selectUnspentNotesV2 ::
selectUnspentNotesV2 pool za amt recv policy = do selectUnspentNotesV2 pool za amt recv policy = do
case policy of case policy of
Full -> Full ->
case recv of if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
4 -> do then return $
orchNotes <- getWalletUnspentOrchNotes pool za Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes else if elem 4 recv && elem 3 recv
if a1 > 0 then return $
then return $ Left $
Left $ PrivacyPolicyError "Not enough notes for Full privacy" PrivacyPolicyError
else return $ Right ([], [], oList) "Combination of receivers not allowed for Full privacy"
3 -> do else if 4 `elem` recv
sapNotes <- getWalletUnspentSapNotes pool za then do
let (a2, sList) = checkSapling (fromIntegral amt) sapNotes orchNotes <- getWalletUnspentOrchNotes pool za
if a2 > 0 let (a1, oList) =
then return $ checkOrchard (fromIntegral amt) orchNotes
Left $ PrivacyPolicyError "Not enough notes for Full privacy" if a1 > 0
else return $ Right ([], sList, []) then return $
_anyOther -> Left $
return $ PrivacyPolicyError
Left $ PrivacyPolicyError "Receiver not capable of Full privacy" "Not enough notes for Full privacy"
else return $ Right ([], [], oList)
else do
sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) =
checkSapling (fromIntegral amt) sapNotes
if a2 > 0
then return $
Left $
PrivacyPolicyError
"Not enough notes for Full privacy"
else return $ Right ([], sList, [])
Medium -> Medium ->
if recv > 2 if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
then do then return $
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
else do
orchNotes <- getWalletUnspentOrchNotes pool za orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0 if a1 > 0
@ -2124,27 +2375,16 @@ selectUnspentNotesV2 pool za amt recv policy = do
PrivacyPolicyError "Not enough notes for Medium privacy" PrivacyPolicyError "Not enough notes for Medium privacy"
else return $ Right ([], sList, oList) else return $ Right ([], sList, oList)
else return $ Right ([], [], oList) else return $ Right ([], [], oList)
else return $
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
Low -> Low ->
if recv == 0 if 0 `elem` recv
then return $ Left ZHError then return $ Left ZHError
else do else do
case recv of if elem 5 recv || elem 6 recv
3 -> do then return $
sapNotes <- getWalletUnspentSapNotes pool za Left $
let (a1, sList) = checkSapling (fromIntegral amt) sapNotes PrivacyPolicyError
if a1 > 0 "Exchange addresses not supported with Low privacy"
then do else do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a2, oList) = checkOrchard a1 orchNotes
if a2 > 0
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 orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0 if a1 > 0
@ -2152,27 +2392,27 @@ selectUnspentNotesV2 pool za amt recv policy = do
sapNotes <- getWalletUnspentSapNotes pool za sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = checkSapling a1 sapNotes let (a2, sList) = checkSapling a1 sapNotes
if a2 > 0 if a2 > 0
then return $ then do
Left $ trNotes <- getWalletUnspentTrNotes pool za
PrivacyPolicyError "Not enough notes for Low privacy" let (a3, tList) = checkTransparent a2 trNotes
if a3 > 0
then return $ Left InsufficientFunds
else return $ Right (tList, sList, oList)
else return $ Right ([], sList, oList) else return $ Right ([], sList, oList)
else return $ Right ([], [], oList) else return $ Right ([], [], oList)
None -> do None -> do
orchNotes <- getWalletUnspentOrchNotes pool za if elem 3 recv || elem 4 recv
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes then return $
if a1 > 0 Left $
then do PrivacyPolicyError
sapNotes <- getWalletUnspentSapNotes pool za "Shielded recipients not compatible with privacy policy."
let (a2, sList) = checkSapling a1 sapNotes else do
if a2 > 0 trNotes <- getWalletUnspentTrNotes pool za
then do let (a3, tList) = checkTransparent (fromIntegral amt) trNotes
trNotes <- getWalletUnspentTrNotes pool za if a3 > 0
let (a3, tList) = checkTransparent a2 trNotes then return $
if a3 > 0 Left $ PrivacyPolicyError "Insufficient transparent funds"
then return $ Left InsufficientFunds else return $ Right (tList, [], [])
else return $ Right (tList, sList, oList)
else return $ Right ([], sList, oList)
else return $ Right ([], [], oList)
where where
checkTransparent :: checkTransparent ::
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote]) Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
@ -2235,6 +2475,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 =
@ -2327,13 +2580,83 @@ finalizeOperation pool op status result = do
] ]
where_ (ops ^. OperationId ==. val op) where_ (ops ^. OperationId ==. val op)
-- * 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 -- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> IO () rewindWalletData :: ConnectionPool -> Int -> IO ()
rewindWalletData pool b = do rewindWalletData pool b = do
rewindWalletTransactions pool b
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ flip PS.runSqlPool pool $ do
delete $ do oldBlocks <-
blk <- from $ table @ZcashBlock select $ do
where_ $ blk ^. ZcashBlockHeight >=. val b blk <- from $ table @ZcashBlock
clearWalletTransactions pool 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

View file

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

View file

@ -8,21 +8,28 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
module Zenith.RPC where module Zenith.RPC where
import Control.Concurrent (forkIO)
import Control.Exception (try) import Control.Exception (try)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
import Data.Aeson import Data.Aeson
import qualified Data.HexString as H
import Data.Int import Data.Int
import Data.Scientific (floatingOrInteger) import Data.Scientific (floatingOrInteger)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time.Clock (getCurrentTime)
import qualified Data.UUID as U import qualified Data.UUID as U
import Data.UUID.V4 (nextRandom)
import qualified Data.Vector as V import qualified Data.Vector as V
import Database.Esqueleto.Experimental import Database.Esqueleto.Experimental
( entityKey ( ConnectionPool
, entityKey
, entityVal , entityVal
, fromSqlKey , fromSqlKey
, toSqlKey , toSqlKey
@ -31,43 +38,72 @@ import Servant
import Text.Read (readMaybe) import Text.Read (readMaybe)
import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (parseAddress) import ZcashHaskell.Orchard (parseAddress)
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..)) import ZcashHaskell.Types
import Zenith.Core (createCustomWalletAddress, createZcashAccount) ( BlockResponse(..)
, RpcError(..)
, Scope(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..)
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
( checkBlockChain
, createCustomWalletAddress
, createZcashAccount
, prepareTxV2
, syncWallet
)
import Zenith.DB import Zenith.DB
( Operation(..) ( Operation(..)
, ZcashAccount(..) , ZcashAccount(..)
, ZcashBlock(..)
, ZcashWallet(..) , ZcashWallet(..)
, completeSync
, finalizeOperation
, findNotesByAddress , findNotesByAddress
, getAccountById , getAccountById
, getAccounts , getAccounts
, getAddressById , getAddressById
, getAddresses , getAddresses
, getExternalAddresses , getExternalAddresses
, getLastSyncBlock
, getMaxAccount , getMaxAccount
, getMaxAddress , getMaxAddress
, getMaxBlock
, getMinBirthdayHeight
, getOperation , getOperation
, getPoolBalance , getPoolBalance
, getUnconfPoolBalance , getUnconfPoolBalance
, getWalletNotes , getWalletNotes
, getWallets , getWallets
, initPool , initPool
, isSyncing
, rewindWalletData
, saveAccount , saveAccount
, saveAddress , saveAddress
, saveBlock
, saveOperation
, saveWallet , saveWallet
, startSync
, toZcashAccountAPI , toZcashAccountAPI
, toZcashAddressAPI , toZcashAddressAPI
, toZcashWalletAPI , toZcashWalletAPI
, walletExists , walletExists
) )
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
import Zenith.Types import Zenith.Types
( AccountBalance(..) ( AccountBalance(..)
, Config(..) , Config(..)
, HexStringDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ZcashAccountAPI(..) , ZcashAccountAPI(..)
, ZcashAddressAPI(..) , ZcashAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZcashNoteAPI(..) , ZcashNoteAPI(..)
, ZcashWalletAPI(..) , ZcashWalletAPI(..)
, ZenithStatus(..)
, ZenithUuid(..) , ZenithUuid(..)
) )
import Zenith.Utils (jsonNumber) import Zenith.Utils (jsonNumber)
@ -83,6 +119,7 @@ data ZenithMethod
| GetNewAccount | GetNewAccount
| GetNewAddress | GetNewAddress
| GetOperationStatus | GetOperationStatus
| SendMany
| UnknownMethod | UnknownMethod
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -97,6 +134,7 @@ instance ToJSON ZenithMethod where
toJSON GetNewAccount = Data.Aeson.String "getnewaccount" toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
toJSON GetNewAddress = Data.Aeson.String "getnewaddress" toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus" toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
toJSON SendMany = Data.Aeson.String "sendmany"
toJSON UnknownMethod = Data.Aeson.Null toJSON UnknownMethod = Data.Aeson.Null
instance FromJSON ZenithMethod where instance FromJSON ZenithMethod where
@ -112,6 +150,7 @@ instance FromJSON ZenithMethod where
"getnewaccount" -> pure GetNewAccount "getnewaccount" -> pure GetNewAccount
"getnewaddress" -> pure GetNewAddress "getnewaddress" -> pure GetNewAddress
"getoperationstatus" -> pure GetOperationStatus "getoperationstatus" -> pure GetOperationStatus
"sendmany" -> pure SendMany
_ -> pure UnknownMethod _ -> pure UnknownMethod
data ZenithParams data ZenithParams
@ -125,6 +164,7 @@ data ZenithParams
| NameIdParams !T.Text !Int | NameIdParams !T.Text !Int
| NewAddrParams !Int !T.Text !Bool !Bool | NewAddrParams !Int !T.Text !Bool !Bool
| OpParams !ZenithUuid | OpParams !ZenithUuid
| SendParams !Int ![ProposedNote] !PrivacyPolicy
| TestParams !T.Text | TestParams !T.Text
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -148,6 +188,8 @@ instance ToJSON ZenithParams where
[Data.Aeson.String "ExcludeTransparent" | t] [Data.Aeson.String "ExcludeTransparent" | t]
toJSON (OpParams i) = toJSON (OpParams i) =
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid 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 data ZenithResponse
= InfoResponse !T.Text !ZenithInfo = InfoResponse !T.Text !ZenithInfo
@ -159,6 +201,7 @@ data ZenithResponse
| NewItemResponse !T.Text !Int64 | NewItemResponse !T.Text !Int64
| NewAddrResponse !T.Text !ZcashAddressAPI | NewAddrResponse !T.Text !ZcashAddressAPI
| OpResponse !T.Text !Operation | OpResponse !T.Text !Operation
| SendResponse !T.Text !U.UUID
| ErrorResponse !T.Text !Double !T.Text | ErrorResponse !T.Text !Double !T.Text
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -179,6 +222,7 @@ instance ToJSON ZenithResponse where
toJSON (NewItemResponse i ix) = packRpcResponse i ix toJSON (NewItemResponse i ix) = packRpcResponse i ix
toJSON (NewAddrResponse i a) = packRpcResponse i a toJSON (NewAddrResponse i a) = packRpcResponse i a
toJSON (OpResponse i u) = packRpcResponse i u toJSON (OpResponse i u) = packRpcResponse i u
toJSON (SendResponse i o) = packRpcResponse i o
instance FromJSON ZenithResponse where instance FromJSON ZenithResponse where
parseJSON = parseJSON =
@ -258,6 +302,10 @@ instance FromJSON ZenithResponse where
case floatingOrInteger k of case floatingOrInteger k of
Left _e -> fail "Unknown value" Left _e -> fail "Unknown value"
Right k' -> pure $ NewItemResponse i k' 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" _anyOther -> fail "Malformed JSON"
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1) Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
@ -416,6 +464,30 @@ instance FromJSON RpcCall where
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
else pure $ RpcCall v i GetOperationStatus BadParams else pure $ RpcCall v i GetOperationStatus BadParams
_anyOther -> 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 type ZenithRPC
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@ -573,27 +645,35 @@ zenithServer state = getinfo :<|> handleRPC
case parameters req of case parameters req of
NameParams t -> do NameParams t -> do
let dbPath = w_dbPath state let dbPath = w_dbPath state
sP <- liftIO generateWalletSeedPhrase
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
r <- syncChk <- liftIO $ isSyncing pool
liftIO $ if syncChk
saveWallet pool $ then return $
ZcashWallet ErrorResponse
t (callId req)
(ZcashNetDB $ w_network state) (-32012)
(PhraseDB sP) "The Zenith server is syncing, please try again later."
(w_startBlock state) else do
0 sP <- liftIO generateWalletSeedPhrase
case r of r <-
Nothing -> liftIO $
return $ saveWallet pool $
ErrorResponse ZcashWallet
(callId req) t
(-32007) (ZcashNetDB $ w_network state)
"Entity with that name already exists." (PhraseDB sP)
Just r' -> (w_startBlock state)
return $ 0
NewItemResponse (callId req) $ fromSqlKey $ entityKey r' case r of
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Just r' ->
return $
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAccount -> GetNewAccount ->
@ -601,34 +681,45 @@ zenithServer state = getinfo :<|> handleRPC
NameIdParams t i -> do NameIdParams t i -> do
let dbPath = w_dbPath state let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
w <- liftIO $ walletExists pool i syncChk <- liftIO $ isSyncing pool
case w of if syncChk
Just w' -> do then return $
aIdx <- liftIO $ getMaxAccount pool $ entityKey w' ErrorResponse
nAcc <- (callId req)
liftIO (-32012)
(try $ createZcashAccount t (aIdx + 1) w' :: IO "The Zenith server is syncing, please try again later."
(Either IOError ZcashAccount)) else do
case nAcc of w <- liftIO $ walletExists pool i
Left e -> case w of
Just w' -> do
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
nAcc <-
liftIO
(try $ createZcashAccount t (aIdx + 1) w' :: IO
(Either IOError ZcashAccount))
case nAcc of
Left e ->
return $
ErrorResponse (callId req) (-32010) $ T.pack $ show e
Right nAcc' -> do
r <- liftIO $ saveAccount pool nAcc'
case r of
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Just x ->
return $
NewItemResponse (callId req) $
fromSqlKey $ entityKey x
Nothing ->
return $ return $
ErrorResponse (callId req) (-32010) $ T.pack $ show e ErrorResponse
Right nAcc' -> do (callId req)
r <- liftIO $ saveAccount pool nAcc' (-32008)
case r of "Wallet does not exist."
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Just x ->
return $
NewItemResponse (callId req) $
fromSqlKey $ entityKey x
Nothing ->
return $
ErrorResponse (callId req) (-32008) "Wallet does not exist."
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAddress -> GetNewAddress ->
@ -637,35 +728,49 @@ zenithServer state = getinfo :<|> handleRPC
let dbPath = w_dbPath state let dbPath = w_dbPath state
let net = w_network state let net = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i syncChk <- liftIO $ isSyncing pool
case acc of if syncChk
Just acc' -> do then return $
maxAddr <- ErrorResponse
liftIO $ getMaxAddress pool (entityKey acc') External (callId req)
newAddr <- (-32012)
liftIO $ "The Zenith server is syncing, please try again later."
createCustomWalletAddress else do
n acc <-
(maxAddr + 1) liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
net case acc of
External Just acc' -> do
acc' maxAddr <-
s liftIO $ getMaxAddress pool (entityKey acc') External
t newAddr <-
dbAddr <- liftIO $ saveAddress pool newAddr liftIO $
case dbAddr of createCustomWalletAddress
Just nAddr -> do n
return $ (maxAddr + 1)
NewAddrResponse (callId req) (toZcashAddressAPI nAddr) net
External
acc'
s
t
dbAddr <- liftIO $ saveAddress pool newAddr
case dbAddr of
Just nAddr -> do
return $
NewAddrResponse
(callId req)
(toZcashAddressAPI nAddr)
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Nothing -> Nothing ->
return $ return $
ErrorResponse ErrorResponse
(callId req) (callId req)
(-32007) (-32006)
"Entity with that name already exists." "Account does not exist."
Nothing ->
return $
ErrorResponse (callId req) (-32006) "Account does not exist."
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetOperationStatus -> GetOperationStatus ->
@ -682,6 +787,89 @@ zenithServer state = getinfo :<|> handleRPC
ErrorResponse (callId req) (-32009) "Operation ID not found" ErrorResponse (callId req) (-32009) "Operation ID not found"
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" 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 Bool
authenticate config = BasicAuthCheck check authenticate config = BasicAuthCheck check
@ -694,3 +882,67 @@ authenticate config = BasicAuthCheck check
packRpcResponse :: ToJSON a => T.Text -> a -> Value packRpcResponse :: ToJSON a => T.Text -> a -> Value
packRpcResponse i x = packRpcResponse i x =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= 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 , ZcashBlockId
, clearWalletData , clearWalletData
, clearWalletTransactions , clearWalletTransactions
, completeSync
, getBlock , getBlock
, getMaxBlock , getMaxBlock
, getMinBirthdayHeight , getMinBirthdayHeight
@ -47,10 +48,16 @@ import Zenith.DB
, saveBlock , saveBlock
, saveConfs , saveConfs
, saveTransaction , saveTransaction
, startSync
, updateWalletSync , updateWalletSync
, upgradeQrTable , upgradeQrTable
) )
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..)) import Zenith.Types
( Config(..)
, HexStringDB(..)
, ZcashNetDB(..)
, ZenithStatus(..)
)
import Zenith.Utils (jsonNumber) import Zenith.Utils (jsonNumber)
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database -- | 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 upgradeQrTable pool1
clearWalletTransactions pool1 clearWalletTransactions pool1
clearWalletData pool1 clearWalletData pool1
_ <- startSync pool1
dbBlock <- getMaxBlock pool1 znet dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight pool1 b <- liftIO $ getMinBirthdayHeight pool1
let sb = max dbBlock b 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 pool2 pg2 znet) bl2 `concurrently_`-}
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-} {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
print "Please wait..." print "Please wait..."
_ <- completeSync pool1 Successful
print "Rescan complete" print "Rescan complete"
-- | Function to process a raw block and extract the transaction information -- | Function to process a raw block and extract the transaction information
@ -119,7 +128,9 @@ processBlock host port pool pg net b = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1] [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of case r of
Left e -> liftIO $ throwIO $ userError e Left e -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -129,7 +140,9 @@ processBlock host port pool pg net b = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0] [Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
case r2 of case r2 of
Left e2 -> liftIO $ throwIO $ userError e2 Left e2 -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- bi <-
@ -160,7 +173,9 @@ processTx host port bt pool t = do
"getrawtransaction" "getrawtransaction"
[Data.Aeson.String $ toText t, jsonNumber 1] [Data.Aeson.String $ toText t, jsonNumber 1]
case r of case r of
Left e -> liftIO $ throwIO $ userError e Left e -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right rawTx -> do Right rawTx -> do
case readZebraTransaction (ztr_hex rawTx) of case readZebraTransaction (ztr_hex rawTx) of
Nothing -> return () Nothing -> return ()
@ -223,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

View file

@ -23,13 +23,23 @@ import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.UUID as U import qualified Data.UUID as U
import Database.Persist.TH import Database.Persist.TH
import GHC.Generics import GHC.Generics
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
import ZcashHaskell.Sapling (encodeSaplingAddress)
import ZcashHaskell.Transparent
( encodeExchangeAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
( OrchardSpendingKey(..) ( ExchangeAddress(..)
, OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, Rseed(..) , Rseed(..)
, SaplingAddress(..)
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Scope(..) , Scope(..)
, TransparentAddress(..)
, TransparentSpendingKey , TransparentSpendingKey
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
@ -207,9 +217,54 @@ data PrivacyPolicy
$(deriveJSON defaultOptions ''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 data ShieldDeshieldOp
= Shield = Shield
| Deshield | Deshield
deriving (Eq, Show, Read, Ord) deriving (Eq, Show, Read, Ord)
-- ** `zebrad` -- ** `zebrad`

View file

@ -7,7 +7,7 @@ import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.Configurator import Data.Configurator
import Data.Maybe (fromMaybe) import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time.Clock (getCurrentTime) import Data.Time.Clock (getCurrentTime)
@ -18,7 +18,7 @@ import Servant
import System.Directory import System.Directory
import Test.HUnit hiding (State) import Test.HUnit hiding (State)
import Test.Hspec import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
import ZcashHaskell.Types import ZcashHaskell.Types
( ZcashNet(..) ( ZcashNet(..)
, ZebraGetBlockChainInfo(..) , ZebraGetBlockChainInfo(..)
@ -39,6 +39,9 @@ import Zenith.RPC
) )
import Zenith.Types import Zenith.Types
( Config(..) ( Config(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ValidAddressAPI(..)
, ZcashAccountAPI(..) , ZcashAccountAPI(..)
, ZcashAddressAPI(..) , ZcashAddressAPI(..)
, ZcashWalletAPI(..) , ZcashWalletAPI(..)
@ -572,6 +575,107 @@ main = do
Left e -> assertFailure e Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32009) Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
Right _ -> assertFailure "unexpected response" 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 -> IO ()
startAPI config = do startAPI config = do

View file

@ -123,55 +123,6 @@ main = do
let ua = let ua =
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x" "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
isValidUnifiedAddress ua `shouldNotBe` Nothing 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 describe "Note selection for Tx" $ do
it "Value less than balance" $ do it "Value less than balance" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
@ -181,10 +132,6 @@ main = do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
let res = selectUnspentNotes pool (toSqlKey 1) 84000000 let res = selectUnspentNotes pool (toSqlKey 1) 84000000
res `shouldThrow` anyIOException 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 describe "Testing validation" $ do
it "Unified" $ do it "Unified" $ do
let a = let a =
@ -267,9 +214,11 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001331 3001331
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"Sending memo to orchard" 0.005
(Just "Sending memo to orchard")
]
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -291,9 +240,11 @@ main = do
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"Sending memo to sapling" 0.005
(Just "Sending memo to sapling")
]
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -313,13 +264,49 @@ main = do
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"" 0.005
Nothing
]
Full Full
tx `shouldBe` tx `shouldBe`
Left Left
(PrivacyPolicyError "Receiver not capable of Full privacy") (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 describe "Medium" $ do
it "To Orchard" $ do it "To Orchard" $ do
let uaRead = let uaRead =
@ -338,9 +325,11 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"Sending memo to orchard" 0.005
(Just "Sending memo to orchard")
]
Medium Medium
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -362,9 +351,11 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"Sending memo to orchard" 0.005
(Just "Sending memo to sapling")
]
Medium Medium
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -384,13 +375,48 @@ main = do
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"" 0.005
Nothing
]
Medium Medium
tx `shouldBe` tx `shouldBe`
Left Left
(PrivacyPolicyError "Receiver not capable of Medium privacy") (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 describe "Low" $ do
it "To Orchard" $ do it "To Orchard" $ do
let uaRead = let uaRead =
@ -409,9 +435,11 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"Sending memo to orchard" 0.005
Nothing
]
Low Low
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -433,9 +461,11 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"Sending memo to orchard" 0.005
Nothing
]
Low Low
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -455,9 +485,11 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"" 0.005
Nothing
]
Low Low
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -480,14 +512,16 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"Sending memo to orchard" 0.005
Nothing
]
None None
tx `shouldBe` tx `shouldBe`
Left Left
(PrivacyPolicyError (PrivacyPolicyError
"Receiver not compatible with privacy policy") "Shielded recipients not compatible with privacy policy.")
it "To Sapling" $ do it "To Sapling" $ do
let uaRead = let uaRead =
parseAddress parseAddress
@ -505,14 +539,16 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"Sending memo to orchard" 0.005
Nothing
]
None None
tx `shouldBe` tx `shouldBe`
Left Left
(PrivacyPolicyError (PrivacyPolicyError
"Receiver not compatible with privacy policy") "Shielded recipients not compatible with privacy policy.")
it "To Transparent" $ do it "To Transparent" $ do
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
case uaRead of case uaRead of
@ -528,9 +564,11 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
0.005 [ ProposedNote
(fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
"" 0.005
Nothing
]
None None
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e

View file

@ -132,6 +132,7 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }, { "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" } { "$ref": "#/components/errors/DuplicateName" }
] ]
}, },
@ -228,6 +229,7 @@
"errors": [ "errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }, { "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/DuplicateName" }, { "$ref": "#/components/errors/DuplicateName" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidWallet" } { "$ref": "#/components/errors/InvalidWallet" }
] ]
}, },
@ -444,6 +446,7 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/InvalidAccount" }, { "$ref": "#/components/errors/InvalidAccount" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" } { "$ref": "#/components/errors/DuplicateName" }
] ]
}, },
@ -593,10 +596,11 @@
{ {
"name": "sendmany", "name": "sendmany",
"summary": "Send transaction(s)", "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).", "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": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}], "tags": [],
"params": [ "params": [
{ "$ref": "#/components/contentDescriptors/AccountId"}, { "$ref": "#/components/contentDescriptors/AccountId"},
{ "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
{ "$ref": "#/components/contentDescriptors/TxRequestArray"} { "$ref": "#/components/contentDescriptors/TxRequestArray"}
], ],
"paramStructure": "by-position", "paramStructure": "by-position",
@ -610,14 +614,19 @@
"examples": [ "examples": [
{ {
"name": "Send a transaction", "name": "Send a transaction",
"summary": "Send one transaction", "summary": "Send a transaction",
"description": "Send a single transaction", "description": "Send a transaction with one output",
"params": [ "params": [
{ {
"name": "Account index", "name": "Account index",
"summary": "The index for the account to use", "summary": "The index for the account to use",
"value": "1" "value": "1"
}, },
{
"name": "Privacy Policy",
"summary": "The selected privacy policy",
"value": "Full"
},
{ {
"name": "Transaction request", "name": "Transaction request",
"summary": "The transaction to attempt", "summary": "The transaction to attempt",
@ -640,7 +649,7 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }, { "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/InvalidRecipient" }, { "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidAccount" } { "$ref": "#/components/errors/InvalidAccount" }
] ]
}, },
@ -736,6 +745,16 @@
"type": "array", "type": "array",
"items": { "$ref": "#/components/schemas/TxRequest"} "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": { "schemas": {
@ -814,8 +833,7 @@
"properties": { "properties": {
"address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" }, "address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
"amount": { "type": "number", "description": "The amount to send in ZEC"}, "amount": { "type": "number", "description": "The amount to send in ZEC"},
"memo": { "type": "string", "description": "The shielded memo to include, if applicable"}, "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."}
} }
} }
}, },
@ -872,6 +890,10 @@
"InvalidRecipient": { "InvalidRecipient": {
"code": -32011, "code": -32011,
"message": "The provided recipient address is not valid." "message": "The provided recipient address is not valid."
},
"ZenithBusy": {
"code": -32012,
"message": "The Zenith server is syncing, please try again later."
} }
} }
} }