Cleanup

servant-client-core/src/Servant/Client/Core/Internal/Request.hs

@@ -107,53 +107,3 @@ setRequestBodyLBS b t req
 --
 setRequestBody :: RequestBody -> MediaType -> Request -> Request
 setRequestBody b t req = req { requestBody = Just (b, t) }
-
-{-reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request-}
-{-reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =-}
-    {-setheaders . setAccept . setrqb . setQS <$> parseRequest url-}
-
-  {-where url = show $ nullURI { uriScheme = case reqScheme of-}
-                                  {-Http  -> "http:"-}
-                                  {-Https -> "https:"-}
-                             {-, uriAuthority = Just $-}
-                                 {-URIAuth { uriUserInfo = ""-}
-                                         {-, uriRegName = reqHost-}
-                                         {-, uriPort = ":" ++ show reqPort-}
-                                         {-}-}
-                             {-, uriPath = fullPath-}
-                             {-}-}
-        {-fullPath = path ++ cs (Builder.toLazyByteString (reqPath req))-}
-
-        {-setrqb r = case reqBody req of-}
-                     {-Nothing -> r-}
-                     {-Just (b,t) -> r { requestBody = b-}
-                                     {-, requestHeaders = requestHeaders r-}
-                                                     {-++ [(hContentType, cs . show $ t)] }-}
-        {-setQS = setQueryString $ queryTextToQuery (qs req)-}
-        {-setheaders r = r { requestHeaders = requestHeaders r-}
-                                         {-<> fmap toProperHeader (headers req) }-}
-        {-setAccept r = r { requestHeaders = filter ((/= "Accept") . fst) (requestHeaders r)-}
-                                        {-<> [("Accept", renderHeader $ reqAccept req)-}
-                                              {-| not . null . reqAccept $ req] }-}
-        {-toProperHeader (name, val) =-}
-          {-(fromString name, encodeUtf8 val)-}
-
-
-    {- #if !MIN_VERSION_http_client(0,4,30)-}
-    {--- 'parseRequest' is introduced in http-client-0.4.30-}
-    {--- it differs from 'parseUrl', by not throwing exceptions on non-2xx http statuses-}
-    {----}
-    {--- See for implementations:-}
-    {--- http://hackage.haskell.org/package/http-client-0.4.30/docs/src/Network-HTTP-Client-Request.html#parseRequest-}
-    {--- http://hackage.haskell.org/package/http-client-0.5.0/docs/src/Network-HTTP-Client-Request.html#parseRequest-}
-    {-parseRequest :: MonadThrow m => String -> m Request-}
-    {-parseRequest url = liftM disableStatusCheck (parseUrl url)-}
-      {-where-}
-        {-disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing }-}
-    {- #endif-}
-
-
-    {--- * performing requests-}
-
-    {-displayHttpRequest :: Method -> String-}
-    {-displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"-}

servant-client/src/Servant/Client/HttpClient.hs

@@ -20,33 +20,24 @@ import           Control.Monad
 import           Control.Monad.Base          (MonadBase (..))
 import           Control.Monad.Catch         (MonadCatch, MonadThrow)
 import           Control.Monad.Error.Class   (MonadError (..))
+import           Control.Monad.Reader
+import           Control.Monad.Trans.Control (MonadBaseControl (..))
+import           Control.Monad.Trans.Except
 import           Data.ByteString.Builder     (toLazyByteString)
 import qualified Data.ByteString.Lazy        as BSL
+import           Data.Foldable               (toList)
+import           Data.Functor.Alt            (Alt (..))
 import           Data.Monoid                 ((<>))
 import           Data.String                 (fromString)
 import qualified Data.Text                   as T
 import           GHC.Exts                    (fromList)
-{-import           Control.Monad.IO.Class      ()-}
-import           Control.Monad.Reader
-import           Control.Monad.Trans.Control (MonadBaseControl (..))
-import           Control.Monad.Trans.Except
-{-import           Data.ByteString.Lazy        hiding (any, elem, filter, map,-}
-                                              {-null, pack)-}
-import           Data.Foldable               (toList)
-import           Data.Functor.Alt            (Alt (..))
-import           Data.Proxy
-{-import           Data.String.Conversions     (cs)-}
 import           GHC.Generics
-import           Network.HTTP.Media          (parseAccept, renderHeader, (//))
+import           Network.HTTP.Media          (renderHeader)
 import           Network.HTTP.Types          (hContentType, renderQuery,
                                               statusCode)
-{-import           Servant.API.ContentTypes-}
 import           Servant.Client.Core
-{-import           Servant.Common.BaseUrl-}
-{-import           Servant.Common.Req-}
 
 import qualified Network.HTTP.Client         as Client
-{-import qualified Network.HTTP.Types.Header   as HTTP-}
 
 data ClientEnv
   = ClientEnv
@@ -97,15 +88,8 @@ performRequest req = do
     Left err -> throwError $ err
     Right response -> do
       let status = Client.responseStatus response
-          body = Client.responseBody response
-          hdrs = Client.responseHeaders response
           status_code = statusCode status
           ourResponse = clientResponseToReponse response
-      ct <- case lookup "Content-Type" $ Client.responseHeaders response of
-                 Nothing -> pure $ "application"//"octet-stream"
-                 Just t -> case parseAccept t of
-                   Nothing -> throwError $ InvalidContentTypeHeader ourResponse
-                   Just t' -> pure t'
       unless (status_code >= 200 && status_code < 300) $
         throwError $ FailureResponse ourResponse
       return ourResponse
@@ -135,24 +119,8 @@ requestToClientRequest burl r = Client.defaultRequest
   where
     (body, contentTypeHdr) = case requestBody r of
       Nothing -> (Client.RequestBodyLBS "", Nothing)
-      Just (RequestBodyLBS body, typ)
+      Just (RequestBodyLBS body', typ)
-        -> (Client.RequestBodyLBS body, Just (hContentType, renderHeader typ))
+        -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))
-
-{-performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req-}
-    {--> ClientM ([HTTP.Header], result)-}
-{-performRequestCT ct reqMethod req = do-}
-  {-let acceptCTS = contentTypes ct-}
-  {-(_status, respBody, respCT, hdrs, _response) <--}
-    {-performRequest reqMethod (req { reqAccept = toList acceptCTS })-}
-  {-unless (any (matches respCT) acceptCTS) $ throwError $ UnsupportedContentType respCT respBody-}
-  {-case mimeUnrender ct respBody of-}
-    {-Left err -> throwError $ DecodeFailure err respCT respBody-}
-    {-Right val -> return (hdrs, val)-}
-
-{-performRequestNoBody :: Method -> Req -> ClientM [HTTP.Header]-}
-{-performRequestNoBody reqMethod req = do-}
-  {-(_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req-}
-  {-return hdrs-}
 
 catchConnectionError :: IO a -> IO (Either ServantError a)
 catchConnectionError action =