git.iko.soy/servant
on master help sign in
Add multiple mimetypes tests
da55698Oleg Grenrus
servant/servant.cabal+5
compare with master
unifiedsplit
@@ -113,6 +113,7 @@ test-suite spec
113 , attoparsec
113 , attoparsec
114 , bytestring
114 , bytestring
115 , hspec == 2.*
115 , hspec == 2.*
116+ , http-media
116 , QuickCheck
117 , QuickCheck
117 , quickcheck-instances
118 , quickcheck-instances
118 , servant
119 , servant
@@ -120,6 +121,10 @@ test-suite spec
120 , text
121 , text
121 , url
122 , url
122
123
124+ if !impl(ghc >= 8.0)
125+ build-depends:
126+ semigroups >= 0.16 && < 0.19
127+
123test-suite doctests
128test-suite doctests
124 build-depends: base
129 build-depends: base
125 , servant
130 , servant
servant/test/Servant/API/ContentTypesSpec.hs+33
@@ -14,9 +14,11 @@ import Prelude.Compat
14import Data.Aeson
14import Data.Aeson
15import Data.ByteString.Char8 (ByteString, append, pack)
15import Data.ByteString.Char8 (ByteString, append, pack)
16import qualified Data.ByteString.Lazy as BSL
16import qualified Data.ByteString.Lazy as BSL
17+import qualified Data.ByteString.Lazy.Char8 as BSL8
17import Data.Either
18import Data.Either
18import Data.Function (on)
19import Data.Function (on)
19import Data.List (maximumBy)
20import Data.List (maximumBy)
21+import qualified Data.List.NonEmpty as NE
20import Data.Maybe (fromJust, isJust, isNothing)
22import Data.Maybe (fromJust, isJust, isNothing)
21import Data.Proxy
23import Data.Proxy
22import Data.String (IsString (..))
24import Data.String (IsString (..))
@@ -24,8 +26,10 @@ import Data.String.Conversions (cs)
24import qualified Data.Text as TextS
26import qualified Data.Text as TextS
25import qualified Data.Text.Lazy as TextL
27import qualified Data.Text.Lazy as TextL
26import GHC.Generics
28import GHC.Generics
29+import qualified Network.HTTP.Media as M
27import Test.Hspec
30import Test.Hspec
28import Test.QuickCheck
31import Test.QuickCheck
32+import Text.Read (readMaybe)
29import "quickcheck-instances" Test.QuickCheck.Instances ()
33import "quickcheck-instances" Test.QuickCheck.Instances ()
30
34
31import Servant.API.ContentTypes
35import Servant.API.ContentTypes
@@ -101,6 +105,14 @@ spec = describe "Servant.API.ContentTypes" $ do
101 "application/octet-stream" ("content" :: ByteString)
105 "application/octet-stream" ("content" :: ByteString)
102 `shouldSatisfy` isJust
106 `shouldSatisfy` isJust
103
107
108+ it "returns Just if the 'Accept' header matches, with multiple mime types" $ do
109+ handleAcceptH (Proxy :: Proxy '[JSONorText]) "application/json" (3 :: Int)
110+ `shouldSatisfy` isJust
111+ handleAcceptH (Proxy :: Proxy '[JSONorText]) "text/plain" (3 :: Int)
112+ `shouldSatisfy` isJust
113+ handleAcceptH (Proxy :: Proxy '[JSONorText]) "image/jpeg" (3 :: Int)
114+ `shouldBe` Nothing
115+
104 it "returns the Content-Type as the first element of the tuple" $ do
116 it "returns the Content-Type as the first element of the tuple" $ do
105 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
117 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
106 `shouldSatisfy` ((== "application/json") . fst . fromJust)
118 `shouldSatisfy` ((== "application/json") . fst . fromJust)
@@ -158,6 +170,15 @@ spec = describe "Servant.API.ContentTypes" $ do
158 (encode val)
170 (encode val)
159 `shouldBe` Just (Right val)
171 `shouldBe` Just (Right val)
160
172
173+ it "returns Just (Right val) if the decoding succeeds for either of multiple mime-types" $ do
174+ let val = 42 :: Int
175+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "application/json"
176+ "42" `shouldBe` Just (Right val)
177+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "text/plain"
178+ "42" `shouldBe` Just (Right val)
179+ handleCTypeH (Proxy :: Proxy '[JSONorText]) "image/jpeg"
180+ "42" `shouldBe` (Nothing :: Maybe (Either String Int))
181+
161#if MIN_VERSION_aeson(0,9,0)
182#if MIN_VERSION_aeson(0,9,0)
162 -- aeson >= 0.9 decodes top-level strings
183 -- aeson >= 0.9 decodes top-level strings
163 describe "eitherDecodeLenient" $ do
184 describe "eitherDecodeLenient" $ do
@@ -201,6 +222,18 @@ instance ToJSON ByteString where
201instance IsString AcceptHeader where
222instance IsString AcceptHeader where
202 fromString = AcceptHeader . fromString
223 fromString = AcceptHeader . fromString
203
224
225+-- To test multiple content types
226+data JSONorText
227+
228+instance Accept JSONorText where
229+ contentTypes _ = "text" M.// "plain" NE.:| [ "application" M.// "json" ]
230+
231+instance MimeRender JSONorText Int where
232+ mimeRender _ = cs . show
233+
234+instance MimeUnrender JSONorText Int where
235+ mimeUnrender _ = maybe (Left "") Right . readMaybe . BSL8.unpack
236+
204addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
237addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
205addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
238addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
206 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)
239 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)