Fix missing canonicalize changes

This commit is contained in:
Julian K. Arni 2015-04-19 18:31:23 +02:00
parent eae2f5f282
commit d7fcf2b19b
3 changed files with 44 additions and 43 deletions

View File

@ -13,6 +13,7 @@
module Servant.Client
( client
, HasClient(..)
, Client
, ServantError(..)
, module Servant.Common.BaseUrl
) where
@ -130,7 +131,7 @@ instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content
-- HTTP header.
instance HasClient (Get (ct ': cts) ()) where
type Client (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
type Client' (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host =
performRequestNoBody H.methodGet req [204] host
@ -167,7 +168,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
clientWithRoute Proxy req mval =
clientWithRoute (Proxy :: Proxy sublayout) $
maybe req (\value -> addHeader hname value req) mval
maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval
where hname = symbolVal (Proxy :: Proxy sym)
@ -184,7 +185,7 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content
-- HTTP header.
instance HasClient (Post (ct ': cts) ()) where
type Client (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
type Client' (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPost req [204] host
@ -201,7 +202,7 @@ instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content
-- HTTP header.
instance HasClient (Put (ct ': cts) ()) where
type Client (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
type Client' (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPut req [204] host
@ -210,7 +211,7 @@ instance HasClient (Put (ct ': cts) ()) where
-- will just require an argument that specifies the scheme, host
-- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
type Client (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
type Client' (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req host =
performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] host
@ -218,7 +219,7 @@ instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content
-- HTTP header.
instance HasClient (Patch (ct ': cts) ()) where
type Client (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
type Client' (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPatch req [204] host
@ -489,7 +490,7 @@ instance (MimeRender ct a, HasClient sublayout)
clientWithRoute Proxy req body =
clientWithRoute (Proxy :: Proxy sublayout) $ do
let ctProxy = Proxy :: Proxy ct
setRQBody (toByteString ctProxy body) (contentType ctProxy) req
setRQBody (mimeRender ctProxy body) (contentType ctProxy) req
-- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where

View File

@ -172,7 +172,7 @@ performRequestCT ct reqMethod req wantedStatus reqHost = do
either
(left . (\s -> DecodeFailure s respCT respBody))
return
(fromByteString ct respBody)
(mimeUnrender ct respBody)
performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ()
performRequestNoBody reqMethod req wantedStatus reqHost = do

View File

@ -1,42 +1,42 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fcontext-stack=25 #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.ClientSpec where
import Control.Applicative
import qualified Control.Arrow as Arrow
import Control.Concurrent
import Control.Exception
import Control.Monad.Trans.Either
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Char
import Data.Foldable (forM_)
import Data.Monoid
import Data.Proxy
import qualified Data.Text as T
import GHC.Generics
import qualified Network.HTTP.Client as C
import Network.HTTP.Media
import Network.HTTP.Types
import Network.Socket
import Network.Wai hiding (Response)
import Network.Wai.Handler.Warp
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.HUnit
import Test.QuickCheck
import Control.Applicative
import qualified Control.Arrow as Arrow
import Control.Concurrent
import Control.Exception
import Control.Monad.Trans.Either
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Char
import Data.Foldable (forM_)
import Data.Monoid
import Data.Proxy
import qualified Data.Text as T
import GHC.Generics
import qualified Network.HTTP.Client as C
import Network.HTTP.Media
import Network.HTTP.Types
import Network.Socket
import Network.Wai hiding (Response)
import Network.Wai.Handler.Warp
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.HUnit
import Test.QuickCheck
import Servant.API
import Servant.Client
import Servant.Server
import Servant.API
import Servant.Client
import Servant.Server
-- * test data types
@ -289,8 +289,8 @@ spec = do
_ -> fail $ "expected InvalidContentTypeHeader, 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 ())) =>
WrappedApi :: (HasServer (Canonicalize api), Server api ~ EitherT (Int, String) IO a,
HasClient (Canonicalize api), Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
Proxy api -> WrappedApi