symantic-http-test-0.0.1.20190410: Hspec/Client/Raw.hs

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