Some tests for errors
This commit is contained in:
parent
fe6962d0b9
commit
23311a8f5d
2 changed files with 40 additions and 3 deletions
|
@ -71,6 +71,7 @@ test-suite spec
|
|||
, deepseq
|
||||
, either
|
||||
, hspec == 2.*
|
||||
, http-client
|
||||
, http-media
|
||||
, http-types
|
||||
, network >= 2.6
|
||||
|
|
|
@ -5,7 +5,9 @@
|
|||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -fcontext-stack=25 #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Servant.ClientSpec where
|
||||
|
||||
import Control.Applicative
|
||||
|
@ -21,6 +23,7 @@ import Data.Monoid
|
|||
import Data.Proxy
|
||||
import qualified Data.Text as T
|
||||
import GHC.Generics
|
||||
import Network.HTTP.Client (HttpException(..))
|
||||
import Network.HTTP.Media
|
||||
import Network.HTTP.Types
|
||||
import Network.Socket
|
||||
|
@ -59,6 +62,10 @@ instance FromFormUrlEncoded Person where
|
|||
a <- lookupEither "age" xs
|
||||
return $ Person (T.unpack n) (read $ T.unpack a)
|
||||
|
||||
deriving instance Eq ServantError
|
||||
|
||||
instance Eq HttpException where
|
||||
a == b = show a == show b
|
||||
|
||||
alice :: Person
|
||||
alice = Person "Alice" 42
|
||||
|
@ -111,6 +118,19 @@ server = serve api (
|
|||
withServer :: (BaseUrl -> IO a) -> IO a
|
||||
withServer action = withWaiDaemon (return server) action
|
||||
|
||||
type FailApi =
|
||||
"get" :> Get '[FormUrlEncoded] Person
|
||||
failApi :: Proxy FailApi
|
||||
failApi = Proxy
|
||||
|
||||
failServer :: Application
|
||||
failServer = serve failApi (
|
||||
return alice
|
||||
)
|
||||
|
||||
withFailServer :: (BaseUrl -> IO a) -> IO a
|
||||
withFailServer action = withWaiDaemon (return failServer) action
|
||||
|
||||
getGet :: BaseUrl -> EitherT ServantError IO Person
|
||||
getDelete :: BaseUrl -> EitherT ServantError IO ()
|
||||
getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
|
||||
|
@ -216,11 +236,27 @@ spec = do
|
|||
responseStatus `shouldBe` (Status 500 "error message")
|
||||
mapM_ test $
|
||||
(WrappedApi (Proxy :: Proxy Delete), "Delete") :
|
||||
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") :
|
||||
(WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Delete") :
|
||||
(WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Delete") :
|
||||
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
|
||||
(WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
|
||||
(WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
|
||||
[]
|
||||
|
||||
context "client returns errors appropriately" $ do
|
||||
it "reports connection errors" $ do
|
||||
Right host <- return $ parseBaseUrl "127.0.0.1:987654"
|
||||
Left (ConnectionError (FailedConnectionException2 "127.0.0.1" 987654 False _)) <- runEitherT (getGet host)
|
||||
return ()
|
||||
it "reports non-success responses" $ withFailServer $ \ host -> do
|
||||
Left res <- runEitherT (getDelete host)
|
||||
case res of
|
||||
FailureResponse (Status 404 "Not Found") _ _ -> return ()
|
||||
_ -> fail $ "expected 404 response, but got " <> show res
|
||||
it "reports unsupported content types" $ withFailServer $ \ host -> do
|
||||
Left res <- runEitherT (getGet host)
|
||||
case res of
|
||||
FailureResponse (Status 404 "Not Found") _ _ -> return ()
|
||||
_ -> fail $ "expected 404 response, but got " <> show res
|
||||
|
||||
data WrappedApi where
|
||||
WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
|
||||
HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
|
||||
|
|
Loading…
Reference in a new issue