zenith/test/ServerSpec.hs

{-# LANGUAGE OverloadedStrings #-}

import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (SomeException, throwIO, try)
import Control.Monad (when)
import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson
import qualified Data.ByteString as BS
import Data.Configurator
import Data.Maybe (fromMaybe)
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 Network.HTTP.Simple
import Network.Wai.Handler.Warp (run)
import Servant
import System.Directory
import Test.HUnit hiding (State)
import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Types
  ( ZcashNet(..)
  , ZebraGetBlockChainInfo(..)
  , ZebraGetInfo(..)
  )
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (Operation(..), initDb, initPool, saveOperation)
import Zenith.RPC
  ( RpcCall(..)
  , State(..)
  , ZenithInfo(..)
  , ZenithMethod(..)
  , ZenithParams(..)
  , ZenithRPC(..)
  , ZenithResponse(..)
  , authenticate
  , zenithServer
  )
import Zenith.Types
  ( Config(..)
  , ZcashAccountAPI(..)
  , ZcashAddressAPI(..)
  , ZcashWalletAPI(..)
  , ZenithStatus(..)
  , ZenithUuid(..)
  )

main :: IO ()
main = do
  config <- load ["$(HOME)/Zenith/zenith.cfg"]
  let dbFilePath = "test.db"
  nodeUser <- require config "nodeUser"
  nodePwd <- require config "nodePwd"
  zebraPort <- require config "zebraPort"
  zebraHost <- require config "zebraHost"
  nodePort <- require config "nodePort"
  let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
  hspec $ do
    describe "RPC methods" $ do
      beforeAll_ (startAPI myConfig) $ do
        describe "getinfo" $ do
          it "bad credentials" $ do
            res <-
              makeZenithCall
                "127.0.0.1"
                nodePort
                "baduser"
                "idontknow"
                GetInfo
                BlankParams
            res `shouldBe` Left "Invalid credentials"
          it "correct credentials" $ do
            res <-
              makeZenithCall
                "127.0.0.1"
                nodePort
                nodeUser
                nodePwd
                GetInfo
                BlankParams
            case res of
              Left e -> assertFailure e
              Right r ->
                r `shouldBe`
                InfoResponse "zh" (ZenithInfo "0.7.0.0-beta" TestNet "v1.9.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"
          describe "getnewwallet" $ do
            it "bad credentials" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  "baduser"
                  "idontknow"
                  GetNewWallet
                  BlankParams
              res `shouldBe` Left "Invalid credentials"
            describe "correct credentials" $ do
              it "no params" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewWallet
                    BlankParams
                case res of
                  Left e -> assertFailure e
                  Right r ->
                    r `shouldBe` ErrorResponse "zh" (-32602) "Invalid params"
              it "Valid params" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewWallet
                    (NameParams "Main")
                case res of
                  Left e -> assertFailure e
                  Right r -> r `shouldBe` NewItemResponse "zh" 1
              it "duplicate name" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewWallet
                    (NameParams "Main")
                case res of
                  Left e -> assertFailure e
                  Right r ->
                    r `shouldBe`
                    ErrorResponse
                      "zh"
                      (-32007)
                      "Entity with that name already exists."
          describe "listwallet" $ do
            it "wallet exists" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  nodeUser
                  nodePwd
                  ListWallets
                  BlankParams
              case res of
                Left e -> assertFailure e
                Right (WalletListResponse i k) ->
                  zw_name (head k) `shouldBe` "Main"
                Right _ -> assertFailure "Unexpected response"
        describe "Accounts" $ do
          describe "listaccounts" $ do
            it "bad credentials" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  "baduser"
                  "idontknow"
                  ListAccounts
                  BlankParams
              res `shouldBe` Left "Invalid credentials"
            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" (-32008) "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"
                  nodePort
                  nodeUser
                  nodePwd
                  ListAccounts
                  (AccountsParams 1)
              case res of
                Left e -> assertFailure e
                Right r ->
                  r `shouldBe`
                  AccountListResponse "zh" [ZcashAccountAPI 1 1 "Personal"]
        describe "Addresses" $ do
          describe "listaddresses" $ do
            it "bad credentials" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  "baduser"
                  "idontknow"
                  ListAddresses
                  BlankParams
              res `shouldBe` Left "Invalid credentials"
            it "correct credentials, no addresses" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  nodeUser
                  nodePwd
                  ListAddresses
                  (AddressesParams 1)
              case res of
                Left e -> assertFailure e
                Right r ->
                  r `shouldBe`
                  ErrorResponse
                    "zh"
                    (-32003)
                    "No addresses available for this account. Please create one first"
          describe "getnewaddress" $ do
            it "bad credentials" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  "baduser"
                  "idontknow"
                  GetNewAddress
                  BlankParams
              res `shouldBe` Left "Invalid credentials"
            describe "correct credentials" $ do
              it "invalid account" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewAddress
                    (NewAddrParams 17 "Business" False False)
                case res of
                  Left e -> assertFailure e
                  Right r ->
                    r `shouldBe`
                    ErrorResponse "zh" (-32006) "Account does not exist."
              it "valid account" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewAddress
                    (NewAddrParams 1 "Business" False False)
                case res of
                  Left e -> assertFailure e
                  Right (NewAddrResponse i a) -> zd_name a `shouldBe` "Business"
                  Right _ -> assertFailure "unexpected response"
              it "valid account, duplicate name" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewAddress
                    (NewAddrParams 1 "Business" False False)
                case res of
                  Left e -> assertFailure e
                  Right r ->
                    r `shouldBe`
                    ErrorResponse
                      "zh"
                      (-32007)
                      "Entity with that name already exists."
              it "valid account, no sapling" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewAddress
                    (NewAddrParams 1 "NoSapling" True False)
                case res of
                  Left e -> assertFailure e
                  Right (NewAddrResponse i a) -> zd_legacy a `shouldBe` Nothing
                  Right _ -> assertFailure "unexpected response"
              it "valid account, no transparent" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewAddress
                    (NewAddrParams 1 "NoTransparent" False True)
                case res of
                  Left e -> assertFailure e
                  Right (NewAddrResponse i a) ->
                    zd_transparent a `shouldBe` Nothing
                  Right _ -> assertFailure "unexpected response"
              it "valid account, orchard only" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetNewAddress
                    (NewAddrParams 1 "OrchOnly" True True)
                case res of
                  Left e -> assertFailure e
                  Right (NewAddrResponse i a) ->
                    a `shouldSatisfy`
                    (\b ->
                       (zd_transparent b == Nothing) && (zd_legacy b == Nothing))
                  Right _ -> assertFailure "unexpected response"
          describe "listaddresses" $ do
            it "correct credentials, addresses exist" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  nodeUser
                  nodePwd
                  ListAddresses
                  (AddressesParams 1)
              case res of
                Left e -> assertFailure e
                Right (AddressListResponse i a) -> length a `shouldBe` 4
        describe "Notes" $ do
          describe "listreceived" $ do
            it "bad credentials" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  "baduser"
                  "idontknow"
                  ListReceived
                  BlankParams
              res `shouldBe` Left "Invalid credentials"
            describe "correct credentials" $ do
              it "no parameters" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    ListReceived
                    BlankParams
                case res of
                  Left e -> assertFailure e
                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
              it "unknown index" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    ListReceived
                    (NotesParams "17")
                case res of
                  Left e -> assertFailure e
                  Right (ErrorResponse i c m) -> c `shouldBe` (-32004)
        describe "Balance" $ do
          describe "getbalance" $ do
            it "bad credentials" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  "baduser"
                  "idontknow"
                  GetBalance
                  BlankParams
              res `shouldBe` Left "Invalid credentials"
            describe "correct credentials" $ do
              it "no parameters" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetBalance
                    BlankParams
                case res of
                  Left e -> assertFailure e
                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
              it "unknown index" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetBalance
                    (BalanceParams 17)
                case res of
                  Left e -> assertFailure e
                  Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
        describe "Operations" $ do
          describe "getoperationstatus" $ do
            it "bad credentials" $ do
              res <-
                makeZenithCall
                  "127.0.0.1"
                  nodePort
                  "baduser"
                  "idontknow"
                  GetOperationStatus
                  BlankParams
              res `shouldBe` Left "Invalid credentials"
            describe "correct credentials" $ do
              it "invalid ID" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetOperationStatus
                    (NameParams "badId")
                case res of
                  Left e -> assertFailure e
                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
              it "valid ID" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetOperationStatus
                    (OpParams
                       (ZenithUuid $
                        fromMaybe U.nil $
                        U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4"))
                case res of
                  Left e -> assertFailure e
                  Right (OpResponse i o) ->
                    operationUuid o `shouldBe`
                    (ZenithUuid $
                     fromMaybe U.nil $
                     U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
                  Right _ -> assertFailure "unexpected response"
              it "valid ID not found" $ do
                res <-
                  makeZenithCall
                    "127.0.0.1"
                    nodePort
                    nodeUser
                    nodePwd
                    GetOperationStatus
                    (OpParams
                       (ZenithUuid $
                        fromMaybe U.nil $
                        U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a5"))
                case res of
                  Left e -> assertFailure e
                  Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
                  Right _ -> assertFailure "unexpected response"

startAPI :: Config -> IO ()
startAPI config = do
  putStrLn "Starting test RPC server"
  checkDbFile <- doesFileExist "test.db"
  when checkDbFile $ removeFile "test.db"
  let ctx = authenticate config :. EmptyContext
  w <-
    try $ checkZebra (c_zebraHost config) (c_zebraPort config) :: IO
      (Either IOError ZebraGetInfo)
  case w of
    Right zebra -> do
      bc <-
        try $ checkBlockChain (c_zebraHost config) (c_zebraPort config) :: IO
          (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
              pool <- runNoLoggingT $ initPool "test.db"
              ts <- getCurrentTime
              y <-
                saveOperation
                  pool
                  (Operation
                     (ZenithUuid $
                      fromMaybe U.nil $
                      U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
                     ts
                     Nothing
                     Processing
                     Nothing)
              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 ::
     T.Text -- ^ Hostname for `zebrad`
  -> Int -- ^ Port for `zebrad`
  -> BS.ByteString
  -> BS.ByteString
  -> ZenithMethod -- ^ RPC method to call
  -> ZenithParams -- ^ List of parameters
  -> IO (Either String ZenithResponse)
makeZenithCall host port usr pwd m params = do
  let payload = RpcCall "2.0" "zh" m params
  let myRequest =
        setRequestBodyJSON payload $
        setRequestPort port $
        setRequestHost (E.encodeUtf8 host) $
        setRequestBasicAuth usr pwd $ setRequestMethod "POST" defaultRequest
  r <- httpJSONEither myRequest
  case getResponseStatusCode r of
    403 -> return $ Left "Invalid credentials"
    200 ->
      case getResponseBody r of
        Left e -> return $ Left $ show e
        Right r' -> return $ Right r'
    e -> return $ Left $ show e ++ show (getResponseBody r)