http-проводник, оснастка и ленивый IO

У меня есть два http-сервера, работающие с JSON API, используя фреймворк Snap

мой первый прототип содержит обработчик, похожий на этот пример обработчика

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" <>"\" }"

все работает как шарм. Я думаю, что сталкиваюсь с одной из ловушек ленивого ввода-вывода, но я не знаю, как это исправить.

Я также попробовал несколько вариантов без единого 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

Который также не показал успеха.

1 ответ

Решение

Я решил эту проблему - на самом деле это была проблема с 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 экземпляр и пусть библиотека справится с этим.

Другие вопросы по тегам