2

我有两个使用 snap 框架的 json api 的 http-servers

我的第一个原型包含一个类似于这个示例处理程序的处理程序

import           Data.ByteString (ByteString)
import           Data.ByteString.Char8 as B (unwords, putStrLn)
import           Data.ByteString.Lazy.Char8 as L (putStrLn)
import           Control.Monad.IO.Class (liftIO)
import           Data.Monoid ((<>))
import           Snap.Core (getParam, modifyResponse, setHeader, writeLBS) 
import           Network.HTTP.Conduit
import           Network.HTTP.Client (defaultManagerSettings)


exampleHandler :: AppHandler ()
exampleHandler = do resp <- liftIO
                         $ do L.putStrLn "Begin request ..."
                              initReq <- parseUrl "http://localhost:8001/api"
                              manager <- newManager defaultManagerSettings
                              let req  = initReq { method = "GET"
                                                 , proxy = Nothing}
                              r <- httpLbs req manager
                              L.putStrLn "... finished request."
                              return $ responseBody r
                    liftIO . L.putStrLn $ "resp: " <> resp
                    modifyResponse $ setHeader "Content-Type" "application/json"
                    writeLBS $ "{ \"data\": \""<> resp <>"\" }"

如果我发出 ajax 请求，则会发送和接收响应 - 当服务器resp: testdata在控制台上写入时我会看到这一点，但发送到浏览器的响应writeLBS却不是。现在，如果我将最后一行更改为

                    writeLBS $ "{ \"data\": \""<> "something fixed" <>"\" }"

一切都像魅力一样。我想我遇到了惰性 IO 的陷阱之一，但我不知道如何解决这个问题。

我还尝试了一些没有单liftIO块但放在liftIO必要的地方的变体。

编辑

根据@MichaelSnoyman 的评论，我做了一些研究writeLBS并试图

               modifyResponse $ setBufferingMode False
                              . setHeader "Content-Type" "application/json"
               writeLBS resp

正如我认为的那样，缓冲可能是问题 - 不，不是

此外，我试图明确地写一个setResponseBody

               let bb = enumBuilder . fromLazyByteString $ "{ \"data\": \""<> resp <>"\" }"
               modifyResponse $ setBufferingMode False
                              . setHeader "Content-Type" "application/json"
                              . setResponseBody bb

这也表明没有成功。

4

1 回答 1

0

我已经解决了这个问题 - 实际上是 javascript 获取手写 json 的问题（自我注意：永远不要再这样做了）。输入数据末尾有一个未正确编码的不间断空格，而我是 JS 的新手，我没有从错误消息中得到它。

中间解决方案是添加urlEncode并制作严格的ByteString

               let respB = urlEncode . L.toStrict $ C.responseBody resp
               modifyResponse $ setBufferingMode False
                              . setHeader "Content-Type" "application/json"
               writeBS $ "{ \"data\": \"" <> respB <> "\" }"

当然，您必须相应地更改导入。

长期的解决方案是：编写一个适当的from/toJSON实例并让库处理这个问题。

于 2015-10-21T08:21:08.377 回答