summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2019-04-30 13:29:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-04-30 13:29:00 (GMT)
commitc759a2f9eda2fed6af5b610bafb128a4a231c06e (patch)
treebe555df9069342d97c980874cb1eb8a9ed63517c
parent92311aba7f16c4a1eb2673242d6284913d126daa (diff)
version 2.3.7.1HEAD2.3.7.1master
-rw-r--r--ChangeLog.md4
-rw-r--r--Network/HTTP/Simple.hs3
-rw-r--r--http-conduit.cabal2
-rw-r--r--test/main.hs17
4 files changed, 19 insertions, 7 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index f56104b..196e610 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,9 @@
# ChangeLog for http-conduit
+## 2.3.7.1
+
+* Properly skip whitespace after JSON body [#401](https://github.com/snoyberg/http-client/issues/401)
+
## 2.3.7
* Ensure entire JSON response body is consumed [#395](https://github.com/snoyberg/http-client/issues/395)
diff --git a/Network/HTTP/Simple.hs b/Network/HTTP/Simple.hs
index ff0b1e7..a7d7939 100644
--- a/Network/HTTP/Simple.hs
+++ b/Network/HTTP/Simple.hs
@@ -106,6 +106,7 @@ import Control.Monad.Trans.Resource (MonadResource, MonadThrow)
import qualified Control.Exception as E (bracket)
import Data.Void (Void)
import qualified Data.Attoparsec.ByteString as Atto
+import qualified Data.Attoparsec.ByteString.Char8 as Atto8
-- | Perform an HTTP request and return the body as a @ByteString@.
--
@@ -153,7 +154,7 @@ httpJSONEither req = liftIO $ httpSink req' sink
where
req' = addRequestHeader H.hAccept "application/json" req
sink orig = fmap (\x -> fmap (const x) orig) $ do
- eres1 <- C.sinkParserEither (json' <* Atto.endOfInput)
+ eres1 <- C.sinkParserEither (json' <* (Atto8.skipSpace *> Atto.endOfInput))
case eres1 of
Left e -> return $ Left $ JSONParseException req' orig e
diff --git a/http-conduit.cabal b/http-conduit.cabal
index 7a32cf9..a163da5 100644
--- a/http-conduit.cabal
+++ b/http-conduit.cabal
@@ -1,5 +1,5 @@
name: http-conduit
-version: 2.3.7
+version: 2.3.7.1
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
diff --git a/test/main.hs b/test/main.hs
index 599b76c..411506f 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -463,11 +463,15 @@ main = do
res <- I.readIORef ref
res `shouldBe` qs
- describe "Simple" $ do
- it "JSON" $ jsonApp $ \port -> do
+ describe "Simple.JSON" $ do
+ it "normal" $ jsonApp $ \port -> do
req <- parseUrlThrow $ "http://localhost:" ++ show port
value <- Simple.httpJSON req
responseBody value `shouldBe` jsonValue
+ it "trailing whitespace" $ jsonApp $ \port -> do
+ req <- parseUrlThrow $ "http://localhost:" ++ show port ++ "/trailing"
+ value <- Simple.httpJSON req
+ responseBody value `shouldBe` jsonValue
it "RequestBodyIO" $ echo $ \port -> do
manager <- newManager tlsManagerSettings
@@ -607,11 +611,14 @@ rawApp bs =
src = yield bs
jsonApp :: (Int -> IO ()) -> IO ()
-jsonApp = withApp $ \_req -> return $ responseLBS
+jsonApp = withApp $ \req -> return $ responseLBS
status200
[ ("Content-Type", "application/json")
- ]
- (A.encode jsonValue)
+ ] $
+ case pathInfo req of
+ [] -> A.encode jsonValue
+ ["trailing"] -> A.encode jsonValue <> " \n\r\n\t "
+ x -> error $ "unsupported: " ++ show x
jsonValue :: A.Value
jsonValue = A.object