GHCJSiProxyExample.hs

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