]> Git — Sourcephile - haskell/symantic-http.git/blob - symantic-http-test/Hspec/Client/Raw.hs
Bump stack resolver to lts-13.19
[haskell/symantic-http.git] / 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