{-# 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" 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" 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)