implemented 'instance HasClient Raw'

src/Servant/API/Delete.hs

@@ -39,7 +39,7 @@ instance HasClient Delete where
   type Client Delete = BaseUrl -> EitherT String IO ()
 
   clientWithRoute Proxy req host =
-    performRequest methodDelete req 204 host
+    performRequestJSON methodDelete req 204 host
 
 instance HasDocs Delete where
   docsFor Proxy (endpoint, action) =

src/Servant/API/Get.hs

@@ -39,7 +39,7 @@ instance ToJSON result => HasServer (Get result) where
 instance FromJSON result => HasClient (Get result) where
   type Client (Get result) = BaseUrl -> EitherT String IO result
   clientWithRoute Proxy req host =
-    performRequest methodGet req 200 host
+    performRequestJSON methodGet req 200 host
 
 instance ToSample a => HasDocs (Get a) where
   docsFor Proxy (endpoint, action) =

src/Servant/API/Post.hs

@@ -42,7 +42,7 @@ instance FromJSON a => HasClient (Post a) where
   type Client (Post a) = BaseUrl -> EitherT String IO a
 
   clientWithRoute Proxy req uri =
-    performRequest methodPost req 201 uri
+    performRequestJSON methodPost req 201 uri
 
 instance ToSample a => HasDocs (Post a) where
   docsFor Proxy (endpoint, action) =

src/Servant/API/Put.hs

@@ -41,7 +41,7 @@ instance FromJSON a => HasClient (Put a) where
   type Client (Put a) = BaseUrl -> EitherT String IO a
 
   clientWithRoute Proxy req host =
-    performRequest methodPut req 200 host
+    performRequestJSON methodPut req 200 host
 
 instance ToSample a => HasDocs (Put a) where
   docsFor Proxy (endpoint, action) =

src/Servant/API/Raw.hs

@@ -1,10 +1,17 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 module Servant.API.Raw where
 
+import Control.Monad.Trans.Either
+import Data.ByteString.Lazy
 import Data.Proxy
+import Network.HTTP.Types
 import Network.Wai
-import Servant.Docs
+import Servant.Client
+import Servant.Common.BaseUrl
+import Servant.Common.Req
+import Servant.Docs hiding (Method)
 import Servant.Server
 
 -- | Endpoint for plugging in your own Wai 'Application's.
@@ -18,6 +25,14 @@ instance HasServer Raw where
   route Proxy rawApplication request respond =
     rawApplication request (respond . succeedWith)
 
+instance HasClient Raw where
+  type Client Raw = Method -> BaseUrl -> EitherT String IO ByteString
+
+  clientWithRoute :: Proxy Raw -> Req -> Client Raw
+  clientWithRoute Proxy req method host =
+    performRequest method req (const True) host
+
+
 instance HasDocs Raw where
   docsFor _proxy (endpoint, action) =
     single endpoint action

src/Servant/Common/Req.hs

@@ -77,9 +77,13 @@ __withGlobalManager action = modifyMVar __manager $ \ manager -> do
   result <- action manager
   return (manager, result)
 
-performRequest :: FromJSON result =>
+
-  Method -> Req -> Int -> BaseUrl -> EitherT String IO result
+displayHttpRequest :: Method -> String
-performRequest method req wantedStatus host = do
+displayHttpRequest method = "HTTP " ++ cs method ++ " request"
+
+
+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO ByteString
+performRequest method req isWantedStatus host = do
   partialRequest <- liftIO $ reqToRequest req host
 
   let request = partialRequest { Client.method = method
@@ -90,22 +94,28 @@ performRequest method req wantedStatus host = do
     Client.httpLbs request manager
   case eResponse of
     Left status ->
-      left (requestString ++ " failed with status: " ++ showStatus status)
+      left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)
 
     Right response -> do
       let status = Client.responseStatus response
-      when (statusCode status /= wantedStatus) $
+      unless (isWantedStatus (statusCode status)) $
-        left (requestString ++ " failed with status: " ++ showStatus status)
+        left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)
-      result <- either
+      return $ Client.responseBody response
-        (\ message -> left (requestString ++ " returned invalid json: " ++ message))
-        return
-        (decodeLenient (Client.responseBody response))
-      return result
   where
-    requestString = "HTTP " ++ cs method ++ " request"
     showStatus (Status code message) =
       show code ++ " - " ++ cs message
 
+
+performRequestJSON :: FromJSON result =>
+  Method -> Req -> Int -> BaseUrl -> EitherT String IO result
+performRequestJSON method req wantedStatus host = do
+  responseBody <- performRequest method req (== wantedStatus) host
+  either
+    (\ message -> left (displayHttpRequest method ++ " returned invalid json: " ++ message))
+    return
+    (decodeLenient responseBody)
+
+
 catchStatusCodeException :: IO a -> IO (Either Status a)
 catchStatusCodeException action = catch (Right <$> action) $
   \ e -> case e of

test/Servant/ClientSpec.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Servant.ClientSpec where
@@ -8,10 +9,12 @@ module Servant.ClientSpec where
 import Control.Concurrent
 import Control.Exception
 import Control.Monad.Trans.Either
+import Data.ByteString.Lazy (ByteString)
 import Data.Char
 import Data.Foldable (forM_)
 import Data.Proxy
 import Data.Typeable
+import Network.HTTP.Types
 import Network.Socket
 import Network.Wai
 import Network.Wai.Handler.Warp
@@ -33,6 +36,8 @@ type Api =
   :<|> "param" :> QueryParam "name" String :> Get Person
   :<|> "params" :> QueryParams "names" String :> Get [Person]
   :<|> "flag" :> QueryFlag "flag" :> Get Bool
+  :<|> "rawSuccess" :> Raw
+  :<|> "rawFailure" :> Raw
   :<|> "multiple" :>
             Capture "first" String :>
             QueryParam "second" Int :>
@@ -53,6 +58,8 @@ server = serve api (
                    Nothing -> left (400, "missing parameter"))
   :<|> (\ names -> return (zipWith Person names [0..]))
   :<|> return
+  :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
+  :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
   :<|> \ a b c d -> return (a, b, c, d)
  )
 
@@ -65,6 +72,8 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person
 getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
 getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
 getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
+getRawSuccess :: Method -> BaseUrl -> EitherT String IO ByteString
+getRawFailure :: Method -> BaseUrl -> EitherT String IO ByteString
 getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
   -> BaseUrl
   -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
@@ -74,6 +83,8 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
  :<|> getQueryParam
  :<|> getQueryParams
  :<|> getQueryFlag
+ :<|> getRawSuccess
+ :<|> getRawFailure
  :<|> getMultiple)
     = client api