f44ab3d · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Cleanup

f44ab3dJulian K. Arni9 years ago

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

compare with master

unifiedsplit

@@ -107,53 +107,3 @@ setRequestBodyLBS b t req

107--

108setRequestBody :: RequestBody -> MediaType -> Request -> Request

109setRequestBody b t req = req { requestBody = Just (b, t) }

110−

111−{-reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request-}

112−{-reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =-}

113− {-setheaders . setAccept . setrqb . setQS <$> parseRequest url-}

114−

115− {-where url = show $ nullURI { uriScheme = case reqScheme of-}

116− {-Http -> "http:"-}

117− {-Https -> "https:"-}

118− {-, uriAuthority = Just $-}

119− {-URIAuth { uriUserInfo = ""-}

120− {-, uriRegName = reqHost-}

121− {-, uriPort = ":" ++ show reqPort-}

122− {-}-}

123− {-, uriPath = fullPath-}

124− {-}-}

125− {-fullPath = path ++ cs (Builder.toLazyByteString (reqPath req))-}

126−

127− {-setrqb r = case reqBody req of-}

128− {-Nothing -> r-}

129− {-Just (b,t) -> r { requestBody = b-}

130− {-, requestHeaders = requestHeaders r-}

131− {-++ [(hContentType, cs . show $ t)] }-}

132− {-setQS = setQueryString $ queryTextToQuery (qs req)-}

133− {-setheaders r = r { requestHeaders = requestHeaders r-}

134− {-<> fmap toProperHeader (headers req) }-}

135− {-setAccept r = r { requestHeaders = filter ((/= "Accept") . fst) (requestHeaders r)-}

136− {-<> [("Accept", renderHeader $ reqAccept req)-}

137− {-| not . null . reqAccept $ req] }-}

138− {-toProperHeader (name, val) =-}

139− {-(fromString name, encodeUtf8 val)-}

140−

141−

142− {- #if !MIN_VERSION_http_client(0,4,30)-}

143− {--- 'parseRequest' is introduced in http-client-0.4.30-}

144− {--- it differs from 'parseUrl', by not throwing exceptions on non-2xx http statuses-}

145− {----}

146− {--- See for implementations:-}

147− {--- http://hackage.haskell.org/package/http-client-0.4.30/docs/src/Network-HTTP-Client-Request.html#parseRequest-}

148− {--- http://hackage.haskell.org/package/http-client-0.5.0/docs/src/Network-HTTP-Client-Request.html#parseRequest-}

149− {-parseRequest :: MonadThrow m => String -> m Request-}

150− {-parseRequest url = liftM disableStatusCheck (parseUrl url)-}

151− {-where-}

152− {-disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing }-}

153− {- #endif-}

154−

155−

156− {--- * performing requests-}

157−

158− {-displayHttpRequest :: Method -> String-}

159− {-displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"-}

servant-client/src/Servant/Client/HttpClient.hs+8−40

@@ -20,33 +20,24 @@ import Control.Monad

20import Control.Monad.Base (MonadBase (..))

21import Control.Monad.Catch (MonadCatch, MonadThrow)

22import Control.Monad.Error.Class (MonadError (..))

23+import Control.Monad.Reader

24+import Control.Monad.Trans.Control (MonadBaseControl (..))

25+import Control.Monad.Trans.Except

23import Data.ByteString.Builder (toLazyByteString)

26import Data.ByteString.Builder (toLazyByteString)

24import qualified Data.ByteString.Lazy as BSL

27import qualified Data.ByteString.Lazy as BSL

28+import Data.Foldable (toList)

29+import Data.Functor.Alt (Alt (..))

25import Data.Monoid ((<>))

30import Data.Monoid ((<>))

26import Data.String (fromString)

31import Data.String (fromString)

27import qualified Data.Text as T

32import qualified Data.Text as T

28import GHC.Exts (fromList)

33import GHC.Exts (fromList)

29−{-import Control.Monad.IO.Class ()-}

30−import Control.Monad.Reader

31−import Control.Monad.Trans.Control (MonadBaseControl (..))

32−import Control.Monad.Trans.Except

33−{-import Data.ByteString.Lazy hiding (any, elem, filter, map,-}

34− {-null, pack)-}

35−import Data.Foldable (toList)

36−import Data.Functor.Alt (Alt (..))

37−import Data.Proxy

38−{-import Data.String.Conversions (cs)-}

39import GHC.Generics

34import GHC.Generics

40−import Network.HTTP.Media (parseAccept, renderHeader, (//))

35+import Network.HTTP.Media (renderHeader)

41import Network.HTTP.Types (hContentType, renderQuery,

36import Network.HTTP.Types (hContentType, renderQuery,

42 statusCode)

37 statusCode)

43−{-import Servant.API.ContentTypes-}

44import Servant.Client.Core

38import Servant.Client.Core

45−{-import Servant.Common.BaseUrl-}

46−{-import Servant.Common.Req-}

48import qualified Network.HTTP.Client as Client

40import qualified Network.HTTP.Client as Client

49−{-import qualified Network.HTTP.Types.Header as HTTP-}

51data ClientEnv

42data ClientEnv

52 = ClientEnv

43 = ClientEnv

@@ -97,15 +88,8 @@ performRequest req = do

97 Left err -> throwError $ err

88 Left err -> throwError $ err

98 Right response -> do

89 Right response -> do

99 let status = Client.responseStatus response

90 let status = Client.responseStatus response

100− body = Client.responseBody response

101− hdrs = Client.responseHeaders response

102 status_code = statusCode status

91 status_code = statusCode status

103 ourResponse = clientResponseToReponse response

92 ourResponse = clientResponseToReponse response

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

105− Nothing -> pure $ "application"//"octet-stream"

106− Just t -> case parseAccept t of

107− Nothing -> throwError $ InvalidContentTypeHeader ourResponse

108− Just t' -> pure t'

109 unless (status_code >= 200 && status_code < 300) $

93 unless (status_code >= 200 && status_code < 300) $

110 throwError $ FailureResponse ourResponse

94 throwError $ FailureResponse ourResponse

111 return ourResponse

95 return ourResponse

@@ -135,24 +119,8 @@ requestToClientRequest burl r = Client.defaultRequest

135 where

119 where

136 (body, contentTypeHdr) = case requestBody r of

120 (body, contentTypeHdr) = case requestBody r of

137 Nothing -> (Client.RequestBodyLBS "", Nothing)

121 Nothing -> (Client.RequestBodyLBS "", Nothing)

138− Just (RequestBodyLBS body, typ)

122+ Just (RequestBodyLBS body', typ)

139− -> (Client.RequestBodyLBS body, Just (hContentType, renderHeader typ))

123+ -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))

140−

141−{-performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req-}

142− {--> ClientM ([HTTP.Header], result)-}

143−{-performRequestCT ct reqMethod req = do-}

144− {-let acceptCTS = contentTypes ct-}

145− {-(_status, respBody, respCT, hdrs, _response) <--}

146− {-performRequest reqMethod (req { reqAccept = toList acceptCTS })-}

147− {-unless (any (matches respCT) acceptCTS) $ throwError $ UnsupportedContentType respCT respBody-}

148− {-case mimeUnrender ct respBody of-}

149− {-Left err -> throwError $ DecodeFailure err respCT respBody-}

150− {-Right val -> return (hdrs, val)-}

151−

152−{-performRequestNoBody :: Method -> Req -> ClientM [HTTP.Header]-}

153−{-performRequestNoBody reqMethod req = do-}

154− {-(_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req-}

155− {-return hdrs-}

156

124

157catchConnectionError :: IO a -> IO (Either ServantError a)

125catchConnectionError :: IO a -> IO (Either ServantError a)

158catchConnectionError action =

126catchConnectionError action =