Last active
November 3, 2017 19:01
-
-
Save adnelson/2a74242f757ffa222732f85488fccc6f to your computer and use it in GitHub Desktop.
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
-- | 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 | |
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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment