Merge pull request #84 from haskell-servant/wip-json-decode-eof
fix a bug in our `eitherDecodeLenient` function
This commit is contained in:
Alp Mestanogullari
commit
5c25c56d50
2 changed files with 55 additions and 38 deletions
|
|
@ -66,29 +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, Value,
|
||||
encode, parseJSON)
|
||||
import Data.Aeson.Parser (value)
|
||||
import Data.Aeson.Types (parseEither)
|
||||
import Data.Attoparsec.ByteString (endOfInput, parseOnly)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
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 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
|
||||
|
|
@ -291,10 +293,22 @@ instance MimeRender OctetStream BS.ByteString where
|
|||
|
||||
-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
|
||||
-- objects and arrays.
|
||||
--
|
||||
-- Will handle trailing whitespace, but not trailing junk. ie.
|
||||
--
|
||||
-- >>> eitherDecodeLenient "1 " :: Either String Int
|
||||
-- Right 1
|
||||
--
|
||||
-- >>> eitherDecodeLenient "1 junk" :: Either String Int
|
||||
-- Left "trailing junk after valid JSON: endOfInput"
|
||||
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
|
||||
eitherDecodeLenient input = do
|
||||
v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
|
||||
parseEither parseJSON v
|
||||
eitherDecodeLenient input =
|
||||
parseOnly parser (cs input) >>= parseEither parseJSON
|
||||
where
|
||||
parser = skipSpace
|
||||
*> Data.Aeson.Parser.value
|
||||
<* skipSpace
|
||||
<* (endOfInput <?> "trailing junk after valid JSON")
|
||||
|
||||
-- | `eitherDecode`
|
||||
instance FromJSON a => MimeUnrender JSON a where
|
||||
|
|
|
|||
|
|
@ -8,14 +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.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)
|
||||
|
|
@ -36,54 +37,56 @@ spec :: Spec
|
|||
spec = describe "Servant.API.ContentTypes" $ do
|
||||
|
||||
describe "The JSON Content-Type type" $ do
|
||||
let p = Proxy :: Proxy JSON
|
||||
|
||||
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)
|
||||
|
||||
it "has mimeUnrender reverse mimeRender for valid top-level json ([Int]) " $ do
|
||||
let p = Proxy :: Proxy JSON
|
||||
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::[Int])
|
||||
|
||||
it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
|
||||
let p = Proxy :: Proxy JSON
|
||||
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
|
||||
|
||||
describe "The FormUrlEncoded Content-Type type" $ do
|
||||
|
||||
let isNonNull ("", "") = False
|
||||
isNonNull _ = True
|
||||
let p = Proxy :: Proxy FormUrlEncoded
|
||||
|
||||
it "has mimeUnrender reverse mimeRender" $ do
|
||||
let p = Proxy :: Proxy FormUrlEncoded
|
||||
property $ \x -> all isNonNull x
|
||||
property $ \x -> all (/= mempty) x
|
||||
==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])
|
||||
|
||||
it "has mimeUnrender reverse exportParams (Network.URL)" $ do
|
||||
let p = Proxy :: Proxy FormUrlEncoded
|
||||
property $ \x -> all isNonNull x
|
||||
property $ \x -> all (/= mempty) x
|
||||
==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
|
||||
|
||||
it "has importParams (Network.URL) reverse mimeRender" $ do
|
||||
let p = Proxy :: Proxy FormUrlEncoded
|
||||
property $ \x -> all isNonNull x
|
||||
property $ \x -> all (/= mempty) x
|
||||
==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])
|
||||
|
||||
describe "The PlainText Content-Type type" $ do
|
||||
let p = Proxy :: Proxy PlainText
|
||||
|
||||
it "has mimeUnrender reverse mimeRender (lazy Text)" $ do
|
||||
let p = Proxy :: Proxy PlainText
|
||||
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextL.Text)
|
||||
|
||||
it "has mimeUnrender reverse mimeRender (strict Text)" $ do
|
||||
let p = Proxy :: Proxy PlainText
|
||||
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::TextS.Text)
|
||||
|
||||
describe "The OctetStream Content-Type type" $ do
|
||||
let p = Proxy :: Proxy OctetStream
|
||||
|
||||
it "is id (Lazy ByteString)" $ do
|
||||
let p = Proxy :: Proxy OctetStream
|
||||
property $ \x -> mimeRender p x == (x :: BSL.ByteString)
|
||||
&& mimeUnrender p x == Right x
|
||||
|
||||
it "is fromStrict/toStrict (Strict ByteString)" $ do
|
||||
let p = Proxy :: Proxy OctetStream
|
||||
property $ \x -> mimeRender p x == BSL.fromStrict (x :: ByteString)
|
||||
&& mimeUnrender p (BSL.fromStrict x) == Right x
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue