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

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE NoMonomorphismRestriction #-}
   3 {-# OPTIONS_GHC -Wno-missing-signatures #-}
   4 module Hspec.Client.Raw where
   5
   6 import Data.Either (Either(..))
   7 import Data.Function (($))
   8 import System.IO (IO)
   9 import Test.Hspec
  10 import Test.Tasty
  11 import Test.Tasty.Hspec
  12 import Test.Tasty.HUnit (assertFailure)
  13 import Text.Show (Show(..))
  14 import qualified Network.HTTP.Client as Client
  15 import qualified Network.HTTP.Types as HTTP
  16 import qualified Network.Wai as Wai
  17
  18 import Symantic.HTTP
  19 import Symantic.HTTP.Client
  20 import Symantic.HTTP.Server
  21 import Hspec.Utils
  22 import Hspec.Utils.Server
  23
  24 api = "success" </> raw
  25   <!> "failure" </> raw
  26
  27 srv = server api $
  28         route_success :!:
  29         route_failure
  30         where
  31         route_success _req res = res $ Wai.responseLBS HTTP.ok200 [] "rawSuccess"
  32         route_failure _req res = res $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure"
  33
  34 cli_success
  35  :!: cli_failure
  36  = client api
  37
  38 hspec :: IO [TestTree]
  39 hspec = testSpecs $ describe "raw" $
  40         beforeAll (runTestServer srv) $
  41         afterAll killTestServer $ do
  42                 it "raw on success" $ \TestServer{..} -> do
  43                         res <- runClient env (cli_success HTTP.methodGet)
  44                         case res of
  45                          Left e -> assertFailure $ show e
  46                          Right r -> do
  47                                 Client.responseStatus r `shouldBe` HTTP.status200
  48                                 Client.responseBody   r `shouldBe` "rawSuccess"
  49                 it "raw should return a Left in case of failure" $ \TestServer{..} -> do
  50                         res <- runClient env (cli_failure HTTP.methodGet)
  51                         case res of
  52                          Right (_a::ClientResponse) -> do
  53                                 assertFailure "expected Left, but got Right"
  54                          Left (ClientError_FailureResponse r) -> do
  55                                 Client.responseStatus r `shouldBe` HTTP.status400
  56                                 Client.responseBody   r `shouldBe` "rawFailure"
  57                          Left e -> assertFailure $ "expected FailureResponse, but got " <> show e