From 09ab1191a5604d297494db0157410c4c69bc294f Mon Sep 17 00:00:00 2001
From: Rick Owens <rick@owenssoftware.com>
Date: Sun, 29 Mar 2015 14:01:43 -0400
Subject: [PATCH 1/2] Removed obsolete HTTP package from dependency list.

This is because it doesn't seem like elm-reactor is using anything in
the HTTP package any more.
---
 elm-reactor.cabal | 1 -
 1 file changed, 1 deletion(-)

diff --git a/elm-reactor.cabal b/elm-reactor.cabal
index bc2f00e..0ba428e 100644
--- a/elm-reactor.cabal
+++ b/elm-reactor.cabal
@@ -78,7 +78,6 @@ Executable elm-reactor
     elm-compiler >= 0.14.1 && < 0.15,
     filepath,
     fsnotify >= 0.1.0.2,
-    HTTP,
     mtl,
     process,
     snap-core,

From 017703342a48023ced112d25bf0cb95435f7eed5 Mon Sep 17 00:00:00 2001
From: Rick Owens <rick@owenssoftware.com>
Date: Sun, 29 Mar 2015 14:01:45 -0400
Subject: [PATCH 2/2] Added --forward command line option.

---
 backend/Main.hs   | 50 +++++++++++++++++++++++++++++++++++++++++++++++
 elm-reactor.cabal |  2 ++
 2 files changed, 52 insertions(+)

diff --git a/backend/Main.hs b/backend/Main.hs
index 25dc079..732bd16 100644
--- a/backend/Main.hs
+++ b/backend/Main.hs
@@ -25,10 +25,18 @@ import qualified Utils
 import Paths_elm_reactor (version)
 import Elm.Utils ((|>))
 
+import Network.HTTP.Client (withManager, defaultManagerSettings, httpLbs,
+  responseStatus, responseHeaders, parseUrl, RequestBody(RequestBodyLBS),
+  responseBody)
+import Network.HTTP.Types(Status(statusCode))
+import qualified Network.HTTP.Client as HTTP (Request(path, method,
+  requestHeaders, requestBody))
+
 
 data Flags = Flags
     { bind :: String
     , port :: Int
+    , forward :: Maybe String
     }
     deriving (Data,Typeable,Show,Eq)
 
@@ -37,6 +45,13 @@ flags :: Flags
 flags = Flags
   { bind = "0.0.0.0" &= help "set the host to bind to (default: 0.0.0.0)" &= typ "SPEC"
   , port = 8000 &= help "set the port of the reactor (default: 8000)"
+  , forward = Nothing &= help (
+      "Forward requests that would otherwise return a 404 to the given\
+      \ server. The path portion of the url is ignored and replaced with\
+      \ the path of the request. This is useful for avoiding cross-origin web\
+      \ requests when using elm-reactor to debug elm programs that make server\
+      \ requests."
+    ) &= typ "URL"
   } &= help "Interactive development tool that makes it easy to develop and debug Elm programs.\n\
             \    Read more about it at <https://github.com/elm-lang/elm-reactor>."
     &= helpArg [explicit, name "help", name "h"]
@@ -66,9 +81,44 @@ main =
           <|> route [ ("socket", socket) ]
           <|> serveDirectoryWith directoryConfig "."
           <|> serveAssets
+          <|> forwardRequest (forward cargs)
           <|> error404
 
 
+forwardRequest :: Maybe String -> Snap ()
+forwardRequest Nothing = pass
+forwardRequest (Just forwardUrl) = do
+  rqHeaders <- getsRequest headers
+  method_ <- getsRequest rqMethod
+  uri <- getsRequest rqURI
+  rqBody <- readRequestBody maxBound
+  request <- makeRequest uri rqHeaders method_ rqBody
+  response <- liftIO $ withManager defaultManagerSettings (httpLbs request)
+  modifyResponse (
+      setHeaders (responseHeaders response)
+      . setResponseCode (statusCode (responseStatus response))
+    )
+  writeLBS (responseBody response)
+  where
+    setHeaders hrds response =
+      foldr (uncurry setHeader) response (filter notSpecial hrds)
+
+    notSpecial ("content-length", _) = False
+    notSpecial _ = True
+
+    makeRequest uri hrds m rqBody = liftIO $ do
+      req <- parseUrl forwardUrl
+      return req {
+        HTTP.path = uri,
+        HTTP.method = showMethod m,
+        HTTP.requestHeaders = listHeaders hrds,
+        HTTP.requestBody = RequestBodyLBS rqBody
+      }
+
+    showMethod (Method m_) = m_
+    showMethod m_ = BSC.pack (show m_)
+
+
 startupMessage :: String
 startupMessage =
   "Elm Reactor " ++ Version.showVersion version
diff --git a/elm-reactor.cabal b/elm-reactor.cabal
index 0ba428e..3db18c1 100644
--- a/elm-reactor.cabal
+++ b/elm-reactor.cabal
@@ -78,6 +78,8 @@ Executable elm-reactor
     elm-compiler >= 0.14.1 && < 0.15,
     filepath,
     fsnotify >= 0.1.0.2,
+    http-client,
+    http-types,
     mtl,
     process,
     snap-core,