d876031 · servant · git.iko.soy

servant-server/CHANGELOG.md+4

compare with master

unifiedsplit

@@ -7,6 +7,10 @@

7 efficiently. Functions `layout` and `layoutWithContext` have been

8 added to visualize the router layout for debugging purposes. Test

9 cases for expected router layouts have been added.

10+* If an endpoint is discovered to have a non-matching "accept header",

11+ this is now a recoverable rather than a fatal failure, allowing

12+ different endpoints for the same route, but with different content

13+ types to be specified modularly.

10* Export `throwError` from module `Servant`

14* Export `throwError` from module `Servant`

11* Add `Handler` type synonym

15* Add `Handler` type synonym

12

16

servant-server/src/Servant/Server/Internal.hs+8−1

@@ -154,10 +154,17 @@ methodCheck method request

154 | allowedMethod method request = return ()

155 | otherwise = delayedFail err405

156

157+-- This has switched between using 'Fail' and 'FailFatal' a number of

158+-- times. If the 'acceptCheck' is run after the body check (which would

159+-- be morally right), then we have to set this to 'FailFatal', because

160+-- the body check is not reversible, and therefore backtracking after the

161+-- body check is no longer an option. However, we now run the accept

162+-- check before the body check and can therefore afford to make it

163+-- recoverable.

157acceptCheck :: (AllMime list) => Proxy list -> B.ByteString -> DelayedIO ()

164acceptCheck :: (AllMime list) => Proxy list -> B.ByteString -> DelayedIO ()

158acceptCheck proxy accH

165acceptCheck proxy accH

159 | canHandleAcceptH proxy (AcceptHeader accH) = return ()

166 | canHandleAcceptH proxy (AcceptHeader accH) = return ()

160− | otherwise = delayedFailFatal err406

167+ | otherwise = delayedFail err406

161

168

162methodRouter :: (AllCTRender ctypes a)

169methodRouter :: (AllCTRender ctypes a)

163 => Method -> Proxy ctypes -> Status

170 => Method -> Proxy ctypes -> Status

servant-server/src/Servant/Server/Internal/RoutingApplication.hs+11−5

@@ -203,16 +203,22 @@ addBodyCheck Delayed{..} new =

203 } -- Note [Existential Record Update]

204

205

206−-- | Add an accept header check to the end of the body block.

206+-- | Add an accept header check to the beginning of the body

207−-- The accept header check should occur after the body check,

207+-- block. There is a tradeoff here. In principle, we'd like

208−-- but this will be the case, because the accept header check

208+-- to take a bad body (400) response take precedence over a

209−-- is only scheduled by the method combinators.

209+-- failed accept check (406). BUT to allow streaming the body,

210+-- we cannot run the body check and then still backtrack.

211+-- We therefore do the accept check before the body check,

212+-- when we can still backtrack. There are other solutions to

213+-- this, but they'd be more complicated (such as delaying the

214+-- body check further so that it can still be run in a situation

215+-- where we'd otherwise report 406).

210addAcceptCheck :: Delayed env a

216addAcceptCheck :: Delayed env a

211 -> DelayedIO ()

217 -> DelayedIO ()

212 -> Delayed env a

218 -> Delayed env a

213addAcceptCheck Delayed{..} new =

219addAcceptCheck Delayed{..} new =

214 Delayed

220 Delayed

215− { bodyD = bodyD <* new

221+ { bodyD = new *> bodyD

216 , ..

222 , ..

217 } -- Note [Existential Record Update]

223 } -- Note [Existential Record Update]

218

224

servant-server/test/Servant/Server/ErrorSpec.hs+24−7

@@ -53,6 +53,23 @@ errorOrderApi = Proxy

53errorOrderServer :: Server ErrorOrderApi

54errorOrderServer = \_ _ _ -> throwE err402

55

56+-- On error priorities:

57+--

58+-- We originally had

59+--

60+-- 404, 405, 401, 415, 400, 406, 402

61+--

62+-- but we changed this to

63+--

64+-- 404, 405, 401, 406, 415, 400, 402

65+--

66+-- for servant-0.7.

67+--

68+-- This change is due to the body check being irreversible (to support

69+-- streaming). Any check done after the body check has to be made fatal,

70+-- breaking modularity. We've therefore moved the accept check before

71+-- the body check, to allow it being recoverable and modular, and this

72+-- goes along with promoting the error priority of 406.

56errorOrderSpec :: Spec

73errorOrderSpec :: Spec

57errorOrderSpec =

74errorOrderSpec =

58 describe "HTTP error order" $

75 describe "HTTP error order" $

@@ -86,18 +103,18 @@ errorOrderSpec =

86 request goodMethod goodUrl [badAuth, badContentType, badAccept] badBody

103 request goodMethod goodUrl [badAuth, badContentType, badAccept] badBody

87 `shouldRespondWith` 401

104 `shouldRespondWith` 401

88

105

89− it "has 415 as its fourth highest priority error" $ do

106+ it "has 406 as its fourth highest priority error" $ do

90 request goodMethod goodUrl [goodAuth, badContentType, badAccept] badBody

107 request goodMethod goodUrl [goodAuth, badContentType, badAccept] badBody

108+ `shouldRespondWith` 406

109+

110+ it "has 415 as its fifth highest priority error" $ do

111+ request goodMethod goodUrl [goodAuth, badContentType, goodAccept] badBody

91 `shouldRespondWith` 415

112 `shouldRespondWith` 415

92

113

93− it "has 400 as its fifth highest priority error" $ do

114+ it "has 400 as its sixth highest priority error" $ do

94− request goodMethod goodUrl [goodAuth, goodContentType, badAccept] badBody

115+ request goodMethod goodUrl [goodAuth, goodContentType, goodAccept] badBody

95 `shouldRespondWith` 400

116 `shouldRespondWith` 400

96

117

97− it "has 406 as its sixth highest priority error" $ do

98− request goodMethod goodUrl [goodAuth, goodContentType, badAccept] goodBody

99− `shouldRespondWith` 406

100−

101 it "has handler-level errors as last priority" $ do

118 it "has handler-level errors as last priority" $ do

102 request goodMethod goodUrl [goodAuth, goodContentType, goodAccept] goodBody

119 request goodMethod goodUrl [goodAuth, goodContentType, goodAccept] goodBody

103 `shouldRespondWith` 402

120 `shouldRespondWith` 402

servant-server/test/Servant/ServerSpec.hs+10

@@ -99,6 +99,9 @@ type VerbApi method status

99 :<|> "noContent" :> Verb method status '[JSON] NoContent

100 :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person)

101 :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent)

102+ :<|> "accept" :> ( Verb method status '[JSON] Person

103+ :<|> Verb method status '[PlainText] String

104+ )

102

105

103verbSpec :: Spec

106verbSpec :: Spec

104verbSpec = describe "Servant.API.Verb" $ do

107verbSpec = describe "Servant.API.Verb" $ do

@@ -107,6 +110,7 @@ verbSpec = describe "Servant.API.Verb" $ do

107 :<|> return NoContent

110 :<|> return NoContent

108 :<|> return (addHeader 5 alice)

111 :<|> return (addHeader 5 alice)

109 :<|> return (addHeader 10 NoContent)

112 :<|> return (addHeader 10 NoContent)

113+ :<|> (return alice :<|> return "B")

110 get200 = Proxy :: Proxy (VerbApi 'GET 200)

114 get200 = Proxy :: Proxy (VerbApi 'GET 200)

111 post210 = Proxy :: Proxy (VerbApi 'POST 210)

115 post210 = Proxy :: Proxy (VerbApi 'POST 210)

112 put203 = Proxy :: Proxy (VerbApi 'PUT 203)

116 put203 = Proxy :: Proxy (VerbApi 'PUT 203)

@@ -161,6 +165,12 @@ verbSpec = describe "Servant.API.Verb" $ do

161 [(hAccept, "application/json")] ""

165 [(hAccept, "application/json")] ""

162 liftIO $ statusCode (simpleStatus response) `shouldBe` status

166 liftIO $ statusCode (simpleStatus response) `shouldBe` status

163

167

168+ unless (status `elem` [214, 215] || method == methodHead) $

169+ it "allows modular specification of supported content types" $ do

170+ response <- THW.request method "/accept" [(hAccept, "text/plain")] ""

171+ liftIO $ statusCode (simpleStatus response) `shouldBe` status

172+ liftIO $ simpleBody response `shouldBe` "B"

173+

164 it "sets the Content-Type header" $ do

174 it "sets the Content-Type header" $ do

165 response <- THW.request method "" [] ""

175 response <- THW.request method "" [] ""

166 liftIO $ simpleHeaders response `shouldContain`

176 liftIO $ simpleHeaders response `shouldContain`