Compare commits

..

No commits in common. "d3a5c36e6b3acbff4b8260c084ce85819ca97280" and "53eac75aa57a56761614759e3559747aa5e650b6" have entirely different histories.

12 changed files with 551 additions and 1840 deletions

View file

@ -20,7 +20,6 @@ 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
@ -28,7 +27,6 @@ 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,22 +2,15 @@
module Server where module Server where
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad (forever, when) import Control.Monad (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 import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
( State(..)
, ZenithRPC(..)
, authenticate
, scanZebra
, zenithServer
)
import Zenith.Scanner (rescanZebra) import Zenith.Scanner (rescanZebra)
import Zenith.Types (Config(..)) import Zenith.Types (Config(..))
@ -46,12 +39,6 @@ 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,7 +2,6 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Zenith.CLI where module Zenith.CLI where
@ -63,14 +62,13 @@ 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 (forM_, forever, unless, void, when) import Control.Monad (forever, unless, void, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger
( LoggingT ( LoggingT
, NoLoggingT
, logDebugN , logDebugN
, runFileLoggingT
, runNoLoggingT , runNoLoggingT
, runStderrLoggingT
) )
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
@ -90,15 +88,8 @@ 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 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
( getSaplingFromUA import ZcashHaskell.Transparent (encodeTransparentReceiver)
, 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
@ -109,12 +100,9 @@ import Zenith.Types
, HexStringDB(..) , HexStringDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..) , PrivacyPolicy(..)
, ProposedNote(..)
, ShieldDeshieldOp(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZenithStatus(..) , ShieldDeshieldOp(..)
) )
import Zenith.Utils import Zenith.Utils
( displayTaz ( displayTaz
@ -173,8 +161,10 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry makeLenses ''AdrBookEntry
newtype ShDshEntry = ShDshEntry data ShDshEntry = ShDshEntry
{ _shAmt :: Float { _totalTransparent :: !Float
, _totalShielded :: !Float
, _shAmt :: !Float
} deriving (Show) } deriving (Show)
makeLenses ''ShDshEntry makeLenses ''ShDshEntry
@ -242,8 +232,7 @@ data State = State
, _sentTx :: !(Maybe HexString) , _sentTx :: !(Maybe HexString)
, _unconfBalance :: !Integer , _unconfBalance :: !Integer
, _deshieldForm :: !(Form ShDshEntry () Name) , _deshieldForm :: !(Form ShDshEntry () Name)
, _tBalance :: !Integer , _shieldForm :: !(Form ShDshEntry () Name)
, _sBalance :: !Integer
} }
makeLenses ''State makeLenses ''State
@ -260,11 +249,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
@ -308,7 +297,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, 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 $
@ -434,33 +424,14 @@ 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)
(C.hCenter (renderForm (st ^. deshieldForm) <=>
(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)
(C.hCenter (renderForm (st ^. shieldForm) <=>
(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
@ -707,10 +678,26 @@ 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 tbal = mkDeshieldForm bal =
newForm newForm
[ label "Amount: " @@= [ label "Total Transp. : " @@=
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal) editShowableFieldWithValidate totalTransparent TotalTranspField (isAmountValid bal)
, label "Total Shielded : " @@=
editShowableFieldWithValidate totalShielded TotalShieldedField (isAmountValid bal)
, label "Amount: " @@=
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
]
where
isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
mkShieldForm bal =
newForm
[ label "Amount to Shield: " @@=
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Float -> Bool
@ -832,10 +819,6 @@ 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
syncChk <- liftIO $ isSyncing pool
if syncChk
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
else do
logDebugN $ logDebugN $
"dbBlock: " <> "dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
@ -846,31 +829,24 @@ scanZebra dbP zHost zPort b eChan znet = do
else max chkBlock b else max chkBlock b
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then do then do
liftIO $ liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
else do else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] let bList = [(sb + 1) .. (zgb_blocks bStatus)]
if not (null bList) if not (null bList)
then do then do
let step = let step =
(1.0 :: Float) / (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
fromIntegral (zgb_blocks bStatus - (sb + 1))
_ <- liftIO $ startSync pool
mapM_ (liftIO . processBlock pool step) bList mapM_ (liftIO . processBlock pool step) bList
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
confUp <- confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
IO IO
(Either IOError ()) (Either IOError ())
case confUp of case confUp of
Left _e0 -> do Left _e0 ->
_ <- liftIO $ completeSync pool Failed
liftIO $ liftIO $
BC.writeBChan eChan $ BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
TickMsg "Failed to update unconfirmed transactions" Right _ -> return ()
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
@ -882,9 +858,7 @@ 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 -> do Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1
_ <- liftIO $ completeSync pool Failed
liftIO $ BC.writeBChan eChan $ TickMsg e1
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -894,9 +868,7 @@ 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 -> do Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
_ <- 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 <-
@ -953,7 +925,7 @@ appEvent (BT.AppEvent t) = do
Just (_k, w) -> return w Just (_k, w) -> return w
_ <- _ <-
liftIO $ liftIO $
runNoLoggingT $ runFileLoggingT "zenith.log" $
syncWallet syncWallet
(Config (Config
(s ^. dbPath) (s ^. dbPath)
@ -963,11 +935,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
@ -992,7 +964,7 @@ appEvent (BT.AppEvent t) = do
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
runStderrLoggingT $ runFileLoggingT "zenith.log" $
scanZebra scanZebra
(s ^. dbPath) (s ^. dbPath)
(s ^. zebraHost) (s ^. zebraHost)
@ -1216,7 +1188,6 @@ 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
@ -1230,102 +1201,16 @@ appEvent (BT.VtyEvent e) = do
fs <- BT.gets formState fs <- BT.gets formState
BT.modify $ BT.modify $
setFieldValid setFieldValid
(isRecipientValidGUI (isRecipientValidGUI (fs ^. policyField) (fs ^. sendTo))
(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
V.EvKey (V.KChar 'p') [] -> do
if allFieldsValid (s ^. deshieldForm)
then do
pool <-
liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selWal <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
selAcc <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $
L.listMoveToBeginning $
s ^. accounts
case fAcc of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
selAddr <-
do case L.listSelectedElement $ s ^. addresses of
Nothing -> do
let fAddr =
L.listSelectedElement $
L.listMoveToBeginning $
s ^. addresses
case fAddr of
Nothing ->
throw $
userError "Failed to select address"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
fs1 <- BT.zoom deshieldForm $ BT.gets formState
let tAddrMaybe =
Transparent <$>
((decodeTransparentAddress .
E.encodeUtf8 .
encodeTransparentReceiver (s ^. network)) =<<
(t_rec =<<
(isValidUnifiedAddress .
E.encodeUtf8 .
getUA . walletAddressUAddress)
(entityVal selAddr)))
bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal
case tAddrMaybe of
Nothing -> do
BT.modify $
set
msg
"Failed to obtain transparent address"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
Just tAddr -> do
_ <-
liftIO $
forkIO $
deshieldTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
(ProposedNote
(ValidAddressAPI tAddr)
(fs1 ^. shAmt)
Nothing)
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
else do
BT.modify $ set msg "Invalid inputs"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
ev -> ev ->
BT.zoom deshieldForm $ do BT.zoom deshieldForm $ do
handleFormEvent (BT.VtyEvent ev) handleFormEvent (BT.VtyEvent ev)
-- fs <- BT.gets formState
-- ev -> BT.zoom deshieldForm $ L.handleListEvent ev
AdrBook -> do AdrBook -> do
case e of case e of
V.EvKey (V.KChar 'x') [] -> V.EvKey (V.KChar 'x') [] ->
@ -1343,7 +1228,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
_any -> do _ -> 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
@ -1509,53 +1394,6 @@ 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
@ -1582,57 +1420,10 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set dialogBox SendTx BT.modify $ set dialogBox SendTx
V.EvKey (V.KChar 'b') [] -> V.EvKey (V.KChar 'b') [] ->
BT.modify $ set dialogBox AdrBook BT.modify $ set dialogBox AdrBook
V.EvKey (V.KChar 'd') [] -> do V.EvKey (V.KChar 'd') [] ->
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') [] -> do V.EvKey (V.KChar 'h') [] ->
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath BT.modify $ set dialogBox ShieldForm
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 ->
@ -1647,8 +1438,6 @@ 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
@ -1731,14 +1520,6 @@ 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 $
@ -1752,7 +1533,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) 1) (L.list AcList (Vec.fromList accList) 0)
(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 " ++
@ -1781,9 +1562,8 @@ runZenithTUI config = do
"" ""
Nothing Nothing
uBal uBal
(mkDeshieldForm 0 (ShDshEntry 0.0)) (mkDeshieldForm 0 (ShDshEntry 0 0 0.0 ))
tBal (mkShieldForm 0 (ShDshEntry 0 0 0.0 ))
sBal
Left _e -> do Left _e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
@ -1803,7 +1583,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 $ walList !! ix let bl = zcashWalletLastSync $ entityVal selWallet
addrL <- addrL <-
if not (null aL) if not (null aL)
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
@ -1997,30 +1777,15 @@ 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 policy = do sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
BC.writeBChan chan $ TickMsg "Preparing transaction..." BC.writeBChan chan $ TickMsg "Preparing transaction..."
case parseAddress (E.encodeUtf8 ua) of case parseAddressUA ua znet of
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do Just outUA -> do
res <- res <-
runNoLoggingT $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTx pool zHost zPort znet accId bl amt outUA memo
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
@ -2034,56 +1799,3 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = 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, fromMaybe) import Data.Maybe (fromJust)
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,11 +34,7 @@ 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 import GHC.Float.RealFracMethods (floorFloatInteger)
( 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
@ -79,13 +75,11 @@ 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(..)
) )
@ -547,7 +541,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 = floorFloatInteger $ amt * (10 ^ 8) let zats = fromIntegral $ 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
@ -727,123 +721,6 @@ 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
@ -852,13 +729,38 @@ prepareTxV2 ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> [ProposedNote] -> Float
-> ValidAddress
-> T.Text
-> PrivacyPolicy -> PrivacyPolicy
-> NoLoggingT IO (Either TxError HexString) -> LoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
accRead <- liftIO $ getAccountById pool za accRead <- liftIO $ getAccountById pool za
let recipients = map extractReceiver pnotes let recipient =
logDebugN $ T.pack $ show recipients case va of
Unified ua ->
case o_rec ua of
Nothing ->
case s_rec ua of
Nothing ->
case t_rec ua of
Nothing -> (0, "")
Just r3 ->
case tr_type r3 of
P2PKH -> (1, toBytes $ tr_bytes r3)
P2SH -> (2, toBytes $ tr_bytes r3)
Just r2 -> (3, getBytes r2)
Just r1 -> (4, getBytes r1)
Sapling sa -> (3, getBytes $ sa_receiver sa)
Transparent ta ->
case tr_type (ta_receiver ta) of
P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
Exchange ea ->
case tr_type (ex_address ea) of
P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
logDebugN $ T.pack $ show recipient
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
@ -869,21 +771,14 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes 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 amt = foldl' (\x y -> x + pn_amt y) 0 pnotes let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
let zats = ceilingFloatInteger $ amt * (10 ^ 8) logDebugN $ T.pack $ show zats
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 selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
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"
@ -891,7 +786,6 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes 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
@ -912,7 +806,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
--print oSpends --print oSpends
dummy' <- dummy' <-
liftIO $ liftIO $
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy makeOutgoing acc recipient zats (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
@ -940,7 +834,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
pool pool
za za
(zats + feeAmt) (zats + feeAmt)
(map (\(x, _, _, _) -> x) recipients) (fst recipient)
policy policy
case finalNotePlan of case finalNotePlan of
Right (tList1, sList1, oList1) -> do Right (tList1, sList1, oList1) -> do
@ -969,7 +863,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
liftIO $ liftIO $
makeOutgoing makeOutgoing
acc acc
recipients recipient
zats
(noteTotal1 - feeAmt - zats) (noteTotal1 - feeAmt - zats)
policy policy
logDebugN $ T.pack $ show outgoing' logDebugN $ T.pack $ show outgoing'
@ -994,186 +889,141 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes 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, T.Text)] -> (Int, BS.ByteString)
-> Integer
-> Integer -> Integer
-> PrivacyPolicy -> PrivacyPolicy
-> IO (Either TxError [OutgoingNote]) -> IO (Either TxError [OutgoingNote])
makeOutgoing acc recvs chg pol = do makeOutgoing acc (k, recvr) zats chg policy = 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 pol of case k of
Full -> 4 ->
if elem 1 k || elem 2 k || elem 5 k || elem 6 k case policy of
then return $ None ->
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 = let chgRcvr =
fromJust $ fromJust $
s_rec =<< o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
isValidUnifiedAddress return $
(E.encodeUtf8 internalUA) Right
let cnote = [ OutgoingNote
OutgoingNote 4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
3 ->
case policy of
None ->
return $
Left $
PrivacyPolicyError "Receiver not compatible with privacy policy"
Full -> do
let chgRcvr =
fromJust $
s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
3 3
(getBytes $ (getBytes $
getSapSK $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
zcashAccountSapSpendKey $ entityVal acc)
(getBytes chgRcvr) (getBytes chgRcvr)
(fromIntegral chg) (fromIntegral chg)
"" ""
True True
let onotes = , OutgoingNote
map 3
(prepareOutgoingNote (entityVal acc)) (getBytes $
recvs getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
return $ Right $ cnote : onotes recvr
else if 4 `elem` k (fromIntegral zats)
(E.encodeUtf8 memo)
False
]
_anyOther -> do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
3
(getBytes $
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
2 ->
if policy <= Low
then do then do
let chgRcvr =
fromJust $
o_rec =<<
isValidUnifiedAddress
(E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $
zcashAccountOrchSpendKey $
entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes =
map
(prepareOutgoingNote (entityVal acc))
recvs
return $ Right $ cnote : onotes
else return $ Left ZHError
Medium ->
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
return $ Right $ cnote : onotes
Low ->
if elem 5 k || elem 6 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
return $ Right $ cnote : onotes
None ->
if elem 3 k || elem 4 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else do
let chgRcvr = let chgRcvr =
fromJust $ fromJust $
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote = return $
OutgoingNote Right
[ OutgoingNote
1 1
BS.empty BS.empty
(toBytes $ tr_bytes chgRcvr) (toBytes $ tr_bytes chgRcvr)
(fromIntegral chg) (fromIntegral chg)
"" ""
True True
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs , OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
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]
@ -1261,7 +1111,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
syncWallet :: syncWallet ::
Config -- ^ configuration parameters Config -- ^ configuration parameters
-> Entity ZcashWallet -> Entity ZcashWallet
-> NoLoggingT IO () -> LoggingT 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,13 +291,6 @@ 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
@ -1191,61 +1184,6 @@ 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 $
@ -1256,57 +1194,6 @@ 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 $
@ -1317,57 +1204,6 @@ 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
@ -1412,66 +1248,47 @@ 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
sapNotes <- trChgNotes <-
case sReceiver of case ctReceiver of
Nothing -> return [] Nothing -> return []
Just sR -> liftIO $ getSapNotes pool sR Just tR -> liftIO $ getTrNotes pool tR
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_` valList (map entityKey trNotes)) (trSpends ^. WalletTrSpendNote `in_`
valList (map entityKey (trNotes <> trChgNotes)))
pure trSpends pure trSpends
sapSpends <- mapM (getSapSpends . entityKey) sapNotes sapNotes <-
orchSpends <- mapM (getOrchSpends . entityKey) orchNotes case sReceiver of
mapM_ subTSpend trSpends
mapM_ subSSpend $ catMaybes sapSpends
mapM_ subOSpend $ catMaybes orchSpends
foundTxs <- getTxs $ entityKey w
trChgNotes <-
case ctReceiver of
Nothing -> return [] Nothing -> return []
Just tR -> liftIO $ getTrFilteredNotes pool foundTxs tR Just sR -> liftIO $ getSapNotes pool sR
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 <- sapChgNotes <-
case csReceiver of case csReceiver of
Nothing -> return [] Nothing -> return []
Just sR -> liftIO $ getSapFilteredNotes pool foundTxs sR Just sR -> liftIO $ getSapNotes pool sR
sapChgNotes' <- liftIO $ mapM (traceSapDag pool) sapChgNotes sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes)
sapChgSpends <- orchNotes <-
mapM (getSapSpends . entityKey) (sapChgNotes <> concat sapChgNotes') case oReceiver of
Nothing -> return []
Just oR -> liftIO $ getOrchNotes pool oR
orchChgNotes <- orchChgNotes <-
case coReceiver of case coReceiver of
Nothing -> return [] Nothing -> return []
Just oR -> liftIO $ getOrchFilteredNotes pool foundTxs oR Just oR -> liftIO $ getOrchNotes pool oR
orchChgNotes' <- liftIO $ mapM (traceOrchDag pool) orchChgNotes orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
orchChgSpends <- clearUserTx (entityKey w)
mapM (getOrchSpends . entityKey) (orchChgNotes <> concat orchChgNotes') mapM_ addTr trNotes
mapM_ addTr (trChgNotes <> concat trChgNotes') mapM_ addTr trChgNotes
mapM_ addSap (sapChgNotes <> concat sapChgNotes') mapM_ addSap sapNotes
mapM_ addOrch (orchChgNotes <> concat orchChgNotes') mapM_ addSap sapChgNotes
mapM_ subTSpend trChgSpends mapM_ addOrch orchNotes
mapM_ subSSpend $ catMaybes sapChgSpends mapM_ addOrch orchChgNotes
mapM_ subOSpend $ catMaybes orchChgSpends mapM_ subTSpend trSpends
mapM_ subSSpend $ catMaybes sapSpends
mapM_ subOSpend $ catMaybes orchSpends
where where
clearUserTx :: WalletAddressId -> NoLoggingT IO () clearUserTx :: WalletAddressId -> NoLoggingT IO ()
clearUserTx waId = do clearUserTx waId = do
@ -1481,16 +1298,6 @@ 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
@ -2030,51 +1837,6 @@ 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 $
@ -2318,7 +2080,7 @@ selectUnspentNotesV2 ::
ConnectionPool ConnectionPool
-> ZcashAccountId -> ZcashAccountId
-> Integer -> Integer
-> [Int] -> Int
-> PrivacyPolicy -> PrivacyPolicy
-> IO -> IO
(Either (Either
@ -2329,40 +2091,27 @@ selectUnspentNotesV2 ::
selectUnspentNotesV2 pool za amt recv policy = do selectUnspentNotesV2 pool za amt recv policy = do
case policy of case policy of
Full -> Full ->
if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv case recv of
then return $ 4 -> do
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
else if elem 4 recv && elem 3 recv
then return $
Left $
PrivacyPolicyError
"Combination of receivers not allowed for Full privacy"
else if 4 `elem` recv
then do
orchNotes <- getWalletUnspentOrchNotes pool za orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
checkOrchard (fromIntegral amt) orchNotes
if a1 > 0 if a1 > 0
then return $ then return $
Left $ Left $ PrivacyPolicyError "Not enough notes for Full privacy"
PrivacyPolicyError
"Not enough notes for Full privacy"
else return $ Right ([], [], oList) else return $ Right ([], [], oList)
else do 3 -> do
sapNotes <- getWalletUnspentSapNotes pool za sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
checkSapling (fromIntegral amt) sapNotes
if a2 > 0 if a2 > 0
then return $ then return $
Left $ Left $ PrivacyPolicyError "Not enough notes for Full privacy"
PrivacyPolicyError
"Not enough notes for Full privacy"
else return $ Right ([], sList, []) else return $ Right ([], sList, [])
_anyOther ->
return $
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
Medium -> Medium ->
if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv if recv > 2
then return $ then do
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
@ -2375,16 +2124,40 @@ 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 0 `elem` recv if recv == 0
then return $ Left ZHError then return $ Left ZHError
else do else do
if elem 5 recv || elem 6 recv case recv of
3 -> do
sapNotes <- getWalletUnspentSapNotes pool za
let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
if a1 > 0
then do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a2, oList) = checkOrchard a1 orchNotes
if a2 > 0
then return $ then return $
Left $ Left $
PrivacyPolicyError PrivacyPolicyError "Not enough notes for Low privacy"
"Exchange addresses not supported with Low privacy" else return $ Right ([], sList, oList)
else do else return $ Right ([], sList, [])
_anyOther -> do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
then do
sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = checkSapling a1 sapNotes
if a2 > 0
then return $
Left $
PrivacyPolicyError "Not enough notes for Low privacy"
else return $ Right ([], sList, oList)
else return $ Right ([], [], oList)
None -> do
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
@ -2400,19 +2173,6 @@ selectUnspentNotesV2 pool za amt recv policy = do
else return $ Right (tList, sList, oList) 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
if elem 3 recv || elem 4 recv
then return $
Left $
PrivacyPolicyError
"Shielded recipients not compatible with privacy policy."
else do
trNotes <- getWalletUnspentTrNotes pool za
let (a3, tList) = checkTransparent (fromIntegral amt) trNotes
if a3 > 0
then return $
Left $ PrivacyPolicyError "Insufficient transparent funds"
else return $ Right (tList, [], [])
where where
checkTransparent :: checkTransparent ::
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote]) Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
@ -2475,19 +2235,6 @@ 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 =
@ -2580,83 +2327,13 @@ 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 $ do flip PS.runSqlPool pool $
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
select $ do
txs <- from $ table @ZcashTransaction
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
pure txs
let oldTxKeys = map entityKey oldTxs
delete $ do
x <- from $ table @TransparentNote
where_ $ x ^. TransparentNoteTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @TransparentSpend
where_ $ x ^. TransparentSpendTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ShieldOutput
where_ $ x ^. ShieldOutputTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ShieldSpend
where_ $ x ^. ShieldSpendTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @OrchAction
where_ $ x ^. OrchActionTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ZcashTransaction
where_ $ x ^. ZcashTransactionId `in_` valList oldTxKeys
delete $ do delete $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_ $ blk ^. ZcashBlockHeight >=. val b
clearWalletTransactions pool

View file

@ -1391,7 +1391,8 @@ 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
runNoLoggingT $ syncWallet (model ^. configuration) cW runFileLoggingT "zenith.log" $
syncWallet (model ^. configuration) cW
pool <- pool <-
runNoLoggingT $ runNoLoggingT $
initPool $ c_dbPath $ model ^. configuration initPool $ c_dbPath $ model ^. configuration
@ -1612,6 +1613,7 @@ 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
@ -1619,10 +1621,6 @@ 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
syncChk <- isSyncing pool
if syncChk
then sendMsg (ShowError "Sync already in progress")
else do
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
@ -1635,19 +1633,12 @@ scanZebra dbPath zHost zPort net sendMsg = do
if not (null bList) if not (null bList)
then do then do
let step = (1.0 :: Float) / fromIntegral (length bList) let step = (1.0 :: Float) / fromIntegral (length bList)
_ <- startSync pool
mapM_ (processBlock pool step) bList 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) else sendMsg (SyncVal 1.0)
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
Right _ -> return ()
where where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do processBlock pool step bl = do
@ -1659,9 +1650,7 @@ 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 -> do Left e1 -> sendMsg (ShowError $ showt e1)
_ <- completeSync pool Failed
sendMsg (ShowError $ showt e1)
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -1671,9 +1660,7 @@ 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 -> do Left e2 -> sendMsg (ShowError $ showt e2)
_ <- completeSync pool Failed
sendMsg (ShowError $ showt e2)
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- bi <-
@ -1708,22 +1695,8 @@ 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 <-
runNoLoggingT $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
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,28 +8,21 @@
{-# 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 (runFileLoggingT, runNoLoggingT, runStderrLoggingT) import Control.Monad.Logger (runNoLoggingT)
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
( ConnectionPool ( entityKey
, entityKey
, entityVal , entityVal
, fromSqlKey , fromSqlKey
, toSqlKey , toSqlKey
@ -38,72 +31,43 @@ 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 import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
( BlockResponse(..) import Zenith.Core (createCustomWalletAddress, createZcashAccount)
, 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)
@ -119,7 +83,6 @@ data ZenithMethod
| GetNewAccount | GetNewAccount
| GetNewAddress | GetNewAddress
| GetOperationStatus | GetOperationStatus
| SendMany
| UnknownMethod | UnknownMethod
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -134,7 +97,6 @@ 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
@ -150,7 +112,6 @@ 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
@ -164,7 +125,6 @@ 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)
@ -188,8 +148,6 @@ 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
@ -201,7 +159,6 @@ 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)
@ -222,7 +179,6 @@ 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 =
@ -302,10 +258,6 @@ 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)
@ -464,30 +416,6 @@ 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
@ -645,16 +573,8 @@ 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
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
sP <- liftIO generateWalletSeedPhrase sP <- liftIO generateWalletSeedPhrase
pool <- liftIO $ runNoLoggingT $ initPool dbPath
r <- r <-
liftIO $ liftIO $
saveWallet pool $ saveWallet pool $
@ -681,14 +601,6 @@ 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
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
w <- liftIO $ walletExists pool i w <- liftIO $ walletExists pool i
case w of case w of
Just w' -> do Just w' -> do
@ -716,10 +628,7 @@ zenithServer state = getinfo :<|> handleRPC
fromSqlKey $ entityKey x fromSqlKey $ entityKey x
Nothing -> Nothing ->
return $ return $
ErrorResponse ErrorResponse (callId req) (-32008) "Wallet does not exist."
(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 ->
@ -728,16 +637,7 @@ 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
syncChk <- liftIO $ isSyncing pool acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
acc <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
case acc of case acc of
Just acc' -> do Just acc' -> do
maxAddr <- maxAddr <-
@ -756,9 +656,7 @@ zenithServer state = getinfo :<|> handleRPC
case dbAddr of case dbAddr of
Just nAddr -> do Just nAddr -> do
return $ return $
NewAddrResponse NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
(callId req)
(toZcashAddressAPI nAddr)
Nothing -> Nothing ->
return $ return $
ErrorResponse ErrorResponse
@ -767,10 +665,7 @@ zenithServer state = getinfo :<|> handleRPC
"Entity with that name already exists." "Entity with that name already exists."
Nothing -> Nothing ->
return $ return $
ErrorResponse ErrorResponse (callId req) (-32006) "Account does not exist."
(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 ->
@ -787,89 +682,6 @@ 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
@ -882,67 +694,3 @@ 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,7 +37,6 @@ import Zenith.DB
, ZcashBlockId , ZcashBlockId
, clearWalletData , clearWalletData
, clearWalletTransactions , clearWalletTransactions
, completeSync
, getBlock , getBlock
, getMaxBlock , getMaxBlock
, getMinBirthdayHeight , getMinBirthdayHeight
@ -48,16 +47,10 @@ import Zenith.DB
, saveBlock , saveBlock
, saveConfs , saveConfs
, saveTransaction , saveTransaction
, startSync
, updateWalletSync , updateWalletSync
, upgradeQrTable , upgradeQrTable
) )
import Zenith.Types import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
( 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
@ -81,7 +74,6 @@ 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
@ -107,7 +99,6 @@ 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
@ -128,9 +119,7 @@ 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 -> do Left e -> liftIO $ throwIO $ userError e
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -140,9 +129,7 @@ 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 -> do Left e2 -> liftIO $ throwIO $ userError e2
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- bi <-
@ -173,9 +160,7 @@ 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 -> do Left e -> liftIO $ throwIO $ userError e
_ <- 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 ()
@ -238,7 +223,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 <- runNoLoggingT $ mapM (syncWallet config) w' r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
liftIO $ print r liftIO $ print r
-- | Detect chain re-orgs -- | Detect chain re-orgs

View file

@ -23,23 +23,13 @@ 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
( ExchangeAddress(..) ( OrchardSpendingKey(..)
, OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, Rseed(..) , Rseed(..)
, SaplingAddress(..)
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Scope(..) , Scope(..)
, TransparentAddress(..)
, TransparentSpendingKey , TransparentSpendingKey
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
@ -217,51 +207,6 @@ 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

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 (fromJust, fromMaybe) import Data.Maybe (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, parseAddress) import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Types import ZcashHaskell.Types
( ZcashNet(..) ( ZcashNet(..)
, ZebraGetBlockChainInfo(..) , ZebraGetBlockChainInfo(..)
@ -39,9 +39,6 @@ import Zenith.RPC
) )
import Zenith.Types import Zenith.Types
( Config(..) ( Config(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ValidAddressAPI(..)
, ZcashAccountAPI(..) , ZcashAccountAPI(..)
, ZcashAddressAPI(..) , ZcashAddressAPI(..)
, ZcashWalletAPI(..) , ZcashWalletAPI(..)
@ -575,107 +572,6 @@ 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,6 +123,55 @@ 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"
@ -132,6 +181,10 @@ 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 =
@ -214,11 +267,9 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001331 3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
(Just "Sending memo to orchard") (fromJust uaRead)
] "Sending memo to orchard"
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -240,11 +291,9 @@ main = do
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
(Just "Sending memo to sapling") (fromJust uaRead)
] "Sending memo to sapling"
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -264,49 +313,13 @@ main = do
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing (fromJust uaRead)
] ""
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 =
@ -325,11 +338,9 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
(Just "Sending memo to orchard") (fromJust uaRead)
] "Sending memo to orchard"
Medium Medium
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -351,11 +362,9 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
(Just "Sending memo to sapling") (fromJust uaRead)
] "Sending memo to orchard"
Medium Medium
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -375,48 +384,13 @@ main = do
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing (fromJust uaRead)
] ""
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 =
@ -435,11 +409,9 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing (fromJust uaRead)
] "Sending memo to orchard"
Low Low
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -461,11 +433,9 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing (fromJust uaRead)
] "Sending memo to orchard"
Low Low
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -485,11 +455,9 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing (fromJust uaRead)
] ""
Low Low
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
@ -512,16 +480,14 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing (fromJust uaRead)
] "Sending memo to orchard"
None None
tx `shouldBe` tx `shouldBe`
Left Left
(PrivacyPolicyError (PrivacyPolicyError
"Shielded recipients not compatible with privacy policy.") "Receiver not compatible with privacy policy")
it "To Sapling" $ do it "To Sapling" $ do
let uaRead = let uaRead =
parseAddress parseAddress
@ -539,16 +505,14 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing (fromJust uaRead)
] "Sending memo to orchard"
None None
tx `shouldBe` tx `shouldBe`
Left Left
(PrivacyPolicyError (PrivacyPolicyError
"Shielded recipients not compatible with privacy policy.") "Receiver 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
@ -564,11 +528,9 @@ main = do
TestNet TestNet
(toSqlKey 1) (toSqlKey 1)
3001372 3001372
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing (fromJust uaRead)
] ""
None None
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e

View file

@ -132,7 +132,6 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }, { "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" } { "$ref": "#/components/errors/DuplicateName" }
] ]
}, },
@ -229,7 +228,6 @@
"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" }
] ]
}, },
@ -446,7 +444,6 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/InvalidAccount" }, { "$ref": "#/components/errors/InvalidAccount" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" } { "$ref": "#/components/errors/DuplicateName" }
] ]
}, },
@ -596,11 +593,10 @@
{ {
"name": "sendmany", "name": "sendmany",
"summary": "Send transaction(s)", "summary": "Send transaction(s)",
"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.", "description": "Send one or more transactions by specifying the source account, the recipient address, the amount, the shielded memo (optional) and the privacy policy (optional).",
"tags": [], "tags": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}],
"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",
@ -614,19 +610,14 @@
"examples": [ "examples": [
{ {
"name": "Send a transaction", "name": "Send a transaction",
"summary": "Send a transaction", "summary": "Send one transaction",
"description": "Send a transaction with one output", "description": "Send a single transaction",
"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",
@ -649,7 +640,7 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }, { "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" }, { "$ref": "#/components/errors/InvalidRecipient" },
{ "$ref": "#/components/errors/InvalidAccount" } { "$ref": "#/components/errors/InvalidAccount" }
] ]
}, },
@ -745,16 +736,6 @@
"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": {
@ -833,7 +814,8 @@
"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."}
} }
} }
}, },
@ -890,10 +872,6 @@
"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."
} }
} }
} }