snoyberg/keter
1
1
Fork 0
mirror of https://github.com/snoyberg/keter.git synced 2024-12-14 08:05:40 +03:00
Code Issues Projects Releases Wiki Activity

Debugging - print chunk sizes of HTTP bodies through proxy

Browse Source
This commit is contained in:
Aaron Friel 2013-03-24 13:33:36 -05:00
parent 6a8fb4db82
commit e8b6c7c7f6
2 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Keter/ReverseProxy.hs
View File

@ -151,12 +151,16 @@ hasLegacyMessageLength headers =
handleLegacyMessage :: Status -> ResponseHeaders -> ResumableSource (ResourceT IO) S.ByteString -> ResourceT IO Wai.Response
handleLegacyMessage status headers body = do
liftIO $ print "Pre consume"
content <- body $$+- (CL.isolate 100 =$ CL.consume >>= return)
content <- body $$+- (CL.mapM (liftIO . go) =$ CL.isolate 100 =$ CL.consume)
liftIO $ print "Post consume"
return $
case content of
[] -> Wai.ResponseBuilder status headers flush
(x:_) -> Wai.ResponseBuilder status headers (foldl1 (<>) $ map fromByteString content)
where
go s = do
putStrLn $ "Received chunk of size: " ++ show (S.length s)
return s
-- Simply map the output of the HTTP-Conduit to a response without unwrapping the base ResourceT.
mapResponse :: Status -> ResponseHeaders -> (Source (ResourceT IO) S.ByteString, (ResourceT IO) ()) -> Wai.Response
@ -169,7 +173,7 @@ simpleReverseProxy (RPEntry (ReverseProxyConfig h p _ ssl respRules reqRules) mg
let proxiedRequest = def
{ method = Wai.requestMethod request
, secure = ssl
, host = encodeUtf8 $ h
, host = encodeUtf8 h
, port = p
, path = Wai.rawPathInfo request
, queryString = Wai.rawQueryString request
@ -183,12 +187,12 @@ simpleReverseProxy (RPEntry (ReverseProxyConfig h p _ ssl respRules reqRules) mg
}
response <- http proxiedRequest mgr
let status = responseStatus response
respHeaders = (filterHeaders $ map (rewriteHeader respRuleMap) (responseHeaders response))
respHeaders = filterHeaders $ map (rewriteHeader respRuleMap) (responseHeaders response)
-- hasLegacyMessageLength checks the response headers before stripping out
-- transfer encoding, content length fields
case hasLegacyMessageLength (responseHeaders response) of
True -> handleLegacyMessage status respHeaders (responseBody response)
False -> mapResponse status respHeaders <$> (unwrapResumable $ responseBody response)
if hasLegacyMessageLength (responseHeaders response)
then handleLegacyMessage status respHeaders (responseBody response)
else mapResponse status respHeaders <$> unwrapResumable (responseBody response)
where
reqRuleMap = Map.fromList . map (\k -> (CI.mk . encodeUtf8 $ ruleHeader k, k)) $ Set.toList reqRules
respRuleMap = Map.fromList . map (\k -> (CI.mk . encodeUtf8 $ ruleHeader k, k)) $ Set.toList respRules
@ -196,5 +200,4 @@ simpleReverseProxy (RPEntry (ReverseProxyConfig h p _ ssl respRules reqRules) mg
useHeader ("Content-Length", _) = False
useHeader ("Host", _) = False
useHeader _ = True
filterHeaders = filter useHeader
filterHeaders = filter useHeader

2
keter.cabal
View File

@ -49,7 +49,7 @@ Library
, http-types
, regex-tdfa >= 1.1
, attoparsec >= 0.10
, http-conduit >= 1.9
, http-conduit >= 1.9.2.3
, case-insensitive
, array
Exposed-Modules: Keter.Process