101 lines
3 KiB
Haskell
101 lines
3 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
|
||
|
|
import Control.Concurrent (forkIO, threadDelay)
|
||
|
|
import Control.Exception (SomeException, try)
|
||
|
|
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 Test.HUnit
|
||
|
|
import Test.Hspec
|
||
|
|
import ZcashHaskell.Types (ZcashNet(..))
|
||
|
|
import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer)
|
||
|
|
import Zenith.Types
|
||
|
|
( Config(..)
|
||
|
|
, RpcCall(..)
|
||
|
|
, ZenithInfo(..)
|
||
|
|
, ZenithMethod(..)
|
||
|
|
, ZenithParams(..)
|
||
|
|
, ZenithResponse(..)
|
||
|
|
)
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
config <- load ["$(HOME)/Zenith/zenith.cfg"]
|
||
|
|
dbFilePath <- require config "dbFilePath"
|
||
|
|
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")
|
||
|
|
|
||
|
|
startAPI :: Config -> IO ()
|
||
|
|
startAPI config = do
|
||
|
|
putStrLn "Starting test RPC server"
|
||
|
|
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'
|