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