diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index aea3c5a..4f9a712 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -22,6 +22,7 @@ import Control.Exception (throwIO) import Control.Monad (forM_, when) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger (NoLoggingT, runNoLoggingT) +import Data.Aeson hiding (Key, Value) import Data.Bifunctor (bimap) import qualified Data.ByteString as BS import Data.HexString @@ -76,6 +77,7 @@ import Zenith.Types , UnifiedAddressDB(..) , ZcashNetDB(..) , ZcashPool(..) + , ZcashWalletAPI(..) ) share @@ -262,6 +264,17 @@ share 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 -- | Initializes the database initDb :: diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs index 30b7f5b..6bfe11f 100644 --- a/src/Zenith/RPC.hs +++ b/src/Zenith/RPC.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} @@ -8,24 +7,161 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE LambdaCase #-} module Zenith.RPC where import Control.Exception (try) import Control.Monad.IO.Class (liftIO) +import Control.Monad.Logger (runNoLoggingT) import Data.Aeson import qualified Data.Text as T +import qualified Data.Vector as V import Servant -import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..)) -import Zenith.Core (checkBlockChain, checkZebra) -import Zenith.Types - ( Config(..) - , RpcCall(..) - , ZenithInfo(..) - , ZenithMethod(..) - , ZenithParams(..) - , ZenithResponse(..) +import ZcashHaskell.Types + ( RpcError(..) + , ZcashNet(..) + , ZebraGetBlockChainInfo(..) + , ZebraGetInfo(..) ) +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 = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody @@ -47,6 +183,34 @@ zenithServer config = getinfo :<|> handleRPC case method req of UnknownMethod -> 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 -> case parameters req of BlankParams -> do @@ -56,7 +220,7 @@ zenithServer config = getinfo :<|> handleRPC liftIO $ try $ checkZebra host port :: Handler (Either IOError ZebraGetInfo) case zInfo of - Left e -> + Left _e -> return $ ErrorResponse (callId req) (-32000) "Zebra not available" Right zI -> do @@ -64,7 +228,7 @@ zenithServer config = getinfo :<|> handleRPC liftIO $ try $ checkBlockChain host port :: Handler (Either IOError ZebraGetBlockChainInfo) case bInfo of - Left e1 -> + Left _e1 -> return $ ErrorResponse (callId req) (-32000) "Zebra not available" Right bI -> diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index ed2749f..d4688af 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -18,7 +18,6 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Text.Encoding.Error (lenientDecode) -import qualified Data.Vector as V import Database.Persist.TH import GHC.Generics import ZcashHaskell.Types @@ -44,6 +43,9 @@ newtype ZcashNetDB = ZcashNetDB { getNet :: ZcashNet } deriving newtype (Eq, Show, Read) +instance ToJSON ZcashNetDB where + toJSON (ZcashNetDB z) = toJSON z + derivePersistField "ZcashNetDB" newtype UnifiedAddressDB = UnifiedAddressDB @@ -99,118 +101,34 @@ data Config = Config , c_zenithPort :: !Int } deriving (Eq, Prelude.Show) --- ** Zenith methods -data ZenithMethod - = GetInfo - | UnknownMethod - deriving (Eq, Prelude.Show) +-- ** API types +data ZcashWalletAPI = ZcashWalletAPI + { zw_index :: !Int + , zw_name :: !T.Text + , zw_network :: !ZcashNet + , zw_birthday :: !Int + , zw_lastSync :: !Int + } deriving (Eq, Prelude.Show) -instance ToJSON ZenithMethod where - toJSON GetInfo = Data.Aeson.String "getinfo" - 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) = +instance ToJSON ZcashWalletAPI where + toJSON (ZcashWalletAPI i n net b l) = object - [ "jsonrpc" .= ("2.0" :: String) - , "id" .= i - , "error" .= object ["code" .= c, "message" .= m] + [ "index" .= i + , "name" .= n + , "network" .= net + , "birthday" .= b + , "lastSync" .= l ] -instance FromJSON ZenithResponse where +instance FromJSON ZcashWalletAPI 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 -> 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 + withObject "ZcashWalletAPI" $ \obj -> do + i <- obj .: "index" + n <- obj .: "name" + net <- obj .: "network" + b <- obj .: "birthday" + l <- obj .: "lastSync" + pure $ ZcashWalletAPI i n net b l -- ** `zebrad` -- | Type for modeling the tree state response diff --git a/test/ServerSpec.hs b/test/ServerSpec.hs index 52a5a56..ab645d7 100644 --- a/test/ServerSpec.hs +++ b/test/ServerSpec.hs @@ -2,6 +2,7 @@ import Control.Concurrent (forkIO, threadDelay) import Control.Exception (SomeException, try) +import Control.Monad (when) import Data.Aeson import qualified Data.ByteString as BS import Data.Configurator @@ -10,23 +11,27 @@ import qualified Data.Text.Encoding as E import Network.HTTP.Simple import Network.Wai.Handler.Warp (run) import Servant +import System.Directory import Test.HUnit import Test.Hspec import ZcashHaskell.Types (ZcashNet(..)) -import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer) -import Zenith.Types - ( Config(..) - , RpcCall(..) +import Zenith.DB (initDb) +import Zenith.RPC + ( RpcCall(..) , ZenithInfo(..) , ZenithMethod(..) , ZenithParams(..) + , ZenithRPC(..) , ZenithResponse(..) + , authenticate + , zenithServer ) +import Zenith.Types (Config(..)) main :: IO () main = do config <- load ["$(HOME)/Zenith/zenith.cfg"] - dbFilePath <- require config "dbFilePath" + let dbFilePath = "test.db" nodeUser <- require config "nodeUser" nodePwd <- require config "nodePwd" zebraPort <- require config "zebraPort" @@ -61,10 +66,42 @@ main = do Right r -> r `shouldBe` 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 = do putStrLn "Starting test RPC server" + checkDbFile <- doesFileExist "test.db" + when checkDbFile $ removeFile "test.db" + _ <- initDb "test.db" let ctx = authenticate config :. EmptyContext forkIO $ run (c_zenithPort config) $ @@ -98,3 +135,4 @@ makeZenithCall host port usr pwd m params = do case getResponseBody r of Left e -> return $ Left $ show e Right r' -> return $ Right r' + e -> return $ Left $ show e ++ show (getResponseBody r) diff --git a/zenith-openrpc.json b/zenith-openrpc.json index 26e788e..13dc854 100644 --- a/zenith-openrpc.json +++ b/zenith-openrpc.json @@ -10,13 +10,93 @@ }, "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" } ], - "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": { "contentDescriptors": {}, - "schemas": {}, - "examples": {} + "schemas": { + "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" + } + } } }