使用reflex-dom客户端访问服务器服务器

Question

I'm using version 0.4 of reflex-dom and I have a tiny reflex-dom client:

{-# LANGUAGE OverloadedStrings #-}
import Reflex.Dom
import qualified Data.Text as T
import Data.Monoid

main :: IO ()
main = mainWidget body

body :: MonadWidget t m => m ()
body  = el "div" $ do
  pb <- getPostBuild
  snd <- button "Send"
  -- Use one of the following URL's:
  let defReq = "http://localhost:8080/name/3"
  -- let defReq = "https://api.nasa.gov/planetary/apod?api_key=DEMO_KEY"
  let req = XhrRequest "GET" defReq (def {_xhrRequestConfig_sendData = defReq} )
  let evReq = tagPromptlyDyn (constDyn req) snd
  evRsp <- performRequestAsync evReq
  let evResult = (result . _xhrResponse_responseText) <$> evRsp
  el "p" $ return ()
  dynText =<< holdDyn "NOPE" evResult
  return ()

result :: Show a => Maybe a -> T.Text
result (Just x) = "Received: " <> T.pack (show x)
result Nothing = "Response is Nothing"

As described in XhrRequest with reflex/reflex-dom , I'm using _xhrResponse_responseText and not decodeXhrResponse .

When I run this client with the NASA URL, it displays a nice JSON string. Therefore I assume, this reflex-dom client is working.

I have a tiny servant server too:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Servant
import Servant.API
import Servant.Server
import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Logger       (withStdoutLogger)
import qualified Data.Text as T

main :: IO ()
main = withStdoutLogger $ \aplogger -> do
         let settings = setPort 8080 $ setLogger aplogger defaultSettings
         runSettings settings app

app :: Application
app = serve userAPI server

userAPI :: Proxy API    -- API usage:  http://localhost:8080/name/2
userAPI = Proxy

type API = "name" :> Capture "pid" Int :> Get '[PlainText] T.Text

server :: Server API
server =  name

name :: Monad m => Int ->  m T.Text
name pid = return $ nameById pid

nameById :: Int -> T.Text
nameById 1 = "Isaac Newton"
nameById 2 = "Galileo Galilei"
nameById 3 = "Marie Curie"
nameById _ = "UNKNOWN!!"

When I access this server in the browser with http://localhost:8080/name/3 or with curl , I see the expected result Marie Curie . Therefore I assume, this servant server is working.

When I run the above reflex-dom client with the URL of the localhost, I can see the request in the stdout log of the server, but the client does NOT display the name of Marie Curie . Instead the client just displays an empty string! So as a team, the client and the server do not work together! Why?

Answer 1

You probably are seeing Cross-Origin Resource Sharing (CORS) problems. You can verify this (in chrome at least) by checking your browser console for an error that looks like this:

XMLHttpRequest cannot load http://localhost:8080/name/3 . No 'Access-Control-Allow-Origin' header is present on the requested resource. Origin ' http://localhost:8000 ' is therefore not allowed access.

If this is the case, you can enable CORS in your server by replacing this line :

app = serve userAPI server

with this line:

app = simpleCors (serve userAPI server)

You will need to import wai-cors:

import Network.Wai.Middleware.Cors

here is your servant server with these changes:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Servant
import Servant.API
import Servant.Server
import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Logger       (withStdoutLogger)
import Network.Wai.Middleware.Cors
import qualified Data.Text as T

main :: IO ()
main = withStdoutLogger $ \aplogger -> do
         let settings = setPort 8080 $ setLogger aplogger defaultSettings
         runSettings settings app

app :: Application
app = simpleCors (serve userAPI server)

userAPI :: Proxy API    -- API usage:  http://localhost:8080/name/2
userAPI = Proxy

type API = "name" :> Capture "pid" Int :> Get '[PlainText] T.Text

server :: Server API
server =  name

name :: Monad m => Int ->  m T.Text
name pid = return $ nameById pid

nameById :: Int -> T.Text
nameById 1 = "Isaac Newton"
nameById 2 = "Galileo Galilei"
nameById 3 = "Marie Curie"
nameById _ = "UNKNOWN!!"