CHANGELOG.md

@@ -17,6 +17,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - `listreceived` RPC method
 - `getbalance` RPC method
 - `getnewwallet` RPC method
+- `getnewaccount` RPC method
 
 ### Changed
 

app/Server.hs

@@ -10,7 +10,7 @@ import Servant
 import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
 import Zenith.Core (checkBlockChain, checkZebra)
 import Zenith.DB (initDb)
-import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer)
+import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
 import Zenith.Scanner (rescanZebra)
 import Zenith.Types (Config(..))
 
@@ -39,8 +39,16 @@ main = do
             Left e2 -> throwIO $ userError e2
             Right x' -> do
               when x' $ rescanZebra zebraHost zebraPort dbFilePath
+              let myState =
+                    State
+                      (zgb_net chainInfo)
+                      zebraHost
+                      zebraPort
+                      dbFilePath
+                      (zgi_build zebra)
+                      (zgb_blocks chainInfo)
               run nodePort $
                 serveWithContext
                   (Proxy :: Proxy ZenithRPC)
                   ctx
-                  (zenithServer myConfig)
+                  (zenithServer myState)

src/Zenith/DB.hs

@@ -451,6 +451,16 @@ getWallets pool n =
       where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
       pure wallets
 
+walletExists :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashWallet))
+walletExists pool n =
+  runNoLoggingT $
+  PS.retryOnBusy $
+  flip PS.runSqlPool pool $ do
+    selectOne $ do
+      wallets <- from $ table @ZcashWallet
+      where_ (wallets ^. ZcashWalletId ==. val (toSqlKey $ fromIntegral n))
+      pure wallets
+
 getNetwork :: ConnectionPool -> WalletAddressId -> IO ZcashNet
 getNetwork pool a = do
   n <-

src/Zenith/RPC.hs

@@ -25,30 +25,29 @@ import Servant
 import Text.Read (readMaybe)
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
 import ZcashHaskell.Orchard (parseAddress)
-import ZcashHaskell.Types
+import ZcashHaskell.Types (RpcError(..), ZcashNet(..))
-  ( RpcError(..)
+import Zenith.Core (createZcashAccount)
-  , ZcashNet(..)
-  , ZebraGetBlockChainInfo(..)
-  , ZebraGetInfo(..)
-  )
-import Zenith.Core (checkBlockChain, checkZebra)
 import Zenith.DB
-  ( ZcashWallet(..)
+  ( ZcashAccount(..)
+  , ZcashWallet(..)
   , findNotesByAddress
   , getAccountById
   , getAccounts
   , getAddressById
   , getAddresses
   , getExternalAddresses
+  , getMaxAccount
   , getPoolBalance
   , getUnconfPoolBalance
   , getWalletNotes
   , getWallets
   , initPool
+  , saveAccount
   , saveWallet
   , toZcashAccountAPI
   , toZcashAddressAPI
   , toZcashWalletAPI
+  , walletExists
   )
 import Zenith.Types
   ( AccountBalance(..)
@@ -70,6 +69,7 @@ data ZenithMethod
   | ListReceived
   | GetBalance
   | GetNewWallet
+  | GetNewAccount
   | UnknownMethod
   deriving (Eq, Prelude.Show)
 
@@ -81,6 +81,7 @@ instance ToJSON ZenithMethod where
   toJSON ListReceived = Data.Aeson.String "listreceived"
   toJSON GetBalance = Data.Aeson.String "getbalance"
   toJSON GetNewWallet = Data.Aeson.String "getnewwallet"
+  toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
   toJSON UnknownMethod = Data.Aeson.Null
 
 instance FromJSON ZenithMethod where
@@ -93,6 +94,7 @@ instance FromJSON ZenithMethod where
       "listreceived" -> pure ListReceived
       "getbalance" -> pure GetBalance
       "getnewwallet" -> pure GetNewWallet
+      "getnewaccount" -> pure GetNewAccount
       _ -> pure UnknownMethod
 
 data ZenithParams
@@ -103,6 +105,7 @@ data ZenithParams
   | NotesParams !T.Text
   | BalanceParams !Int64
   | NameParams !T.Text
+  | NameIdParams !T.Text !Int
   | TestParams !T.Text
   deriving (Eq, Prelude.Show)
 
@@ -114,6 +117,8 @@ instance ToJSON ZenithParams where
   toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
   toJSON (NotesParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
   toJSON (NameParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
+  toJSON (NameIdParams t i) =
+    Data.Aeson.Array $ V.fromList [Data.Aeson.String t, jsonNumber i]
   toJSON (BalanceParams n) =
     Data.Aeson.Array $ V.fromList [jsonNumber $ fromIntegral n]
 
@@ -311,14 +316,34 @@ instance FromJSON RpcCall where
                   pure $ RpcCall v i GetNewWallet (NameParams x)
                 else pure $ RpcCall v i GetNewWallet BadParams
             _anyOther -> pure $ RpcCall v i GetNewWallet BadParams
+        GetNewAccount -> 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
+                  pure $ RpcCall v i GetNewAccount (NameIdParams x y)
+                else pure $ RpcCall v i GetNewAccount BadParams
+            _anyOther -> pure $ RpcCall v i GetNewAccount BadParams
 
 type ZenithRPC
   = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
       '[ JSON]
       RpcCall :> Post '[ JSON] ZenithResponse
 
-zenithServer :: Config -> Server ZenithRPC
+data State = State
-zenithServer config = getinfo :<|> handleRPC
+  { w_network :: !ZcashNet
+  , w_host :: !T.Text
+  , w_port :: !Int
+  , w_dbPath :: !T.Text
+  , w_build :: !T.Text
+  , w_startBlock :: !Int
+  }
+
+zenithServer :: State -> Server ZenithRPC
+zenithServer state = getinfo :<|> handleRPC
   where
     getinfo :: Handler Value
     getinfo =
@@ -335,55 +360,49 @@ zenithServer config = getinfo :<|> handleRPC
         ListWallets ->
           case parameters req of
             BlankParams -> do
-              let dbPath = c_dbPath config
+              pool <- liftIO $ runNoLoggingT $ initPool $ w_dbPath state
-              let host = c_zebraHost config
+              walList <- liftIO $ getWallets pool $ w_network state
-              let port = c_zebraPort config
+              if not (null walList)
-              bc <-
+                then return $
-                liftIO $ try $ checkBlockChain host port :: Handler
+                     WalletListResponse
-                  (Either IOError ZebraGetBlockChainInfo)
+                       (callId req)
-              case bc of
+                       (map toZcashWalletAPI walList)
-                Left _e1 ->
+                else return $
-                  return $
+                     ErrorResponse
-                  ErrorResponse (callId req) (-32000) "Zebra not available"
+                       (callId req)
-                Right chainInfo -> do
+                       (-32001)
-                  pool <- liftIO $ runNoLoggingT $ initPool dbPath
+                       "No wallets available. Please create one first"
-                  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"
         ListAccounts ->
           case parameters req of
             AccountsParams w -> do
-              let dbPath = c_dbPath config
+              let dbPath = w_dbPath state
               pool <- liftIO $ runNoLoggingT $ initPool dbPath
-              accList <-
+              wl <- liftIO $ walletExists pool w
-                liftIO $
+              case wl of
-                runNoLoggingT $ getAccounts pool (toSqlKey $ fromIntegral w)
+                Just wl' -> do
-              if not (null accList)
+                  accList <-
-                then return $
+                    liftIO $ runNoLoggingT $ getAccounts pool (entityKey wl')
-                     AccountListResponse
+                  if not (null accList)
-                       (callId req)
+                    then return $
-                       (map toZcashAccountAPI accList)
+                         AccountListResponse
-                else return $
+                           (callId req)
-                     ErrorResponse
+                           (map toZcashAccountAPI accList)
-                       (callId req)
+                    else return $
-                       (-32002)
+                         ErrorResponse
-                       "No accounts available for this wallet. Please create one first"
+                           (callId req)
+                           (-32002)
+                           "No accounts available for this wallet. Please create one first"
+                Nothing ->
+                  return $
+                  ErrorResponse (callId req) (-32008) "Wallet does not exist."
             _anyOther ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
         ListAddresses ->
           case parameters req of
             AddressesParams a -> do
-              let dbPath = c_dbPath config
+              let dbPath = w_dbPath state
               pool <- liftIO $ runNoLoggingT $ initPool dbPath
               addrList <-
                 liftIO $
@@ -402,29 +421,11 @@ zenithServer config = getinfo :<|> handleRPC
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
         GetInfo ->
           case parameters req of
-            BlankParams -> do
+            BlankParams ->
-              let host = c_zebraHost config
+              return $
-              let port = c_zebraPort config
+              InfoResponse
-              zInfo <-
+                (callId req)
-                liftIO $ try $ checkZebra host port :: Handler
+                (ZenithInfo "0.7.0.0-beta" (w_network state) (w_build state))
-                  (Either IOError ZebraGetInfo)
-              case zInfo of
-                Left _e ->
-                  return $
-                  ErrorResponse (callId req) (-32000) "Zebra not available"
-                Right zI -> do
-                  bInfo <-
-                    liftIO $ try $ checkBlockChain host port :: Handler
-                      (Either IOError ZebraGetBlockChainInfo)
-                  case bInfo of
-                    Left _e1 ->
-                      return $
-                      ErrorResponse (callId req) (-32000) "Zebra not available"
-                    Right bI ->
-                      return $
-                      InfoResponse
-                        (callId req)
-                        (ZenithInfo "0.7.0.0-beta" (zgb_net bI) (zgi_build zI))
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
         ListReceived ->
@@ -432,7 +433,7 @@ zenithServer config = getinfo :<|> handleRPC
             NotesParams x -> do
               case (readMaybe (T.unpack x) :: Maybe Int64) of
                 Just x' -> do
-                  let dbPath = c_dbPath config
+                  let dbPath = w_dbPath state
                   pool <- liftIO $ runNoLoggingT $ initPool dbPath
                   a <- liftIO $ getAddressById pool $ toSqlKey x'
                   case a of
@@ -454,7 +455,7 @@ zenithServer config = getinfo :<|> handleRPC
                         (-32005)
                         "Unable to parse address"
                     Just x' -> do
-                      let dbPath = c_dbPath config
+                      let dbPath = w_dbPath state
                       pool <- liftIO $ runNoLoggingT $ initPool dbPath
                       addrs <- liftIO $ getExternalAddresses pool
                       nList <-
@@ -466,7 +467,7 @@ zenithServer config = getinfo :<|> handleRPC
         GetBalance ->
           case parameters req of
             BalanceParams i -> do
-              let dbPath = c_dbPath config
+              let dbPath = w_dbPath state
               pool <- liftIO $ runNoLoggingT $ initPool dbPath
               acc <- liftIO $ getAccountById pool $ toSqlKey i
               case acc of
@@ -482,38 +483,63 @@ zenithServer config = getinfo :<|> handleRPC
         GetNewWallet ->
           case parameters req of
             NameParams t -> do
-              let host = c_zebraHost config
+              let dbPath = w_dbPath state
-              let port = c_zebraPort config
-              let dbPath = c_dbPath config
               sP <- liftIO generateWalletSeedPhrase
               pool <- liftIO $ runNoLoggingT $ initPool dbPath
-              bInfo <-
+              r <-
-                liftIO $ try $ checkBlockChain host port :: Handler
+                liftIO $
-                  (Either IOError ZebraGetBlockChainInfo)
+                saveWallet pool $
-              case bInfo of
+                ZcashWallet
-                Left _e1 ->
+                  t
+                  (ZcashNetDB $ w_network state)
+                  (PhraseDB sP)
+                  (w_startBlock state)
+                  0
+              case r of
+                Nothing ->
                   return $
-                  ErrorResponse (callId req) (-32000) "Zebra not available"
+                  ErrorResponse
-                Right bI -> do
+                    (callId req)
-                  r <-
+                    (-32007)
-                    liftIO $
+                    "Entity with that name already exists."
-                    saveWallet pool $
+                Just r' ->
-                    ZcashWallet
+                  return $
-                      t
+                  NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
-                      (ZcashNetDB $ zgb_net bI)
+            _anyOtherParams ->
-                      (PhraseDB sP)
+              return $ ErrorResponse (callId req) (-32602) "Invalid params"
-                      (zgb_blocks bI)
+        GetNewAccount ->
-                      0
+          case parameters req of
-                  case r of
+            NameIdParams t i -> do
-                    Nothing ->
+              let dbPath = w_dbPath state
+              pool <- liftIO $ runNoLoggingT $ initPool dbPath
+              w <- liftIO $ walletExists pool i
+              case w of
+                Just w' -> do
+                  aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
+                  nAcc <-
+                    liftIO
+                      (try $ createZcashAccount t (aIdx + 1) w' :: IO
+                         (Either IOError ZcashAccount))
+                  case nAcc of
+                    Left e ->
                       return $
-                      ErrorResponse
+                      ErrorResponse (callId req) (-32610) $ T.pack $ show e
-                        (callId req)
+                    Right nAcc' -> do
-                        (-32007)
+                      r <- liftIO $ saveAccount pool nAcc'
-                        "Entity with that name already exists."
+                      case r of
-                    Just r' ->
+                        Nothing ->
-                      return $
+                          return $
-                      NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
+                          ErrorResponse
+                            (callId req)
+                            (-32007)
+                            "Entity with that name already exists."
+                        Just x ->
+                          return $
+                          NewItemResponse (callId req) $
+                          fromSqlKey $ entityKey x
+                Nothing ->
+                  return $
+                  ErrorResponse (callId req) (-32608) "Wallet does not exist."
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
 

test/ServerSpec.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import Control.Concurrent (forkIO, threadDelay)
-import Control.Exception (SomeException, try)
+import Control.Exception (SomeException, throwIO, try)
 import Control.Monad (when)
 import Data.Aeson
 import qualified Data.ByteString as BS
@@ -12,12 +12,18 @@ import Network.HTTP.Simple
 import Network.Wai.Handler.Warp (run)
 import Servant
 import System.Directory
-import Test.HUnit
+import Test.HUnit hiding (State)
 import Test.Hspec
-import ZcashHaskell.Types (ZcashNet(..))
+import ZcashHaskell.Types
+  ( ZcashNet(..)
+  , ZebraGetBlockChainInfo(..)
+  , ZebraGetInfo(..)
+  )
+import Zenith.Core (checkBlockChain, checkZebra)
 import Zenith.DB (initDb)
 import Zenith.RPC
   ( RpcCall(..)
+  , State(..)
   , ZenithInfo(..)
   , ZenithMethod(..)
   , ZenithParams(..)
@@ -26,7 +32,7 @@ import Zenith.RPC
   , authenticate
   , zenithServer
   )
-import Zenith.Types (Config(..), ZcashWalletAPI(..))
+import Zenith.Types (Config(..), ZcashAccountAPI(..), ZcashWalletAPI(..))
 
 main :: IO ()
 main = do
@@ -176,7 +182,95 @@ main = do
                   ListAccounts
                   BlankParams
               res `shouldBe` Left "Invalid credentials"
-            it "correct credentials, no accounts" $ do
+            describe "correct credentials" $ do
+              it "invalid wallet" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    ListAccounts
+                    (AccountsParams 17)
+                case res of
+                  Left e -> assertFailure e
+                  Right r ->
+                    r `shouldBe`
+                    ErrorResponse "zh" (-32008) "Wallet does not exist."
+              it "valid wallet, no accounts" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    ListAccounts
+                    (AccountsParams 1)
+                case res of
+                  Left e -> assertFailure e
+                  Right r ->
+                    r `shouldBe`
+                    ErrorResponse
+                      "zh"
+                      (-32002)
+                      "No accounts available for this wallet. Please create one first"
+          describe "getnewaccount" $ do
+            it "invalid credentials" $ do
+              res <-
+                makeZenithCall
+                  "127.0.0.1"
+                  nodePort
+                  "baduser"
+                  "idontknow"
+                  GetNewAccount
+                  BlankParams
+              res `shouldBe` Left "Invalid credentials"
+            describe "correct credentials" $ do
+              it "invalid wallet" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetNewAccount
+                    (NameIdParams "Personal" 17)
+                case res of
+                  Left e -> assertFailure e
+                  Right r ->
+                    r `shouldBe`
+                    ErrorResponse "zh" (-32608) "Wallet does not exist."
+              it "valid wallet" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetNewAccount
+                    (NameIdParams "Personal" 1)
+                case res of
+                  Left e -> assertFailure e
+                  Right r -> r `shouldBe` NewItemResponse "zh" 1
+              it "valid wallet, duplicate name" $ do
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    GetNewAccount
+                    (NameIdParams "Personal" 1)
+                case res of
+                  Left e -> assertFailure e
+                  Right r ->
+                    r `shouldBe`
+                    ErrorResponse
+                      "zh"
+                      (-32007)
+                      "Entity with that name already exists."
+          describe "listaccounts" $ do
+            it "valid wallet" $ do
               res <-
                 makeZenithCall
                   "127.0.0.1"
@@ -189,10 +283,7 @@ main = do
                 Left e -> assertFailure e
                 Right r ->
                   r `shouldBe`
-                  ErrorResponse
+                  AccountListResponse "zh" [ZcashAccountAPI 1 1 "Personal"]
-                    "zh"
-                    (-32002)
-                    "No accounts available for this wallet. Please create one first"
         describe "Addresses" $ do
           describe "listaddresses" $ do
             it "bad credentials" $ do
@@ -302,16 +393,38 @@ 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 $
+  w <-
-    run (c_zenithPort config) $
+    try $ checkZebra (c_zebraHost config) (c_zebraPort config) :: IO
-    serveWithContext
+      (Either IOError ZebraGetInfo)
-      (Servant.Proxy :: Servant.Proxy ZenithRPC)
+  case w of
-      ctx
+    Right zebra -> do
-      (zenithServer config)
+      bc <-
-  threadDelay 1000000
+        try $ checkBlockChain (c_zebraHost config) (c_zebraPort config) :: IO
-  putStrLn "Test server is up!"
+          (Either IOError ZebraGetBlockChainInfo)
+      case bc of
+        Left e1 -> throwIO e1
+        Right chainInfo -> do
+          x <- initDb "test.db"
+          case x of
+            Left e2 -> throwIO $ userError e2
+            Right x' -> do
+              let myState =
+                    State
+                      (zgb_net chainInfo)
+                      (c_zebraHost config)
+                      (c_zebraPort config)
+                      "test.db"
+                      (zgi_build zebra)
+                      (zgb_blocks chainInfo)
+              forkIO $
+                run (c_zenithPort config) $
+                serveWithContext
+                  (Servant.Proxy :: Servant.Proxy ZenithRPC)
+                  ctx
+                  (zenithServer myState)
+              threadDelay 1000000
+              putStrLn "Test server is up!"
 
 -- | Make a Zebra RPC call
 makeZenithCall ::

zenith-openrpc.json

@@ -190,7 +190,7 @@
       "name": "getnewaccount",
       "summary": "Create a new account",
       "description": "Create a new account in the given wallet.",
-      "tags": [{"$ref": "#/components/tags/draft"}, {"$ref": "#/components/tags/wip"}],
+      "tags": [],
       "params": [
         { "$ref": "#/components/contentDescriptors/Name"},
         { "$ref": "#/components/contentDescriptors/WalletId"} 
@@ -212,6 +212,11 @@
               "name": "Account name",
               "summary": "The user-friendly name for the Account",
               "value": "Personal"
+            },
+            {
+              "name": "Wallet Id",
+              "summary": "The internal index of the Wallet to use",
+              "value": 1
             }
           ],
           "result": {
@@ -222,7 +227,8 @@
       ],
       "errors": [
         { "$ref": "#/components/errors/ZebraNotAvailable" },
-        { "$ref": "#/components/errors/DuplicateName" }
+        { "$ref": "#/components/errors/DuplicateName" },
+        { "$ref": "#/components/errors/InvalidWallet" }
       ]
     },
     {
@@ -604,6 +610,10 @@
       "InvalidWallet": {
         "code": -32008,
         "message": "Wallet does not exist."
+      },
+      "InternalError": {
+        "code": -32010,
+        "message": "Varies"
       }
     }
   }

zenith.cabal

@@ -67,6 +67,7 @@ library
     , microlens-mtl
     , microlens-th
     , monad-logger
+    , transformers
     , monomer
     , mtl
     , persistent