754 lines
27 KiB
Haskell
754 lines
27 KiB
Haskell
{-# 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 (fromJust, 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, parseAddress)
|
|
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(..)
|
|
, PrivacyPolicy(..)
|
|
, ProposedNote(..)
|
|
, ValidAddressAPI(..)
|
|
, 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"
|
|
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
|
|
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)
|