eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

servant: allow whitespace before JSON

Browse Source
This commit is contained in:
Christian Marie 2015-05-16 12:40:26 +10:00
parent 43d0620403
commit 54131821a5
2 changed files with 28 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
servant/src/Servant/API/ContentTypes.hs
View File

@ -66,30 +66,31 @@ module Servant.API.ContentTypes
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<*))
import Control.Applicative ((*>), (<*))
#endif
import Control.Arrow (left)
import Control.Arrow (left)
import Control.Monad
import Data.Aeson (FromJSON, ToJSON, encode,
parseJSON)
import Data.Aeson.Parser (value)
import Data.Aeson.Types (parseEither)
import Data.Aeson (FromJSON, ToJSON, encode,
parseJSON)
import Data.Aeson.Parser (value)
import Data.Aeson.Types (parseEither)
import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,
skipSpace, (<?>))
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString, fromStrict,
toStrict)
import qualified Data.ByteString.Lazy as B
import Data.Monoid
import Data.String.Conversions (cs)
import qualified Data.Text as TextS
import qualified Data.Text.Encoding as TextS
import qualified Data.Text.Lazy as TextL
import qualified Data.Text.Lazy.Encoding as TextL
import Data.String.Conversions (cs)
import qualified Data.Text as TextS
import qualified Data.Text.Encoding as TextS
import qualified Data.Text.Lazy as TextL
import qualified Data.Text.Lazy.Encoding as TextL
import Data.Typeable
import GHC.Exts (Constraint)
import qualified Network.HTTP.Media as M
import Network.URI (escapeURIString, isUnreserved,
unEscapeString)
import GHC.Exts (Constraint)
import qualified Network.HTTP.Media as M
import Network.URI (escapeURIString,
isUnreserved, unEscapeString)
-- * Provided content types
data JSON deriving Typeable
@ -304,10 +305,10 @@ eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input =
parseOnly parser (cs input) >>= parseEither parseJSON
where
parser =
Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")
parser = skipSpace
*> Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")
-- | `eitherDecode`
instance FromJSON a => MimeUnrender JSON a where

8
servant/test/Servant/API/ContentTypesSpec.hs
View File

@ -8,15 +8,15 @@ module Servant.API.ContentTypesSpec where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
import Data.Monoid
#endif
import Control.Arrow
import Data.Either
import Data.Aeson
import Data.Aeson.Parser (jstring)
import Data.Attoparsec.ByteString (parseOnly)
import Data.Either
import Data.Function (on)
import Data.Proxy
import Data.ByteString.Char8 (ByteString, append, pack)
import qualified Data.ByteString.Lazy as BSL
import Data.List (maximumBy)
@ -26,7 +26,6 @@ import Data.String.Conversions (cs)
import qualified Data.Text as TextS
import qualified Data.Text.Lazy as TextL
import GHC.Generics
import Data.Monoid
import Network.URL (exportParams, importParams)
import Test.Hspec
import Test.QuickCheck
@ -43,6 +42,9 @@ spec = describe "Servant.API.ContentTypes" $ do
it "handles whitespace at end of input" $ do
mimeUnrender p "[1] " `shouldBe` Right [1 :: Int]
it "handles whitespace at beginning of input" $ do
mimeUnrender p " [1] " `shouldBe` Right [1 :: Int]
it "does not like junk at end of input" $ do
mimeUnrender p "[1] this probably shouldn't work"
`shouldSatisfy` (isLeft :: Either a [Int] -> Bool)