import Control.Lens ((+~)) import Data.Default.Class (def) import Test.Framework (defaultMain, Test()) import Test.Framework.Providers.HUnit (testCase) import qualified Control.Concurrent.Async as A import qualified Control.Concurrent.MVar as M import qualified Data.ProtoLens as P import qualified Proto.Google.Protobuf.Duration as D import qualified Servant as S import qualified Servant.Client as SC import qualified Test.HUnit as HU import qualified TestServer import qualified TestClient -- XXX: Since tests run in paralell by default, but are configured with the -- same port, this must be run with the single threaded runtime. This is -- acceptable because the goal here is to test the protobuf de/serialization, -- not servant. main = let d = (D.Duration 12 34) in defaultMain [ getDur def , getDur d , exSec def 0 , exNSec def 0 , exSec d 12 , exNSec d 34 ] -- | Helper to run a client function against a server running in another thread. againstServer :: D.Duration -> (SC.ClientM a) -> IO (Either SC.ServantError a) againstServer served action = let port = 8080 in do ready <- M.newEmptyMVar A.withAsync (TestServer.run port ready served) $ \_ -> do () <- M.takeMVar ready TestClient.run port action getDur :: D.Duration -> Test getDur expect = testCase ("getDur: " ++ show expect) $ do result <- againstServer expect $ TestClient.getDur HU.assertEqual "Client received what server served" (pure expect) result exSec :: D.Duration -> Int -> Test exSec sent expect = testCase ("exSec: " ++ show sent) $ do result <- againstServer undefined $ TestClient.exSec sent HU.assertEqual "Client received seconds component of posted value" (pure expect) result exNSec :: D.Duration -> Int -> Test exNSec sent expect = testCase ("exNSec: " ++ show sent) $ do result <- againstServer undefined $ TestClient.exNSec sent HU.assertEqual "Client received nanoseconds component of posted value" (pure expect) result