d7fcf2b · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Fix missing canonicalize changes

d7fcf2bJulian K. Arni12 years ago

src/Servant/Client.hs+8−7

compare with master

unifiedsplit

@@ -13,6 +13,7 @@

13module Servant.Client

14 ( client

15 , HasClient(..)

16+ , Client

16 , ServantError(..)

17 , ServantError(..)

17 , module Servant.Common.BaseUrl

18 , module Servant.Common.BaseUrl

18 ) where

19 ) where

@@ -130,7 +131,7 @@ instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where

130-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content

131-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content

131-- HTTP header.

132-- HTTP header.

132instance HasClient (Get (ct ': cts) ()) where

133instance HasClient (Get (ct ': cts) ()) where

133− type Client (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

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

134 clientWithRoute Proxy req host =

135 clientWithRoute Proxy req host =

135 performRequestNoBody H.methodGet req [204] host

136 performRequestNoBody H.methodGet req [204] host

136

137

@@ -167,7 +168,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

167

168

168 clientWithRoute Proxy req mval =

169 clientWithRoute Proxy req mval =

169 clientWithRoute (Proxy :: Proxy sublayout) $

170 clientWithRoute (Proxy :: Proxy sublayout) $

170− maybe req (\value -> addHeader hname value req) mval

171+ maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval

171

172

172 where hname = symbolVal (Proxy :: Proxy sym)

173 where hname = symbolVal (Proxy :: Proxy sym)

173

174

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

184-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content

185-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content

185-- HTTP header.

186-- HTTP header.

186instance HasClient (Post (ct ': cts) ()) where

187instance HasClient (Post (ct ': cts) ()) where

187− type Client (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

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

188 clientWithRoute Proxy req host =

189 clientWithRoute Proxy req host =

189 void $ performRequestNoBody H.methodPost req [204] host

190 void $ performRequestNoBody H.methodPost req [204] host

190

191

@@ -201,7 +202,7 @@ instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where

201-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content

202-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content

202-- HTTP header.

203-- HTTP header.

203instance HasClient (Put (ct ': cts) ()) where

204instance HasClient (Put (ct ': cts) ()) where

204− type Client (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

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

205 clientWithRoute Proxy req host =

206 clientWithRoute Proxy req host =

206 void $ performRequestNoBody H.methodPut req [204] host

207 void $ performRequestNoBody H.methodPut req [204] host

207

208

@@ -210,7 +211,7 @@ instance HasClient (Put (ct ': cts) ()) where

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

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

211-- and port to send the request to.

212-- and port to send the request to.

212instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

213instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

213− type Client (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

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

214

215

215 clientWithRoute Proxy req host =

216 clientWithRoute Proxy req host =

216 performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] host

217 performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] host

@@ -218,7 +219,7 @@ instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

218-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content

219-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content

219-- HTTP header.

220-- HTTP header.

220instance HasClient (Patch (ct ': cts) ()) where

221instance HasClient (Patch (ct ': cts) ()) where

221− type Client (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

222+ type Client' (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

222 clientWithRoute Proxy req host =

223 clientWithRoute Proxy req host =

223 void $ performRequestNoBody H.methodPatch req [204] host

224 void $ performRequestNoBody H.methodPatch req [204] host

224

225

@@ -489,7 +490,7 @@ instance (MimeRender ct a, HasClient sublayout)

489 clientWithRoute Proxy req body =

490 clientWithRoute Proxy req body =

490 clientWithRoute (Proxy :: Proxy sublayout) $ do

491 clientWithRoute (Proxy :: Proxy sublayout) $ do

491 let ctProxy = Proxy :: Proxy ct

492 let ctProxy = Proxy :: Proxy ct

492− setRQBody (toByteString ctProxy body) (contentType ctProxy) req

493+ setRQBody (mimeRender ctProxy body) (contentType ctProxy) req

493

494

494-- | Make the querying function append @path@ to the request path.

495-- | Make the querying function append @path@ to the request path.

495instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where

496instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where

src/Servant/Common/Req.hs+1−1

@@ -172,7 +172,7 @@ performRequestCT ct reqMethod req wantedStatus reqHost = do

172 either

173 (left . (\s -> DecodeFailure s respCT respBody))

174 return

175− (fromByteString ct respBody)

175+ (mimeUnrender ct respBody)

176

177performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ()

178performRequestNoBody reqMethod req wantedStatus reqHost = do

test/Servant/ClientSpec.hs+36−36

@@ -1,42 +1,42 @@

1−{-# LANGUAGE GADTs #-}

1+{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE ViewPatterns #-}

4−{-# LANGUAGE DeriveGeneric #-}

2+{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE TypeOperators #-}

3+{-# LANGUAGE FlexibleContexts #-}

6−{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE GADTs #-}

7−{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE OverloadedStrings #-}

6+{-# LANGUAGE RecordWildCards #-}

8{-# LANGUAGE StandaloneDeriving #-}

7{-# LANGUAGE StandaloneDeriving #-}

8+{-# LANGUAGE TypeOperators #-}

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

10{-# OPTIONS_GHC -fno-warn-orphans #-}

11module Servant.ClientSpec where

13−import Control.Applicative

13+import Control.Applicative

14−import qualified Control.Arrow as Arrow

14+import qualified Control.Arrow as Arrow

15−import Control.Concurrent

15+import Control.Concurrent

16−import Control.Exception

16+import Control.Exception

17−import Control.Monad.Trans.Either

17+import Control.Monad.Trans.Either

18−import Data.Aeson

18+import Data.Aeson

19−import Data.ByteString.Lazy (ByteString)

19+import Data.ByteString.Lazy (ByteString)

20−import Data.Char

20+import Data.Char

21−import Data.Foldable (forM_)

21+import Data.Foldable (forM_)

22−import Data.Monoid

22+import Data.Monoid

23−import Data.Proxy

23+import Data.Proxy

24−import qualified Data.Text as T

24+import qualified Data.Text as T

25−import GHC.Generics

25+import GHC.Generics

26−import qualified Network.HTTP.Client as C

26+import qualified Network.HTTP.Client as C

27−import Network.HTTP.Media

27+import Network.HTTP.Media

28−import Network.HTTP.Types

28+import Network.HTTP.Types

29−import Network.Socket

29+import Network.Socket

30−import Network.Wai hiding (Response)

30+import Network.Wai hiding (Response)

31−import Network.Wai.Handler.Warp

31+import Network.Wai.Handler.Warp

32−import Test.Hspec

32+import Test.Hspec

33−import Test.Hspec.QuickCheck

33+import Test.Hspec.QuickCheck

34−import Test.HUnit

34+import Test.HUnit

35−import Test.QuickCheck

35+import Test.QuickCheck

36−

36+

37−import Servant.API

37+import Servant.API

38−import Servant.Client

38+import Servant.Client

39−import Servant.Server

39+import Servant.Server

41-- * test data types

@@ -289,8 +289,8 @@ spec = do

289 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res

290

291data WrappedApi where

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

292+ WrappedApi :: (HasServer (Canonicalize api), Server api ~ EitherT (Int, String) IO a,

293− HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>

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

294 Proxy api -> WrappedApi

295

296