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

More content type tests

Browse Source
This commit is contained in:
Julian K. Arni 2015-02-20 11:13:10 +01:00
parent 0453cc3d2a
commit 08528dccfa
3 changed files with 107 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
servant.cabal
View File

@ -87,6 +87,7 @@ test-suite spec
build-depends:
base == 4.*
, aeson
, bytestring
, hspec == 2.*
, QuickCheck
, parsec

11
src/Servant/API/ContentTypes.hs
View File

@ -104,7 +104,7 @@ instance ( AllMimeRender ctyps a, IsNonEmpty ctyps
-- > instance Accept MyContentType where
-- > contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")
-- >
-- > instance Show a => MimeRender MyContentType where
-- > instance Show a => MimeUnrender MyContentType where
-- > fromByteString _ bs = MyContentType $ unpack bs
-- >
-- > type MyAPI = "path" :> ReqBody '[MyContentType] :> Get '[JSON] Int
@ -191,6 +191,11 @@ instance MimeRender PlainText TextS.Text where
instance MimeRender OctetStream ByteString where
toByteString _ = id
-- | `toStrict`
instance MimeRender OctetStream BS.ByteString where
toByteString _ = fromStrict
--------------------------------------------------------------------------
-- * MimeUnrender Instances
@ -209,3 +214,7 @@ instance MimeUnrender PlainText TextS.Text where
-- | `Right . id`
instance MimeUnrender OctetStream ByteString where
fromByteString _ = Right . id
-- | `Right . toStrict`
instance MimeUnrender OctetStream BS.ByteString where
fromByteString _ = Right . toStrict

97
test/Servant/API/ContentTypesSpec.hs
View File

@ -1,10 +1,21 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.API.ContentTypesSpec where
import Control.Applicative
import Data.Aeson
import Data.Function (on)
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.String (IsString (..))
import Data.String.Conversions (cs)
import qualified Data.Text as TextS
import qualified Data.Text.Lazy as TextL
import GHC.Generics
@ -36,12 +47,66 @@ spec = describe "Servant.API.ContentTypes" $ do
let p = Proxy :: Proxy PlainText
property $ \x -> fromByteString p (toByteString p x) == Right (x::TextS.Text)
describe "The OctetStream Content-Type type" $ do
it "is id (Lazy ByteString)" $ do
let p = Proxy :: Proxy OctetStream
property $ \x -> toByteString p x == (x :: BSL.ByteString)
&& fromByteString p x == Right x
it "is fromStrict/toStrict (Strict ByteString)" $ do
let p = Proxy :: Proxy OctetStream
property $ \x -> toByteString p x == BSL.fromStrict (x :: ByteString)
&& fromByteString p (BSL.fromStrict x) == Right x
describe "handleAcceptH" $ do
it "returns Just if the 'Accept' header matches" $ do
handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
`shouldSatisfy` isJust
handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
`shouldSatisfy` isJust
handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
"application/octet-stream" ("content" :: ByteString)
`shouldSatisfy` isJust
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)
handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
`shouldSatisfy` ((== "application/json;charset=utf-8") . 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)
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])
(acceptH a b c) (i :: Int)
data SomeData = SomeData { record1 :: String, record2 :: Int }
deriving (Generic, Eq, Show)
newtype ZeroToOne = ZeroToOne Float
deriving (Eq, Show, Ord)
instance FromJSON SomeData
instance ToJSON SomeData
instance Arbitrary SomeData where
arbitrary = SomeData <$> arbitrary <*> arbitrary
@ -50,3 +115,33 @@ instance Arbitrary TextL.Text where
instance Arbitrary TextS.Text where
arbitrary = TextS.pack <$> arbitrary
instance Arbitrary ZeroToOne where
arbitrary = ZeroToOne <$> elements [ x / 10 | x <- [1..10]]
instance MimeRender OctetStream Int where
toByteString _ = cs . show
instance MimeRender PlainText Int where
toByteString _ = cs . show
instance MimeRender PlainText ByteString where
toByteString _ = cs
instance ToJSON ByteString where
toJSON x = object [ "val" .= x ]
instance IsString AcceptHeader where
fromString = AcceptHeader . fromString
instance Arbitrary BSL.ByteString where
arbitrary = cs <$> (arbitrary :: Gen String)
instance Arbitrary ByteString where
arbitrary = cs <$> (arbitrary :: Gen String)
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)
cont "" = new
cont old = old `append` ", " `append` new