http-conduit、snap 和 lazy IO

http-conduit, snap and lazy IO

我有两个使用 snap 框架 json api 的 http 服务器

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

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

显示也没有成功。

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

中间解决方案是添加 urlEncode 并进行严格的 ByteString

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

当然你必须相应地改变导入。

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