git.iko.soy/typeable/servant
on master help sign in
Error retry tests
153de01Julian K. Arni
servant-server/test/Servant/Server/ErrorSpec.hs+118−43
compare with master
unifiedsplit
@@ -1,15 +1,19 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE MultiParamTypeClasses #-}
1−{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE TypeOperators #-}
4+{-# LANGUAGE TypeOperators #-}
3−{-# LANGUAGE DataKinds #-}
5+{-# OPTIONS_GHC -fno-warn-orphans #-}
4module Servant.Server.ErrorSpec (spec) where
6module Servant.Server.ErrorSpec (spec) where
5
7
6−import Test.Hspec
8+import Data.Aeson (encode)
9+import qualified Data.ByteString.Lazy.Char8 as BC
10+import Control.Monad.Trans.Either (left)
7−import Data.Proxy
11+import Data.Proxy
8−import Test.Hspec.Wai (request, with, shouldRespondWith)
9−import Network.HTTP.Types (methodGet, methodPost)
12+import Network.HTTP.Types (methodGet, methodPost)
10−import Data.Aeson (encode)
13+import Test.Hspec
14+import Test.Hspec.Wai
11
15
12−import Servant
16+import Servant
13
17
14
18
15-- 1) Check whether one or more endpoints have the right path. Otherwise return 404.
19-- 1) Check whether one or more endpoints have the right path. Otherwise return 404.
@@ -26,9 +30,12 @@ import Servant
26-- 9) Call the handler. Whatever it returns, we return.
30-- 9) Call the handler. Whatever it returns, we return.
27
31
28spec :: Spec
32spec :: Spec
29−spec = do
33+spec = describe "HTTP Errors" $ do
30 errorOrder
34 errorOrder
35+ errorRetry
31
36
37+------------------------------------------------------------------------------
38+-- * Error Order {{{
32
39
33type ErrorOrderApi = "home"
40type ErrorOrderApi = "home"
34 :> ReqBody '[JSON] Int
41 :> ReqBody '[JSON] Int
@@ -39,40 +46,108 @@ errorOrderApi :: Proxy ErrorOrderApi
39errorOrderApi = Proxy
46errorOrderApi = Proxy
40
47
41errorOrderServer :: Server ErrorOrderApi
48errorOrderServer :: Server ErrorOrderApi
42−errorOrderServer = \_ _ -> return 10
49+errorOrderServer = \_ _ -> left err402
43
50
44errorOrder :: Spec
51errorOrder :: Spec
45errorOrder = describe "HTTP error order"
52errorOrder = describe "HTTP error order"
46 $ with (return $ serve errorOrderApi errorOrderServer) $ do
53 $ with (return $ serve errorOrderApi errorOrderServer) $ do
47− let badContentType = ("Content-Type", "text/plain")
54+ let badContentType = ("Content-Type", "text/plain")
48− badAccept = ("Accept", "text/plain")
55+ badAccept = ("Accept", "text/plain")
49− badMethod = methodGet
56+ badMethod = methodGet
50− badUrl = "home/nonexistent"
57+ badUrl = "home/nonexistent"
51− badBody = "nonsense"
58+ badBody = "nonsense"
52− goodContentType = ("Content-Type", "application/json")
59+ goodContentType = ("Content-Type", "application/json")
53− goodAccept = ("Accept", "application/json")
60+ goodAccept = ("Accept", "application/json")
54− goodMethod = methodPost
61+ goodMethod = methodPost
55− goodUrl = "home/5"
62+ goodUrl = "home/5"
56− goodBody = encode (5 :: Int)
63+ goodBody = encode (5 :: Int)
57−
64+
58− it "has 404 as its highest priority error" $ do
65+ it "has 404 as its highest priority error" $ do
59− request badMethod badUrl [badContentType, badAccept] badBody
66+ request badMethod badUrl [badContentType, badAccept] badBody
60− `shouldRespondWith` 404
67+ `shouldRespondWith` 404
61−
68+
62− it "has 405 as its second highest priority error" $ do
69+ it "has 405 as its second highest priority error" $ do
63− request badMethod goodUrl [badContentType, badAccept] badBody
70+ request badMethod goodUrl [badContentType, badAccept] badBody
64− `shouldRespondWith` 405
71+ `shouldRespondWith` 405
65−
72+
66− it "has 415 as its third highest priority error" $ do
73+ it "has 415 as its third highest priority error" $ do
67− request goodMethod goodUrl [badContentType, badAccept] badBody
74+ request goodMethod goodUrl [badContentType, badAccept] badBody
68− `shouldRespondWith` 415
75+ `shouldRespondWith` 415
69−
76+
70− it "has 400 as its fourth highest priority error" $ do
77+ it "has 400 as its fourth highest priority error" $ do
71− request goodMethod goodUrl [goodContentType, badAccept] badBody
78+ request goodMethod goodUrl [goodContentType, badAccept] badBody
72− `shouldRespondWith` 400
79+ `shouldRespondWith` 400
73−
80+
74− it "has 406 as its fifth highest priority error" $ do
81+ it "has 406 as its fifth highest priority error" $ do
75− request goodMethod goodUrl [goodContentType, badAccept] goodBody
82+ request goodMethod goodUrl [goodContentType, badAccept] goodBody
76− `shouldRespondWith` 406
83+ `shouldRespondWith` 406
77−
84+
78−
85+ it "returns handler errors as its lower priority errors" $ do
86+ request goodMethod goodUrl [goodContentType, goodAccept] goodBody
87+ `shouldRespondWith` 402
88+
89+-- }}}
90+------------------------------------------------------------------------------
91+-- * Error Retry {{{
92+
93+type ErrorRetryApi
94+ = "a" :> ReqBody '[JSON] Int :> Post '[JSON] Int -- 0
95+ :<|> "a" :> ReqBody '[PlainText] Int :> Post '[JSON] Int -- 1
96+ :<|> "a" :> ReqBody '[JSON] Int :> Post '[PlainText] Int -- 2
97+ :<|> "a" :> ReqBody '[JSON] String :> Post '[JSON] Int -- 3
98+ :<|> "a" :> ReqBody '[JSON] Int :> Get '[PlainText] Int -- 4
99+ :<|> ReqBody '[JSON] Int :> Get '[JSON] Int -- 5
100+ :<|> ReqBody '[JSON] Int :> Get '[JSON] Int -- 6
101+
102+errorRetryApi :: Proxy ErrorRetryApi
103+errorRetryApi = Proxy
104+
105+errorRetryServer :: Server ErrorRetryApi
106+errorRetryServer
107+ = (\_ -> return 0)
108+ :<|> (\_ -> return 1)
109+ :<|> (\_ -> return 2)
110+ :<|> (\_ -> return 3)
111+ :<|> (\_ -> return 4)
112+ :<|> (\_ -> return 5)
113+ :<|> (\_ -> return 6)
114+
115+errorRetry :: Spec
116+errorRetry = describe "Handler search"
117+ $ with (return $ serve errorRetryApi errorRetryServer) $ do
118+ let plainCT = ("Content-Type", "text/plain")
119+ plainAccept = ("Accept", "text/plain")
120+ jsonCT = ("Content-Type", "application/json")
121+ jsonAccept = ("Accept", "application/json")
122+ jsonBody = encode (1797 :: Int)
123+
124+ it "should continue when URLs don't match" $ do
125+ request methodPost "" [jsonCT, jsonAccept] jsonBody
126+ `shouldRespondWith` 201 { matchBody = Just $ encode (5 :: Int) }
127+
128+ it "should continue when methods don't match" $ do
129+ request methodGet "a" [jsonCT, jsonAccept] jsonBody
130+ `shouldRespondWith` 200 { matchBody = Just $ encode (4 :: Int) }
131+
132+ it "should not continue when Content-Types don't match" $ do
133+ request methodPost "a" [plainCT, jsonAccept] jsonBody
134+ `shouldRespondWith` 415
135+
136+ it "should not continue when body can't be deserialized" $ do
137+ request methodPost "a" [jsonCT, jsonAccept] (encode ("nonsense" :: String))
138+ `shouldRespondWith` 400
139+
140+ it "should not continue when Accepts don't match" $ do
141+ request methodPost "a" [jsonCT, plainAccept] jsonBody
142+ `shouldRespondWith` 406
143+
144+-- }}}
145+------------------------------------------------------------------------------
146+-- * Instances {{{
147+
148+instance MimeUnrender PlainText Int where
149+ mimeUnrender _ = Right . read . BC.unpack
150+
151+instance MimeRender PlainText Int where
152+ mimeRender _ = BC.pack . show
153+-- }}}
servant/CHANGELOG.md+1
@@ -6,6 +6,7 @@ HEAD
6* Add more instances for (:<|>)
6* Add more instances for (:<|>)
7* Use `http-api-data` instead of `Servant.Common.Text`
7* Use `http-api-data` instead of `Servant.Common.Text`
8* Remove matrix params.
8* Remove matrix params.
9+* Add PlainText String MimeRender and MimeUnrender instances.
9
10
100.4.2
110.4.2
11-----
12-----
servant/src/Servant/API/ContentTypes.hs+9
@@ -80,6 +80,7 @@ import qualified Data.ByteString as BS
80import Data.ByteString.Lazy (ByteString, fromStrict,
80import Data.ByteString.Lazy (ByteString, fromStrict,
81 toStrict)
81 toStrict)
82import qualified Data.ByteString.Lazy as B
82import qualified Data.ByteString.Lazy as B
83+import qualified Data.ByteString.Lazy.Char8 as BC
83import Data.Monoid
84import Data.Monoid
84import Data.String.Conversions (cs)
85import Data.String.Conversions (cs)
85import qualified Data.Text as TextS
86import qualified Data.Text as TextS
@@ -279,6 +280,10 @@ instance MimeRender PlainText TextL.Text where
279instance MimeRender PlainText TextS.Text where
280instance MimeRender PlainText TextS.Text where
280 mimeRender _ = fromStrict . TextS.encodeUtf8
281 mimeRender _ = fromStrict . TextS.encodeUtf8
281
282
283+-- | @BC.pack@
284+instance MimeRender PlainText String where
285+ mimeRender _ = BC.pack
286+
282-- | @id@
287-- | @id@
283instance MimeRender OctetStream ByteString where
288instance MimeRender OctetStream ByteString where
284 mimeRender _ = id
289 mimeRender _ = id
@@ -328,6 +333,10 @@ instance MimeUnrender PlainText TextL.Text where
328instance MimeUnrender PlainText TextS.Text where
333instance MimeUnrender PlainText TextS.Text where
329 mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict
334 mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict
330
335
336+-- | @Right . BC.unpack@
337+instance MimeUnrender PlainText String where
338+ mimeUnrender _ = Right . BC.unpack
339+
331-- | @Right . id@
340-- | @Right . id@
332instance MimeUnrender OctetStream ByteString where
341instance MimeUnrender OctetStream ByteString where
333 mimeUnrender _ = Right . id
342 mimeUnrender _ = Right . id