forked from erikd/http-proxy
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
And add it to the cabal file.
- Loading branch information
Showing
2 changed files
with
43 additions
and
10 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,27 +1,48 @@ | ||
{-# LANGUAGE OverloadedStrings #-} | ||
|
||
import Network.HTTP.Proxy (ProxySettings (..), Request (..)) | ||
import qualified Data.ByteString.Char8 as BS | ||
|
||
import Network.HTTP.Proxy (Settings (..), Request (..)) | ||
import qualified Network.HTTP.Proxy as Proxy | ||
import Network.URI (URI (..), URIAuth (..), parseURI) | ||
import Network.Wai.Internal (Response) | ||
|
||
main :: IO () | ||
main = | ||
Proxy.runProxySettings $ | ||
Proxy.defaultProxySettings | ||
{ proxyPort = 31081 | ||
, proxyHttpRequestModifier = Just secureGoogle | ||
, proxyHttpRequestModifier = secureGoogle | ||
} | ||
|
||
-- Modifying the request like this is only possible for unencrypted HTTP connections | ||
-- by my be useful for eg redirecting HTTP to HTTPS. | ||
-- HTTPS cnnections cannot be modified like this because the for HTTPS connections | ||
-- even the request itself is encrypted. | ||
|
||
secureGoogle :: Request -> IO Request | ||
secureGoogle req | ||
| "www.google.com" `BS.isInfixOf` requestPath req | ||
&& not ("https" `BS.isprefixOf` requestPath req = | ||
pure $ req | ||
{ requestPath = "encrypted.google.com" | ||
} | ||
secureGoogle :: Request -> IO (Either Response Request) | ||
secureGoogle req = do | ||
case parseURI $ BS.unpack (requestPath req) of | ||
Nothing -> do | ||
putStrLn $ "Not able to parse: " ++ show (requestPath req) | ||
-- Not much to be done other than just return the Request unmodified. | ||
pure $ Right req | ||
Just uri -> | ||
pure . Right $ req { requestPath = BS.pack $ show (modifyURI uri) } | ||
|
||
modifyURI :: URI -> URI | ||
modifyURI uri = | ||
uri | ||
{ uriAuthority = modifyUriAthority <$> uriAuthority uri | ||
, uriScheme = modifyUriScheme (uriScheme uri) | ||
} | ||
where | ||
modifyUriAthority :: URIAuth -> URIAuth | ||
modifyUriAthority auth = | ||
if uriRegName auth == "www.google.com" | ||
then auth { uriRegName = "encrypted.google.com", uriPort = "" } | ||
else auth | ||
|
||
| otherwise = pure req | ||
modifyUriScheme :: String -> String | ||
modifyUriScheme scheme = | ||
if scheme =="http:" then "https:" else scheme |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters