Fix request-rewrite-proxy example

And add it to the cabal file.

Author: erikd

Diff for: example/request-rewrite-proxy.hs

@@ -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

Diff for: 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