Only 'text' type should have charset parameter

This commit is contained in:
Julian K. Arni 2015-02-20 15:05:24 +01:00
parent 08528dccfa
commit 99374c5868
2 changed files with 47 additions and 18 deletions

View file

@ -44,9 +44,9 @@ data OctetStream deriving Typeable
class Accept ctype where
contentType :: Proxy ctype -> M.MediaType
-- | @application/json;charset=utf-8@
-- | @application/json@
instance Accept JSON where
contentType _ = "application" M.// "json" M./: ("charset", "utf-8")
contentType _ = "application" M.// "json"
-- | @text/plain;charset=utf-8@
instance Accept PlainText where

View file

@ -13,7 +13,7 @@ import Data.Proxy
import Data.ByteString.Char8
import qualified Data.ByteString.Lazy as BSL
import Data.List (maximumBy)
import Data.Maybe (fromJust, isJust)
import Data.Maybe (fromJust, isJust, isNothing)
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import qualified Data.Text as TextS
@ -61,6 +61,10 @@ spec = describe "Servant.API.ContentTypes" $ do
describe "handleAcceptH" $ do
it "returns Nothing if the 'Accept' header doesn't match" $ do
handleAcceptH (Proxy :: Proxy '[JSON]) "text/plain" (3 :: Int)
`shouldSatisfy` isNothing
it "returns Just if the 'Accept' header matches" $ do
handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
`shouldSatisfy` isJust
@ -72,30 +76,55 @@ spec = describe "Servant.API.ContentTypes" $ do
it "returns the Content-Type as the first element of the tuple" $ do
handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
`shouldSatisfy` ((== "application/json;charset=utf-8") . fst . fromJust)
`shouldSatisfy` ((== "application/json") . fst . fromJust)
handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
`shouldSatisfy` ((== "application/json;charset=utf-8") . fst . fromJust)
`shouldSatisfy` ((== "application/json") . fst . fromJust)
handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
"application/octet-stream" ("content" :: ByteString)
`shouldSatisfy` ((== "application/octet-stream") . fst . fromJust)
it "returns the appropriately serialized representation" $ do
property $ \x -> handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (x :: SomeData)
== Just ("application/json;charset=utf-8", encode x)
== Just ("application/json", encode x)
it "respects the Accept spec ordering" $
property $ \a b c i -> fst (fromJust $ val a b c i) == (fst $ highest a b c)
where
highest a b c = maximumBy (compare `on` snd)
[ ("application/octet-stream", a)
, ("application/json;charset=utf-8", b)
, ("text/plain;charset=utf-8", c)
]
acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $
addToAccept (Proxy :: Proxy JSON) b $
addToAccept (Proxy :: Proxy PlainText ) c ""
val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
it "respects the Accept spec ordering" $ do
let highest a b c = maximumBy (compare `on` snd)
[ ("application/octet-stream", a)
, ("application/json", b)
, ("text/plain;charset=utf-8", c)
]
let acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $
addToAccept (Proxy :: Proxy JSON) b $
addToAccept (Proxy :: Proxy PlainText ) c ""
let val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
(acceptH a b c) (i :: Int)
property $ \a b c i -> fst (fromJust $ val a b c i) == fst (highest a b c)
describe "handleCTypeH" $ do
it "returns Nothing if the 'Content-Type' header doesn't match" $ do
handleCTypeH (Proxy :: Proxy '[JSON]) "text/plain" "𝓽𝓱𝓮 𝓽𝓲𝓶𝓮 𝓱𝓪𝓼 𝓬𝓸𝓶𝓮, 𝓽𝓱𝓮 𝔀𝓪𝓵𝓻𝓾𝓼 𝓼𝓪𝓲𝓭 "
`shouldBe` (Nothing :: Maybe (Either String Value))
context "the 'Content-Type' header matches" $ do
it "returns Just if the parameter matches" $ do
handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
"𝕥𝕠 𝕥𝕒𝕝𝕜 𝕠𝕗 𝕞𝕒𝕟𝕪 𝕥𝕙𝕚𝕟𝕘𝕤 "
`shouldSatisfy` (isJust :: Maybe (Either String Value) -> Bool)
it "returns Just if there is no parameter" $ do
handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
"𝕥𝕠 𝕥𝕒𝕝𝕜 𝕠𝕗 𝕞𝕒𝕟𝕪 𝕥𝕙𝕚𝕟𝕘𝕤 "
`shouldSatisfy` (isJust :: Maybe (Either String Value) -> Bool)
it "returns Just Left if the decoding fails" $ do
let isJustLeft :: Maybe (Either String Value) -> Bool
isJustLeft (Just (Left _)) = True
isJustLeft _ = False
handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
"𝕺𝖋 𝖘𝖍𝖔𝖊𝖘--𝖆𝖓𝖉 𝖘𝖍𝖎𝖕𝖘--𝖆𝖓𝖉 𝖘𝖊𝖆𝖑𝖎𝖓𝖌-𝖜𝖆𝖝-- "
`shouldSatisfy` isJustLeft
data SomeData = SomeData { record1 :: String, record2 :: Int }
deriving (Generic, Eq, Show)