diff --git a/example/request-rewrite-proxy.hs b/example/request-rewrite-proxy.hs index a070937..d1badfb 100644 --- a/example/request-rewrite-proxy.hs +++ b/example/request-rewrite-proxy.hs @@ -1,14 +1,18 @@ {-# 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 @@ -16,12 +20,29 @@ main = -- 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 diff --git a/http-proxy.cabal b/http-proxy.cabal index 949aa93..8ea0e46 100644 --- a/http-proxy.cabal +++ b/http-proxy.cabal @@ -154,3 +154,15 @@ executable simple-proxy build-depends: base , http-proxy + +executable request-rewrite-proxy + default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs -threaded -rtsopts "-with-rtsopts=-H1m -K1m" + hs-source-dirs: example + main-is: request-rewrite-proxy.hs + + build-depends: base + , bytestring + , http-proxy + , network-uri + , wai