168 lines
5.1 KiB
Haskell
168 lines
5.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Control.Concurrent (forkIO, threadDelay)
|
|
import Control.Exception (SomeException, try)
|
|
import Control.Monad (when)
|
|
import Data.Aeson
|
|
import qualified Data.ByteString as BS
|
|
import Data.Configurator
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as E
|
|
import Network.HTTP.Simple
|
|
import Network.Wai.Handler.Warp (run)
|
|
import Servant
|
|
import System.Directory
|
|
import Test.HUnit
|
|
import Test.Hspec
|
|
import ZcashHaskell.Types (ZcashNet(..))
|
|
import Zenith.DB (initDb)
|
|
import Zenith.RPC
|
|
( RpcCall(..)
|
|
, ZenithInfo(..)
|
|
, ZenithMethod(..)
|
|
, ZenithParams(..)
|
|
, ZenithRPC(..)
|
|
, ZenithResponse(..)
|
|
, authenticate
|
|
, zenithServer
|
|
)
|
|
import Zenith.Types (Config(..))
|
|
|
|
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.8.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 "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"
|
|
it "correct credentials, 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"
|
|
|
|
startAPI :: Config -> IO ()
|
|
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 $
|
|
run (c_zenithPort config) $
|
|
serveWithContext
|
|
(Servant.Proxy :: Servant.Proxy ZenithRPC)
|
|
ctx
|
|
(zenithServer config)
|
|
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)
|