feat(rpc): add sendmany method

src/Zenith/Core.hs

@@ -737,7 +737,7 @@ prepareTxV2 ::
   -> Int
   -> [ProposedNote]
   -> PrivacyPolicy
-  -> LoggingT IO (Either TxError HexString)
+  -> NoLoggingT IO (Either TxError HexString)
 prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
   accRead <- liftIO $ getAccountById pool za
   let recipients = map extractReceiver pnotes

src/Zenith/GUI.hs

@@ -1557,7 +1557,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
       let zPort = c_zebraPort config
       pool <- runNoLoggingT $ initPool dbPath
       res <-
-        runFileLoggingT "zenith.log" $
+        runNoLoggingT $
         prepareTxV2
           pool
           zHost

src/Zenith/RPC.hs

@@ -9,19 +9,22 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralisedNewtypeDeriving #-}
 
 module Zenith.RPC where
 
+import Control.Concurrent (forkIO)
 import Control.Exception (try)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (runNoLoggingT)
+import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
 import Data.Aeson
+import qualified Data.HexString as H
 import Data.Int
 import Data.Scientific (floatingOrInteger)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
+import Data.Time.Clock (getCurrentTime)
 import qualified Data.UUID as U
+import Data.UUID.V4 (nextRandom)
 import qualified Data.Vector as V
 import Database.Esqueleto.Experimental
   ( entityKey
@@ -32,32 +35,22 @@ import Database.Esqueleto.Experimental
 import Servant
 import Text.Read (readMaybe)
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
-import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
+import ZcashHaskell.Orchard (parseAddress)
-import ZcashHaskell.Sapling (encodeSaplingAddress)
+import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
-import ZcashHaskell.Transparent
+import ZcashHaskell.Utils (makeZebraCall)
-  ( encodeExchangeAddress
+import Zenith.Core (createCustomWalletAddress, createZcashAccount, prepareTxV2)
-  , encodeTransparentReceiver
-  )
-import ZcashHaskell.Types
-  ( ExchangeAddress(..)
-  , RpcError(..)
-  , SaplingAddress(..)
-  , Scope(..)
-  , TransparentAddress(..)
-  , ValidAddress(..)
-  , ZcashNet(..)
-  )
-import Zenith.Core (createCustomWalletAddress, createZcashAccount)
 import Zenith.DB
   ( Operation(..)
   , ZcashAccount(..)
   , ZcashWallet(..)
+  , finalizeOperation
   , findNotesByAddress
   , getAccountById
   , getAccounts
   , getAddressById
   , getAddresses
   , getExternalAddresses
+  , getLastSyncBlock
   , getMaxAccount
   , getMaxAddress
   , getOperation
@@ -68,6 +61,7 @@ import Zenith.DB
   , initPool
   , saveAccount
   , saveAddress
+  , saveOperation
   , saveWallet
   , toZcashAccountAPI
   , toZcashAddressAPI
@@ -86,6 +80,7 @@ import Zenith.Types
   , ZcashNetDB(..)
   , ZcashNoteAPI(..)
   , ZcashWalletAPI(..)
+  , ZenithStatus(..)
   , ZenithUuid(..)
   )
 import Zenith.Utils (jsonNumber)
@@ -458,10 +453,15 @@ instance FromJSON RpcCall where
                     String _ -> do
                       x' <- parseJSON $ a V.! 1
                       y <- parseJSON $ a V.! 2
-                      pure $ RpcCall v i SendMany (SendParams acc y x')
+                      if not (null y)
+                        then pure $ RpcCall v i SendMany (SendParams acc y x')
+                        else pure $ RpcCall v i SendMany BadParams
                     Array _ -> do
                       x' <- parseJSON $ a V.! 1
-                      pure $ RpcCall v i SendMany (SendParams acc x' Full)
+                      if not (null x')
+                        then pure $
+                             RpcCall v i SendMany (SendParams acc x' Full)
+                        else pure $ RpcCall v i SendMany BadParams
                     _anyOther -> pure $ RpcCall v i SendMany BadParams
                 else pure $ RpcCall v i SendMany BadParams
             _anyOther -> pure $ RpcCall v i SendMany BadParams
@@ -735,8 +735,69 @@ zenithServer state = getinfo :<|> handleRPC
           case parameters req of
             SendParams a ns p -> do
               let dbPath = w_dbPath state
+              let zHost = w_host state
+              let zPort = w_port state
+              let znet = w_network state
               pool <- liftIO $ runNoLoggingT $ initPool dbPath
-              undefined
+              opid <- liftIO nextRandom
+              startTime <- liftIO getCurrentTime
+              opkey <-
+                liftIO $
+                saveOperation pool $
+                Operation (ZenithUuid opid) startTime Nothing Processing Nothing
+              case opkey of
+                Nothing ->
+                  return $ ErrorResponse (callId req) (-32010) "Internal Error"
+                Just opkey' -> do
+                  acc <-
+                    liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
+                  case acc of
+                    Just acc' -> do
+                      bl <-
+                        liftIO $
+                        getLastSyncBlock
+                          pool
+                          (zcashAccountWalletId $ entityVal acc')
+                      _ <-
+                        liftIO $
+                        forkIO $ do
+                          res <-
+                            liftIO $
+                            runNoLoggingT $
+                            prepareTxV2
+                              pool
+                              zHost
+                              zPort
+                              znet
+                              (entityKey acc')
+                              bl
+                              ns
+                              p
+                          case res of
+                            Left e ->
+                              finalizeOperation pool opkey' Failed $
+                              T.pack $ show e
+                            Right rawTx -> do
+                              zebraRes <-
+                                makeZebraCall
+                                  zHost
+                                  zPort
+                                  "sendrawtransaction"
+                                  [Data.Aeson.String $ H.toText rawTx]
+                              case zebraRes of
+                                Left e1 ->
+                                  finalizeOperation pool opkey' Failed $
+                                  T.pack $ show e1
+                                Right txId ->
+                                  finalizeOperation pool opkey' Successful $
+                                  "Tx ID: " <> H.toText txId
+                      return $ SendResponse (callId req) opid
+                    Nothing ->
+                      return $
+                      ErrorResponse
+                        (callId req)
+                        (-32006)
+                        "Account does not exist."
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
 

test/ServerSpec.hs

@@ -7,7 +7,7 @@ import Control.Monad.Logger (runNoLoggingT)
 import Data.Aeson
 import qualified Data.ByteString as BS
 import Data.Configurator
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromJust, fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time.Clock (getCurrentTime)
@@ -18,7 +18,7 @@ import Servant
 import System.Directory
 import Test.HUnit hiding (State)
 import Test.Hspec
-import ZcashHaskell.Orchard (isValidUnifiedAddress)
+import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
 import ZcashHaskell.Types
   ( ZcashNet(..)
   , ZebraGetBlockChainInfo(..)
@@ -39,6 +39,9 @@ import Zenith.RPC
   )
 import Zenith.Types
   ( Config(..)
+  , PrivacyPolicy(..)
+  , ProposedNote(..)
+  , ValidAddressAPI(..)
   , ZcashAccountAPI(..)
   , ZcashAddressAPI(..)
   , ZcashWalletAPI(..)
@@ -572,6 +575,107 @@ main = do
                   Left e -> assertFailure e
                   Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
                   Right _ -> assertFailure "unexpected response"
+        describe "Send tx" $ do
+          describe "sendmany" $ do
+            it "bad credentials" $ do
+              res <-
+                makeZenithCall
+                  "127.0.0.1"
+                  nodePort
+                  "baduser"
+                  "idontknow"
+                  SendMany
+                  BlankParams
+              res `shouldBe` Left "Invalid credentials"
+            describe "correct credentials" $ do
+              it "invalid account" $ do
+                let uaRead =
+                      parseAddress
+                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    SendMany
+                    (SendParams
+                       17
+                       [ ProposedNote
+                           (ValidAddressAPI $ fromJust uaRead)
+                           0.005
+                           (Just "A cool memo")
+                       ]
+                       Full)
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
+              it "valid account, empty notes" $ do
+                let uaRead =
+                      parseAddress
+                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    SendMany
+                    (SendParams 1 [] Full)
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
+              it "valid account, single output" $ do
+                let uaRead =
+                      parseAddress
+                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    SendMany
+                    (SendParams
+                       1
+                       [ ProposedNote
+                           (ValidAddressAPI $ fromJust uaRead)
+                           5.0
+                           (Just "A cool memo")
+                       ]
+                       Full)
+                case res of
+                  Left e -> assertFailure e
+                  Right (SendResponse i o) -> o `shouldNotBe` U.nil
+              it "valid account, multiple outputs" $ do
+                let uaRead =
+                      parseAddress
+                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+                let uaRead2 =
+                      parseAddress
+                        "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    SendMany
+                    (SendParams
+                       1
+                       [ ProposedNote
+                           (ValidAddressAPI $ fromJust uaRead)
+                           5.0
+                           (Just "A cool memo")
+                       , ProposedNote
+                           (ValidAddressAPI $ fromJust uaRead2)
+                           1.0
+                           (Just "Not so cool memo")
+                       ]
+                       Full)
+                case res of
+                  Left e -> assertFailure e
+                  Right (SendResponse i o) -> o `shouldNotBe` U.nil
 
 startAPI :: Config -> IO ()
 startAPI config = do