@@ -1,10 +1,21 @@
1−{-# LANGUAGE DeriveGeneric #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE OverloadedStrings #-}
25{-# OPTIONS_GHC -fno-warn-orphans #-}
36module Servant.API.ContentTypesSpec where
47
58import Control.Applicative
69import Data.Aeson
10+import Data.Function (on)
711import Data.Proxy
12+
13+import Data.ByteString.Char8
14+import qualified Data.ByteString.Lazy as BSL
15+import Data.List (maximumBy)
16+import Data.Maybe (fromJust, isJust)
17+import Data.String (IsString (..))
18+import Data.String.Conversions (cs)
819import qualified Data.Text as TextS
920import qualified Data.Text.Lazy as TextL
1021import GHC.Generics
@@ -36,12 +47,66 @@ spec = describe "Servant.API.ContentTypes" $ do
3647 let p = Proxy :: Proxy PlainText
3748 property $ \x -> fromByteString p (toByteString p x) == Right (x::TextS.Text)
3849
50+ describe "The OctetStream Content-Type type" $ do
51+
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
56+
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
61+
62+ describe "handleAcceptH" $ do
63+
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
72+
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)
81+
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)
85+
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)
3999
40100data SomeData = SomeData { record1 :: String, record2 :: Int }
41101 deriving (Generic, Eq, Show)
42102
103+newtype ZeroToOne = ZeroToOne Float
104+ deriving (Eq, Show, Ord)
105+
43106instance FromJSON SomeData
107+
44108instance ToJSON SomeData
109+
45110instance Arbitrary SomeData where
46111 arbitrary = SomeData <$> arbitrary <*> arbitrary
47112
@@ -50,3 +115,33 @@ instance Arbitrary TextL.Text where
50115
51116instance Arbitrary TextS.Text where
52117 arbitrary = TextS.pack <$> arbitrary
118+
119+instance Arbitrary ZeroToOne where
120+ arbitrary = ZeroToOne <$> elements [ x / 10 | x <- [1..10]]
121+
122+instance MimeRender OctetStream Int where
123+ toByteString _ = cs . show
124+
125+instance MimeRender PlainText Int where
126+ toByteString _ = cs . show
127+
128+instance MimeRender PlainText ByteString where
129+ toByteString _ = cs
130+
131+instance ToJSON ByteString where
132+ toJSON x = object [ "val" .= x ]
133+
134+instance IsString AcceptHeader where
135+ fromString = AcceptHeader . fromString
136+
137+instance Arbitrary BSL.ByteString where
138+ arbitrary = cs <$> (arbitrary :: Gen String)
139+
140+instance Arbitrary ByteString where
141+ arbitrary = cs <$> (arbitrary :: Gen String)
142+
143+addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
144+addToAccept 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