Skip to content

Instantly share code, notes, and snippets.

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