diff --git a/servant.cabal b/servant.cabal index 4c54f047..b8af4b65 100644 --- a/servant.cabal +++ b/servant.cabal @@ -45,6 +45,7 @@ library build-depends: base >=4.7 && <5 , aeson >= 0.7 + , attoparsec >= 0.12 , bytestring == 0.10.* , http-media >= 0.4 && < 0.7 , http-types == 0.8.* @@ -86,6 +87,7 @@ test-suite spec build-depends: base == 4.* , aeson + , attoparsec , bytestring , hspec == 2.* , QuickCheck diff --git a/src/Servant/API/ContentTypes.hs b/src/Servant/API/ContentTypes.hs index f2ae6b15..2036a32a 100644 --- a/src/Servant/API/ContentTypes.hs +++ b/src/Servant/API/ContentTypes.hs @@ -11,24 +11,28 @@ {-# LANGUAGE UndecidableInstances #-} module Servant.API.ContentTypes where -import Control.Arrow (left) +import Control.Applicative ((<*)) +import Control.Arrow (left) import Control.Monad -import Data.Aeson (FromJSON, ToJSON, eitherDecode, - encode) -import qualified Data.ByteString as BS -import Data.ByteString.Lazy (ByteString, fromStrict, toStrict) -import qualified Data.ByteString.Lazy as B -import Data.String.Conversions (cs) +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.Monoid -import qualified Data.Text.Lazy as TextL -import qualified Data.Text.Lazy.Encoding as TextL -import qualified Data.Text as TextS -import qualified Data.Text.Encoding as TextS +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 (unEscapeString, escapeURIString, - isUnreserved) +import GHC.Exts (Constraint) +import qualified Network.HTTP.Media as M +import Network.URI (escapeURIString, isUnreserved, + unEscapeString) -- * Provided content types data JSON deriving Typeable @@ -190,6 +194,8 @@ instance ToJSON a => MimeRender JSON a where toByteString _ = encode -- | `encodeFormUrlEncoded . toFormUrlEncoded` +-- Note that the `fromByteString p (toByteString p x) == Right x` law only +-- holds if every element of x is non-null (i.e., not `("", "")`) instance ToFormUrlEncoded a => MimeRender FormUrlEncoded a where toByteString _ = encodeFormUrlEncoded . toFormUrlEncoded @@ -213,11 +219,20 @@ instance MimeRender OctetStream BS.ByteString where -------------------------------------------------------------------------- -- * MimeUnrender Instances +-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just +-- objects and arrays. +eitherDecodeLenient :: FromJSON a => ByteString -> Either String a +eitherDecodeLenient input = do + v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input) + parseEither parseJSON v + -- | `eitherDecode` instance FromJSON a => MimeUnrender JSON a where - fromByteString _ = eitherDecode + fromByteString _ = eitherDecodeLenient -- | `decodeFormUrlEncoded >=> fromFormUrlEncoded` +-- Note that the `fromByteString p (toByteString p x) == Right x` law only +-- holds if every element of x is non-null (i.e., not `("", "")`) instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where fromByteString _ = decodeFormUrlEncoded >=> fromFormUrlEncoded diff --git a/test/Servant/API/ContentTypesSpec.hs b/test/Servant/API/ContentTypesSpec.hs index 49b879dc..2a4a071d 100644 --- a/test/Servant/API/ContentTypesSpec.hs +++ b/test/Servant/API/ContentTypesSpec.hs @@ -8,22 +8,24 @@ module Servant.API.ContentTypesSpec where import Control.Applicative import Control.Arrow import Data.Aeson -import Data.Function (on) +import Data.Aeson.Parser (jstring) +import Data.Attoparsec.ByteString (parseOnly) +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) -import Data.Maybe (fromJust, isJust, isNothing) -import Data.String (IsString (..)) -import Data.String.Conversions (cs) -import qualified Data.Text as TextS -import qualified Data.Text.Lazy as TextL +import Data.ByteString.Char8 (ByteString, append, pack) +import qualified Data.ByteString.Lazy as BSL +import Data.List (maximumBy) +import Data.Maybe (fromJust, isJust, isNothing) +import Data.String (IsString (..)) +import Data.String.Conversions (cs) +import qualified Data.Text as TextS +import qualified Data.Text.Lazy as TextL import GHC.Generics -import Network.URL (importParams, exportParams) +import Network.URL (exportParams, importParams) import Test.Hspec import Test.QuickCheck -import Test.QuickCheck.Instances () +import Test.QuickCheck.Instances () import Servant.API.ContentTypes @@ -42,17 +44,23 @@ spec = describe "Servant.API.ContentTypes" $ do describe "The FormUrlEncoded Content-Type type" $ do + let isNonNull ("", "") = False + isNonNull _ = True + it "has fromByteString reverse toByteString" $ do let p = Proxy :: Proxy FormUrlEncoded - property $ \x -> fromByteString p (toByteString p x) == Right (x::[(TextS.Text,TextS.Text)]) + property $ \x -> all isNonNull x + ==> fromByteString p (toByteString p x) == Right (x::[(TextS.Text,TextS.Text)]) it "has fromByteString reverse exportParams (Network.URL)" $ do let p = Proxy :: Proxy FormUrlEncoded - property $ \x -> (fromByteString p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)]) + property $ \x -> all isNonNull x + ==> (fromByteString p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)]) it "has importParams (Network.URL) reverse toByteString" $ do let p = Proxy :: Proxy FormUrlEncoded - property $ \x -> (fmap (map (cs *** cs)) . importParams . cs . toByteString p $ x) == Just (x::[(TextS.Text,TextS.Text)]) + property $ \x -> all isNonNull x + ==> (fmap (map (cs *** cs)) . importParams . cs . toByteString p $ x) == Just (x::[(TextS.Text,TextS.Text)]) describe "The PlainText Content-Type type" $ do @@ -148,6 +156,14 @@ spec = describe "Servant.API.ContentTypes" $ do (encode val) `shouldBe` Just (Right val) + describe "eitherDecodeLenient" $ do + + it "parses top-level strings" $ do + let toMaybe = either (const Nothing) Just + -- The Left messages differ, so convert to Maybe + property $ \x -> toMaybe (eitherDecodeLenient x) + `shouldBe` toMaybe (parseOnly jstring $ cs x) + data SomeData = SomeData { record1 :: String, record2 :: Int } deriving (Generic, Eq, Show)