Implement listwallets

This commit is contained in:
Rene Vergara 2024-08-05 12:54:02 -05:00
parent 0d5ff79b96
commit f7efa85cdd
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
5 changed files with 341 additions and 128 deletions

View file

@ -22,6 +22,7 @@ import Control.Exception (throwIO)
import Control.Monad (forM_, when) import Control.Monad (forM_, when)
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT) import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Data.Aeson hiding (Key, Value)
import Data.Bifunctor (bimap) import Data.Bifunctor (bimap)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString import Data.HexString
@ -76,6 +77,7 @@ import Zenith.Types
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZcashPool(..) , ZcashPool(..)
, ZcashWalletAPI(..)
) )
share share
@ -262,6 +264,17 @@ share
deriving Show Eq deriving Show Eq
|] |]
-- ** Type conversions
-- | @ZcashWallet@
toZcashWalletAPI :: Entity ZcashWallet -> ZcashWalletAPI
toZcashWalletAPI w =
ZcashWalletAPI
(fromIntegral $ fromSqlKey $ entityKey w)
(zcashWalletName $ entityVal w)
(getNet $ zcashWalletNetwork $ entityVal w)
(zcashWalletBirthdayHeight $ entityVal w)
(zcashWalletLastSync $ entityVal w)
-- * Database functions -- * Database functions
-- | Initializes the database -- | Initializes the database
initDb :: initDb ::

View file

@ -1,5 +1,4 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -8,24 +7,161 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
module Zenith.RPC where module Zenith.RPC where
import Control.Exception (try) import Control.Exception (try)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson import Data.Aeson
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Vector as V
import Servant import Servant
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..)) import ZcashHaskell.Types
import Zenith.Core (checkBlockChain, checkZebra) ( RpcError(..)
import Zenith.Types , ZcashNet(..)
( Config(..) , ZebraGetBlockChainInfo(..)
, RpcCall(..) , ZebraGetInfo(..)
, ZenithInfo(..)
, ZenithMethod(..)
, ZenithParams(..)
, ZenithResponse(..)
) )
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (getWallets, initDb, initPool, toZcashWalletAPI)
import Zenith.Types (Config(..), ZcashWalletAPI(..))
data ZenithMethod
= GetInfo
| ListWallets
| UnknownMethod
deriving (Eq, Prelude.Show)
instance ToJSON ZenithMethod where
toJSON GetInfo = Data.Aeson.String "getinfo"
toJSON ListWallets = Data.Aeson.String "listwallets"
toJSON UnknownMethod = Data.Aeson.Null
instance FromJSON ZenithMethod where
parseJSON =
withText "ZenithMethod" $ \case
"getinfo" -> pure GetInfo
"listwallets" -> pure ListWallets
_ -> pure UnknownMethod
data ZenithParams
= BlankParams
| BadParams
| TestParams !T.Text
deriving (Eq, Prelude.Show)
instance ToJSON ZenithParams where
toJSON BlankParams = Data.Aeson.Array V.empty
toJSON BadParams = Data.Aeson.Null
toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
data ZenithResponse
= InfoResponse !T.Text !ZenithInfo
| WalletListResponse !T.Text ![ZcashWalletAPI]
| ErrorResponse !T.Text !Double !T.Text
deriving (Eq, Prelude.Show)
instance ToJSON ZenithResponse where
toJSON (InfoResponse t i) =
object ["jsonrpc" .= ("2.0" :: String), "id" .= t, "result" .= i]
toJSON (WalletListResponse i w) =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= w]
toJSON (ErrorResponse i c m) =
object
[ "jsonrpc" .= ("2.0" :: String)
, "id" .= i
, "error" .= object ["code" .= c, "message" .= m]
]
instance FromJSON ZenithResponse where
parseJSON =
withObject "ZenithParams" $ \obj -> do
jr <- obj .: "jsonrpc"
i <- obj .: "id"
e <- obj .:? "error"
r <- obj .:? "result"
if jr /= ("2.0" :: String)
then fail "Malformed JSON"
else do
case e of
Nothing -> do
case r of
Nothing -> fail "Malformed JSON"
Just r1 ->
case r1 of
Object k -> do
v <- k .:? "version"
case (v :: Maybe String) of
Nothing -> fail "Unknown result"
Just _v' -> do
k1 <- parseJSON r1
pure $ InfoResponse i k1
Array n -> do
if V.null n
then fail "Malformed JSON"
else do
case V.head n of
Object n' -> do
v1 <- n' .:? "lastSync"
case (v1 :: Maybe Int) of
Just _v1' -> do
k2 <- parseJSON r1
pure $ WalletListResponse i k2
Nothing -> fail "Unknown object"
_anyOther -> fail "Malformed JSON"
_anyOther -> fail "Malformed JSON"
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
data ZenithInfo = ZenithInfo
{ zi_version :: !T.Text
, zi_network :: !ZcashNet
, zi_zebra :: !T.Text
} deriving (Eq, Prelude.Show)
instance ToJSON ZenithInfo where
toJSON (ZenithInfo v n z) =
object ["version" .= v, "network" .= n, "zebraVersion" .= z]
instance FromJSON ZenithInfo where
parseJSON =
withObject "ZenithInfo" $ \obj -> do
v <- obj .: "version"
n <- obj .: "network"
z <- obj .: "zebraVersion"
pure $ ZenithInfo v n z
-- | A type to model Zenith RPC calls
data RpcCall = RpcCall
{ jsonrpc :: !T.Text
, callId :: !T.Text
, method :: !ZenithMethod
, parameters :: !ZenithParams
} deriving (Eq, Prelude.Show)
instance ToJSON RpcCall where
toJSON (RpcCall jr i m p) =
object ["jsonrpc" .= jr, "id" .= i, "method" .= m, "params" .= p]
instance FromJSON RpcCall where
parseJSON =
withObject "RpcCall" $ \obj -> do
v <- obj .: "jsonrpc"
i <- obj .: "id"
m <- obj .: "method"
case m of
UnknownMethod -> pure $ RpcCall v i UnknownMethod BlankParams
ListWallets -> do
p <- obj .: "params"
if null (p :: [Value])
then pure $ RpcCall v i ListWallets BlankParams
else pure $ RpcCall v i ListWallets BadParams
GetInfo -> do
p <- obj .: "params"
if null (p :: [Value])
then pure $ RpcCall v i GetInfo BlankParams
else pure $ RpcCall v i GetInfo BadParams
type ZenithRPC type ZenithRPC
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@ -47,6 +183,34 @@ zenithServer config = getinfo :<|> handleRPC
case method req of case method req of
UnknownMethod -> UnknownMethod ->
return $ ErrorResponse (callId req) (-32601) "Method not found" return $ ErrorResponse (callId req) (-32601) "Method not found"
ListWallets ->
case parameters req of
BlankParams -> do
let dbPath = c_dbPath config
let host = c_zebraHost config
let port = c_zebraPort config
bc <-
liftIO $ try $ checkBlockChain host port :: Handler
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left _e1 ->
return $
ErrorResponse (callId req) (-32000) "Zebra not available"
Right chainInfo -> do
pool <- liftIO $ runNoLoggingT $ initPool dbPath
walList <- liftIO $ getWallets pool $ zgb_net chainInfo
if not (null walList)
then return $
WalletListResponse
(callId req)
(map toZcashWalletAPI walList)
else return $
ErrorResponse
(callId req)
(-32001)
"No wallets available. Please create one first"
_anyOther ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetInfo -> GetInfo ->
case parameters req of case parameters req of
BlankParams -> do BlankParams -> do
@ -56,7 +220,7 @@ zenithServer config = getinfo :<|> handleRPC
liftIO $ try $ checkZebra host port :: Handler liftIO $ try $ checkZebra host port :: Handler
(Either IOError ZebraGetInfo) (Either IOError ZebraGetInfo)
case zInfo of case zInfo of
Left e -> Left _e ->
return $ return $
ErrorResponse (callId req) (-32000) "Zebra not available" ErrorResponse (callId req) (-32000) "Zebra not available"
Right zI -> do Right zI -> do
@ -64,7 +228,7 @@ zenithServer config = getinfo :<|> handleRPC
liftIO $ try $ checkBlockChain host port :: Handler liftIO $ try $ checkBlockChain host port :: Handler
(Either IOError ZebraGetBlockChainInfo) (Either IOError ZebraGetBlockChainInfo)
case bInfo of case bInfo of
Left e1 -> Left _e1 ->
return $ return $
ErrorResponse (callId req) (-32000) "Zebra not available" ErrorResponse (callId req) (-32000) "Zebra not available"
Right bI -> Right bI ->

View file

@ -18,7 +18,6 @@ import Data.Maybe (fromMaybe)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Vector as V
import Database.Persist.TH import Database.Persist.TH
import GHC.Generics import GHC.Generics
import ZcashHaskell.Types import ZcashHaskell.Types
@ -44,6 +43,9 @@ newtype ZcashNetDB = ZcashNetDB
{ getNet :: ZcashNet { getNet :: ZcashNet
} deriving newtype (Eq, Show, Read) } deriving newtype (Eq, Show, Read)
instance ToJSON ZcashNetDB where
toJSON (ZcashNetDB z) = toJSON z
derivePersistField "ZcashNetDB" derivePersistField "ZcashNetDB"
newtype UnifiedAddressDB = UnifiedAddressDB newtype UnifiedAddressDB = UnifiedAddressDB
@ -99,118 +101,34 @@ data Config = Config
, c_zenithPort :: !Int , c_zenithPort :: !Int
} deriving (Eq, Prelude.Show) } deriving (Eq, Prelude.Show)
-- ** Zenith methods -- ** API types
data ZenithMethod data ZcashWalletAPI = ZcashWalletAPI
= GetInfo { zw_index :: !Int
| UnknownMethod , zw_name :: !T.Text
deriving (Eq, Prelude.Show) , zw_network :: !ZcashNet
, zw_birthday :: !Int
, zw_lastSync :: !Int
} deriving (Eq, Prelude.Show)
instance ToJSON ZenithMethod where instance ToJSON ZcashWalletAPI where
toJSON GetInfo = Data.Aeson.String "getinfo" toJSON (ZcashWalletAPI i n net b l) =
toJSON UnknownMethod = Data.Aeson.Null
instance FromJSON ZenithMethod where
parseJSON =
withText "ZenithMethod" $ \case
"getinfo" -> pure GetInfo
_ -> pure UnknownMethod
data ZenithParams
= BlankParams
| BadParams
| TestParams !T.Text
deriving (Eq, Prelude.Show)
instance ToJSON ZenithParams where
toJSON BlankParams = Data.Aeson.Array V.empty
toJSON BadParams = Data.Aeson.Null
toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
data ZenithResponse
= InfoResponse !T.Text !ZenithInfo
| ErrorResponse !T.Text !Double !T.Text
deriving (Eq, Prelude.Show)
instance ToJSON ZenithResponse where
toJSON (InfoResponse t i) =
object ["jsonrpc" .= ("2.0" :: String), "id" .= t, "result" .= i]
toJSON (ErrorResponse i c m) =
object object
[ "jsonrpc" .= ("2.0" :: String) [ "index" .= i
, "id" .= i , "name" .= n
, "error" .= object ["code" .= c, "message" .= m] , "network" .= net
, "birthday" .= b
, "lastSync" .= l
] ]
instance FromJSON ZenithResponse where instance FromJSON ZcashWalletAPI where
parseJSON = parseJSON =
withObject "ZenithParams" $ \obj -> do withObject "ZcashWalletAPI" $ \obj -> do
jr <- obj .: "jsonrpc" i <- obj .: "index"
i <- obj .: "id" n <- obj .: "name"
e <- obj .:? "error" net <- obj .: "network"
r <- obj .:? "result" b <- obj .: "birthday"
if jr /= ("2.0" :: String) l <- obj .: "lastSync"
then fail "Malformed JSON" pure $ ZcashWalletAPI i n net b l
else do
case e of
Nothing -> do
case r of
Nothing -> fail "Malformed JSON"
Just r1 ->
case r1 of
Object k -> do
v <- k .:? "version"
case (v :: Maybe String) of
Nothing -> fail "Unknown result"
Just v' -> do
k1 <- parseJSON r1
pure $ InfoResponse i k1
Array n -> undefined
_anyOther -> fail "Malformed JSON"
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
data ZenithInfo = ZenithInfo
{ zi_version :: !T.Text
, zi_network :: !ZcashNet
, zi_zebra :: !T.Text
} deriving (Eq, Prelude.Show)
instance ToJSON ZenithInfo where
toJSON (ZenithInfo v n z) =
object ["version" .= v, "network" .= n, "zebraVersion" .= z]
instance FromJSON ZenithInfo where
parseJSON =
withObject "ZenithInfo" $ \obj -> do
v <- obj .: "version"
n <- obj .: "network"
z <- obj .: "zebraVersion"
pure $ ZenithInfo v n z
-- | A type to model Zenith RPC calls
data RpcCall = RpcCall
{ jsonrpc :: !T.Text
, callId :: !T.Text
, method :: !ZenithMethod
, parameters :: !ZenithParams
} deriving (Eq, Prelude.Show)
instance ToJSON RpcCall where
toJSON (RpcCall jr i m p) =
object ["jsonrpc" .= jr, "id" .= i, "method" .= m, "params" .= p]
instance FromJSON RpcCall where
parseJSON =
withObject "RpcCall" $ \obj -> do
v <- obj .: "jsonrpc"
i <- obj .: "id"
m <- obj .: "method"
case m of
UnknownMethod -> pure $ RpcCall v i UnknownMethod BlankParams
GetInfo -> do
p <- obj .: "params"
if null (p :: [Value])
then pure $ RpcCall v i GetInfo BlankParams
else pure $ RpcCall v i GetInfo BadParams
-- ** `zebrad` -- ** `zebrad`
-- | Type for modeling the tree state response -- | Type for modeling the tree state response

View file

@ -2,6 +2,7 @@
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (SomeException, try) import Control.Exception (SomeException, try)
import Control.Monad (when)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.Configurator import Data.Configurator
@ -10,23 +11,27 @@ import qualified Data.Text.Encoding as E
import Network.HTTP.Simple import Network.HTTP.Simple
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import Servant import Servant
import System.Directory
import Test.HUnit import Test.HUnit
import Test.Hspec import Test.Hspec
import ZcashHaskell.Types (ZcashNet(..)) import ZcashHaskell.Types (ZcashNet(..))
import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer) import Zenith.DB (initDb)
import Zenith.Types import Zenith.RPC
( Config(..) ( RpcCall(..)
, RpcCall(..)
, ZenithInfo(..) , ZenithInfo(..)
, ZenithMethod(..) , ZenithMethod(..)
, ZenithParams(..) , ZenithParams(..)
, ZenithRPC(..)
, ZenithResponse(..) , ZenithResponse(..)
, authenticate
, zenithServer
) )
import Zenith.Types (Config(..))
main :: IO () main :: IO ()
main = do main = do
config <- load ["$(HOME)/Zenith/zenith.cfg"] config <- load ["$(HOME)/Zenith/zenith.cfg"]
dbFilePath <- require config "dbFilePath" let dbFilePath = "test.db"
nodeUser <- require config "nodeUser" nodeUser <- require config "nodeUser"
nodePwd <- require config "nodePwd" nodePwd <- require config "nodePwd"
zebraPort <- require config "zebraPort" zebraPort <- require config "zebraPort"
@ -61,10 +66,42 @@ main = do
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.8.0")
describe "Wallets" $ do
describe "listwallet" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
ListWallets
BlankParams
res `shouldBe` Left "Invalid credentials"
it "correct credentials, no wallet" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListWallets
BlankParams
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse
"zh"
(-32001)
"No wallets available. Please create one first"
startAPI :: Config -> IO () startAPI :: Config -> IO ()
startAPI config = do startAPI config = do
putStrLn "Starting test RPC server" putStrLn "Starting test RPC server"
checkDbFile <- doesFileExist "test.db"
when checkDbFile $ removeFile "test.db"
_ <- initDb "test.db"
let ctx = authenticate config :. EmptyContext let ctx = authenticate config :. EmptyContext
forkIO $ forkIO $
run (c_zenithPort config) $ run (c_zenithPort config) $
@ -98,3 +135,4 @@ makeZenithCall host port usr pwd m params = do
case getResponseBody r of case getResponseBody r of
Left e -> return $ Left $ show e Left e -> return $ Left $ show e
Right r' -> return $ Right r' Right r' -> return $ Right r'
e -> return $ Left $ show e ++ show (getResponseBody r)

View file

@ -10,13 +10,93 @@
}, },
"servers": [ "servers": [
{ {
"name": "Zenith RPC",
"summary": "The Zenith wallet RPC server",
"description": "This is the server that allows programmatic interaction with the Zenith Zcash wallet via RPC",
"url": "http://localhost:8234" "url": "http://localhost:8234"
} }
], ],
"methods": [], "methods": [
{
"name": "getinfo",
"tags": [ { "$ref": "#/components/tags/information" }],
"result" : {
"name": "Zenith information",
"schema": { "$ref": "#/components/schemas/ZenithInfo" }
},
"params" : [],
"examples": [
{
"name": "GetInfo example",
"summary": "Get information from Zenith",
"description": "Gets the status of the Zenith wallet server",
"params": [],
"result": {
"name": "GetInfo result",
"value": {
"version": "0.7.0.0-beta",
"network": "TestNet",
"zebraVersion": "v1.8.0"
}
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }
]
},
{
"name": "listwallets",
"tags": [ { "$ref": "#/components/tags/wallet" }],
"result": {
"name": "Wallets",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashWallet"
}
}
},
"params": []
}
],
"components": { "components": {
"contentDescriptors": {}, "contentDescriptors": {},
"schemas": {}, "schemas": {
"examples": {} "ZenithInfo": {
"type": "object",
"properties": {
"version": { "type": "string", "description": "Zenith's version"},
"network": { "type": "string", "description": "The network the wallet is connected to"},
"zebraVersion": { "type": "string", "description": "The version of the Zebra node used by Zenith"}
}
},
"ZcashWallet": {
"type": "object",
"properties": {
"index": { "type": "integer", "description": "Internal index of wallet"},
"name": { "type": "string", "description": "User-friendly name of the wallet" },
"network": { "type": "string", "description": "Network the wallet is for. Testnet or MainNet" },
"birthday": { "type": "integer", "description": "Wallet's birthday height" },
"lastSync": { "type": "integer", "description": "Last block the wallet is synced to" }
}
}
},
"examples": {},
"tags": {
"information": {"name": "Information"},
"wallet": {"name": "Wallet"}
},
"errors": {
"ZebraNotAvailable": {
"code": -32000,
"message": "Zebra not available"
},
"NoWallets": {
"code": -32001,
"message": "No wallets available. Please create one first"
}
}
} }
} }