Rene V. Vergara
d476183a1d
New type to support URI data structure created (Types.hs) Function to parse an URI string created (in Utils.hs) Test case added to Benchmark Suite
755 lines
27 KiB
Haskell
755 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"
|
|
currencyCode <- require config "currencyCode"
|
|
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort currencyCode
|
|
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)
|