git.iko.soy/servant
on a2f95f0 help sign in
servant/test/Servant/API/ContentTypesSpec.hs
171 lines 7.8 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, isNothing)
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
24import Test.QuickCheck.Instances ()
26import Servant.API.ContentTypes
28spec :: Spec
29spec = describe "Servant.API.ContentTypes" $ do
31 describe "The JSON Content-Type type" $ do
33 it "has fromByteString reverse toByteString for valid top-level json ([Int]) " $ do
34 let p = Proxy :: Proxy JSON
35 property $ \x -> fromByteString p (toByteString p x) == Right (x::[Int])
37 it "has fromByteString reverse toByteString for valid top-level json " $ do
38 let p = Proxy :: Proxy JSON
39 property $ \x -> fromByteString p (toByteString p x) == Right (x::SomeData)
41 describe "The PlainText Content-Type type" $ do
43 it "has fromByteString reverse toByteString (lazy Text)" $ do
44 let p = Proxy :: Proxy PlainText
45 property $ \x -> fromByteString p (toByteString p x) == Right (x::TextL.Text)
47 it "has fromByteString reverse toByteString (strict Text)" $ do
48 let p = Proxy :: Proxy PlainText
49 property $ \x -> fromByteString p (toByteString p x) == Right (x::TextS.Text)
51 describe "The OctetStream Content-Type type" $ do
53 it "is id (Lazy ByteString)" $ do
54 let p = Proxy :: Proxy OctetStream
55 property $ \x -> toByteString p x == (x :: BSL.ByteString)
56 && fromByteString p x == Right x
58 it "is fromStrict/toStrict (Strict ByteString)" $ do
59 let p = Proxy :: Proxy OctetStream
60 property $ \x -> toByteString p x == BSL.fromStrict (x :: ByteString)
61 && fromByteString p (BSL.fromStrict x) == Right x
63 describe "handleAcceptH" $ do
65 it "returns Nothing if the 'Accept' header doesn't match" $ do
66 handleAcceptH (Proxy :: Proxy '[JSON]) "text/plain" (3 :: Int)
67 `shouldSatisfy` isNothing
69 it "returns Just if the 'Accept' header matches" $ do
70 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
71 `shouldSatisfy` isJust
72 handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
73 `shouldSatisfy` isJust
74 handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
75 "application/octet-stream" ("content" :: ByteString)
76 `shouldSatisfy` isJust
78 it "returns the Content-Type as the first element of the tuple" $ do
79 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
80 `shouldSatisfy` ((== "application/json") . fst . fromJust)
81 handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
82 `shouldSatisfy` ((== "application/json") . fst . fromJust)
83 handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
84 "application/octet-stream" ("content" :: ByteString)
85 `shouldSatisfy` ((== "application/octet-stream") . fst . fromJust)
87 it "returns the appropriately serialized representation" $ do
88 property $ \x -> handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (x :: SomeData)
89 == Just ("application/json", encode x)
91 it "respects the Accept spec ordering" $ do
92 let highest a b c = maximumBy (compare `on` snd)
93 [ ("application/octet-stream", a)
94 , ("application/json", b)
95 , ("text/plain;charset=utf-8", c)
96 ]
97 let acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $
98 addToAccept (Proxy :: Proxy JSON) b $
99 addToAccept (Proxy :: Proxy PlainText ) c ""
100 let val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
101 (acceptH a b c) (i :: Int)
102 property $ \a b c i -> fst (fromJust $ val a b c i) == fst (highest a b c)
104 describe "handleCTypeH" $ do
106 it "returns Nothing if the 'Content-Type' header doesn't match" $ do
107 handleCTypeH (Proxy :: Proxy '[JSON]) "text/plain" "๐“ฝ๐“ฑ๐“ฎ ๐“ฝ๐“ฒ๐“ถ๐“ฎ ๐“ฑ๐“ช๐“ผ ๐“ฌ๐“ธ๐“ถ๐“ฎ, ๐“ฝ๐“ฑ๐“ฎ ๐”€๐“ช๐“ต๐“ป๐“พ๐“ผ ๐“ผ๐“ช๐“ฒ๐“ญ "
108 `shouldBe` (Nothing :: Maybe (Either String Value))
110 context "the 'Content-Type' header matches" $ do
111 it "returns Just if the parameter matches" $ do
112 handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
113 "๐•ฅ๐•  ๐•ฅ๐•’๐•๐•œ ๐• ๐•— ๐•ž๐•’๐•Ÿ๐•ช ๐•ฅ๐•™๐•š๐•Ÿ๐•˜๐•ค "
114 `shouldSatisfy` (isJust :: Maybe (Either String Value) -> Bool)
116 it "returns Just if there is no parameter" $ do
117 handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
118 "๐•ฅ๐•  ๐•ฅ๐•’๐•๐•œ ๐• ๐•— ๐•ž๐•’๐•Ÿ๐•ช ๐•ฅ๐•™๐•š๐•Ÿ๐•˜๐•ค "
119 `shouldSatisfy` (isJust :: Maybe (Either String Value) -> Bool)
121 it "returns Just Left if the decoding fails" $ do
122 let isJustLeft :: Maybe (Either String Value) -> Bool
123 isJustLeft (Just (Left _)) = True
124 isJustLeft _ = False
125 handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
126 "๐•บ๐–‹ ๐–˜๐–๐–”๐–Š๐–˜--๐–†๐–“๐–‰ ๐–˜๐–๐–Ž๐–•๐–˜--๐–†๐–“๐–‰ ๐–˜๐–Š๐–†๐–‘๐–Ž๐–“๐–Œ-๐–œ๐–†๐–-- "
127 `shouldSatisfy` isJustLeft
129 it "returns Just (Right val) if the decoding succeeds" $ do
130 let val = SomeData "Of cabbages--and kings" 12
131 handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
132 (encode val)
133 `shouldBe` Just (Right val)
136data SomeData = SomeData { record1 :: String, record2 :: Int }
137 deriving (Generic, Eq, Show)
139newtype ZeroToOne = ZeroToOne Float
140 deriving (Eq, Show, Ord)
142instance FromJSON SomeData
144instance ToJSON SomeData
146instance Arbitrary SomeData where
147 arbitrary = SomeData <$> arbitrary <*> arbitrary
149instance Arbitrary ZeroToOne where
150 arbitrary = ZeroToOne <$> elements [ x / 10 | x <- [1..10]]
152instance MimeRender OctetStream Int where
153 toByteString _ = cs . show
155instance MimeRender PlainText Int where
156 toByteString _ = cs . show
158instance MimeRender PlainText ByteString where
159 toByteString _ = cs
161instance ToJSON ByteString where
162 toJSON x = object [ "val" .= x ]
164instance IsString AcceptHeader where
165 fromString = AcceptHeader . fromString
167addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
168addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
169 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)
170 cont "" = new
171 cont old = old `append` ", " `append` new