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

时间:2017-02-09 17:28:26

标签: haskell servant reflex

我正在使用0.4版本的reflex-dom而且我有一个很小的反射式客户端:

{-# 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"

XhrRequest with reflex/reflex-dom中所述,我使用的是 _xhrResponse_responseText 而不是 decodeXhrResponse

当我使用NASA URL运行此客户端时,它会显示一个不错的JSON字符串。因此,我认为,这个反射式客户端正在运行。

我也有一个小仆人服务器:

{-# 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!!"

当我使用http://localhost:8080/name/3curl在浏览器中访问此服务器时,我看到了预期结果Marie Curie。因此我假设,这个servant服务器正在运行。

当我使用localhost的URL运行上面的reflex-dom客户端时,我可以在服务器的stdout日志中看到请求,但客户端 NOT 显示玛丽居里。相反,客户端只显示一个空字符串! 所以作为一个团队,客户端和服务器不能一起工作!为什么呢?

1 个答案:

答案 0 :(得分:3)

您可能正在看到跨源资源共享(CORS)问题。您可以通过检查浏览器控制台查看如下错误来验证此信息(至少在chrome中):

  

XMLHttpRequest无法加载http://localhost:8080/name/3。没有   &#39;访问控制允许来源&#39;标题出现在请求的上   资源。起源&#39; http://localhost:8000&#39;因此是不允许的   访问。

如果是这种情况,您可以通过替换此行来启用服务器中的CORS:

app = serve userAPI server

这一行:

app = simpleCors (serve userAPI server)

您需要导入wai-cors:

import Network.Wai.Middleware.Cors

这是您的服务方服务器,包含以下更改:

{-# 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!!"