{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} module Hspec.Client.Raw where import Data.Either (Either(..)) import Data.Function (($)) import System.IO (IO) import Test.Hspec import Test.Tasty import Test.Tasty.Hspec import Test.Tasty.HUnit (assertFailure) import Text.Show (Show(..)) import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Types as HTTP import qualified Network.Wai as Wai import Symantic.HTTP import Symantic.HTTP.Client import Symantic.HTTP.Server import Hspec.Utils import Hspec.Utils.Server api = "success" raw "failure" raw srv = server api $ route_success :!: route_failure where route_success _req res = res $ Wai.responseLBS HTTP.ok200 [] "rawSuccess" route_failure _req res = res $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure" cli_success :!: cli_failure = client api hspec :: IO [TestTree] hspec = testSpecs $ describe "raw" $ beforeAll (runTestServer srv) $ afterAll killTestServer $ do it "raw on success" $ \TestServer{..} -> do res <- runClient env (cli_success HTTP.methodGet) case res of Left e -> assertFailure $ show e Right r -> do Client.responseStatus r `shouldBe` HTTP.status200 Client.responseBody r `shouldBe` "rawSuccess" it "raw should return a Left in case of failure" $ \TestServer{..} -> do res <- runClient env (cli_failure HTTP.methodGet) case res of Right (_a::ClientResponse) -> do assertFailure "expected Left, but got Right" Left (ClientError_FailureResponse r) -> do Client.responseStatus r `shouldBe` HTTP.status400 Client.responseBody r `shouldBe` "rawFailure" Left e -> assertFailure $ "expected FailureResponse, but got " <> show e