Compare commits
No commits in common. "d3a5c36e6b3acbff4b8260c084ce85819ca97280" and "53eac75aa57a56761614759e3559747aa5e650b6" have entirely different histories.
d3a5c36e6b
...
53eac75aa5
12 changed files with 551 additions and 1840 deletions
|
@ -20,7 +20,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
- `getnewaccount` RPC method
|
||||
- `getnewaddress` RPC method
|
||||
- `getoperationstatus` RPC method
|
||||
- `sendmany` RPC method
|
||||
- Function `prepareTxV2` implementing `PrivacyPolicy`
|
||||
|
||||
### Changed
|
||||
|
@ -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
|
||||
- Block tracking for chain re-org detection
|
||||
- Refactored `ZcashPool`
|
||||
- Preventing write operations to occur during wallet sync
|
||||
|
||||
|
||||
## [0.6.0.0-beta]
|
||||
|
|
|
@ -2,22 +2,15 @@
|
|||
|
||||
module Server where
|
||||
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (forever, when)
|
||||
import Control.Monad (when)
|
||||
import Data.Configurator
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import Servant
|
||||
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
|
||||
import Zenith.Core (checkBlockChain, checkZebra)
|
||||
import Zenith.DB (initDb)
|
||||
import Zenith.RPC
|
||||
( State(..)
|
||||
, ZenithRPC(..)
|
||||
, authenticate
|
||||
, scanZebra
|
||||
, zenithServer
|
||||
)
|
||||
import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
|
||||
import Zenith.Scanner (rescanZebra)
|
||||
import Zenith.Types (Config(..))
|
||||
|
||||
|
@ -46,12 +39,6 @@ main = do
|
|||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
when x' $ rescanZebra zebraHost zebraPort dbFilePath
|
||||
_ <-
|
||||
forkIO $
|
||||
forever $ do
|
||||
_ <-
|
||||
scanZebra dbFilePath zebraHost zebraPort (zgb_net chainInfo)
|
||||
threadDelay 90000000
|
||||
let myState =
|
||||
State
|
||||
(zgb_net chainInfo)
|
||||
|
|
|
@ -2,7 +2,6 @@
|
|||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Zenith.CLI where
|
||||
|
||||
|
@ -63,14 +62,13 @@ import qualified Brick.Widgets.List as L
|
|||
import qualified Brick.Widgets.ProgressBar as P
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (throw, throwIO, try)
|
||||
import Control.Monad (forM_, forever, unless, void, when)
|
||||
import Control.Monad (forever, unless, void, when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger
|
||||
( LoggingT
|
||||
, NoLoggingT
|
||||
, logDebugN
|
||||
, runFileLoggingT
|
||||
, runNoLoggingT
|
||||
, runStderrLoggingT
|
||||
)
|
||||
import Data.Aeson
|
||||
import Data.HexString (HexString(..), toText)
|
||||
|
@ -90,15 +88,8 @@ import System.Hclip
|
|||
import Text.Printf
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard
|
||||
( getSaplingFromUA
|
||||
, isValidUnifiedAddress
|
||||
, parseAddress
|
||||
)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeTransparentAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||
import Zenith.Core
|
||||
|
@ -109,12 +100,9 @@ import Zenith.Types
|
|||
, HexStringDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ShieldDeshieldOp(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
, ShieldDeshieldOp(..)
|
||||
)
|
||||
import Zenith.Utils
|
||||
( displayTaz
|
||||
|
@ -173,9 +161,11 @@ data AdrBookEntry = AdrBookEntry
|
|||
|
||||
makeLenses ''AdrBookEntry
|
||||
|
||||
newtype ShDshEntry = ShDshEntry
|
||||
{ _shAmt :: Float
|
||||
} deriving (Show)
|
||||
data ShDshEntry = ShDshEntry
|
||||
{ _totalTransparent :: !Float
|
||||
, _totalShielded :: !Float
|
||||
, _shAmt :: !Float
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''ShDshEntry
|
||||
|
||||
|
@ -242,8 +232,7 @@ data State = State
|
|||
, _sentTx :: !(Maybe HexString)
|
||||
, _unconfBalance :: !Integer
|
||||
, _deshieldForm :: !(Form ShDshEntry () Name)
|
||||
, _tBalance :: !Integer
|
||||
, _sBalance :: !Integer
|
||||
, _shieldForm :: !(Form ShDshEntry () Name)
|
||||
}
|
||||
|
||||
makeLenses ''State
|
||||
|
@ -260,11 +249,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(" Zenith - " <>
|
||||
show (st ^. network) <>
|
||||
" - " <>
|
||||
T.unpack
|
||||
(maybe
|
||||
"(None)"
|
||||
(\(_, w) -> zcashWalletName $ entityVal w)
|
||||
(L.listSelectedElement (st ^. wallets))) ++
|
||||
(T.unpack
|
||||
(maybe
|
||||
"(None)"
|
||||
(\(_, w) -> zcashWalletName $ entityVal w)
|
||||
(L.listSelectedElement (st ^. wallets)))) ++
|
||||
" "))
|
||||
(C.hCenter
|
||||
(str
|
||||
|
@ -291,24 +280,25 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(C.hCenter
|
||||
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
|
||||
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
|
||||
(vBox
|
||||
[ C.hCenter
|
||||
(hBox
|
||||
[ capCommand "W" "allets"
|
||||
, capCommand "A" "ccounts"
|
||||
, capCommand "V" "iew address"
|
||||
, capCommand3 "" "S" "end Tx"
|
||||
])
|
||||
, C.hCenter
|
||||
(hBox
|
||||
[ capCommand2 "Address " "B" "ook"
|
||||
, capCommand2 "s" "H" "ield"
|
||||
, capCommand "D" "e-shield"
|
||||
, capCommand "Q" "uit"
|
||||
, capCommand "?" " Help"
|
||||
, str $ show (st ^. timer)
|
||||
])
|
||||
])
|
||||
(vBox
|
||||
[C.hCenter
|
||||
(hBox
|
||||
[ capCommand "W" "allets"
|
||||
, capCommand "A" "ccounts"
|
||||
, capCommand "V" "iew address"
|
||||
, capCommand3 "" "S" "end Tx"
|
||||
])
|
||||
,C.hCenter
|
||||
(hBox
|
||||
[ capCommand2 "Address " "B" "ook"
|
||||
, capCommand2 "s" "H" "ield"
|
||||
, capCommand "D" "e-shield"
|
||||
, capCommand "Q" "uit"
|
||||
, capCommand "?" " Help"
|
||||
, str $ show (st ^. timer)
|
||||
])
|
||||
]
|
||||
)
|
||||
listBox :: Show e => String -> L.List Name e -> Widget Name
|
||||
listBox titleLabel l =
|
||||
C.vCenter $
|
||||
|
@ -434,33 +424,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
|
||||
DeshieldForm ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
|
||||
(C.hCenter
|
||||
(padAll 1 $
|
||||
vBox
|
||||
[ str $
|
||||
"Transparent Bal.: " ++
|
||||
if st ^. network == MainNet
|
||||
then displayZec (st ^. tBalance)
|
||||
else displayTaz (st ^. tBalance)
|
||||
, str $
|
||||
"Shielded Bal.: " ++
|
||||
if st ^. network == MainNet
|
||||
then displayZec (st ^. sBalance)
|
||||
else displayTaz (st ^. sBalance)
|
||||
]) <=>
|
||||
renderForm (st ^. deshieldForm) <=>
|
||||
(D.dialog (Just (str " De-Shield Zec ")) Nothing 50)
|
||||
(renderForm (st ^. deshieldForm) <=>
|
||||
C.hCenter
|
||||
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
|
||||
ShieldForm ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " Shield ZEC ")) Nothing 50)
|
||||
(C.hCenter
|
||||
(str $
|
||||
"Shield " ++
|
||||
if st ^. network == MainNet
|
||||
then displayZec (st ^. tBalance)
|
||||
else displayTaz (st ^. tBalance) ++ "?") <=>
|
||||
(D.dialog (Just (str " Shield Zec ")) Nothing 50)
|
||||
(renderForm (st ^. shieldForm) <=>
|
||||
C.hCenter
|
||||
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
|
||||
Blank -> emptyWidget
|
||||
|
@ -707,10 +678,26 @@ mkSendForm bal =
|
|||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
||||
mkDeshieldForm tbal =
|
||||
mkDeshieldForm bal =
|
||||
newForm
|
||||
[ label "Amount: " @@=
|
||||
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
|
||||
[ label "Total Transp. : " @@=
|
||||
editShowableFieldWithValidate totalTransparent TotalTranspField (isAmountValid bal)
|
||||
, label "Total Shielded : " @@=
|
||||
editShowableFieldWithValidate totalShielded TotalShieldedField (isAmountValid bal)
|
||||
, label "Amount: " @@=
|
||||
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Float -> Bool
|
||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
||||
mkShieldForm bal =
|
||||
newForm
|
||||
[ label "Amount to Shield: " @@=
|
||||
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Float -> Bool
|
||||
|
@ -832,45 +819,34 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
||||
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
|
||||
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
|
||||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then do
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
||||
else do
|
||||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
then do
|
||||
liftIO $
|
||||
BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
||||
else do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
then do
|
||||
let step =
|
||||
(1.0 :: Float) /
|
||||
fromIntegral (zgb_blocks bStatus - (sb + 1))
|
||||
_ <- liftIO $ startSync pool
|
||||
mapM_ (liftIO . processBlock pool step) bList
|
||||
confUp <-
|
||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $
|
||||
BC.writeBChan eChan $
|
||||
TickMsg "Failed to update unconfirmed transactions"
|
||||
Right _ -> do
|
||||
_ <- liftIO $ completeSync pool Successful
|
||||
return ()
|
||||
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||
let step =
|
||||
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
|
||||
mapM_ (liftIO . processBlock pool step) bList
|
||||
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||
confUp <-
|
||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 ->
|
||||
liftIO $
|
||||
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
|
||||
Right _ -> return ()
|
||||
where
|
||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||
processBlock pool step bl = do
|
||||
|
@ -882,9 +858,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
|
||||
case r of
|
||||
Left e1 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg e1
|
||||
Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
@ -894,9 +868,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
|
@ -953,7 +925,7 @@ appEvent (BT.AppEvent t) = do
|
|||
Just (_k, w) -> return w
|
||||
_ <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
runFileLoggingT "zenith.log" $
|
||||
syncWallet
|
||||
(Config
|
||||
(s ^. dbPath)
|
||||
|
@ -963,11 +935,11 @@ appEvent (BT.AppEvent t) = do
|
|||
"pwd"
|
||||
8080)
|
||||
selWallet
|
||||
BT.modify $ set displayBox BlankDisplay
|
||||
BT.modify $ set barValue 0.0
|
||||
updatedState <- BT.get
|
||||
ns <- liftIO $ refreshWallet updatedState
|
||||
BT.put ns
|
||||
BT.modify $ set displayBox BlankDisplay
|
||||
BT.modify $ set barValue 0.0
|
||||
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
|
||||
BlankDisplay -> do
|
||||
case s ^. dialogBox of
|
||||
|
@ -992,7 +964,7 @@ appEvent (BT.AppEvent t) = do
|
|||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
runStderrLoggingT $
|
||||
runFileLoggingT "zenith.log" $
|
||||
scanZebra
|
||||
(s ^. dbPath)
|
||||
(s ^. zebraHost)
|
||||
|
@ -1216,7 +1188,6 @@ appEvent (BT.VtyEvent e) = do
|
|||
(fs1 ^. sendAmt)
|
||||
(fs1 ^. sendTo)
|
||||
(fs1 ^. sendMemo)
|
||||
(fs1 ^. policyField)
|
||||
BT.modify $ set msg "Preparing transaction..."
|
||||
BT.modify $ set displayBox SendDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
|
@ -1230,102 +1201,16 @@ appEvent (BT.VtyEvent e) = do
|
|||
fs <- BT.gets formState
|
||||
BT.modify $
|
||||
setFieldValid
|
||||
(isRecipientValidGUI
|
||||
(fs ^. policyField)
|
||||
(fs ^. sendTo))
|
||||
(isRecipientValidGUI (fs ^. policyField) (fs ^. sendTo))
|
||||
RecField
|
||||
DeshieldForm -> do
|
||||
case e of
|
||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||
V.EvKey (V.KChar 'p') [] -> do
|
||||
if allFieldsValid (s ^. deshieldForm)
|
||||
then do
|
||||
pool <-
|
||||
liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selWal <-
|
||||
do case L.listSelectedElement $ s ^. wallets of
|
||||
Nothing -> do
|
||||
let fWall =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $ s ^. wallets
|
||||
case fWall of
|
||||
Nothing ->
|
||||
throw $
|
||||
userError "Failed to select wallet"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
selAcc <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
let fAcc =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $
|
||||
s ^. accounts
|
||||
case fAcc of
|
||||
Nothing ->
|
||||
throw $
|
||||
userError "Failed to select wallet"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
selAddr <-
|
||||
do case L.listSelectedElement $ s ^. addresses of
|
||||
Nothing -> do
|
||||
let fAddr =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $
|
||||
s ^. addresses
|
||||
case fAddr of
|
||||
Nothing ->
|
||||
throw $
|
||||
userError "Failed to select address"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
fs1 <- BT.zoom deshieldForm $ BT.gets formState
|
||||
let tAddrMaybe =
|
||||
Transparent <$>
|
||||
((decodeTransparentAddress .
|
||||
E.encodeUtf8 .
|
||||
encodeTransparentReceiver (s ^. network)) =<<
|
||||
(t_rec =<<
|
||||
(isValidUnifiedAddress .
|
||||
E.encodeUtf8 .
|
||||
getUA . walletAddressUAddress)
|
||||
(entityVal selAddr)))
|
||||
bl <-
|
||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
||||
case tAddrMaybe of
|
||||
Nothing -> do
|
||||
BT.modify $
|
||||
set
|
||||
msg
|
||||
"Failed to obtain transparent address"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
Just tAddr -> do
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
deshieldTransaction
|
||||
pool
|
||||
(s ^. eventDispatch)
|
||||
(s ^. zebraHost)
|
||||
(s ^. zebraPort)
|
||||
(s ^. network)
|
||||
(entityKey selAcc)
|
||||
bl
|
||||
(ProposedNote
|
||||
(ValidAddressAPI tAddr)
|
||||
(fs1 ^. shAmt)
|
||||
Nothing)
|
||||
BT.modify $ set displayBox SendDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
else do
|
||||
BT.modify $ set msg "Invalid inputs"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
ev ->
|
||||
BT.zoom deshieldForm $ do
|
||||
handleFormEvent (BT.VtyEvent ev)
|
||||
case e of
|
||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||
ev ->
|
||||
BT.zoom deshieldForm $ do
|
||||
handleFormEvent (BT.VtyEvent ev)
|
||||
-- fs <- BT.gets formState
|
||||
-- ev -> BT.zoom deshieldForm $ L.handleListEvent ev
|
||||
AdrBook -> do
|
||||
case e of
|
||||
V.EvKey (V.KChar 'x') [] ->
|
||||
|
@ -1343,7 +1228,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
"Address copied to Clipboard from >>\n" ++
|
||||
T.unpack (addressBookAbdescrip (entityVal a))
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
_any -> do
|
||||
_ -> do
|
||||
BT.modify $
|
||||
set msg "Error while copying the address!!"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
|
@ -1509,53 +1394,6 @@ appEvent (BT.VtyEvent e) = do
|
|||
BT.put s'
|
||||
BT.modify $ set dialogBox AdrBook
|
||||
ev -> BT.modify $ set dialogBox AdrBookDelForm
|
||||
ShieldForm -> do
|
||||
case e of
|
||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||
V.EvKey (V.KChar 'p') [] -> do
|
||||
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selWal <-
|
||||
do case L.listSelectedElement $ s ^. wallets of
|
||||
Nothing -> do
|
||||
let fWall =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $ s ^. wallets
|
||||
case fWall of
|
||||
Nothing ->
|
||||
throw $
|
||||
userError "Failed to select wallet"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
selAcc <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
let fAcc =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $ s ^. accounts
|
||||
case fAcc of
|
||||
Nothing ->
|
||||
throw $
|
||||
userError "Failed to select account"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
bl <- liftIO $ getLastSyncBlock pool $ entityKey selWal
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
shieldTransaction
|
||||
pool
|
||||
(s ^. eventDispatch)
|
||||
(s ^. zebraHost)
|
||||
(s ^. zebraPort)
|
||||
(s ^. network)
|
||||
(entityKey selAcc)
|
||||
bl
|
||||
BT.modify $ set msg "Preparing transaction..."
|
||||
BT.modify $ set displayBox SendDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
ev ->
|
||||
BT.zoom deshieldForm $ do
|
||||
handleFormEvent (BT.VtyEvent ev)
|
||||
-- Process any other event
|
||||
Blank -> do
|
||||
case e of
|
||||
|
@ -1582,57 +1420,10 @@ appEvent (BT.VtyEvent e) = do
|
|||
BT.modify $ set dialogBox SendTx
|
||||
V.EvKey (V.KChar 'b') [] ->
|
||||
BT.modify $ set dialogBox AdrBook
|
||||
V.EvKey (V.KChar 'd') [] -> do
|
||||
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selAcc <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
let fAcc =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $ s ^. accounts
|
||||
case fAcc of
|
||||
Nothing ->
|
||||
throw $
|
||||
userError "Failed to select 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)
|
||||
V.EvKey (V.KChar 'd') [] ->
|
||||
BT.modify $ set dialogBox DeshieldForm
|
||||
V.EvKey (V.KChar 'h') [] -> do
|
||||
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selAcc <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
let fAcc =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $ s ^. accounts
|
||||
case fAcc of
|
||||
Nothing ->
|
||||
throw $
|
||||
userError "Failed to select account"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
tBal <-
|
||||
liftIO $
|
||||
getTransparentBalance pool $ entityKey selAcc
|
||||
BT.modify $ set tBalance tBal
|
||||
if tBal > 20000
|
||||
then BT.modify $ set dialogBox ShieldForm
|
||||
else do
|
||||
BT.modify $
|
||||
set
|
||||
msg
|
||||
"Not enough transparent funds in this account"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
V.EvKey (V.KChar 'h') [] ->
|
||||
BT.modify $ set dialogBox ShieldForm
|
||||
ev ->
|
||||
case r of
|
||||
Just AList ->
|
||||
|
@ -1647,8 +1438,6 @@ appEvent (BT.VtyEvent e) = do
|
|||
printMsg s = BT.modify $ updateMsg s
|
||||
updateMsg :: String -> State -> State
|
||||
updateMsg = set msg
|
||||
-- fs <- BT.gets formState
|
||||
-- ev -> BT.zoom shdshForm $ L.handleListEvent ev
|
||||
appEvent _ = return ()
|
||||
|
||||
theMap :: A.AttrMap
|
||||
|
@ -1731,14 +1520,6 @@ runZenithTUI config = do
|
|||
if not (null accList)
|
||||
then getUnconfirmedBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
tBal <-
|
||||
if not (null accList)
|
||||
then getTransparentBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
sBal <-
|
||||
if not (null accList)
|
||||
then getShieldedBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
eventChan <- BC.newBChan 10
|
||||
_ <-
|
||||
forkIO $
|
||||
|
@ -1752,7 +1533,7 @@ runZenithTUI config = do
|
|||
State
|
||||
(zgb_net chainInfo)
|
||||
(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 TList (Vec.fromList txList) 1)
|
||||
("Start up Ok! Connected to Zebra " ++
|
||||
|
@ -1781,9 +1562,8 @@ runZenithTUI config = do
|
|||
""
|
||||
Nothing
|
||||
uBal
|
||||
(mkDeshieldForm 0 (ShDshEntry 0.0))
|
||||
tBal
|
||||
sBal
|
||||
(mkDeshieldForm 0 (ShDshEntry 0 0 0.0 ))
|
||||
(mkShieldForm 0 (ShDshEntry 0 0 0.0 ))
|
||||
Left _e -> do
|
||||
print $
|
||||
"No Zebra node available on port " <>
|
||||
|
@ -1803,7 +1583,7 @@ refreshWallet s = do
|
|||
Just (j, w1) -> return (j, w1)
|
||||
Just (k, w) -> return (k, w)
|
||||
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
|
||||
let bl = zcashWalletLastSync $ entityVal $ walList !! ix
|
||||
let bl = zcashWalletLastSync $ entityVal selWallet
|
||||
addrL <-
|
||||
if not (null aL)
|
||||
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
|
||||
|
@ -1997,30 +1777,15 @@ sendTransaction ::
|
|||
-> Float
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
-> 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..."
|
||||
case parseAddress (E.encodeUtf8 ua) of
|
||||
case parseAddressUA ua znet of
|
||||
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
||||
Just outUA -> do
|
||||
res <-
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
accId
|
||||
bl
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI outUA)
|
||||
amt
|
||||
(if memo == ""
|
||||
then Nothing
|
||||
else Just memo)
|
||||
]
|
||||
policy
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
case res of
|
||||
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
|
||||
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
|
||||
Right txId -> BC.writeBChan chan $ TickTx txId
|
||||
|
||||
shieldTransaction ::
|
||||
ConnectionPool
|
||||
-> BC.BChan Tick
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> IO ()
|
||||
shieldTransaction pool chan zHost zPort znet accId bl = do
|
||||
BC.writeBChan chan $ TickMsg "Preparing shielding transaction..."
|
||||
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
|
||||
forM_ res $ \case
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
resp <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ toText rawTx]
|
||||
case resp of
|
||||
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
|
||||
Right txId -> BC.writeBChan chan $ TickTx txId
|
||||
|
||||
deshieldTransaction ::
|
||||
ConnectionPool
|
||||
-> BC.BChan Tick
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> ProposedNote
|
||||
-> IO ()
|
||||
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
|
||||
BC.writeBChan chan $ TickMsg "Deshielding funds..."
|
||||
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
|
||||
case res of
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
resp <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ toText rawTx]
|
||||
case resp of
|
||||
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
|
||||
Right txId -> BC.writeBChan chan $ TickTx txId
|
||||
|
|
|
@ -26,7 +26,7 @@ import qualified Data.ByteString.Lazy as LBS
|
|||
import Data.Digest.Pure.MD5
|
||||
import Data.HexString (HexString, hexString, toBytes, toText)
|
||||
import Data.List
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Pool (Pool)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
|
@ -34,11 +34,7 @@ import Data.Time
|
|||
import qualified Database.Esqueleto.Experimental as ESQ
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import GHC.Float.RealFracMethods
|
||||
( ceilingFloatInteger
|
||||
, floorFloatInt
|
||||
, floorFloatInteger
|
||||
)
|
||||
import GHC.Float.RealFracMethods (floorFloatInteger)
|
||||
import Haskoin.Crypto.Keys (XPrvKey(..))
|
||||
import Lens.Micro ((&), (.~), (^.), set)
|
||||
import Network.HTTP.Client
|
||||
|
@ -79,13 +75,11 @@ import Zenith.Types
|
|||
, OrchardSpendingKeyDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, RseedDB(..)
|
||||
, SaplingSpendingKeyDB(..)
|
||||
, ScopeDB(..)
|
||||
, TransparentSpendingKeyDB(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZebraTreeInfo(..)
|
||||
)
|
||||
|
@ -547,7 +541,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
|||
return $ Left ZHError
|
||||
Just acc -> do
|
||||
logDebugN $ T.pack $ show acc
|
||||
let zats = floorFloatInteger $ amt * (10 ^ 8)
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ T.pack $ show zats
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--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
|
||||
else Nothing
|
||||
|
||||
deshieldNotes ::
|
||||
ConnectionPool
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> ProposedNote
|
||||
-> NoLoggingT IO (Either TxError HexString)
|
||||
deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
|
||||
bal <- liftIO $ getShieldedBalance pool za
|
||||
let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8)
|
||||
if bal > (20000 + zats)
|
||||
then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low
|
||||
else return $ Left InsufficientFunds
|
||||
|
||||
shieldTransparentNotes ::
|
||||
ConnectionPool
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> NoLoggingT IO [Either TxError HexString]
|
||||
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
case accRead of
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
return [Left ZHError]
|
||||
Just acc -> do
|
||||
trNotes' <- liftIO $ getWalletUnspentTrNotes pool za
|
||||
dRecvs <- liftIO $ getReceivers pool trNotes'
|
||||
let fNotes =
|
||||
map
|
||||
(\x ->
|
||||
filter (\y -> walletTrNoteAddress (entityVal y) == x) trNotes')
|
||||
dRecvs
|
||||
forM fNotes $ \trNotes -> do
|
||||
let noteTotal = getTotalAmount (trNotes, [], [])
|
||||
let fee = calculateTxFee (trNotes, [], []) 4
|
||||
tSpends <-
|
||||
liftIO $
|
||||
prepTSpends
|
||||
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||
trNotes
|
||||
chgAddr <- getInternalAddresses pool $ entityKey acc
|
||||
let internalUA =
|
||||
getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||
let oRcvr =
|
||||
fromJust $
|
||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
let snote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - fee)
|
||||
""
|
||||
True
|
||||
let tx =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
[]
|
||||
[]
|
||||
[snote]
|
||||
znet
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
where
|
||||
getTotalAmount ::
|
||||
( [Entity WalletTrNote]
|
||||
, [Entity WalletSapNote]
|
||||
, [Entity WalletOrchNote])
|
||||
-> Integer
|
||||
getTotalAmount (t, s, o) =
|
||||
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
|
||||
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
|
||||
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
|
||||
prepTSpends ::
|
||||
TransparentSpendingKey
|
||||
-> [Entity WalletTrNote]
|
||||
-> IO [TransparentTxSpend]
|
||||
prepTSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
|
||||
case tAddRead of
|
||||
Nothing -> throwIO $ userError "Couldn't read t-address"
|
||||
Just tAdd -> do
|
||||
(XPrvKey _ _ _ _ (SecKey xp_key)) <-
|
||||
genTransparentSecretKey
|
||||
(walletAddressIndex $ entityVal tAdd)
|
||||
(getScope $ walletAddressScope $ entityVal tAdd)
|
||||
sk
|
||||
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
|
||||
case mReverseTxId of
|
||||
Nothing -> throwIO $ userError "failed to get tx ID"
|
||||
Just (ESQ.Value reverseTxId) -> do
|
||||
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
|
||||
return $
|
||||
TransparentTxSpend
|
||||
xp_key
|
||||
(RawOutPoint
|
||||
flipTxId
|
||||
(fromIntegral $ walletTrNotePosition $ entityVal n))
|
||||
(RawTxOut
|
||||
(fromIntegral $ walletTrNoteValue $ entityVal n)
|
||||
(walletTrNoteScript $ entityVal n))
|
||||
|
||||
-- | Prepare a transaction for sending
|
||||
prepareTxV2 ::
|
||||
ConnectionPool
|
||||
|
@ -852,13 +729,38 @@ prepareTxV2 ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> [ProposedNote]
|
||||
-> Float
|
||||
-> ValidAddress
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
-> NoLoggingT IO (Either TxError HexString)
|
||||
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
let recipients = map extractReceiver pnotes
|
||||
logDebugN $ T.pack $ show recipients
|
||||
let recipient =
|
||||
case va of
|
||||
Unified ua ->
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
case s_rec ua of
|
||||
Nothing ->
|
||||
case t_rec ua of
|
||||
Nothing -> (0, "")
|
||||
Just r3 ->
|
||||
case tr_type r3 of
|
||||
P2PKH -> (1, toBytes $ tr_bytes r3)
|
||||
P2SH -> (2, toBytes $ tr_bytes r3)
|
||||
Just r2 -> (3, getBytes r2)
|
||||
Just r1 -> (4, getBytes r1)
|
||||
Sapling sa -> (3, getBytes $ sa_receiver sa)
|
||||
Transparent ta ->
|
||||
case tr_type (ta_receiver ta) of
|
||||
P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
|
||||
P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
|
||||
Exchange ea ->
|
||||
case tr_type (ex_address ea) of
|
||||
P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
|
||||
P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
|
||||
logDebugN $ T.pack $ show recipient
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
|
@ -869,21 +771,14 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
return $ Left ZHError
|
||||
Just acc -> do
|
||||
logDebugN $ T.pack $ show acc
|
||||
let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
|
||||
let zats = ceilingFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ "amt: " <> T.pack (show amt)
|
||||
logDebugN $ "zats: " <> T.pack (show zats)
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ T.pack $ show zats
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
notePlan <-
|
||||
liftIO $
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + 10000)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
|
||||
case notePlan of
|
||||
Right (tList, sList, oList) -> do
|
||||
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 oList
|
||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
|
||||
tSpends <-
|
||||
liftIO $
|
||||
prepTSpends
|
||||
|
@ -912,7 +806,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
--print oSpends
|
||||
dummy' <-
|
||||
liftIO $
|
||||
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
|
||||
makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy
|
||||
case dummy' of
|
||||
Left e -> return $ Left e
|
||||
Right dummy -> do
|
||||
|
@ -940,7 +834,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
pool
|
||||
za
|
||||
(zats + feeAmt)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
(fst recipient)
|
||||
policy
|
||||
case finalNotePlan of
|
||||
Right (tList1, sList1, oList1) -> do
|
||||
|
@ -969,7 +863,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipients
|
||||
recipient
|
||||
zats
|
||||
(noteTotal1 - feeAmt - zats)
|
||||
policy
|
||||
logDebugN $ T.pack $ show outgoing'
|
||||
|
@ -994,136 +889,30 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
logErrorN $ T.pack $ show e
|
||||
return $ Left e
|
||||
where
|
||||
extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text)
|
||||
extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
in case va of
|
||||
Unified ua ->
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
case s_rec ua of
|
||||
Nothing ->
|
||||
case t_rec ua of
|
||||
Nothing -> (0, "", 0, "")
|
||||
Just r3 ->
|
||||
case tr_type r3 of
|
||||
P2PKH ->
|
||||
(1, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
|
||||
P2SH ->
|
||||
(2, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
|
||||
Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
|
||||
Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
|
||||
Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
|
||||
Transparent ta ->
|
||||
case tr_type (ta_receiver ta) of
|
||||
P2PKH ->
|
||||
(1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
|
||||
P2SH ->
|
||||
(2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
|
||||
Exchange ea ->
|
||||
case tr_type (ex_address ea) of
|
||||
P2PKH ->
|
||||
(5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
|
||||
P2SH ->
|
||||
(6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
|
||||
prepareOutgoingNote ::
|
||||
ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote
|
||||
prepareOutgoingNote zac (k, r, a, m) =
|
||||
OutgoingNote
|
||||
(if k == 5
|
||||
then 1
|
||||
else if k == 6
|
||||
then 2
|
||||
else fromIntegral k)
|
||||
(case k of
|
||||
4 -> getBytes $ getOrchSK $ zcashAccountOrchSpendKey zac
|
||||
3 -> getBytes $ getSapSK $ zcashAccountSapSpendKey zac
|
||||
_anyOther -> BS.empty)
|
||||
r
|
||||
(fromIntegral a)
|
||||
(E.encodeUtf8 m)
|
||||
False
|
||||
makeOutgoing ::
|
||||
Entity ZcashAccount
|
||||
-> [(Int, BS.ByteString, Int, T.Text)]
|
||||
-> (Int, BS.ByteString)
|
||||
-> Integer
|
||||
-> Integer
|
||||
-> PrivacyPolicy
|
||||
-> IO (Either TxError [OutgoingNote])
|
||||
makeOutgoing acc recvs chg pol = do
|
||||
let k = map (\(x, _, _, _) -> x) recvs
|
||||
let j = map (\(_, _, x, _) -> x) recvs
|
||||
makeOutgoing acc (k, recvr) zats chg policy = do
|
||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||
case pol of
|
||||
Full ->
|
||||
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
else if elem 3 k && elem 4 k
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Multiple shielded pools not allowed for Full privacy"
|
||||
else if 3 `elem` k
|
||||
then do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
s_rec =<<
|
||||
isValidUnifiedAddress
|
||||
(E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
3
|
||||
(getBytes $
|
||||
getSapSK $
|
||||
zcashAccountSapSpendKey $ entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
let onotes =
|
||||
map
|
||||
(prepareOutgoingNote (entityVal acc))
|
||||
recvs
|
||||
return $ Right $ cnote : onotes
|
||||
else if 4 `elem` k
|
||||
then do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
o_rec =<<
|
||||
isValidUnifiedAddress
|
||||
(E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $
|
||||
getOrchSK $
|
||||
zcashAccountOrchSpendKey $
|
||||
entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
let onotes =
|
||||
map
|
||||
(prepareOutgoingNote (entityVal acc))
|
||||
recvs
|
||||
return $ Right $ cnote : onotes
|
||||
else return $ Left ZHError
|
||||
Medium ->
|
||||
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
else do
|
||||
case k of
|
||||
4 ->
|
||||
case policy of
|
||||
None ->
|
||||
return $
|
||||
Left $
|
||||
PrivacyPolicyError "Receiver not compatible with privacy policy"
|
||||
_anyOther -> do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
4
|
||||
(getBytes $
|
||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
|
@ -1131,20 +920,51 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
(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
|
||||
, 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
|
||||
(getBytes $
|
||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote
|
||||
3
|
||||
(getBytes $
|
||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
recvr
|
||||
(fromIntegral zats)
|
||||
(E.encodeUtf8 memo)
|
||||
False
|
||||
]
|
||||
_anyOther -> do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
4
|
||||
(getBytes $
|
||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
|
@ -1152,28 +972,58 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
(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
|
||||
, OutgoingNote
|
||||
3
|
||||
(getBytes $
|
||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
recvr
|
||||
(fromIntegral zats)
|
||||
(E.encodeUtf8 memo)
|
||||
False
|
||||
]
|
||||
2 ->
|
||||
if policy <= Low
|
||||
then do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
1
|
||||
BS.empty
|
||||
(toBytes $ tr_bytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
|
||||
return $ Right $ cnote : onotes
|
||||
, OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
|
||||
]
|
||||
else return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
1 ->
|
||||
if policy <= Low
|
||||
then do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
1
|
||||
BS.empty
|
||||
(toBytes $ tr_bytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
|
||||
]
|
||||
else return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
_anyOther -> return $ Left ZHError
|
||||
getTotalAmount ::
|
||||
( [Entity WalletTrNote]
|
||||
, [Entity WalletSapNote]
|
||||
|
@ -1261,7 +1111,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
syncWallet ::
|
||||
Config -- ^ configuration parameters
|
||||
-> Entity ZcashWallet
|
||||
-> NoLoggingT IO ()
|
||||
-> LoggingT IO ()
|
||||
syncWallet config w = do
|
||||
startTime <- liftIO getCurrentTime
|
||||
let walletDb = c_dbPath config
|
||||
|
|
499
src/Zenith/DB.hs
499
src/Zenith/DB.hs
|
@ -291,13 +291,6 @@ share
|
|||
result T.Text Maybe
|
||||
UniqueOp uuid
|
||||
deriving Show Eq
|
||||
ChainSync
|
||||
name T.Text
|
||||
start UTCTime
|
||||
end UTCTime Maybe
|
||||
status ZenithStatus
|
||||
UniqueSync name
|
||||
deriving Show Eq
|
||||
|]
|
||||
|
||||
-- ** Type conversions
|
||||
|
@ -1191,61 +1184,6 @@ getTrNotes pool tr = do
|
|||
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
||||
pure tnotes
|
||||
|
||||
getTrFilteredNotes ::
|
||||
ConnectionPool
|
||||
-> [HexStringDB]
|
||||
-> TransparentReceiver
|
||||
-> IO [Entity WalletTrNote]
|
||||
getTrFilteredNotes pool txs tr = do
|
||||
let s =
|
||||
BS.concat
|
||||
[ BS.pack [0x76, 0xA9, 0x14]
|
||||
, (toBytes . tr_bytes) tr
|
||||
, BS.pack [0x88, 0xAC]
|
||||
]
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
(wt :& tnotes) <-
|
||||
from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on`
|
||||
(\(wt :& tnotes) ->
|
||||
wt ^. WalletTransactionId ==. tnotes ^. WalletTrNoteTx)
|
||||
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
||||
where_ (wt ^. WalletTransactionTxId `in_` valList txs)
|
||||
pure tnotes
|
||||
|
||||
traceTrDag :: ConnectionPool -> Entity WalletTrNote -> IO [Entity WalletTrNote]
|
||||
traceTrDag pool note = do
|
||||
trSpend <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
trSpends <- from $ table @WalletTrSpend
|
||||
where_ (trSpends ^. WalletTrSpendNote ==. val (entityKey note))
|
||||
pure trSpends
|
||||
case trSpend of
|
||||
Nothing -> return []
|
||||
Just tnote -> do
|
||||
nxtChg <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
nts <- from $ table @WalletTrNote
|
||||
where_
|
||||
(nts ^. WalletTrNoteTx ==. val (walletTrSpendTx $ entityVal tnote) &&.
|
||||
nts ^.
|
||||
WalletTrNoteChange ==.
|
||||
val True)
|
||||
pure nts
|
||||
case nxtChg of
|
||||
Nothing -> return []
|
||||
Just nxt -> do
|
||||
nxtSearch <- traceTrDag pool nxt
|
||||
return $ nxt : nxtSearch
|
||||
|
||||
getSapNotes :: ConnectionPool -> SaplingReceiver -> IO [Entity WalletSapNote]
|
||||
getSapNotes pool sr = do
|
||||
runNoLoggingT $
|
||||
|
@ -1256,57 +1194,6 @@ getSapNotes pool sr = do
|
|||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
|
||||
pure snotes
|
||||
|
||||
getSapFilteredNotes ::
|
||||
ConnectionPool
|
||||
-> [HexStringDB]
|
||||
-> SaplingReceiver
|
||||
-> IO [Entity WalletSapNote]
|
||||
getSapFilteredNotes pool txs sr = do
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
(wt :& snotes) <-
|
||||
from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on`
|
||||
(\(wt :& snotes) ->
|
||||
wt ^. WalletTransactionId ==. snotes ^. WalletSapNoteTx)
|
||||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
|
||||
where_ (wt ^. WalletTransactionTxId `in_` valList txs)
|
||||
pure snotes
|
||||
|
||||
traceSapDag ::
|
||||
ConnectionPool -> Entity WalletSapNote -> IO [Entity WalletSapNote]
|
||||
traceSapDag pool note = do
|
||||
sapSpend <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
sapSpends <- from $ table @WalletSapSpend
|
||||
where_ (sapSpends ^. WalletSapSpendNote ==. val (entityKey note))
|
||||
pure sapSpends
|
||||
case sapSpend of
|
||||
Nothing -> return []
|
||||
Just snote -> do
|
||||
nxtChg <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
nts <- from $ table @WalletSapNote
|
||||
where_
|
||||
(nts ^. WalletSapNoteTx ==.
|
||||
val (walletSapSpendTx $ entityVal snote) &&.
|
||||
nts ^.
|
||||
WalletSapNoteChange ==.
|
||||
val True)
|
||||
pure nts
|
||||
case nxtChg of
|
||||
Nothing -> return []
|
||||
Just nxt -> do
|
||||
nxtSearch <- traceSapDag pool nxt
|
||||
return $ nxt : nxtSearch
|
||||
|
||||
getOrchNotes :: ConnectionPool -> OrchardReceiver -> IO [Entity WalletOrchNote]
|
||||
getOrchNotes pool o = do
|
||||
runNoLoggingT $
|
||||
|
@ -1317,57 +1204,6 @@ getOrchNotes pool o = do
|
|||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
|
||||
pure onotes
|
||||
|
||||
getOrchFilteredNotes ::
|
||||
ConnectionPool
|
||||
-> [HexStringDB]
|
||||
-> OrchardReceiver
|
||||
-> IO [Entity WalletOrchNote]
|
||||
getOrchFilteredNotes pool txs o = do
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
(wt :& onotes) <-
|
||||
from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on`
|
||||
(\(wt :& onotes) ->
|
||||
wt ^. WalletTransactionId ==. onotes ^. WalletOrchNoteTx)
|
||||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
|
||||
where_ (wt ^. WalletTransactionTxId `in_` valList txs)
|
||||
pure onotes
|
||||
|
||||
traceOrchDag ::
|
||||
ConnectionPool -> Entity WalletOrchNote -> IO [Entity WalletOrchNote]
|
||||
traceOrchDag pool note = do
|
||||
orchSpend <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
orchSpends <- from $ table @WalletOrchSpend
|
||||
where_ (orchSpends ^. WalletOrchSpendNote ==. val (entityKey note))
|
||||
pure orchSpends
|
||||
case orchSpend of
|
||||
Nothing -> return []
|
||||
Just onote -> do
|
||||
nxtChg <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
nts <- from $ table @WalletOrchNote
|
||||
where_
|
||||
(nts ^. WalletOrchNoteTx ==.
|
||||
val (walletOrchSpendTx $ entityVal onote) &&.
|
||||
nts ^.
|
||||
WalletOrchNoteChange ==.
|
||||
val True)
|
||||
pure nts
|
||||
case nxtChg of
|
||||
Nothing -> return []
|
||||
Just nxt -> do
|
||||
nxtSearch <- traceOrchDag pool nxt
|
||||
return $ nxt : nxtSearch
|
||||
|
||||
getWalletNotes ::
|
||||
ConnectionPool -- ^ database path
|
||||
-> Entity WalletAddress
|
||||
|
@ -1412,66 +1248,47 @@ getWalletTransactions pool w = do
|
|||
case tReceiver of
|
||||
Nothing -> return []
|
||||
Just tR -> liftIO $ getTrNotes pool tR
|
||||
sapNotes <-
|
||||
case sReceiver of
|
||||
trChgNotes <-
|
||||
case ctReceiver of
|
||||
Nothing -> return []
|
||||
Just sR -> liftIO $ getSapNotes pool sR
|
||||
orchNotes <-
|
||||
case oReceiver of
|
||||
Nothing -> return []
|
||||
Just oR -> liftIO $ getOrchNotes pool oR
|
||||
clearUserTx (entityKey w)
|
||||
mapM_ addTr trNotes
|
||||
mapM_ addSap sapNotes
|
||||
mapM_ addOrch orchNotes
|
||||
Just tR -> liftIO $ getTrNotes pool tR
|
||||
trSpends <-
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
trSpends <- from $ table @WalletTrSpend
|
||||
where_
|
||||
(trSpends ^. WalletTrSpendNote `in_` valList (map entityKey trNotes))
|
||||
(trSpends ^. WalletTrSpendNote `in_`
|
||||
valList (map entityKey (trNotes <> trChgNotes)))
|
||||
pure trSpends
|
||||
sapSpends <- mapM (getSapSpends . entityKey) sapNotes
|
||||
orchSpends <- mapM (getOrchSpends . entityKey) orchNotes
|
||||
mapM_ subTSpend trSpends
|
||||
mapM_ subSSpend $ catMaybes sapSpends
|
||||
mapM_ subOSpend $ catMaybes orchSpends
|
||||
foundTxs <- getTxs $ entityKey w
|
||||
trChgNotes <-
|
||||
case ctReceiver of
|
||||
sapNotes <-
|
||||
case sReceiver of
|
||||
Nothing -> return []
|
||||
Just tR -> liftIO $ getTrFilteredNotes pool foundTxs tR
|
||||
trChgNotes' <- liftIO $ mapM (traceTrDag pool) trChgNotes
|
||||
trChgSpends <-
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
trS <- from $ table @WalletTrSpend
|
||||
where_
|
||||
(trS ^. WalletTrSpendNote `in_`
|
||||
valList (map entityKey (trChgNotes <> concat trChgNotes')))
|
||||
pure trS
|
||||
Just sR -> liftIO $ getSapNotes pool sR
|
||||
sapChgNotes <-
|
||||
case csReceiver of
|
||||
Nothing -> return []
|
||||
Just sR -> liftIO $ getSapFilteredNotes pool foundTxs sR
|
||||
sapChgNotes' <- liftIO $ mapM (traceSapDag pool) sapChgNotes
|
||||
sapChgSpends <-
|
||||
mapM (getSapSpends . entityKey) (sapChgNotes <> concat sapChgNotes')
|
||||
Just sR -> liftIO $ getSapNotes pool sR
|
||||
sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes)
|
||||
orchNotes <-
|
||||
case oReceiver of
|
||||
Nothing -> return []
|
||||
Just oR -> liftIO $ getOrchNotes pool oR
|
||||
orchChgNotes <-
|
||||
case coReceiver of
|
||||
Nothing -> return []
|
||||
Just oR -> liftIO $ getOrchFilteredNotes pool foundTxs oR
|
||||
orchChgNotes' <- liftIO $ mapM (traceOrchDag pool) orchChgNotes
|
||||
orchChgSpends <-
|
||||
mapM (getOrchSpends . entityKey) (orchChgNotes <> concat orchChgNotes')
|
||||
mapM_ addTr (trChgNotes <> concat trChgNotes')
|
||||
mapM_ addSap (sapChgNotes <> concat sapChgNotes')
|
||||
mapM_ addOrch (orchChgNotes <> concat orchChgNotes')
|
||||
mapM_ subTSpend trChgSpends
|
||||
mapM_ subSSpend $ catMaybes sapChgSpends
|
||||
mapM_ subOSpend $ catMaybes orchChgSpends
|
||||
Just oR -> liftIO $ getOrchNotes pool oR
|
||||
orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
|
||||
clearUserTx (entityKey w)
|
||||
mapM_ addTr trNotes
|
||||
mapM_ addTr trChgNotes
|
||||
mapM_ addSap sapNotes
|
||||
mapM_ addSap sapChgNotes
|
||||
mapM_ addOrch orchNotes
|
||||
mapM_ addOrch orchChgNotes
|
||||
mapM_ subTSpend trSpends
|
||||
mapM_ subSSpend $ catMaybes sapSpends
|
||||
mapM_ subOSpend $ catMaybes orchSpends
|
||||
where
|
||||
clearUserTx :: WalletAddressId -> NoLoggingT IO ()
|
||||
clearUserTx waId = do
|
||||
|
@ -1481,16 +1298,6 @@ getWalletTransactions pool w = do
|
|||
u <- from $ table @UserTx
|
||||
where_ (u ^. UserTxAddress ==. val waId)
|
||||
return ()
|
||||
getTxs :: WalletAddressId -> NoLoggingT IO [HexStringDB]
|
||||
getTxs waId = do
|
||||
res <-
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
t <- from $ table @UserTx
|
||||
where_ (t ^. UserTxAddress ==. val waId)
|
||||
return (t ^. UserTxHex)
|
||||
return $ map (\(Value x) -> x) res
|
||||
getSapSpends ::
|
||||
WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend))
|
||||
getSapSpends n = do
|
||||
|
@ -2030,51 +1837,6 @@ getUnconfPoolBalance pool za = do
|
|||
let oBal = sum oAmts
|
||||
return $ AccountBalance tBal sBal oBal
|
||||
|
||||
rewindWalletTransactions :: ConnectionPool -> Int -> IO ()
|
||||
rewindWalletTransactions pool b = do
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
delete $ do
|
||||
_ <- from $ table @UserTx
|
||||
return ()
|
||||
oldTxs <-
|
||||
select $ do
|
||||
txs <- from $ table @WalletTransaction
|
||||
where_ $ txs ^. WalletTransactionBlock >. val b
|
||||
pure txs
|
||||
let oldKeys = map entityKey oldTxs
|
||||
delete $ do
|
||||
x <- from $ table @WalletOrchSpend
|
||||
where_ $ x ^. WalletOrchSpendTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletOrchNote
|
||||
where_ $ x ^. WalletOrchNoteTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletSapNote
|
||||
where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletSapSpend
|
||||
where_ $ x ^. WalletSapSpendTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletTrNote
|
||||
where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletTrSpend
|
||||
where_ $ x ^. WalletTrSpendTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
txs <- from $ table @WalletTransaction
|
||||
where_ $ txs ^. WalletTransactionBlock >. val b
|
||||
return ()
|
||||
update $ \w -> do
|
||||
set w [ZcashWalletLastSync =. val b]
|
||||
|
||||
clearWalletTransactions :: ConnectionPool -> IO ()
|
||||
clearWalletTransactions pool = do
|
||||
runNoLoggingT $
|
||||
|
@ -2318,7 +2080,7 @@ selectUnspentNotesV2 ::
|
|||
ConnectionPool
|
||||
-> ZcashAccountId
|
||||
-> Integer
|
||||
-> [Int]
|
||||
-> Int
|
||||
-> PrivacyPolicy
|
||||
-> IO
|
||||
(Either
|
||||
|
@ -2329,40 +2091,27 @@ selectUnspentNotesV2 ::
|
|||
selectUnspentNotesV2 pool za amt recv policy = do
|
||||
case policy of
|
||||
Full ->
|
||||
if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
|
||||
else if elem 4 recv && elem 3 recv
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy"
|
||||
else if 4 `elem` recv
|
||||
then do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) =
|
||||
checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Not enough notes for Full privacy"
|
||||
else return $ Right ([], [], oList)
|
||||
else do
|
||||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a2, sList) =
|
||||
checkSapling (fromIntegral amt) sapNotes
|
||||
if a2 > 0
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Not enough notes for Full privacy"
|
||||
else return $ Right ([], sList, [])
|
||||
case recv of
|
||||
4 -> do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
|
||||
else return $ Right ([], [], oList)
|
||||
3 -> do
|
||||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
|
||||
if a2 > 0
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
|
||||
else return $ Right ([], sList, [])
|
||||
_anyOther ->
|
||||
return $
|
||||
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
|
||||
Medium ->
|
||||
if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
|
||||
else do
|
||||
if recv > 2
|
||||
then do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
|
@ -2375,16 +2124,27 @@ selectUnspentNotesV2 pool za amt recv policy = do
|
|||
PrivacyPolicyError "Not enough notes for Medium privacy"
|
||||
else return $ Right ([], sList, oList)
|
||||
else return $ Right ([], [], oList)
|
||||
else return $
|
||||
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
|
||||
Low ->
|
||||
if 0 `elem` recv
|
||||
if recv == 0
|
||||
then return $ Left ZHError
|
||||
else do
|
||||
if elem 5 recv || elem 6 recv
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Exchange addresses not supported with Low privacy"
|
||||
else do
|
||||
case recv of
|
||||
3 -> do
|
||||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
|
||||
if a1 > 0
|
||||
then do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a2, oList) = checkOrchard a1 orchNotes
|
||||
if a2 > 0
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError "Not enough notes for Low privacy"
|
||||
else return $ Right ([], sList, oList)
|
||||
else return $ Right ([], sList, [])
|
||||
_anyOther -> do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
|
@ -2392,27 +2152,27 @@ selectUnspentNotesV2 pool za amt recv policy = do
|
|||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a2, sList) = checkSapling a1 sapNotes
|
||||
if a2 > 0
|
||||
then do
|
||||
trNotes <- getWalletUnspentTrNotes pool za
|
||||
let (a3, tList) = checkTransparent a2 trNotes
|
||||
if a3 > 0
|
||||
then return $ Left InsufficientFunds
|
||||
else return $ Right (tList, sList, oList)
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError "Not enough notes for Low privacy"
|
||||
else return $ Right ([], sList, oList)
|
||||
else return $ Right ([], [], oList)
|
||||
None -> do
|
||||
if elem 3 recv || elem 4 recv
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy."
|
||||
else do
|
||||
trNotes <- getWalletUnspentTrNotes pool za
|
||||
let (a3, tList) = checkTransparent (fromIntegral amt) trNotes
|
||||
if a3 > 0
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Insufficient transparent funds"
|
||||
else return $ Right (tList, [], [])
|
||||
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 do
|
||||
trNotes <- getWalletUnspentTrNotes pool za
|
||||
let (a3, tList) = checkTransparent a2 trNotes
|
||||
if a3 > 0
|
||||
then return $ Left InsufficientFunds
|
||||
else return $ Right (tList, sList, oList)
|
||||
else return $ Right ([], sList, oList)
|
||||
else return $ Right ([], [], oList)
|
||||
where
|
||||
checkTransparent ::
|
||||
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
|
||||
|
@ -2475,19 +2235,6 @@ saveConfs pool b c = do
|
|||
set bl [ZcashBlockConf =. val c]
|
||||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
||||
|
||||
getReceivers :: ConnectionPool -> [Entity WalletTrNote] -> IO [WalletAddressId]
|
||||
getReceivers pool ns = do
|
||||
r <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $
|
||||
distinct $ do
|
||||
t <- from $ table @WalletTrNote
|
||||
where_ (t ^. WalletTrNoteId `in_` valList (map entityKey ns))
|
||||
return (t ^. WalletTrNoteAddress)
|
||||
return $ map (\(Value x) -> x) r
|
||||
|
||||
-- | Helper function to extract a Unified Address from the database
|
||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||
readUnifiedAddressDB =
|
||||
|
@ -2580,83 +2327,13 @@ finalizeOperation pool op status result = do
|
|||
]
|
||||
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
|
||||
rewindWalletData :: ConnectionPool -> Int -> IO ()
|
||||
rewindWalletData pool b = do
|
||||
rewindWalletTransactions pool b
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
select $ do
|
||||
txs <- from $ table @ZcashTransaction
|
||||
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
|
||||
pure txs
|
||||
let oldTxKeys = map entityKey oldTxs
|
||||
delete $ do
|
||||
x <- from $ table @TransparentNote
|
||||
where_ $ x ^. TransparentNoteTx `in_` valList oldTxKeys
|
||||
delete $ do
|
||||
x <- from $ table @TransparentSpend
|
||||
where_ $ x ^. TransparentSpendTx `in_` valList oldTxKeys
|
||||
delete $ do
|
||||
x <- from $ table @ShieldOutput
|
||||
where_ $ x ^. ShieldOutputTx `in_` valList oldTxKeys
|
||||
delete $ do
|
||||
x <- from $ table @ShieldSpend
|
||||
where_ $ x ^. ShieldSpendTx `in_` valList oldTxKeys
|
||||
delete $ do
|
||||
x <- from $ table @OrchAction
|
||||
where_ $ x ^. OrchActionTx `in_` valList oldTxKeys
|
||||
delete $ do
|
||||
x <- from $ table @ZcashTransaction
|
||||
where_ $ x ^. ZcashTransactionId `in_` valList oldTxKeys
|
||||
delete $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
flip PS.runSqlPool pool $
|
||||
delete $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >=. val b
|
||||
clearWalletTransactions pool
|
||||
|
|
|
@ -1391,7 +1391,8 @@ handleEvent wenv node model evt =
|
|||
case currentWallet of
|
||||
Nothing -> return $ ShowError "No wallet available"
|
||||
Just cW -> do
|
||||
runNoLoggingT $ syncWallet (model ^. configuration) cW
|
||||
runFileLoggingT "zenith.log" $
|
||||
syncWallet (model ^. configuration) cW
|
||||
pool <-
|
||||
runNoLoggingT $
|
||||
initPool $ c_dbPath $ model ^. configuration
|
||||
|
@ -1612,6 +1613,7 @@ handleEvent wenv node model evt =
|
|||
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
||||
return $ ShowMessage "Address Book entry updated!!"
|
||||
|
||||
-- model & recipientValid .~ ((model ^. privacyChoice) == Low) ]
|
||||
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
|
||||
scanZebra dbPath zHost zPort net sendMsg = do
|
||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
|
@ -1619,35 +1621,24 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
b <- liftIO $ getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
if syncChk
|
||||
then sendMsg (ShowError "Sync already in progress")
|
||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then sendMsg (ShowError "Invalid starting block for scan")
|
||||
else do
|
||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then sendMsg (ShowError "Invalid starting block for scan")
|
||||
else do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
then do
|
||||
let step = (1.0 :: Float) / fromIntegral (length bList)
|
||||
_ <- startSync pool
|
||||
mapM_ (processBlock pool step) bList
|
||||
confUp <-
|
||||
try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- completeSync pool Failed
|
||||
sendMsg
|
||||
(ShowError "Failed to update unconfirmed transactions")
|
||||
Right _ -> do
|
||||
_ <- completeSync pool Successful
|
||||
return ()
|
||||
else sendMsg (SyncVal 1.0)
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
then do
|
||||
let step = (1.0 :: Float) / fromIntegral (length bList)
|
||||
mapM_ (processBlock pool step) bList
|
||||
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
|
||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||
processBlock pool step bl = do
|
||||
|
@ -1659,9 +1650,7 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ showt bl, jsonNumber 1]
|
||||
case r of
|
||||
Left e1 -> do
|
||||
_ <- completeSync pool Failed
|
||||
sendMsg (ShowError $ showt e1)
|
||||
Left e1 -> sendMsg (ShowError $ showt e1)
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
@ -1671,9 +1660,7 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ showt bl, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> do
|
||||
_ <- completeSync pool Failed
|
||||
sendMsg (ShowError $ showt e2)
|
||||
Left e2 -> sendMsg (ShowError $ showt e2)
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
|
@ -1708,22 +1695,8 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
|
|||
let zPort = c_zebraPort config
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
res <-
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
accId
|
||||
bl
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI addr)
|
||||
amt
|
||||
(if memo == ""
|
||||
then Nothing
|
||||
else Just memo)
|
||||
]
|
||||
policy
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
|
||||
case res of
|
||||
Left e -> sendMsg $ ShowError $ T.pack $ show e
|
||||
Right rawTx -> do
|
||||
|
|
|
@ -8,28 +8,21 @@
|
|||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
|
||||
module Zenith.RPC where
|
||||
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Exception (try)
|
||||
import Control.Monad (unless, when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
|
||||
import Control.Monad.Logger (runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import qualified Data.HexString as H
|
||||
import Data.Int
|
||||
import Data.Scientific (floatingOrInteger)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import qualified Data.UUID as U
|
||||
import Data.UUID.V4 (nextRandom)
|
||||
import qualified Data.Vector as V
|
||||
import Database.Esqueleto.Experimental
|
||||
( ConnectionPool
|
||||
, entityKey
|
||||
( entityKey
|
||||
, entityVal
|
||||
, fromSqlKey
|
||||
, toSqlKey
|
||||
|
@ -38,72 +31,43 @@ import Servant
|
|||
import Text.Read (readMaybe)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard (parseAddress)
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
, RpcError(..)
|
||||
, Scope(..)
|
||||
, ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||
import Zenith.Core
|
||||
( checkBlockChain
|
||||
, createCustomWalletAddress
|
||||
, createZcashAccount
|
||||
, prepareTxV2
|
||||
, syncWallet
|
||||
)
|
||||
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
|
||||
import Zenith.Core (createCustomWalletAddress, createZcashAccount)
|
||||
import Zenith.DB
|
||||
( Operation(..)
|
||||
, ZcashAccount(..)
|
||||
, ZcashBlock(..)
|
||||
, ZcashWallet(..)
|
||||
, completeSync
|
||||
, finalizeOperation
|
||||
, findNotesByAddress
|
||||
, getAccountById
|
||||
, getAccounts
|
||||
, getAddressById
|
||||
, getAddresses
|
||||
, getExternalAddresses
|
||||
, getLastSyncBlock
|
||||
, getMaxAccount
|
||||
, getMaxAddress
|
||||
, getMaxBlock
|
||||
, getMinBirthdayHeight
|
||||
, getOperation
|
||||
, getPoolBalance
|
||||
, getUnconfPoolBalance
|
||||
, getWalletNotes
|
||||
, getWallets
|
||||
, initPool
|
||||
, isSyncing
|
||||
, rewindWalletData
|
||||
, saveAccount
|
||||
, saveAddress
|
||||
, saveBlock
|
||||
, saveOperation
|
||||
, saveWallet
|
||||
, startSync
|
||||
, toZcashAccountAPI
|
||||
, toZcashAddressAPI
|
||||
, toZcashWalletAPI
|
||||
, walletExists
|
||||
)
|
||||
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
|
||||
import Zenith.Types
|
||||
( AccountBalance(..)
|
||||
, Config(..)
|
||||
, HexStringDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ZcashAccountAPI(..)
|
||||
, ZcashAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZcashNoteAPI(..)
|
||||
, ZcashWalletAPI(..)
|
||||
, ZenithStatus(..)
|
||||
, ZenithUuid(..)
|
||||
)
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
@ -119,7 +83,6 @@ data ZenithMethod
|
|||
| GetNewAccount
|
||||
| GetNewAddress
|
||||
| GetOperationStatus
|
||||
| SendMany
|
||||
| UnknownMethod
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
@ -134,7 +97,6 @@ instance ToJSON ZenithMethod where
|
|||
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
|
||||
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
|
||||
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
|
||||
toJSON SendMany = Data.Aeson.String "sendmany"
|
||||
toJSON UnknownMethod = Data.Aeson.Null
|
||||
|
||||
instance FromJSON ZenithMethod where
|
||||
|
@ -150,7 +112,6 @@ instance FromJSON ZenithMethod where
|
|||
"getnewaccount" -> pure GetNewAccount
|
||||
"getnewaddress" -> pure GetNewAddress
|
||||
"getoperationstatus" -> pure GetOperationStatus
|
||||
"sendmany" -> pure SendMany
|
||||
_ -> pure UnknownMethod
|
||||
|
||||
data ZenithParams
|
||||
|
@ -164,7 +125,6 @@ data ZenithParams
|
|||
| NameIdParams !T.Text !Int
|
||||
| NewAddrParams !Int !T.Text !Bool !Bool
|
||||
| OpParams !ZenithUuid
|
||||
| SendParams !Int ![ProposedNote] !PrivacyPolicy
|
||||
| TestParams !T.Text
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
@ -188,8 +148,6 @@ instance ToJSON ZenithParams where
|
|||
[Data.Aeson.String "ExcludeTransparent" | t]
|
||||
toJSON (OpParams i) =
|
||||
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
|
||||
toJSON (SendParams i ns p) =
|
||||
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
|
||||
|
||||
data ZenithResponse
|
||||
= InfoResponse !T.Text !ZenithInfo
|
||||
|
@ -201,7 +159,6 @@ data ZenithResponse
|
|||
| NewItemResponse !T.Text !Int64
|
||||
| NewAddrResponse !T.Text !ZcashAddressAPI
|
||||
| OpResponse !T.Text !Operation
|
||||
| SendResponse !T.Text !U.UUID
|
||||
| ErrorResponse !T.Text !Double !T.Text
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
@ -222,7 +179,6 @@ instance ToJSON ZenithResponse where
|
|||
toJSON (NewItemResponse i ix) = packRpcResponse i ix
|
||||
toJSON (NewAddrResponse i a) = packRpcResponse i a
|
||||
toJSON (OpResponse i u) = packRpcResponse i u
|
||||
toJSON (SendResponse i o) = packRpcResponse i o
|
||||
|
||||
instance FromJSON ZenithResponse where
|
||||
parseJSON =
|
||||
|
@ -302,10 +258,6 @@ instance FromJSON ZenithResponse where
|
|||
case floatingOrInteger k of
|
||||
Left _e -> fail "Unknown value"
|
||||
Right k' -> pure $ NewItemResponse i k'
|
||||
String s -> do
|
||||
case U.fromText s of
|
||||
Nothing -> fail "Unknown value"
|
||||
Just u -> pure $ SendResponse i u
|
||||
_anyOther -> fail "Malformed JSON"
|
||||
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
|
||||
|
||||
|
@ -464,30 +416,6 @@ instance FromJSON RpcCall where
|
|||
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
|
||||
else pure $ RpcCall v i GetOperationStatus BadParams
|
||||
_anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
|
||||
SendMany -> do
|
||||
p <- obj .: "params"
|
||||
case p of
|
||||
Array a ->
|
||||
if V.length a >= 2
|
||||
then do
|
||||
acc <- parseJSON $ a V.! 0
|
||||
x <- parseJSON $ a V.! 1
|
||||
case x of
|
||||
String _ -> do
|
||||
x' <- parseJSON $ a V.! 1
|
||||
y <- parseJSON $ a V.! 2
|
||||
if not (null y)
|
||||
then pure $ RpcCall v i SendMany (SendParams acc y x')
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
Array _ -> do
|
||||
x' <- parseJSON $ a V.! 1
|
||||
if not (null x')
|
||||
then pure $
|
||||
RpcCall v i SendMany (SendParams acc x' Full)
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
_anyOther -> pure $ RpcCall v i SendMany BadParams
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
_anyOther -> pure $ RpcCall v i SendMany BadParams
|
||||
|
||||
type ZenithRPC
|
||||
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
||||
|
@ -645,35 +573,27 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
case parameters req of
|
||||
NameParams t -> do
|
||||
let dbPath = w_dbPath state
|
||||
sP <- liftIO generateWalletSeedPhrase
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
sP <- liftIO generateWalletSeedPhrase
|
||||
r <-
|
||||
liftIO $
|
||||
saveWallet pool $
|
||||
ZcashWallet
|
||||
t
|
||||
(ZcashNetDB $ w_network state)
|
||||
(PhraseDB sP)
|
||||
(w_startBlock state)
|
||||
0
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just r' ->
|
||||
return $
|
||||
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
|
||||
r <-
|
||||
liftIO $
|
||||
saveWallet pool $
|
||||
ZcashWallet
|
||||
t
|
||||
(ZcashNetDB $ w_network state)
|
||||
(PhraseDB sP)
|
||||
(w_startBlock state)
|
||||
0
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just r' ->
|
||||
return $
|
||||
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetNewAccount ->
|
||||
|
@ -681,45 +601,34 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
NameIdParams t i -> do
|
||||
let dbPath = w_dbPath state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
w <- liftIO $ walletExists pool i
|
||||
case w of
|
||||
Just w' -> do
|
||||
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
|
||||
nAcc <-
|
||||
liftIO
|
||||
(try $ createZcashAccount t (aIdx + 1) w' :: IO
|
||||
(Either IOError ZcashAccount))
|
||||
case nAcc of
|
||||
Left e ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32010) $ T.pack $ show e
|
||||
Right nAcc' -> do
|
||||
r <- liftIO $ saveAccount pool nAcc'
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just x ->
|
||||
return $
|
||||
NewItemResponse (callId req) $
|
||||
fromSqlKey $ entityKey x
|
||||
Nothing ->
|
||||
w <- liftIO $ walletExists pool i
|
||||
case w of
|
||||
Just w' -> do
|
||||
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
|
||||
nAcc <-
|
||||
liftIO
|
||||
(try $ createZcashAccount t (aIdx + 1) w' :: IO
|
||||
(Either IOError ZcashAccount))
|
||||
case nAcc of
|
||||
Left e ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32008)
|
||||
"Wallet does not exist."
|
||||
ErrorResponse (callId req) (-32010) $ T.pack $ show e
|
||||
Right nAcc' -> do
|
||||
r <- liftIO $ saveAccount pool nAcc'
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just x ->
|
||||
return $
|
||||
NewItemResponse (callId req) $
|
||||
fromSqlKey $ entityKey x
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32008) "Wallet does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetNewAddress ->
|
||||
|
@ -728,49 +637,35 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
let dbPath = w_dbPath state
|
||||
let net = 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
|
||||
acc <-
|
||||
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
maxAddr <-
|
||||
liftIO $ getMaxAddress pool (entityKey acc') External
|
||||
newAddr <-
|
||||
liftIO $
|
||||
createCustomWalletAddress
|
||||
n
|
||||
(maxAddr + 1)
|
||||
net
|
||||
External
|
||||
acc'
|
||||
s
|
||||
t
|
||||
dbAddr <- liftIO $ saveAddress pool newAddr
|
||||
case dbAddr of
|
||||
Just nAddr -> do
|
||||
return $
|
||||
NewAddrResponse
|
||||
(callId req)
|
||||
(toZcashAddressAPI nAddr)
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
maxAddr <-
|
||||
liftIO $ getMaxAddress pool (entityKey acc') External
|
||||
newAddr <-
|
||||
liftIO $
|
||||
createCustomWalletAddress
|
||||
n
|
||||
(maxAddr + 1)
|
||||
net
|
||||
External
|
||||
acc'
|
||||
s
|
||||
t
|
||||
dbAddr <- liftIO $ saveAddress pool newAddr
|
||||
case dbAddr of
|
||||
Just nAddr -> do
|
||||
return $
|
||||
NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32006)
|
||||
"Account does not exist."
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32006) "Account does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetOperationStatus ->
|
||||
|
@ -787,89 +682,6 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
ErrorResponse (callId req) (-32009) "Operation ID not found"
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
SendMany ->
|
||||
case parameters req of
|
||||
SendParams a ns p -> do
|
||||
let dbPath = w_dbPath state
|
||||
let zHost = w_host state
|
||||
let zPort = w_port state
|
||||
let znet = w_network state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
opid <- liftIO nextRandom
|
||||
startTime <- liftIO getCurrentTime
|
||||
opkey <-
|
||||
liftIO $
|
||||
saveOperation pool $
|
||||
Operation
|
||||
(ZenithUuid opid)
|
||||
startTime
|
||||
Nothing
|
||||
Processing
|
||||
Nothing
|
||||
case opkey of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32010) "Internal Error"
|
||||
Just opkey' -> do
|
||||
acc <-
|
||||
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
bl <-
|
||||
liftIO $
|
||||
getLastSyncBlock
|
||||
pool
|
||||
(zcashAccountWalletId $ entityVal acc')
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $ do
|
||||
res <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
(entityKey acc')
|
||||
bl
|
||||
ns
|
||||
p
|
||||
case res of
|
||||
Left e ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e
|
||||
Right rawTx -> do
|
||||
zebraRes <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ H.toText rawTx]
|
||||
case zebraRes of
|
||||
Left e1 ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e1
|
||||
Right txId ->
|
||||
finalizeOperation pool opkey' Successful $
|
||||
"Tx ID: " <> H.toText txId
|
||||
return $ SendResponse (callId req) opid
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32006)
|
||||
"Account does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
|
||||
authenticate :: Config -> BasicAuthCheck Bool
|
||||
authenticate config = BasicAuthCheck check
|
||||
|
@ -882,67 +694,3 @@ authenticate config = BasicAuthCheck check
|
|||
packRpcResponse :: ToJSON a => T.Text -> a -> Value
|
||||
packRpcResponse i x =
|
||||
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
|
||||
|
||||
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
|
||||
scanZebra dbPath zHost zPort net = do
|
||||
bStatus <- checkBlockChain zHost zPort
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
unless syncChk $ do
|
||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (sb > zgb_blocks bStatus || sb < 1) $ do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
unless (null bList) $ do
|
||||
_ <- startSync pool
|
||||
mapM_ (processBlock pool) bList
|
||||
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- completeSync pool Failed
|
||||
return ()
|
||||
Right _ -> do
|
||||
wals <- getWallets pool net
|
||||
runNoLoggingT $
|
||||
mapM_
|
||||
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
|
||||
wals
|
||||
_ <- completeSync pool Successful
|
||||
return ()
|
||||
where
|
||||
processBlock :: ConnectionPool -> Int -> IO ()
|
||||
processBlock pool bl = do
|
||||
r <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
|
||||
case r of
|
||||
Left _ -> completeSync pool Failed
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack (show bl), jsonNumber 0]
|
||||
case r2 of
|
||||
Left _ -> completeSync pool Failed
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
saveBlock pool $
|
||||
ZcashBlock
|
||||
(fromIntegral $ bl_height blk)
|
||||
(HexStringDB $ bl_hash blk)
|
||||
(fromIntegral $ bl_confirmations blk)
|
||||
blockTime
|
||||
(ZcashNetDB net)
|
||||
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
||||
|
|
|
@ -37,7 +37,6 @@ import Zenith.DB
|
|||
, ZcashBlockId
|
||||
, clearWalletData
|
||||
, clearWalletTransactions
|
||||
, completeSync
|
||||
, getBlock
|
||||
, getMaxBlock
|
||||
, getMinBirthdayHeight
|
||||
|
@ -48,16 +47,10 @@ import Zenith.DB
|
|||
, saveBlock
|
||||
, saveConfs
|
||||
, saveTransaction
|
||||
, startSync
|
||||
, updateWalletSync
|
||||
, upgradeQrTable
|
||||
)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, HexStringDB(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
)
|
||||
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
||||
-- | 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
|
||||
clearWalletTransactions pool1
|
||||
clearWalletData pool1
|
||||
_ <- startSync pool1
|
||||
dbBlock <- getMaxBlock pool1 znet
|
||||
b <- liftIO $ getMinBirthdayHeight pool1
|
||||
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 pool3 pg3 znet) bl3-}
|
||||
print "Please wait..."
|
||||
_ <- completeSync pool1 Successful
|
||||
print "Rescan complete"
|
||||
|
||||
-- | Function to process a raw block and extract the transaction information
|
||||
|
@ -128,9 +119,7 @@ processBlock host port pool pg net b = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
@ -140,9 +129,7 @@ processBlock host port pool pg net b = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e2
|
||||
Left e2 -> liftIO $ throwIO $ userError e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
|
@ -173,9 +160,7 @@ processTx host port bt pool t = do
|
|||
"getrawtransaction"
|
||||
[Data.Aeson.String $ toText t, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Right rawTx -> do
|
||||
case readZebraTransaction (ztr_hex rawTx) of
|
||||
Nothing -> return ()
|
||||
|
@ -238,7 +223,7 @@ clearSync config = do
|
|||
w <- getWallets pool $ zgb_net chainInfo
|
||||
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
|
||||
r <- runNoLoggingT $ mapM (syncWallet config) w'
|
||||
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
|
||||
liftIO $ print r
|
||||
|
||||
-- | Detect chain re-orgs
|
||||
|
|
|
@ -23,23 +23,13 @@ import Data.Text.Encoding.Error (lenientDecode)
|
|||
import qualified Data.UUID as U
|
||||
import Database.Persist.TH
|
||||
import GHC.Generics
|
||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Sapling (encodeSaplingAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( encodeExchangeAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( ExchangeAddress(..)
|
||||
, OrchardSpendingKey(..)
|
||||
( OrchardSpendingKey(..)
|
||||
, Phrase(..)
|
||||
, Rseed(..)
|
||||
, SaplingAddress(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, Scope(..)
|
||||
, TransparentAddress(..)
|
||||
, TransparentSpendingKey
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
|
||||
|
@ -217,51 +207,6 @@ data PrivacyPolicy
|
|||
|
||||
$(deriveJSON defaultOptions ''PrivacyPolicy)
|
||||
|
||||
newtype ValidAddressAPI = ValidAddressAPI
|
||||
{ getVA :: ValidAddress
|
||||
} deriving newtype (Eq, Show)
|
||||
|
||||
instance ToJSON ValidAddressAPI where
|
||||
toJSON (ValidAddressAPI va) =
|
||||
case va of
|
||||
Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
|
||||
Sapling sa ->
|
||||
maybe
|
||||
Data.Aeson.Null
|
||||
Data.Aeson.String
|
||||
(encodeSaplingAddress (net_type sa) (sa_receiver sa))
|
||||
Transparent ta ->
|
||||
Data.Aeson.String $
|
||||
encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
|
||||
Exchange ea ->
|
||||
maybe
|
||||
Data.Aeson.Null
|
||||
Data.Aeson.String
|
||||
(encodeExchangeAddress (ex_network ea) (ex_address ea))
|
||||
|
||||
data ProposedNote = ProposedNote
|
||||
{ pn_addr :: !ValidAddressAPI
|
||||
, pn_amt :: !Float
|
||||
, pn_memo :: !(Maybe T.Text)
|
||||
} deriving (Eq, Prelude.Show)
|
||||
|
||||
instance FromJSON ProposedNote where
|
||||
parseJSON =
|
||||
withObject "ProposedNote" $ \obj -> do
|
||||
a <- obj .: "address"
|
||||
n <- obj .: "amount"
|
||||
m <- obj .:? "memo"
|
||||
case parseAddress (E.encodeUtf8 a) of
|
||||
Nothing -> fail "Invalid address"
|
||||
Just a' ->
|
||||
if n > 0 && n < 21000000
|
||||
then pure $ ProposedNote (ValidAddressAPI a') n m
|
||||
else fail "Invalid amount"
|
||||
|
||||
instance ToJSON ProposedNote where
|
||||
toJSON (ProposedNote a n m) =
|
||||
object ["address" .= a, "amount" .= n, "memo" .= m]
|
||||
|
||||
data ShieldDeshieldOp
|
||||
= Shield
|
||||
| Deshield
|
||||
|
|
|
@ -7,7 +7,7 @@ import Control.Monad.Logger (runNoLoggingT)
|
|||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Configurator
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
|
@ -18,7 +18,7 @@ import Servant
|
|||
import System.Directory
|
||||
import Test.HUnit hiding (State)
|
||||
import Test.Hspec
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||
import ZcashHaskell.Types
|
||||
( ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
|
@ -39,9 +39,6 @@ import Zenith.RPC
|
|||
)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashAccountAPI(..)
|
||||
, ZcashAddressAPI(..)
|
||||
, ZcashWalletAPI(..)
|
||||
|
@ -575,107 +572,6 @@ main = do
|
|||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
|
||||
Right _ -> assertFailure "unexpected response"
|
||||
describe "Send tx" $ do
|
||||
describe "sendmany" $ do
|
||||
it "bad credentials" $ do
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
"baduser"
|
||||
"idontknow"
|
||||
SendMany
|
||||
BlankParams
|
||||
res `shouldBe` Left "Invalid credentials"
|
||||
describe "correct credentials" $ do
|
||||
it "invalid account" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
17
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "A cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
|
||||
it "valid account, empty notes" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams 1 [] Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||
it "valid account, single output" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
1
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
5.0
|
||||
(Just "A cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (SendResponse i o) -> o `shouldNotBe` U.nil
|
||||
it "valid account, multiple outputs" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
1
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
5.0
|
||||
(Just "A cool memo")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
1.0
|
||||
(Just "Not so cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (SendResponse i o) -> o `shouldNotBe` U.nil
|
||||
|
||||
startAPI :: Config -> IO ()
|
||||
startAPI config = do
|
||||
|
|
220
test/Spec.hs
220
test/Spec.hs
|
@ -123,6 +123,55 @@ main = do
|
|||
let ua =
|
||||
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
|
||||
isValidUnifiedAddress ua `shouldNotBe` Nothing
|
||||
describe "Function tests" $ do
|
||||
describe "Sapling Decoding" $ do
|
||||
let sk =
|
||||
SaplingSpendingKey
|
||||
"\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB"
|
||||
let tree =
|
||||
SaplingCommitmentTree $
|
||||
hexString
|
||||
"01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
||||
let nextTree =
|
||||
SaplingCommitmentTree $
|
||||
hexString
|
||||
"01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
||||
it "Sapling is decoded correctly" $ do
|
||||
so <-
|
||||
runSqlite "zenith.db" $
|
||||
selectList [ShieldOutputTx ==. toSqlKey 38318] []
|
||||
let cmus = map (getHex . shieldOutputCmu . entityVal) so
|
||||
let pos =
|
||||
getSaplingNotePosition <$>
|
||||
(getSaplingWitness =<<
|
||||
updateSaplingCommitmentTree tree (head cmus))
|
||||
let pos1 = getSaplingNotePosition <$> getSaplingWitness tree
|
||||
let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree
|
||||
case pos of
|
||||
Nothing -> assertFailure "couldn't get note position"
|
||||
Just p -> do
|
||||
print p
|
||||
print pos1
|
||||
print pos2
|
||||
let dn =
|
||||
decodeSaplingOutputEsk
|
||||
sk
|
||||
(ShieldedOutput
|
||||
(getHex $ shieldOutputCv $ entityVal $ head so)
|
||||
(getHex $ shieldOutputCmu $ entityVal $ head so)
|
||||
(getHex $ shieldOutputEphKey $ entityVal $ head so)
|
||||
(getHex $ shieldOutputEncCipher $ entityVal $ head so)
|
||||
(getHex $ shieldOutputOutCipher $ entityVal $ head so)
|
||||
(getHex $ shieldOutputProof $ entityVal $ head so))
|
||||
TestNet
|
||||
External
|
||||
p
|
||||
case dn of
|
||||
Nothing -> assertFailure "couldn't decode Sap output"
|
||||
Just d ->
|
||||
a_nullifier d `shouldBe`
|
||||
hexString
|
||||
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
|
||||
describe "Note selection for Tx" $ do
|
||||
it "Value less than balance" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
|
@ -132,6 +181,10 @@ main = do
|
|||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
|
||||
res `shouldThrow` anyIOException
|
||||
it "Fee calculation" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
||||
calculateTxFee res 3 `shouldBe` 20000
|
||||
describe "Testing validation" $ do
|
||||
it "Unified" $ do
|
||||
let a =
|
||||
|
@ -214,11 +267,9 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
@ -240,11 +291,9 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to sapling"
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
@ -264,49 +313,13 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
""
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy")
|
||||
describe "Medium" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
|
@ -325,11 +338,9 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
@ -351,11 +362,9 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
@ -375,48 +384,13 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
""
|
||||
Medium
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Low" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
|
@ -435,11 +409,9 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
@ -461,11 +433,9 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
@ -485,11 +455,9 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
""
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
@ -512,16 +480,14 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
"Receiver not compatible with privacy policy")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
|
@ -539,16 +505,14 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
"Receiver not compatible with privacy policy")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
|
@ -564,11 +528,9 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
""
|
||||
None
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
|
@ -132,7 +132,6 @@
|
|||
],
|
||||
"errors": [
|
||||
{ "$ref": "#/components/errors/ZebraNotAvailable" },
|
||||
{ "$ref": "#/components/errors/ZenithBusy" },
|
||||
{ "$ref": "#/components/errors/DuplicateName" }
|
||||
]
|
||||
},
|
||||
|
@ -229,7 +228,6 @@
|
|||
"errors": [
|
||||
{ "$ref": "#/components/errors/ZebraNotAvailable" },
|
||||
{ "$ref": "#/components/errors/DuplicateName" },
|
||||
{ "$ref": "#/components/errors/ZenithBusy" },
|
||||
{ "$ref": "#/components/errors/InvalidWallet" }
|
||||
]
|
||||
},
|
||||
|
@ -446,7 +444,6 @@
|
|||
],
|
||||
"errors": [
|
||||
{ "$ref": "#/components/errors/InvalidAccount" },
|
||||
{ "$ref": "#/components/errors/ZenithBusy" },
|
||||
{ "$ref": "#/components/errors/DuplicateName" }
|
||||
]
|
||||
},
|
||||
|
@ -596,11 +593,10 @@
|
|||
{
|
||||
"name": "sendmany",
|
||||
"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.",
|
||||
"tags": [],
|
||||
"description": "Send one or more transactions by specifying the source account, the recipient address, the amount, the shielded memo (optional) and the privacy policy (optional).",
|
||||
"tags": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}],
|
||||
"params": [
|
||||
{ "$ref": "#/components/contentDescriptors/AccountId"},
|
||||
{ "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
|
||||
{ "$ref": "#/components/contentDescriptors/TxRequestArray"}
|
||||
],
|
||||
"paramStructure": "by-position",
|
||||
|
@ -614,19 +610,14 @@
|
|||
"examples": [
|
||||
{
|
||||
"name": "Send a transaction",
|
||||
"summary": "Send a transaction",
|
||||
"description": "Send a transaction with one output",
|
||||
"summary": "Send one transaction",
|
||||
"description": "Send a single transaction",
|
||||
"params": [
|
||||
{
|
||||
"name": "Account index",
|
||||
"summary": "The index for the account to use",
|
||||
"value": "1"
|
||||
},
|
||||
{
|
||||
"name": "Privacy Policy",
|
||||
"summary": "The selected privacy policy",
|
||||
"value": "Full"
|
||||
},
|
||||
{
|
||||
"name": "Transaction request",
|
||||
"summary": "The transaction to attempt",
|
||||
|
@ -649,7 +640,7 @@
|
|||
],
|
||||
"errors": [
|
||||
{ "$ref": "#/components/errors/ZebraNotAvailable" },
|
||||
{ "$ref": "#/components/errors/ZenithBusy" },
|
||||
{ "$ref": "#/components/errors/InvalidRecipient" },
|
||||
{ "$ref": "#/components/errors/InvalidAccount" }
|
||||
]
|
||||
},
|
||||
|
@ -745,16 +736,6 @@
|
|||
"type": "array",
|
||||
"items": { "$ref": "#/components/schemas/TxRequest"}
|
||||
}
|
||||
},
|
||||
"PrivacyPolicy": {
|
||||
"name": "Privacy Policy",
|
||||
"summary": "The chosen privacy policy to use for the transaction",
|
||||
"description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.",
|
||||
"required": false,
|
||||
"schema": {
|
||||
"type": "string",
|
||||
"enum": ["None", "Low", "Medium", "Full"]
|
||||
}
|
||||
}
|
||||
},
|
||||
"schemas": {
|
||||
|
@ -833,7 +814,8 @@
|
|||
"properties": {
|
||||
"address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
|
||||
"amount": { "type": "number", "description": "The amount to send in ZEC"},
|
||||
"memo": { "type": "string", "description": "The shielded memo to include, if applicable"}
|
||||
"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": {
|
||||
"code": -32011,
|
||||
"message": "The provided recipient address is not valid."
|
||||
},
|
||||
"ZenithBusy": {
|
||||
"code": -32012,
|
||||
"message": "The Zenith server is syncing, please try again later."
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue