From 23311a8f5dec64b49e2caf50d58fbaa65efc8f3a Mon Sep 17 00:00:00 2001
From: Timo von Holtz <tvh@anchor.com.au>
Date: Mon, 9 Mar 2015 09:59:40 +1100
Subject: [PATCH] Some tests for errors

---
 servant-client.cabal       |  1 +
 test/Servant/ClientSpec.hs | 42 +++++++++++++++++++++++++++++++++++---
 2 files changed, 40 insertions(+), 3 deletions(-)

diff --git a/servant-client.cabal b/servant-client.cabal
index 77b832b7..b743e1a5 100644
--- a/servant-client.cabal
+++ b/servant-client.cabal
@@ -71,6 +71,7 @@ test-suite spec
     , deepseq
     , either
     , hspec == 2.*
+    , http-client
     , http-media
     , http-types
     , network >= 2.6
diff --git a/test/Servant/ClientSpec.hs b/test/Servant/ClientSpec.hs
index 812d10c4..b843de4c 100644
--- a/test/Servant/ClientSpec.hs
+++ b/test/Servant/ClientSpec.hs
@@ -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 ())) =>