eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Some tests for errors

Browse source
This commit is contained in:
Timo von Holtz 2015-03-09 09:59:40 +11:00
parent fe6962d0b9
commit 23311a8f5d
2 changed files with 40 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client.cabal
View file

@ -71,6 +71,7 @@ test-suite spec
, deepseq , deepseq
, either , either
, hspec == 2.* , hspec == 2.*
, http-client
, http-media , http-media
, http-types , http-types
, network >= 2.6 , network >= 2.6

42
test/Servant/ClientSpec.hs
View file

@ -5,7 +5,9 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fcontext-stack=25 #-} {-# OPTIONS_GHC -fcontext-stack=25 #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.ClientSpec where module Servant.ClientSpec where
import Control.Applicative import Control.Applicative
@ -21,6 +23,7 @@ import Data.Monoid
import Data.Proxy import Data.Proxy
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Generics import GHC.Generics
import Network.HTTP.Client (HttpException(..))
import Network.HTTP.Media import Network.HTTP.Media
import Network.HTTP.Types import Network.HTTP.Types
import Network.Socket import Network.Socket
@ -59,6 +62,10 @@ instance FromFormUrlEncoded Person where
a <- lookupEither "age" xs a <- lookupEither "age" xs
return $ Person (T.unpack n) (read $ T.unpack a) 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 = Person "Alice" 42 alice = Person "Alice" 42
@ -111,6 +118,19 @@ server = serve api (
withServer :: (BaseUrl -> IO a) -> IO a withServer :: (BaseUrl -> IO a) -> IO a
withServer action = withWaiDaemon (return server) action 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 getGet :: BaseUrl -> EitherT ServantError IO Person
getDelete :: BaseUrl -> EitherT ServantError IO () getDelete :: BaseUrl -> EitherT ServantError IO ()
getCapture :: String -> BaseUrl -> EitherT ServantError IO Person getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
@ -216,11 +236,27 @@ spec = do
responseStatus `shouldBe` (Status 500 "error message") responseStatus `shouldBe` (Status 500 "error message")
mapM_ test $ mapM_ test $
(WrappedApi (Proxy :: Proxy Delete), "Delete") : (WrappedApi (Proxy :: Proxy Delete), "Delete") :
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
(WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
(WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Delete") : (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 data WrappedApi where
WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a, WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) => HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>