mirror of
https://github.com/zap-proto/haskell.git
synced 2026-10-30 15:05:00 +00:00
Ian Denhardt
f569041319
This will be more handy, and it also makes sure they actually build (provided we remember to sync them -- it would be good to automate that). This caught the regressions fixed in the previous two commits.
98 lines
3.9 KiB
Haskell
98 lines
3.9 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
module CalculatorExample (tests) where
|
|
|
|
import Data.Word
|
|
import Test.Hspec
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
import Control.Concurrent.Async (race_)
|
|
import Control.Exception.Safe (throwIO, try)
|
|
import Data.Default (def)
|
|
import Data.Foldable (for_)
|
|
import Data.String (fromString)
|
|
import Network.Simple.TCP (connect, serve)
|
|
import System.Environment (getEnv)
|
|
import System.Exit (ExitCode(ExitSuccess))
|
|
import System.IO.Error (isDoesNotExistError)
|
|
import System.Process (callProcess, readProcessWithExitCode)
|
|
|
|
import Capnp.Rpc.Transport (socketTransport)
|
|
import Capnp.Rpc.Untyped (ConnConfig(..), handleConn)
|
|
import Capnp.TraversalLimit (defaultLimit)
|
|
|
|
import qualified Examples.Rpc.CalculatorClient
|
|
import qualified Examples.Rpc.CalculatorServer
|
|
|
|
getExe :: String -> IO (Maybe FilePath)
|
|
getExe varName =
|
|
try (getEnv varName) >>= \case
|
|
Left e
|
|
| isDoesNotExistError e -> do
|
|
putStrLn $ varName ++ " not set; skipping."
|
|
pure Nothing
|
|
| otherwise ->
|
|
throwIO e
|
|
Right path ->
|
|
pure (Just path)
|
|
|
|
tests :: Spec
|
|
tests = describe "Check our example against the C++ implementation" $ do
|
|
clientPath <- runIO $ getExe "CXX_CALCULATOR_CLIENT"
|
|
serverPath <- runIO $ getExe "CXX_CALCULATOR_SERVER"
|
|
for_ clientPath $ \clientPath ->
|
|
it "Should pass when run against our server" $
|
|
Examples.Rpc.CalculatorServer.main
|
|
`race_` (waitForServer >> cxxClient clientPath 4000)
|
|
for_ serverPath $ \serverPath ->
|
|
it "Should pass when run against our client" $
|
|
cxxServer serverPath 4000
|
|
`race_` (waitForServer >> Examples.Rpc.CalculatorClient.main)
|
|
for_ ((,) <$> clientPath <*> serverPath) $ \(clientPath, serverPath) ->
|
|
it "Should pass when run aginst the C++ server, proxied through us." $
|
|
cxxServer serverPath 4000
|
|
`race_` (waitForServer >> runProxy 4000 6000)
|
|
-- we wait twice, so that the proxy also has time to start:
|
|
`race_` (waitForServer >> waitForServer >> cxxClient clientPath 6000)
|
|
where
|
|
-- | Give the server a bit of time to start up.
|
|
waitForServer :: IO ()
|
|
waitForServer = threadDelay 100000
|
|
|
|
cxxServer :: FilePath -> Word16 -> IO ()
|
|
cxxServer path port =
|
|
callProcess path ["localhost:" ++ show port]
|
|
cxxClient :: FilePath -> Word16 -> IO ()
|
|
cxxClient path port = do
|
|
(eStatus, out, err) <- readProcessWithExitCode path ["localhost:" ++ show port] ""
|
|
(eStatus, out, err)
|
|
`shouldBe`
|
|
( ExitSuccess
|
|
, unlines
|
|
[ "Evaluating a literal... PASS"
|
|
, "Using add and subtract... PASS"
|
|
, "Pipelining eval() calls... PASS"
|
|
, "Defining functions... PASS"
|
|
, "Using a callback... PASS"
|
|
]
|
|
, ""
|
|
)
|
|
|
|
-- | @'runProxy' serverPort clientPort@ connects to the server listening at
|
|
-- localhost:serverPort, requests its bootstrap interface, and then listens
|
|
-- on clientPort, offering a proxy of the server's bootstrap interface as our
|
|
-- own.
|
|
runProxy :: Word16 -> Word16 -> IO ()
|
|
runProxy serverPort clientPort =
|
|
connect "localhost" (fromString $ show serverPort) $ \(serverSock, _addr) ->
|
|
handleConn (socketTransport serverSock defaultLimit) def
|
|
{ debugMode = True
|
|
, withBootstrap = Just $ \_sup client ->
|
|
serve "localhost" (fromString $ show clientPort) $ \(clientSock, _addr) ->
|
|
handleConn (socketTransport clientSock defaultLimit) def
|
|
{ getBootstrap = \_sup -> pure $ Just client
|
|
, debugMode = True
|
|
}
|
|
}
|