adnelson · November 3, 2017 19:01 · Nov 3, 2017 · Nov 3, 2017 · Nov 3, 2017
diff --git a/GHCJSiProxyExample.hs b/GHCJSiProxyExample.hs
@@ -1,5 +1,25 @@
-module GHCJSiProxyExample where
-
+-- | Optionally set up a reverse HTTP proxy to a ghcjsi server.
+-- 
+-- The idea here is that you are working on an application which has a 
+-- GHCJS frontend and a GHC backend. The backend delivers the front-end 
+-- JavaScript to the browser, and also provides some kind of REST API 
+-- which the frontend uses. The API server is assumed to be the same 
+-- server which serves the frontend code, so that you don't need to set 
+-- up CORS.
+--
+-- When developing on your front-end code, you want to be able to rapidly 
+-- recompile, which is much faster with ghcjsi. However, your front-end 
+-- needs to be able to interact with the backend API over HTTP, which 
+-- means you need to have the API server on the same host as the frontend.
+-- 
+-- The solution presented here is to proxy requests from the back-end to 
+-- the ghcjsi server, while still serving the API as well. Presumably this
+-- is only desirable during development, so I hid it behind a compiler 
+-- flag with CPP, but it could be done with booleans or config or however else.
+--
+-- The "API" is obviously bogus here but in the real world it would be something 
+-- which served the front-end JavaScript object as well as handling API requests.
+--
 import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
 import Network.HTTP.ReverseProxy
 #ifdef PROXY_GHCJSI

diff --git a/GHCJSiProxyExample → GHCJSiProxyExample.hs b/GHCJSiProxyExample → GHCJSiProxyExample.hs
diff --git a/GHCJSiProxyExample b/GHCJSiProxyExample
@@ -0,0 +1,61 @@
+module GHCJSiProxyExample where
+
+import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
+import Network.HTTP.ReverseProxy
+#ifdef PROXY_GHCJSI
+import Network.HTTP.Types.Status (status500)
+#else
+import Network.HTTP.Types.Status (status404)
+#endif
+import Network.Wai (Application, responseLBS)
+import Network.Wai.Handler.Warp (runSettings, defaultSettings, setLogger, setPort)
+import Network.Wai.Logger (withStdoutLogger)
+import Servant ((:<|>)(..), Proxy(..), Server, Raw)
+import Servant ((:>), Get, JSON)
+import Servant.Server (serve)
+import qualified Data.ByteString.Lazy.Char8 as LB8
+
+
+type SomeAPI
+   -- Some information that the backend needs to provide to the frontend
+   =   "info" :> Get '[JSON] Int
+
+   -- Catch-all: either proxy to ghcjsi or throw 404
+   :<|> Raw
+
+implementation :: Manager -> Server SomeAPI
+implementation manager = pure 123 :<|> catchall
+  where
+    catchall :: Application
+#ifdef PROXY_GHCJSI
+    catchall req sendResponse = do
+      -- Proxy the request to the ghcjsi server. You might need to
+      -- modify the path in the request, if this is not on the '/' route.
+      let getDest req = do
+            pure (WPRModifiedRequest req $ ProxyDest "localhost" 6400)
+          -- The function requires an error handler; just send a 500
+          onError err _ sendResp = do
+            sendResp $ responseLBS status500 [] (LB8.pack $ show err)
+      waiProxyTo getDest onError manager req sendResponse
+#else
+    -- Send a 404 response
+    catchall req sendResponse = do
+      let headers = [("Content-Type", "text/html; charset=UTF-8")]
+          path = LB8.fromStrict $ rawPathInfo req
+          method = LB8.pack $ show $ requestMethod req
+          message = concat ["Route ", path, " was not found, or does ",
+                            "not support method ", method, "\n"]
+      sendResponse $ responseLBS status404 headers message
+#endif
+
+
+main :: IO ()
+main = do
+  let port = 3000
+  putStrLn $ concat ["Running on ", show port]
+  manager <- newManager defaultManagerSettings
+  withStdoutLogger $ \appLogger -> do
+    let
+      settings = setPort port $ setLogger appLogger defaultSettings
+      app = implementation manager
+    runSettings settings $ serve (Proxy @ SomeAPI) app