Implement getnewaddress RPC method

This commit is contained in:
Rene Vergara 2024-08-30 15:14:48 -05:00
parent 6503af6a98
commit 1caa4efdb4
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
7 changed files with 399 additions and 20 deletions

View file

@ -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

View file

@ -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 ::

View file

@ -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

View file

@ -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"

View file

@ -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

View file

@ -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" }