Implement listwallets

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

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

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
+-- ** 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
-      [ "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 =
-    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`
 -- | Type for modeling the tree state response

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.DB (initDb)
-import Zenith.Types
+import Zenith.RPC
-  ( Config(..)
+  ( RpcCall(..)
-  , 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)

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": {},
+	  "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"
+      }
+    }
   }
 }