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
实例,让库处理这个。
我有两个使用 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
实例,让库处理这个。