{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP.Client.Response
( getRedirectedRequest
, getResponse
, lbsResponse
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import qualified Data.CaseInsensitive as CI
import Control.Arrow (second)
import Data.Monoid (mempty)
import qualified Network.HTTP.Types as W
import Network.URI (parseURIReference, escapeURIString, isAllowedInURI)
import Network.HTTP.Client.Types
import Network.HTTP.Client.Request
import Network.HTTP.Client.Util
import Network.HTTP.Client.Body
import Network.HTTP.Client.Headers
import Data.KeyedPool
getRedirectedRequest :: Request -> W.ResponseHeaders -> CookieJar -> Int -> Maybe Request
getRedirectedRequest req hs cookie_jar code
| 300 <= code && code < 400 = do
l' <- lookup "location" hs
let l = escapeURIString isAllowedInURI (S8.unpack l')
req' <- setUriRelative req =<< parseURIReference l
return $
if code == 302 || code == 303
then req'
{ method = "GET"
, requestBody = RequestBodyBS ""
, cookieJar = cookie_jar'
, requestHeaders = filter ((/= W.hContentType) . fst) $ requestHeaders req'
}
else req' {cookieJar = cookie_jar'}
| otherwise = Nothing
where
cookie_jar' = fmap (const cookie_jar) $ cookieJar req
lbsResponse :: Response BodyReader -> IO (Response L.ByteString)
lbsResponse res = do
bss <- brConsume $ responseBody res
return res
{ responseBody = L.fromChunks bss
}
getResponse :: Maybe Int
-> Request
-> Managed Connection
-> Maybe (IO ())
-> IO (Response BodyReader)
getResponse timeout' req@(Request {..}) mconn cont = do
let conn = managedResource mconn
StatusHeaders s version hs <- parseStatusHeaders conn timeout' cont
let mcl = lookup "content-length" hs >>= readDec . S8.unpack
isChunked = ("transfer-encoding", CI.mk "chunked") `elem` map (second CI.mk) hs
toPut = Just "close" /= lookup "connection" hs && version > W.HttpVersion 1 0
cleanup bodyConsumed = managedRelease mconn $ if toPut && bodyConsumed then Reuse else DontReuse
body <-
if hasNoBody method (W.statusCode s) || (mcl == Just 0 && not isChunked)
then do
cleanup True
return brEmpty
else do
body1 <-
if isChunked
then makeChunkedReader rawBody conn
else
case mcl of
Just len -> makeLengthReader len conn
Nothing -> makeUnlimitedReader conn
body2 <- if needsGunzip req hs
then makeGzipReader body1
else return body1
return $ brAddCleanup (cleanup True) body2
return Response
{ responseStatus = s
, responseVersion = version
, responseHeaders = hs
, responseBody = body
, responseCookieJar = Data.Monoid.mempty
, responseClose' = ResponseClose (cleanup False)
}
hasNoBody :: ByteString
-> Int
-> Bool
hasNoBody "HEAD" _ = True
hasNoBody _ 204 = True
hasNoBody _ 304 = True
hasNoBody _ i = 100 <= i && i < 200