git.iko.soy/servant
on 08528dc help sign in
servant/test/Servant/API/ContentTypesSpec.hs
147 lines 6.1 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
6module Servant.API.ContentTypesSpec where
8import Control.Applicative
9import Data.Aeson
10import Data.Function (on)
11import Data.Proxy
13import Data.ByteString.Char8
14import qualified Data.ByteString.Lazy as BSL
15import Data.List (maximumBy)
16import Data.Maybe (fromJust, isJust)
17import Data.String (IsString (..))
18import Data.String.Conversions (cs)
19import qualified Data.Text as TextS
20import qualified Data.Text.Lazy as TextL
21import GHC.Generics
22import Test.Hspec
23import Test.QuickCheck
25import Servant.API.ContentTypes
27spec :: Spec
28spec = describe "Servant.API.ContentTypes" $ do
30 describe "The JSON Content-Type type" $ do
32 it "has fromByteString reverse toByteString for valid top-level json ([Int]) " $ do
33 let p = Proxy :: Proxy JSON
34 property $ \x -> fromByteString p (toByteString p x) == Right (x::[Int])
36 it "has fromByteString reverse toByteString for valid top-level json " $ do
37 let p = Proxy :: Proxy JSON
38 property $ \x -> fromByteString p (toByteString p x) == Right (x::SomeData)
40 describe "The PlainText Content-Type type" $ do
42 it "has fromByteString reverse toByteString (lazy Text)" $ do
43 let p = Proxy :: Proxy PlainText
44 property $ \x -> fromByteString p (toByteString p x) == Right (x::TextL.Text)
46 it "has fromByteString reverse toByteString (strict Text)" $ do
47 let p = Proxy :: Proxy PlainText
48 property $ \x -> fromByteString p (toByteString p x) == Right (x::TextS.Text)
50 describe "The OctetStream Content-Type type" $ do
52 it "is id (Lazy ByteString)" $ do
53 let p = Proxy :: Proxy OctetStream
54 property $ \x -> toByteString p x == (x :: BSL.ByteString)
55 && fromByteString p x == Right x
57 it "is fromStrict/toStrict (Strict ByteString)" $ do
58 let p = Proxy :: Proxy OctetStream
59 property $ \x -> toByteString p x == BSL.fromStrict (x :: ByteString)
60 && fromByteString p (BSL.fromStrict x) == Right x
62 describe "handleAcceptH" $ do
64 it "returns Just if the 'Accept' header matches" $ do
65 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
66 `shouldSatisfy` isJust
67 handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
68 `shouldSatisfy` isJust
69 handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
70 "application/octet-stream" ("content" :: ByteString)
71 `shouldSatisfy` isJust
73 it "returns the Content-Type as the first element of the tuple" $ do
74 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
75 `shouldSatisfy` ((== "application/json;charset=utf-8") . fst . fromJust)
76 handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
77 `shouldSatisfy` ((== "application/json;charset=utf-8") . fst . fromJust)
78 handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
79 "application/octet-stream" ("content" :: ByteString)
80 `shouldSatisfy` ((== "application/octet-stream") . fst . fromJust)
82 it "returns the appropriately serialized representation" $ do
83 property $ \x -> handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (x :: SomeData)
84 == Just ("application/json;charset=utf-8", encode x)
86 it "respects the Accept spec ordering" $
87 property $ \a b c i -> fst (fromJust $ val a b c i) == (fst $ highest a b c)
88 where
89 highest a b c = maximumBy (compare `on` snd)
90 [ ("application/octet-stream", a)
91 , ("application/json;charset=utf-8", b)
92 , ("text/plain;charset=utf-8", c)
93 ]
94 acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $
95 addToAccept (Proxy :: Proxy JSON) b $
96 addToAccept (Proxy :: Proxy PlainText ) c ""
97 val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
98 (acceptH a b c) (i :: Int)
100data SomeData = SomeData { record1 :: String, record2 :: Int }
101 deriving (Generic, Eq, Show)
103newtype ZeroToOne = ZeroToOne Float
104 deriving (Eq, Show, Ord)
106instance FromJSON SomeData
108instance ToJSON SomeData
110instance Arbitrary SomeData where
111 arbitrary = SomeData <$> arbitrary <*> arbitrary
113instance Arbitrary TextL.Text where
114 arbitrary = TextL.pack <$> arbitrary
116instance Arbitrary TextS.Text where
117 arbitrary = TextS.pack <$> arbitrary
119instance Arbitrary ZeroToOne where
120 arbitrary = ZeroToOne <$> elements [ x / 10 | x <- [1..10]]
122instance MimeRender OctetStream Int where
123 toByteString _ = cs . show
125instance MimeRender PlainText Int where
126 toByteString _ = cs . show
128instance MimeRender PlainText ByteString where
129 toByteString _ = cs
131instance ToJSON ByteString where
132 toJSON x = object [ "val" .= x ]
134instance IsString AcceptHeader where
135 fromString = AcceptHeader . fromString
137instance Arbitrary BSL.ByteString where
138 arbitrary = cs <$> (arbitrary :: Gen String)
140instance Arbitrary ByteString where
141 arbitrary = cs <$> (arbitrary :: Gen String)
143addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
144addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
145 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)
146 cont "" = new
147 cont old = old `append` ", " `append` new