eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Only 'text' type should have charset parameter

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/Servant/API/ContentTypes.hs
View file

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

61
test/Servant/API/ContentTypesSpec.hs
View file

@ -13,7 +13,7 @@ import Data.Proxy
import Data.ByteString.Char8 import Data.ByteString.Char8
import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy as BSL
import Data.List (maximumBy) import Data.List (maximumBy)
import Data.Maybe (fromJust, isJust) import Data.Maybe (fromJust, isJust, isNothing)
import Data.String (IsString (..)) import Data.String (IsString (..))
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import qualified Data.Text as TextS import qualified Data.Text as TextS
@ -61,6 +61,10 @@ spec = describe "Servant.API.ContentTypes" $ do
describe "handleAcceptH" $ 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 it "returns Just if the 'Accept' header matches" $ do
handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int) handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
`shouldSatisfy` isJust `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 it "returns the Content-Type as the first element of the tuple" $ do
handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int) 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) 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]) handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
"application/octet-stream" ("content" :: ByteString) "application/octet-stream" ("content" :: ByteString)
`shouldSatisfy` ((== "application/octet-stream") . fst . fromJust) `shouldSatisfy` ((== "application/octet-stream") . fst . fromJust)
it "returns the appropriately serialized representation" $ do it "returns the appropriately serialized representation" $ do
property $ \x -> handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (x :: SomeData) 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" $ it "respects the Accept spec ordering" $ do
property $ \a b c i -> fst (fromJust $ val a b c i) == (fst $ highest a b c) let highest a b c = maximumBy (compare `on` snd)
where [ ("application/octet-stream", a)
highest a b c = maximumBy (compare `on` snd) , ("application/json", b)
[ ("application/octet-stream", a) , ("text/plain;charset=utf-8", c)
, ("application/json;charset=utf-8", b) ]
, ("text/plain;charset=utf-8", c) let acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $
] addToAccept (Proxy :: Proxy JSON) b $
acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $ addToAccept (Proxy :: Proxy PlainText ) c ""
addToAccept (Proxy :: Proxy JSON) b $ let val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
addToAccept (Proxy :: Proxy PlainText ) c ""
val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
(acceptH a b c) (i :: Int) (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 } data SomeData = SomeData { record1 :: String, record2 :: Int }
deriving (Generic, Eq, Show) deriving (Generic, Eq, Show)