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