git.iko.soy/servant
on b00596a help sign in
servant/test/Servant/API/ContentTypesSpec.hs
187 lines 8.7 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 Control.Arrow
10import Data.Aeson
11import Data.Function (on)
12import Data.Proxy
14import Data.ByteString.Char8 (ByteString, append, pack)
15import qualified Data.ByteString.Lazy as BSL
16import Data.List (maximumBy)
17import Data.Maybe (fromJust, isJust, isNothing)
18import Data.String (IsString (..))
19import Data.String.Conversions (cs)
20import qualified Data.Text as TextS
21import qualified Data.Text.Lazy as TextL
22import GHC.Generics
23import Network.URL (importParams, exportParams)
24import Test.Hspec
25import Test.QuickCheck
26import Test.QuickCheck.Instances ()
28import Servant.API.ContentTypes
30spec :: Spec
31spec = describe "Servant.API.ContentTypes" $ do
33 describe "The JSON Content-Type type" $ do
35 it "has fromByteString reverse toByteString for valid top-level json ([Int]) " $ do
36 let p = Proxy :: Proxy JSON
37 property $ \x -> fromByteString p (toByteString p x) == Right (x::[Int])
39 it "has fromByteString reverse toByteString for valid top-level json " $ do
40 let p = Proxy :: Proxy JSON
41 property $ \x -> fromByteString p (toByteString p x) == Right (x::SomeData)
43 describe "The FormUrlEncoded Content-Type type" $ do
45 it "has fromByteString reverse toByteString" $ do
46 let p = Proxy :: Proxy FormUrlEncoded
47 property $ \x -> fromByteString p (toByteString p x) == Right (x::[(TextS.Text,TextS.Text)])
49 it "has fromByteString reverse exportParams (Network.URL)" $ do
50 let p = Proxy :: Proxy FormUrlEncoded
51 property $ \x -> (fromByteString p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
53 it "has importParams (Network.URL) reverse toByteString" $ do
54 let p = Proxy :: Proxy FormUrlEncoded
55 property $ \x -> (fmap (map (cs *** cs)) . importParams . cs . toByteString p $ x) == Just (x::[(TextS.Text,TextS.Text)])
57 describe "The PlainText Content-Type type" $ do
59 it "has fromByteString reverse toByteString (lazy Text)" $ do
60 let p = Proxy :: Proxy PlainText
61 property $ \x -> fromByteString p (toByteString p x) == Right (x::TextL.Text)
63 it "has fromByteString reverse toByteString (strict Text)" $ do
64 let p = Proxy :: Proxy PlainText
65 property $ \x -> fromByteString p (toByteString p x) == Right (x::TextS.Text)
67 describe "The OctetStream Content-Type type" $ do
69 it "is id (Lazy ByteString)" $ do
70 let p = Proxy :: Proxy OctetStream
71 property $ \x -> toByteString p x == (x :: BSL.ByteString)
72 && fromByteString p x == Right x
74 it "is fromStrict/toStrict (Strict ByteString)" $ do
75 let p = Proxy :: Proxy OctetStream
76 property $ \x -> toByteString p x == BSL.fromStrict (x :: ByteString)
77 && fromByteString p (BSL.fromStrict x) == Right x
79 describe "handleAcceptH" $ do
81 it "returns Nothing if the 'Accept' header doesn't match" $ do
82 handleAcceptH (Proxy :: Proxy '[JSON]) "text/plain" (3 :: Int)
83 `shouldSatisfy` isNothing
85 it "returns Just if the 'Accept' header matches" $ do
86 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
87 `shouldSatisfy` isJust
88 handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
89 `shouldSatisfy` isJust
90 handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
91 "application/octet-stream" ("content" :: ByteString)
92 `shouldSatisfy` isJust
94 it "returns the Content-Type as the first element of the tuple" $ do
95 handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int)
96 `shouldSatisfy` ((== "application/json") . fst . fromJust)
97 handleAcceptH (Proxy :: Proxy '[PlainText, JSON]) "application/json" (3 :: Int)
98 `shouldSatisfy` ((== "application/json") . fst . fromJust)
99 handleAcceptH (Proxy :: Proxy '[PlainText, JSON, OctetStream])
100 "application/octet-stream" ("content" :: ByteString)
101 `shouldSatisfy` ((== "application/octet-stream") . fst . fromJust)
103 it "returns the appropriately serialized representation" $ do
104 property $ \x -> handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (x :: SomeData)
105 == Just ("application/json", encode x)
107 it "respects the Accept spec ordering" $ do
108 let highest a b c = maximumBy (compare `on` snd)
109 [ ("application/octet-stream", a)
110 , ("application/json", b)
111 , ("text/plain;charset=utf-8", c)
112 ]
113 let acceptH a b c = addToAccept (Proxy :: Proxy OctetStream) a $
114 addToAccept (Proxy :: Proxy JSON) b $
115 addToAccept (Proxy :: Proxy PlainText ) c ""
116 let val a b c i = handleAcceptH (Proxy :: Proxy '[OctetStream, JSON, PlainText])
117 (acceptH a b c) (i :: Int)
118 property $ \a b c i -> fst (fromJust $ val a b c i) == fst (highest a b c)
120 describe "handleCTypeH" $ do
122 it "returns Nothing if the 'Content-Type' header doesn't match" $ do
123 handleCTypeH (Proxy :: Proxy '[JSON]) "text/plain" "๐“ฝ๐“ฑ๐“ฎ ๐“ฝ๐“ฒ๐“ถ๐“ฎ ๐“ฑ๐“ช๐“ผ ๐“ฌ๐“ธ๐“ถ๐“ฎ, ๐“ฝ๐“ฑ๐“ฎ ๐”€๐“ช๐“ต๐“ป๐“พ๐“ผ ๐“ผ๐“ช๐“ฒ๐“ญ "
124 `shouldBe` (Nothing :: Maybe (Either String Value))
126 context "the 'Content-Type' header matches" $ do
127 it "returns Just if the parameter matches" $ do
128 handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
129 "๐•ฅ๐•  ๐•ฅ๐•’๐•๐•œ ๐• ๐•— ๐•ž๐•’๐•Ÿ๐•ช ๐•ฅ๐•™๐•š๐•Ÿ๐•˜๐•ค "
130 `shouldSatisfy` (isJust :: Maybe (Either String Value) -> Bool)
132 it "returns Just if there is no parameter" $ do
133 handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
134 "๐•ฅ๐•  ๐•ฅ๐•’๐•๐•œ ๐• ๐•— ๐•ž๐•’๐•Ÿ๐•ช ๐•ฅ๐•™๐•š๐•Ÿ๐•˜๐•ค "
135 `shouldSatisfy` (isJust :: Maybe (Either String Value) -> Bool)
137 it "returns Just Left if the decoding fails" $ do
138 let isJustLeft :: Maybe (Either String Value) -> Bool
139 isJustLeft (Just (Left _)) = True
140 isJustLeft _ = False
141 handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
142 "๐•บ๐–‹ ๐–˜๐–๐–”๐–Š๐–˜--๐–†๐–“๐–‰ ๐–˜๐–๐–Ž๐–•๐–˜--๐–†๐–“๐–‰ ๐–˜๐–Š๐–†๐–‘๐–Ž๐–“๐–Œ-๐–œ๐–†๐–-- "
143 `shouldSatisfy` isJustLeft
145 it "returns Just (Right val) if the decoding succeeds" $ do
146 let val = SomeData "Of cabbages--and kings" 12
147 handleCTypeH (Proxy :: Proxy '[JSON]) "application/json"
148 (encode val)
149 `shouldBe` Just (Right val)
152data SomeData = SomeData { record1 :: String, record2 :: Int }
153 deriving (Generic, Eq, Show)
155newtype ZeroToOne = ZeroToOne Float
156 deriving (Eq, Show, Ord)
158instance FromJSON SomeData
160instance ToJSON SomeData
162instance Arbitrary SomeData where
163 arbitrary = SomeData <$> arbitrary <*> arbitrary
165instance Arbitrary ZeroToOne where
166 arbitrary = ZeroToOne <$> elements [ x / 10 | x <- [1..10]]
168instance MimeRender OctetStream Int where
169 toByteString _ = cs . show
171instance MimeRender PlainText Int where
172 toByteString _ = cs . show
174instance MimeRender PlainText ByteString where
175 toByteString _ = cs
177instance ToJSON ByteString where
178 toJSON x = object [ "val" .= x ]
180instance IsString AcceptHeader where
181 fromString = AcceptHeader . fromString
183addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
184addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
185 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)
186 cont "" = new
187 cont old = old `append` ", " `append` new