diff --git a/servant/servant.cabal b/servant/servant.cabal index f273b176..df1e4aee 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -113,6 +113,7 @@ test-suite spec , attoparsec , bytestring , hspec == 2.* + , http-media , QuickCheck , quickcheck-instances , servant @@ -120,6 +121,10 @@ test-suite spec , text , url + if !impl(ghc >= 8.0) + build-depends: + semigroups >= 0.16 && < 0.19 + test-suite doctests build-depends: base , servant diff --git a/servant/test/Servant/API/ContentTypesSpec.hs b/servant/test/Servant/API/ContentTypesSpec.hs index a0ae13d7..560569c9 100644 --- a/servant/test/Servant/API/ContentTypesSpec.hs +++ b/servant/test/Servant/API/ContentTypesSpec.hs @@ -14,9 +14,11 @@ import Prelude.Compat import Data.Aeson import Data.ByteString.Char8 (ByteString, append, pack) import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Lazy.Char8 as BSL8 import Data.Either import Data.Function (on) import Data.List (maximumBy) +import qualified Data.List.NonEmpty as NE import Data.Maybe (fromJust, isJust, isNothing) import Data.Proxy import Data.String (IsString (..)) @@ -24,8 +26,10 @@ import Data.String.Conversions (cs) import qualified Data.Text as TextS import qualified Data.Text.Lazy as TextL import GHC.Generics +import qualified Network.HTTP.Media as M import Test.Hspec import Test.QuickCheck +import Text.Read (readMaybe) import "quickcheck-instances" Test.QuickCheck.Instances () import Servant.API.ContentTypes @@ -101,6 +105,14 @@ spec = describe "Servant.API.ContentTypes" $ do "application/octet-stream" ("content" :: ByteString) `shouldSatisfy` isJust + it "returns Just if the 'Accept' header matches, with multiple mime types" $ do + handleAcceptH (Proxy :: Proxy '[JSONorText]) "application/json" (3 :: Int) + `shouldSatisfy` isJust + handleAcceptH (Proxy :: Proxy '[JSONorText]) "text/plain" (3 :: Int) + `shouldSatisfy` isJust + handleAcceptH (Proxy :: Proxy '[JSONorText]) "image/jpeg" (3 :: Int) + `shouldBe` Nothing + it "returns the Content-Type as the first element of the tuple" $ do handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int) `shouldSatisfy` ((== "application/json") . fst . fromJust) @@ -158,6 +170,15 @@ spec = describe "Servant.API.ContentTypes" $ do (encode val) `shouldBe` Just (Right val) + it "returns Just (Right val) if the decoding succeeds for either of multiple mime-types" $ do + let val = 42 :: Int + handleCTypeH (Proxy :: Proxy '[JSONorText]) "application/json" + "42" `shouldBe` Just (Right val) + handleCTypeH (Proxy :: Proxy '[JSONorText]) "text/plain" + "42" `shouldBe` Just (Right val) + handleCTypeH (Proxy :: Proxy '[JSONorText]) "image/jpeg" + "42" `shouldBe` (Nothing :: Maybe (Either String Int)) + #if MIN_VERSION_aeson(0,9,0) -- aeson >= 0.9 decodes top-level strings describe "eitherDecodeLenient" $ do @@ -201,6 +222,18 @@ instance ToJSON ByteString where instance IsString AcceptHeader where fromString = AcceptHeader . fromString +-- To test multiple content types +data JSONorText + +instance Accept JSONorText where + contentTypes _ = "text" M.// "plain" NE.:| [ "application" M.// "json" ] + +instance MimeRender JSONorText Int where + mimeRender _ = cs . show + +instance MimeUnrender JSONorText Int where + mimeUnrender _ = maybe (Left "") Right . readMaybe . BSL8.unpack + addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h) where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)