Implement getnewaddress
RPC method
This commit is contained in:
parent
6503af6a98
commit
1caa4efdb4
7 changed files with 399 additions and 20 deletions
|
@ -18,6 +18,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
||||||
- `getbalance` RPC method
|
- `getbalance` RPC method
|
||||||
- `getnewwallet` RPC method
|
- `getnewwallet` RPC method
|
||||||
- `getnewaccount` RPC method
|
- `getnewaccount` RPC method
|
||||||
|
- `getnewaddress` RPC method
|
||||||
|
|
||||||
### Changed
|
### Changed
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
module Zenith.Core where
|
module Zenith.Core where
|
||||||
|
|
||||||
import Control.Exception (throwIO, try)
|
import Control.Exception (throwIO, try)
|
||||||
import Control.Monad (forM, when)
|
import Control.Monad (forM, unless, when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
( LoggingT
|
( LoggingT
|
||||||
|
@ -223,6 +223,47 @@ createWalletAddress n i zNet scope za = do
|
||||||
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
|
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
|
||||||
(ScopeDB scope)
|
(ScopeDB scope)
|
||||||
|
|
||||||
|
-- | Create an external unified address for the given account and index with custom receivers
|
||||||
|
createCustomWalletAddress ::
|
||||||
|
T.Text -- ^ The address nickname
|
||||||
|
-> Int -- ^ The address' index
|
||||||
|
-> ZcashNet -- ^ The network for this address
|
||||||
|
-> Scope -- ^ External or Internal
|
||||||
|
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
|
||||||
|
-> Bool -- ^ Exclude Sapling
|
||||||
|
-> Bool -- ^ Exclude Transparent
|
||||||
|
-> IO WalletAddress
|
||||||
|
createCustomWalletAddress n i zNet scope za exSap exTr = do
|
||||||
|
let oRec =
|
||||||
|
genOrchardReceiver i scope $
|
||||||
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
|
||||||
|
let sRec =
|
||||||
|
if exSap
|
||||||
|
then Nothing
|
||||||
|
else case scope of
|
||||||
|
External ->
|
||||||
|
genSaplingPaymentAddress i $
|
||||||
|
getSapSK $ zcashAccountSapSpendKey $ entityVal za
|
||||||
|
Internal ->
|
||||||
|
genSaplingInternalAddress $
|
||||||
|
getSapSK $ zcashAccountSapSpendKey $ entityVal za
|
||||||
|
tRec <-
|
||||||
|
if exTr
|
||||||
|
then return Nothing
|
||||||
|
else Just <$>
|
||||||
|
genTransparentReceiver
|
||||||
|
i
|
||||||
|
scope
|
||||||
|
(getTranSK $ zcashAccountTPrivateKey $ entityVal za)
|
||||||
|
return $
|
||||||
|
WalletAddress
|
||||||
|
i
|
||||||
|
(entityKey za)
|
||||||
|
n
|
||||||
|
(UnifiedAddressDB $
|
||||||
|
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec tRec)
|
||||||
|
(ScopeDB scope)
|
||||||
|
|
||||||
-- * Wallet
|
-- * Wallet
|
||||||
-- | Find the Sapling notes that match the given spending key
|
-- | Find the Sapling notes that match the given spending key
|
||||||
findSaplingOutputs ::
|
findSaplingOutputs ::
|
||||||
|
|
|
@ -303,16 +303,20 @@ toZcashAddressAPI a =
|
||||||
(getUA $ walletAddressUAddress $ entityVal a)
|
(getUA $ walletAddressUAddress $ entityVal a)
|
||||||
(getSaplingFromUA $
|
(getSaplingFromUA $
|
||||||
TE.encodeUtf8 $ getUA $ walletAddressUAddress $ entityVal a)
|
TE.encodeUtf8 $ getUA $ walletAddressUAddress $ entityVal a)
|
||||||
(encodeTransparentReceiver
|
(case t_rec =<<
|
||||||
(maybe
|
(isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress)
|
||||||
TestNet
|
(entityVal a) of
|
||||||
ua_net
|
Nothing -> Nothing
|
||||||
((isValidUnifiedAddress .
|
Just tRec ->
|
||||||
TE.encodeUtf8 . getUA . walletAddressUAddress) $
|
Just $
|
||||||
entityVal a)) <$>
|
encodeTransparentReceiver
|
||||||
(t_rec =<<
|
(maybe
|
||||||
(isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress)
|
TestNet
|
||||||
(entityVal a)))
|
ua_net
|
||||||
|
((isValidUnifiedAddress .
|
||||||
|
TE.encodeUtf8 . getUA . walletAddressUAddress) $
|
||||||
|
entityVal a))
|
||||||
|
tRec)
|
||||||
|
|
||||||
-- | @WalletTrNote@
|
-- | @WalletTrNote@
|
||||||
trToZcashNoteAPI :: ConnectionPool -> Entity WalletTrNote -> IO ZcashNoteAPI
|
trToZcashNoteAPI :: ConnectionPool -> Entity WalletTrNote -> IO ZcashNoteAPI
|
||||||
|
|
|
@ -25,8 +25,8 @@ 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(..), ZcashNet(..))
|
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
|
||||||
import Zenith.Core (createZcashAccount)
|
import Zenith.Core (createCustomWalletAddress, createZcashAccount)
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
( ZcashAccount(..)
|
( ZcashAccount(..)
|
||||||
, ZcashWallet(..)
|
, ZcashWallet(..)
|
||||||
|
@ -37,12 +37,14 @@ import Zenith.DB
|
||||||
, getAddresses
|
, getAddresses
|
||||||
, getExternalAddresses
|
, getExternalAddresses
|
||||||
, getMaxAccount
|
, getMaxAccount
|
||||||
|
, getMaxAddress
|
||||||
, getPoolBalance
|
, getPoolBalance
|
||||||
, getUnconfPoolBalance
|
, getUnconfPoolBalance
|
||||||
, getWalletNotes
|
, getWalletNotes
|
||||||
, getWallets
|
, getWallets
|
||||||
, initPool
|
, initPool
|
||||||
, saveAccount
|
, saveAccount
|
||||||
|
, saveAddress
|
||||||
, saveWallet
|
, saveWallet
|
||||||
, toZcashAccountAPI
|
, toZcashAccountAPI
|
||||||
, toZcashAddressAPI
|
, toZcashAddressAPI
|
||||||
|
@ -70,6 +72,7 @@ data ZenithMethod
|
||||||
| GetBalance
|
| GetBalance
|
||||||
| GetNewWallet
|
| GetNewWallet
|
||||||
| GetNewAccount
|
| GetNewAccount
|
||||||
|
| GetNewAddress
|
||||||
| UnknownMethod
|
| UnknownMethod
|
||||||
deriving (Eq, Prelude.Show)
|
deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
|
@ -82,6 +85,7 @@ instance ToJSON ZenithMethod where
|
||||||
toJSON GetBalance = Data.Aeson.String "getbalance"
|
toJSON GetBalance = Data.Aeson.String "getbalance"
|
||||||
toJSON GetNewWallet = Data.Aeson.String "getnewwallet"
|
toJSON GetNewWallet = Data.Aeson.String "getnewwallet"
|
||||||
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
|
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
|
||||||
|
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
|
||||||
toJSON UnknownMethod = Data.Aeson.Null
|
toJSON UnknownMethod = Data.Aeson.Null
|
||||||
|
|
||||||
instance FromJSON ZenithMethod where
|
instance FromJSON ZenithMethod where
|
||||||
|
@ -95,6 +99,7 @@ instance FromJSON ZenithMethod where
|
||||||
"getbalance" -> pure GetBalance
|
"getbalance" -> pure GetBalance
|
||||||
"getnewwallet" -> pure GetNewWallet
|
"getnewwallet" -> pure GetNewWallet
|
||||||
"getnewaccount" -> pure GetNewAccount
|
"getnewaccount" -> pure GetNewAccount
|
||||||
|
"getnewaddress" -> pure GetNewAddress
|
||||||
_ -> pure UnknownMethod
|
_ -> pure UnknownMethod
|
||||||
|
|
||||||
data ZenithParams
|
data ZenithParams
|
||||||
|
@ -106,6 +111,7 @@ data ZenithParams
|
||||||
| BalanceParams !Int64
|
| BalanceParams !Int64
|
||||||
| NameParams !T.Text
|
| NameParams !T.Text
|
||||||
| NameIdParams !T.Text !Int
|
| NameIdParams !T.Text !Int
|
||||||
|
| NewAddrParams !Int !T.Text !Bool !Bool
|
||||||
| TestParams !T.Text
|
| TestParams !T.Text
|
||||||
deriving (Eq, Prelude.Show)
|
deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
|
@ -121,6 +127,12 @@ instance ToJSON ZenithParams where
|
||||||
Data.Aeson.Array $ V.fromList [Data.Aeson.String t, jsonNumber i]
|
Data.Aeson.Array $ V.fromList [Data.Aeson.String t, jsonNumber i]
|
||||||
toJSON (BalanceParams n) =
|
toJSON (BalanceParams n) =
|
||||||
Data.Aeson.Array $ V.fromList [jsonNumber $ fromIntegral n]
|
Data.Aeson.Array $ V.fromList [jsonNumber $ fromIntegral n]
|
||||||
|
toJSON (NewAddrParams a n s t) =
|
||||||
|
Data.Aeson.Array $
|
||||||
|
V.fromList $
|
||||||
|
[jsonNumber a, Data.Aeson.String n] <>
|
||||||
|
[Data.Aeson.String "ExcludeSapling" | s] <>
|
||||||
|
[Data.Aeson.String "ExcludeTransparent" | t]
|
||||||
|
|
||||||
data ZenithResponse
|
data ZenithResponse
|
||||||
= InfoResponse !T.Text !ZenithInfo
|
= InfoResponse !T.Text !ZenithInfo
|
||||||
|
@ -130,6 +142,7 @@ data ZenithResponse
|
||||||
| NoteListResponse !T.Text ![ZcashNoteAPI]
|
| NoteListResponse !T.Text ![ZcashNoteAPI]
|
||||||
| BalanceResponse !T.Text !AccountBalance !AccountBalance
|
| BalanceResponse !T.Text !AccountBalance !AccountBalance
|
||||||
| NewItemResponse !T.Text !Int64
|
| NewItemResponse !T.Text !Int64
|
||||||
|
| NewAddrResponse !T.Text !ZcashAddressAPI
|
||||||
| ErrorResponse !T.Text !Double !T.Text
|
| ErrorResponse !T.Text !Double !T.Text
|
||||||
deriving (Eq, Prelude.Show)
|
deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
|
@ -148,6 +161,7 @@ instance ToJSON ZenithResponse where
|
||||||
toJSON (BalanceResponse i c u) =
|
toJSON (BalanceResponse i c u) =
|
||||||
packRpcResponse i $ object ["confirmed" .= c, "unconfirmed" .= u]
|
packRpcResponse i $ object ["confirmed" .= c, "unconfirmed" .= u]
|
||||||
toJSON (NewItemResponse i ix) = packRpcResponse i ix
|
toJSON (NewItemResponse i ix) = packRpcResponse i ix
|
||||||
|
toJSON (NewAddrResponse i a) = packRpcResponse i a
|
||||||
|
|
||||||
instance FromJSON ZenithResponse where
|
instance FromJSON ZenithResponse where
|
||||||
parseJSON =
|
parseJSON =
|
||||||
|
@ -168,6 +182,7 @@ instance FromJSON ZenithResponse where
|
||||||
Object k -> do
|
Object k -> do
|
||||||
v <- k .:? "version"
|
v <- k .:? "version"
|
||||||
v5 <- k .:? "unconfirmed"
|
v5 <- k .:? "unconfirmed"
|
||||||
|
v6 <- k .:? "ua"
|
||||||
case (v :: Maybe String) of
|
case (v :: Maybe String) of
|
||||||
Just _v' -> do
|
Just _v' -> do
|
||||||
k1 <- parseJSON r1
|
k1 <- parseJSON r1
|
||||||
|
@ -179,7 +194,12 @@ instance FromJSON ZenithResponse where
|
||||||
j1 <- k6 .: "confirmed"
|
j1 <- k6 .: "confirmed"
|
||||||
j2 <- k6 .: "unconfirmed"
|
j2 <- k6 .: "unconfirmed"
|
||||||
pure $ BalanceResponse i j1 j2
|
pure $ BalanceResponse i j1 j2
|
||||||
Nothing -> fail "Unknown object"
|
Nothing ->
|
||||||
|
case (v6 :: Maybe String) of
|
||||||
|
Just _v6' -> do
|
||||||
|
k7 <- parseJSON r1
|
||||||
|
pure $ NewAddrResponse i k7
|
||||||
|
Nothing -> fail "Unknown object"
|
||||||
Array n -> do
|
Array n -> do
|
||||||
if V.null n
|
if V.null n
|
||||||
then fail "Malformed JSON"
|
then fail "Malformed JSON"
|
||||||
|
@ -327,6 +347,38 @@ instance FromJSON RpcCall where
|
||||||
pure $ RpcCall v i GetNewAccount (NameIdParams x y)
|
pure $ RpcCall v i GetNewAccount (NameIdParams x y)
|
||||||
else pure $ RpcCall v i GetNewAccount BadParams
|
else pure $ RpcCall v i GetNewAccount BadParams
|
||||||
_anyOther -> pure $ RpcCall v i GetNewAccount BadParams
|
_anyOther -> pure $ RpcCall v i GetNewAccount BadParams
|
||||||
|
GetNewAddress -> do
|
||||||
|
p <- obj .: "params"
|
||||||
|
case p of
|
||||||
|
Array a ->
|
||||||
|
if V.length a >= 2
|
||||||
|
then do
|
||||||
|
x <- parseJSON $ a V.! 0
|
||||||
|
y <- parseJSON $ a V.! 1
|
||||||
|
(sap, tr) <-
|
||||||
|
case a V.!? 2 of
|
||||||
|
Nothing -> return (False, False)
|
||||||
|
Just s -> do
|
||||||
|
s' <- parseJSON s
|
||||||
|
case s' of
|
||||||
|
("ExcludeSapling" :: String) -> do
|
||||||
|
case a V.!? 3 of
|
||||||
|
Nothing -> return (True, False)
|
||||||
|
Just t -> do
|
||||||
|
t' <- parseJSON t
|
||||||
|
return
|
||||||
|
(True, t' == ("ExcludeTransparent" :: String))
|
||||||
|
("ExcludeTransparent" :: String) -> do
|
||||||
|
case a V.!? 3 of
|
||||||
|
Nothing -> return (False, True)
|
||||||
|
Just t -> do
|
||||||
|
t' <- parseJSON t
|
||||||
|
return
|
||||||
|
(t' == ("ExcludeSapling" :: String), True)
|
||||||
|
_anyOther -> return (False, False)
|
||||||
|
pure $ RpcCall v i GetNewAddress (NewAddrParams x y sap tr)
|
||||||
|
else pure $ RpcCall v i GetNewAddress BadParams
|
||||||
|
_anyOther -> pure $ RpcCall v i GetNewAddress BadParams
|
||||||
|
|
||||||
type ZenithRPC
|
type ZenithRPC
|
||||||
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
||||||
|
@ -523,7 +575,7 @@ zenithServer state = getinfo :<|> handleRPC
|
||||||
case nAcc of
|
case nAcc of
|
||||||
Left e ->
|
Left e ->
|
||||||
return $
|
return $
|
||||||
ErrorResponse (callId req) (-32610) $ T.pack $ show e
|
ErrorResponse (callId req) (-32010) $ T.pack $ show e
|
||||||
Right nAcc' -> do
|
Right nAcc' -> do
|
||||||
r <- liftIO $ saveAccount pool nAcc'
|
r <- liftIO $ saveAccount pool nAcc'
|
||||||
case r of
|
case r of
|
||||||
|
@ -539,7 +591,44 @@ zenithServer state = getinfo :<|> handleRPC
|
||||||
fromSqlKey $ entityKey x
|
fromSqlKey $ entityKey x
|
||||||
Nothing ->
|
Nothing ->
|
||||||
return $
|
return $
|
||||||
ErrorResponse (callId req) (-32608) "Wallet does not exist."
|
ErrorResponse (callId req) (-32008) "Wallet does not exist."
|
||||||
|
_anyOtherParams ->
|
||||||
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||||
|
GetNewAddress ->
|
||||||
|
case parameters req of
|
||||||
|
NewAddrParams i n s t -> do
|
||||||
|
let dbPath = w_dbPath state
|
||||||
|
let net = w_network state
|
||||||
|
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||||
|
acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
|
||||||
|
case acc of
|
||||||
|
Just acc' -> do
|
||||||
|
maxAddr <-
|
||||||
|
liftIO $ getMaxAddress pool (entityKey acc') External
|
||||||
|
newAddr <-
|
||||||
|
liftIO $
|
||||||
|
createCustomWalletAddress
|
||||||
|
n
|
||||||
|
(maxAddr + 1)
|
||||||
|
net
|
||||||
|
External
|
||||||
|
acc'
|
||||||
|
s
|
||||||
|
t
|
||||||
|
dbAddr <- liftIO $ saveAddress pool newAddr
|
||||||
|
case dbAddr of
|
||||||
|
Just nAddr -> do
|
||||||
|
return $
|
||||||
|
NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
|
||||||
|
Nothing ->
|
||||||
|
return $
|
||||||
|
ErrorResponse
|
||||||
|
(callId req)
|
||||||
|
(-32007)
|
||||||
|
"Entity with that name already exists."
|
||||||
|
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"
|
||||||
|
|
||||||
|
|
|
@ -14,6 +14,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.Types
|
import ZcashHaskell.Types
|
||||||
( ZcashNet(..)
|
( ZcashNet(..)
|
||||||
, ZebraGetBlockChainInfo(..)
|
, ZebraGetBlockChainInfo(..)
|
||||||
|
@ -32,7 +33,12 @@ import Zenith.RPC
|
||||||
, authenticate
|
, authenticate
|
||||||
, zenithServer
|
, zenithServer
|
||||||
)
|
)
|
||||||
import Zenith.Types (Config(..), ZcashAccountAPI(..), ZcashWalletAPI(..))
|
import Zenith.Types
|
||||||
|
( Config(..)
|
||||||
|
, ZcashAccountAPI(..)
|
||||||
|
, ZcashAddressAPI(..)
|
||||||
|
, ZcashWalletAPI(..)
|
||||||
|
)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
@ -71,7 +77,7 @@ main = do
|
||||||
Left e -> assertFailure e
|
Left e -> assertFailure e
|
||||||
Right r ->
|
Right r ->
|
||||||
r `shouldBe`
|
r `shouldBe`
|
||||||
InfoResponse "zh" (ZenithInfo "0.7.0.0-beta" TestNet "v1.8.0")
|
InfoResponse "zh" (ZenithInfo "0.7.0.0-beta" TestNet "v1.9.0")
|
||||||
describe "Wallets" $ do
|
describe "Wallets" $ do
|
||||||
describe "listwallet" $ do
|
describe "listwallet" $ do
|
||||||
it "bad credentials" $ do
|
it "bad credentials" $ do
|
||||||
|
@ -239,7 +245,7 @@ main = do
|
||||||
Left e -> assertFailure e
|
Left e -> assertFailure e
|
||||||
Right r ->
|
Right r ->
|
||||||
r `shouldBe`
|
r `shouldBe`
|
||||||
ErrorResponse "zh" (-32608) "Wallet does not exist."
|
ErrorResponse "zh" (-32008) "Wallet does not exist."
|
||||||
it "valid wallet" $ do
|
it "valid wallet" $ do
|
||||||
res <-
|
res <-
|
||||||
makeZenithCall
|
makeZenithCall
|
||||||
|
@ -313,6 +319,118 @@ main = do
|
||||||
"zh"
|
"zh"
|
||||||
(-32003)
|
(-32003)
|
||||||
"No addresses available for this account. Please create one first"
|
"No addresses available for this account. Please create one first"
|
||||||
|
describe "getnewaddress" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
GetNewAddress
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "invalid account" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 17 "Business" False False)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse "zh" (-32006) "Account does not exist."
|
||||||
|
it "valid account" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "Business" False False)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (NewAddrResponse i a) -> zd_name a `shouldBe` "Business"
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
it "valid account, duplicate name" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "Business" False False)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse
|
||||||
|
"zh"
|
||||||
|
(-32007)
|
||||||
|
"Entity with that name already exists."
|
||||||
|
it "valid account, no sapling" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "NoSapling" True False)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (NewAddrResponse i a) -> zd_legacy a `shouldBe` Nothing
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
it "valid account, no transparent" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "NoTransparent" False True)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (NewAddrResponse i a) ->
|
||||||
|
zd_transparent a `shouldBe` Nothing
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
it "valid account, orchard only" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "OrchOnly" True True)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (NewAddrResponse i a) ->
|
||||||
|
a `shouldSatisfy`
|
||||||
|
(\b ->
|
||||||
|
(zd_transparent b == Nothing) && (zd_legacy b == Nothing))
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
describe "listaddresses" $ do
|
||||||
|
it "correct credentials, addresses exist" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListAddresses
|
||||||
|
(AddressesParams 1)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (AddressListResponse i a) -> length a `shouldBe` 4
|
||||||
describe "Notes" $ do
|
describe "Notes" $ do
|
||||||
describe "listreceived" $ do
|
describe "listreceived" $ do
|
||||||
it "bad credentials" $ do
|
it "bad credentials" $ do
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
Subproject commit 0b2fae2b5db6878b7669d639a5cb8c73b986906e
|
Subproject commit ce19e174cc636f1e9fce9114875ab0cb1df10213
|
|
@ -304,6 +304,132 @@
|
||||||
"$ref": "#/components/schemas/ZcashAddress"
|
"$ref": "#/components/schemas/ZcashAddress"
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
"examples": [
|
||||||
|
{
|
||||||
|
"name": "GetNewAddress example",
|
||||||
|
"summary": "Get a new address for the given account",
|
||||||
|
"description": "Get a new address for the given account with an Orchard receiver, a Sapling receiver and a transparent receiver (default)",
|
||||||
|
"params": [
|
||||||
|
{
|
||||||
|
"name": "Account Id",
|
||||||
|
"summary": "The account index",
|
||||||
|
"value": 1
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "Name",
|
||||||
|
"summary": "User-friendly name for the address",
|
||||||
|
"value": "AllRecvs"
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"result":
|
||||||
|
{
|
||||||
|
"index": 14,
|
||||||
|
"account": 1,
|
||||||
|
"name": "AllRecvs",
|
||||||
|
"ua": "utest1as2fhusjt5r7xl8963jnkkums6gue6qvu7fpw2cvrctwnwrku9r4av9zmmjt7mmet927cq9z4z0hq2w7tpm7qa8lzl5fyj6d83un6v3q78c76j7thpuzyzr260apm8xvjua5fvmrfzy59mpurec7tfamp6nd6eq95pe8vzm69hfsfea29u4v3a6lyuaah20c4k6rvf9skz35ct2r54z",
|
||||||
|
"legacy": "ztestsapling1esn0wamf8w3nz2juwryscc3l8e5xtll6aewx0r2h5xtmrpnzsw2k23lec65agn8v59r72v2krrh",
|
||||||
|
"transparent": "tmMteg5HxFnmn4mbm2UNEGzWgLX16bGLg16"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "GetNewAddress - no transparent",
|
||||||
|
"summary": "Get a new address for the given account with no transparent receiver",
|
||||||
|
"description": "Get a new address for the given account with an Orchard receiver, a Sapling receiver and *no* transparent receiver (default)",
|
||||||
|
"params": [
|
||||||
|
{
|
||||||
|
"name": "Account Id",
|
||||||
|
"summary": "The account index",
|
||||||
|
"value": 1
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "Name",
|
||||||
|
"summary": "User-friendly name for the address",
|
||||||
|
"value": "NoTransparent"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "ExcludeTransparent",
|
||||||
|
"summary": "Option to exclude transparent receivers from the address",
|
||||||
|
"value": "ExcludeTransparent"
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"result":
|
||||||
|
{
|
||||||
|
"index": 15,
|
||||||
|
"account": 1,
|
||||||
|
"name": "NoTransparent",
|
||||||
|
"ua": "utest1l0t3uzadaxa4jg7qatsfwqdvfp0qtedyyall65hm2nzwnwdmcvd7j4z6wdrftpsjxv8aw4qh0hka3wdqj0z48xrhg356dlapy36ug6tt20tkzavwccjfup8wy8sdkcc60rpf400mwek73n0ph9jyw9ae60rm5jt8rx75nzhyuymern2t",
|
||||||
|
"legacy": "ztestsapling1vp3kzw7rqldfvaw5edfgqq66qm0xnexmscwnys220403mqqh9uyl0sqsye37aelrese42y8ecnx",
|
||||||
|
"transparent": null
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "GetNewAddress - no Sapling",
|
||||||
|
"summary": "Get a new address for the given account with no Sapling receiver",
|
||||||
|
"description": "Get a new address for the given account with an Orchard receiver and a transparent receiver, and *no* Sapling receiver.",
|
||||||
|
"params": [
|
||||||
|
{
|
||||||
|
"name": "Account Id",
|
||||||
|
"summary": "The account index",
|
||||||
|
"value": 1
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "Name",
|
||||||
|
"summary": "User-friendly name for the address",
|
||||||
|
"value": "NoSapling"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "ExcludeSapling",
|
||||||
|
"summary": "Option to exclude Sapling receivers from the address",
|
||||||
|
"value": "ExcludeSapling"
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"result":
|
||||||
|
{
|
||||||
|
"index": 16,
|
||||||
|
"account": 3,
|
||||||
|
"name": "NoSapling",
|
||||||
|
"ua": "utest14yvw4msvn9r5nggv2s0yye8phqwrhsx8ddfvpg30zp4gtf928myaua8jwxssl7frr8eagvcrsa8tuu9dlh7cvksv3lkudvyrq2ysrtzate0dud7x0zhgz26wqccn8w7346v4kfagv3e",
|
||||||
|
"legacy": null,
|
||||||
|
"transparent": "tmQ7z6q46NLQXpeNkfeRL6wJwJWA4picf6b"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "GetNewAddress - Orchard only",
|
||||||
|
"summary": "Get a new address for the given account with only an Orchard receiver",
|
||||||
|
"description": "Get a new address for the given account with an Orchard receiver and *no* transparent receiver, and *no* Sapling receiver.",
|
||||||
|
"params": [
|
||||||
|
{
|
||||||
|
"name": "Account Id",
|
||||||
|
"summary": "The account index",
|
||||||
|
"value": 1
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "Name",
|
||||||
|
"summary": "User-friendly name for the address",
|
||||||
|
"value": "OrchardOnly"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "ExcludeSapling",
|
||||||
|
"summary": "Option to exclude Sapling receivers from the address",
|
||||||
|
"value": "ExcludeSapling"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"name": "ExcludeTransparent",
|
||||||
|
"summary": "Option to exclude transparent receivers from the address",
|
||||||
|
"value": "ExcludeTransparent"
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"result":
|
||||||
|
{
|
||||||
|
"index": 17,
|
||||||
|
"account": 3,
|
||||||
|
"name": "OrchardOnly",
|
||||||
|
"ua": "utest1890l0xjxcsapk0u7jnqdglzwp04rt4r8zfvh7qx6a76fq96fyxg9xysvklwjymm9xuxzk0578pvv3yzv0w8l5x4run96mahky5defw0m",
|
||||||
|
"legacy": null,
|
||||||
|
"transparent": null
|
||||||
|
}
|
||||||
|
}
|
||||||
|
],
|
||||||
"errors": [
|
"errors": [
|
||||||
{ "$ref": "#/components/errors/InvalidAccount" },
|
{ "$ref": "#/components/errors/InvalidAccount" },
|
||||||
{ "$ref": "#/components/errors/DuplicateName" }
|
{ "$ref": "#/components/errors/DuplicateName" }
|
||||||
|
|
Loading…
Reference in a new issue