git.iko.soy/typeable/servant
on ci-fix-followups help sign in
typeable/servant/servant-client/test/Servant/FailSpec.hs
81 lines 3.3 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE GADTs #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE UndecidableInstances #-}
14{-# OPTIONS_GHC -freduction-depth=100 #-}
15{-# OPTIONS_GHC -fno-warn-orphans #-}
16{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
18module Servant.FailSpec (spec) where
20import Prelude ()
21import Prelude.Compat
23import Data.Monoid ()
24import Data.Semigroup
25 ((<>))
26import qualified Network.HTTP.Types as HTTP
27import Test.Hspec
29import Servant.API
30 ((:<|>) ((:<|>)))
31import Servant.Client
32import Servant.ClientTestUtils
34spec :: Spec
35spec = describe "Servant.FailSpec" $ do
36 failSpec
38failSpec :: Spec
39failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
41 context "client returns errors appropriately" $ do
42 it "reports FailureResponse" $ \(_, baseUrl) -> do
43 let (_ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
44 Left res <- runClient getDeleteEmpty baseUrl
45 case res of
46 FailureResponse _ r | responseStatusCode r == HTTP.status404 -> return ()
47 _ -> fail $ "expected 404 response, but got " <> show res
49 it "reports DecodeFailure" $ \(_, baseUrl) -> do
50 let (_ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
51 Left res <- runClient (getCapture "foo") baseUrl
52 case res of
53 DecodeFailure _ _ -> return ()
54 _ -> fail $ "expected DecodeFailure, but got " <> show res
56 it "reports ConnectionError" $ \_ -> do
57 let (getGetWrongHost :<|> _) = client api
58 Left res <- runClient getGetWrongHost (BaseUrl Http "127.0.0.1" 19872 "")
59 case res of
60 ConnectionError _ -> return ()
61 _ -> fail $ "expected ConnectionError, but got " <> show res
63 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
64 let (_ :<|> getGet :<|> _ ) = client api
65 Left res <- runClient getGet baseUrl
66 case res of
67 UnsupportedContentType "application/octet-stream" _ -> return ()
68 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
70 it "reports UnsupportedContentType when there are response headers" $ \(_, baseUrl) -> do
71 Left res <- runClient getRespHeaders baseUrl
72 case res of
73 UnsupportedContentType "application/x-www-form-urlencoded" _ -> return ()
74 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
76 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
77 let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
78 Left res <- runClient (getBody alice) baseUrl
79 case res of
80 InvalidContentTypeHeader _ -> return ()
81 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res