ba46ecc · servant · git.iko.soy

git.iko.soy/servant

Use `ServantError` to report Errors instead of `String`

commitba46ecc0a9cfba1ac2d5fd8286df8416f8a367ea authorTimo von Holtz <tvh@anchor.com.au> dateThu 5 Mar 2015, 12:46 (12 years ago) parent83aff14

4 files changed+65−58

compare with master

unifiedsplit

CHANGELOG.md+1 src/Servant/Client.hs+6−7 src/Servant/Common/Req.hs+24−20 test/Servant/ClientSpec.hs+34−31

CHANGELOG.md+1

@@ -3,6 +3,7 @@

33* Support content-type aware combinators and `Accept`/`Content-type` headers

44* Added a lot of tests

55* Support multiple concurrent threads

6+* Use `ServantError` to report Errors instead of `String`

780.2.2

89-----

src/Servant/Client.hs+6−7

@@ -11,12 +11,12 @@

1111module Servant.Client

1212 ( client

1313 , HasClient(..)

14+ , ServantError(..)

1415 , module Servant.Common.BaseUrl

1516 ) where

1617

1718import Control.Monad

1819import Control.Monad.Trans.Either

19−import Data.Aeson

2020import Data.ByteString.Lazy (ByteString)

2121import Data.List

2222import Data.Proxy

@@ -29,7 +29,6 @@ import Servant.API

2929import Servant.API.ContentTypes

3030import Servant.Common.BaseUrl

3131import Servant.Common.Req

32−import Servant.Common.Text

3332

3433-- * Accessing APIs as a Client

3534

@@ -109,7 +108,7 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)

109108-- will just require an argument that specifies the scheme, host

110109-- and port to send the request to.

111110instance HasClient Delete where

112− type Client Delete = BaseUrl -> EitherT String IO ()

111+ type Client Delete = BaseUrl -> EitherT ServantError IO ()

113112

114113 clientWithRoute Proxy req host =

115114 void $ performRequest H.methodDelete req (== 204) host

@@ -119,7 +118,7 @@ instance HasClient Delete where

119118-- will just require an argument that specifies the scheme, host

120119-- and port to send the request to.

121120instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where

122− type Client (Get (ct ': cts) result) = BaseUrl -> EitherT String IO result

121+ type Client (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result

123122 clientWithRoute Proxy req host =

124123 performRequestCT (Proxy :: Proxy ct) H.methodGet req 200 host

125124

@@ -165,7 +164,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

165164-- will just require an argument that specifies the scheme, host

166165-- and port to send the request to.

167166instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where

168− type Client (Post (ct ': cts) a) = BaseUrl -> EitherT String IO a

167+ type Client (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

169168

170169 clientWithRoute Proxy req uri =

171170 performRequestCT (Proxy :: Proxy ct) H.methodPost req 201 uri

@@ -175,7 +174,7 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where

175174-- will just require an argument that specifies the scheme, host

176175-- and port to send the request to.

177176instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where

178− type Client (Put (ct ': cts) a) = BaseUrl -> EitherT String IO a

177+ type Client (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

179178

180179 clientWithRoute Proxy req host =

181180 performRequestCT (Proxy :: Proxy ct) H.methodPut req 200 host

@@ -414,7 +413,7 @@ instance (KnownSymbol sym, HasClient sublayout)

414413-- | Pick a 'Method' and specify where the server you want to query is. You get

415414-- back the status code and the response body as a 'ByteString'.

416415instance HasClient Raw where

417− type Client Raw = H.Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)

416+ type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)

418417

419418 clientWithRoute :: Proxy Raw -> Req -> Client Raw

420419 clientWithRoute Proxy req httpMethod host =

src/Servant/Common/Req.hs+24−20

@@ -27,6 +27,14 @@ import System.IO.Unsafe

2727

2828import qualified Network.HTTP.Client as Client

2929

30+data ServantError

31+ = FailureResponse Status MediaType ByteString

32+ | DecodeFailure String MediaType ByteString

33+ | UnsupportedContentType MediaType ByteString

34+ | ConnectionError HttpException

35+ | InvalidContentTypeHeader String

36+ deriving (Show)

37+

3038data Req = Req

3139 { reqPath :: String

3240 , qs :: QueryText

@@ -109,7 +117,7 @@ displayHttpRequest :: Method -> String

109117displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

110118

111119

112−performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)

120+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)

113121performRequest reqMethod req isWantedStatus reqHost = do

114122 partialRequest <- liftIO $ reqToRequest req reqHost

115123

@@ -118,43 +126,39 @@ performRequest reqMethod req isWantedStatus reqHost = do

118126 }

119127

120128 eResponse <- liftIO $ __withGlobalManager $ \ manager ->

121− catchStatusCodeException $

129+ catchHttpException $

122130 Client.httpLbs request manager

123131 case eResponse of

124− Left status ->

125− left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)

132+ Left err ->

133+ left $ ConnectionError err

126134

127135 Right response -> do

128136 let status = Client.responseStatus response

129− unless (isWantedStatus (statusCode status)) $

130− left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)

137+ body = Client.responseBody response

138+ status_code = statusCode status

131139 ct <- case lookup "Content-Type" $ Client.responseHeaders response of

132140 Nothing -> pure $ "application"//"octet-stream"

133141 Just t -> case parseAccept t of

134− Nothing -> left $ "invalid Content-Type header: " <> cs t

142+ Nothing -> left . InvalidContentTypeHeader . cs $ t

135143 Just t' -> pure t'

136− return (statusCode status, Client.responseBody response, ct)

137− where

138− showStatus (Status code message) =

139− show code ++ " - " ++ cs message

144+ unless (isWantedStatus status_code) $

145+ left $ FailureResponse status ct body

146+ return (status_code, body, ct)

140147

141148performRequestCT :: MimeUnrender ct result =>

142− Proxy ct -> Method -> Req -> Int -> BaseUrl -> EitherT String IO result

149+ Proxy ct -> Method -> Req -> Int -> BaseUrl -> EitherT ServantError IO result

143150performRequestCT ct reqMethod req wantedStatus reqHost = do

144151 let acceptCT = contentType ct

145152 (_status, respBody, respCT) <-

146153 performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost

147154 unless (matches respCT (acceptCT)) $

148− left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT

155+ left $ UnsupportedContentType respCT respBody

149156 either

150− (left . ((displayHttpRequest reqMethod ++ " returned invalid response of type" ++ show respCT) ++))

157+ (left . (\s -> DecodeFailure s respCT respBody))

151158 return

152159 (fromByteString ct respBody)

153160

154161

155−catchStatusCodeException :: IO a -> IO (Either Status a)

156−catchStatusCodeException action =

157− catch (Right <$> action) $ \e ->

158− case e of

159− Client.StatusCodeException status _ _ -> return $ Left status

160− exc -> throwIO exc

162+catchHttpException :: IO a -> IO (Either HttpException a)

163+catchHttpException action =

164+ catch (Right <$> action) (pure . Left)

test/Servant/ClientSpec.hs+34−31

@@ -8,6 +8,8 @@

88{-# OPTIONS_GHC -fcontext-stack=25 #-}

99module Servant.ClientSpec where

1010

11+import Control.Applicative

12+import qualified Control.Arrow as Arrow

1113import Control.Concurrent

1214import Control.Exception

1315import Control.Monad.Trans.Either

@@ -29,7 +31,6 @@ import Test.Hspec.QuickCheck

2931import Test.QuickCheck

3032

3133import Servant.API

32−import Servant.API.ContentTypes

3334import Servant.Client

3435import Servant.Server

3536

@@ -110,21 +111,21 @@ server = serve api (

110111withServer :: (BaseUrl -> IO a) -> IO a

111112withServer action = withWaiDaemon (return server) action

112113

113−getGet :: BaseUrl -> EitherT String IO Person

114−getDelete :: BaseUrl -> EitherT String IO ()

115−getCapture :: String -> BaseUrl -> EitherT String IO Person

116−getBody :: Person -> BaseUrl -> EitherT String IO Person

117−getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person

118−getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]

119−getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool

120−getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person

121−getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]

122−getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool

123−getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)

124−getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)

114+getGet :: BaseUrl -> EitherT ServantError IO Person

115+getDelete :: BaseUrl -> EitherT ServantError IO ()

116+getCapture :: String -> BaseUrl -> EitherT ServantError IO Person

117+getBody :: Person -> BaseUrl -> EitherT ServantError IO Person

118+getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person

119+getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]

120+getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool

121+getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person

122+getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]

123+getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool

124+getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)

125+getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)

125126getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

126127 -> BaseUrl

127− -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])

128+ -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])

128129( getGet

129130 :<|> getDelete

130131 :<|> getCapture

@@ -143,32 +144,32 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

143144spec :: Spec

144145spec = do

145146 it "Servant.API.Get" $ withServer $ \ host -> do

146− runEitherT (getGet host) `shouldReturn` Right alice

147+ (Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice

147148

148149 it "Servant.API.Delete" $ withServer $ \ host -> do

149− runEitherT (getDelete host) `shouldReturn` Right ()

150+ (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()

150151

151152 it "Servant.API.Capture" $ withServer $ \ host -> do

152− runEitherT (getCapture "Paula" host) `shouldReturn` Right (Person "Paula" 0)

153+ (Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0)

153154

154155 it "Servant.API.ReqBody" $ withServer $ \ host -> do

155156 let p = Person "Clara" 42

156− runEitherT (getBody p host) `shouldReturn` Right p

157+ (Arrow.left show <$> runEitherT (getBody p host)) `shouldReturn` Right p

157158

158159 it "Servant.API.QueryParam" $ withServer $ \ host -> do

159− runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice

160− Left result <- runEitherT (getQueryParam (Just "bob") host)

161− result `shouldContain` "bob not found"

160+ (Arrow.left show <$> runEitherT (getQueryParam (Just "alice") host)) `shouldReturn` Right alice

161+ Left (FailureResponse s _ _) <- runEitherT (getQueryParam (Just "bob") host)

162+ statusCode s `shouldBe` 400

162163

163164 it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do

164− runEitherT (getQueryParams [] host) `shouldReturn` Right []

165− runEitherT (getQueryParams ["alice", "bob"] host)

165+ (Arrow.left show <$> runEitherT (getQueryParams [] host)) `shouldReturn` Right []

166+ (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"] host))

166167 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]

167168

168169 context "Servant.API.QueryParam.QueryFlag" $

169170 forM_ [False, True] $ \ flag ->

170171 it (show flag) $ withServer $ \ host -> do

171− runEitherT (getQueryFlag flag host) `shouldReturn` Right flag

172+ (Arrow.left show <$> runEitherT (getQueryFlag flag host)) `shouldReturn` Right flag

172173

173174{-

174175 it "Servant.API.MatrixParam" $ withServer $ \ host -> do

@@ -188,17 +189,19 @@ spec = do

188189-}

189190

190191 it "Servant.API.Raw on success" $ withServer $ \ host -> do

191− runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")

192+ (Arrow.left show <$> runEitherT (getRawSuccess methodGet host))

193+ `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")

192194

193195 it "Servant.API.Raw on failure" $ withServer $ \ host -> do

194− runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")

196+ (Arrow.left show <$> runEitherT (getRawFailure methodGet host))

197+ `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")

195198

196199 modifyMaxSuccess (const 20) $ do

197200 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $

198201 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->

199202 ioProperty $ do

200203 withServer $ \ host -> do

201− result <- runEitherT (getMultiple cap num flag body host)

204+ result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body host)

202205 return $

203206 result === Right (cap, num, flag, body)

204207

@@ -209,10 +212,10 @@ spec = do

209212 it desc $

210213 withWaiDaemon (return (serve api (left (500, "error message")))) $

211214 \ host -> do

212− let getResponse :: BaseUrl -> EitherT String IO ()

215+ let getResponse :: BaseUrl -> EitherT ServantError IO ()

213216 getResponse = client api

214− Left result <- runEitherT (getResponse host)

215− result `shouldContain` "error message"

217+ Left (FailureResponse status _ _) <- runEitherT (getResponse host)

218+ status `shouldBe` (Status 500 "error message")

216219 mapM_ test $

217220 (WrappedApi (Proxy :: Proxy Delete), "Delete") :

218221 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") :

@@ -222,7 +225,7 @@ spec = do

222225

223226data WrappedApi where

224227 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,

225− HasClient api, Client api ~ (BaseUrl -> EitherT String IO ())) =>

228+ HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>

226229 Proxy api -> WrappedApi

227230

228231