Fix remaining test cases

This commit is contained in:
Julian K. Arni 2015-05-08 15:07:11 +02:00 committed by Brandon Martin
parent f5dd4bfdbd
commit eba7d654c2

View File

@ -132,7 +132,6 @@ withServer action = withWaiDaemon (return server) action
type FailApi =
"get" :> Raw
:<|> "delete" :> Raw
:<|> "capture" :> Capture "name" String :> Raw
:<|> "body" :> Raw
failApi :: Proxy FailApi
@ -141,7 +140,6 @@ failApi = Proxy
failServer :: Application
failServer = serve failApi (
(\ _request respond -> respond $ responseLBS ok200 [] "")
:<|> (\ _request respond -> respond $ responseLBS ok200 [] "")
:<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
:<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
)
@ -275,6 +273,8 @@ spec = withServer $ \ baseUrl -> do
(WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
[]
type RawRight = (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
failSpec :: IO ()
failSpec = withFailServer $ \ baseUrl -> do
let getGet :: EitherT ServantError IO Person
@ -284,8 +284,11 @@ failSpec = withFailServer $ \ baseUrl -> do
( getGet
:<|> getDelete
:<|> getCapture
:<|> getBody)
= client failApi baseUrl
:<|> getBody
:<|> _ )
= client api baseUrl
getGetWrongHost :: EitherT ServantError IO Person
(getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872)
hspec $ do
context "client returns errors appropriately" $ do
@ -302,10 +305,9 @@ failSpec = withFailServer $ \ baseUrl -> do
_ -> fail $ "expected DecodeFailure, but got " <> show res
it "reports ConnectionError" $ do
Right _ <- return $ parseBaseUrl "127.0.0.1:987654"
Left res <- runEitherT getGet
Left res <- runEitherT getGetWrongHost
case res of
ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
ConnectionError (C.FailedConnectionException2 "127.0.0.1" 19872 False _) -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ do