File tree Expand file tree Collapse file tree 2 files changed +2
-28
lines changed
servant-server/src/Servant/Server Expand file tree Collapse file tree 2 files changed +2
-28
lines changed Original file line number Diff line number Diff line change @@ -158,7 +158,7 @@ methodCheck method request
158
158
acceptCheck :: (AllMime list ) => Proxy list -> B. ByteString -> IO (RouteResult () )
159
159
acceptCheck proxy accH
160
160
| canHandleAcceptH proxy (AcceptHeader accH) = return $ Route ()
161
- | otherwise = return $ Fail err406
161
+ | otherwise = return $ FailFatal err406
162
162
163
163
methodRouter :: (AllCTRender ctypes a )
164
164
=> Method -> Proxy ctypes -> Status
Original file line number Diff line number Diff line change @@ -33,34 +33,8 @@ data RouteResult a =
33
33
| Route ! a
34
34
deriving (Eq , Show , Read , Functor )
35
35
36
- data ReqBodyState = Uncalled
37
- | Called ! B. ByteString
38
- | Done ! B. ByteString
39
-
40
36
toApplication :: RoutingApplication -> Application
41
- toApplication ra request respond = do
42
- reqBodyRef <- newIORef Uncalled
43
- -- We may need to consume the requestBody more than once. In order to
44
- -- maintain the illusion that 'requestBody' works as expected,
45
- -- 'ReqBodyState' is introduced, and the complete body is memoized and
46
- -- returned as many times as requested with empty "Done" marker chunks in
47
- -- between.
48
- -- See https://github.com/haskell-servant/servant/issues/3
49
- let memoReqBody = do
50
- ior <- readIORef reqBodyRef
51
- case ior of
52
- Uncalled -> do
53
- r <- BL. toStrict <$> strictRequestBody request
54
- writeIORef reqBodyRef $ Done r
55
- return r
56
- Called bs -> do
57
- writeIORef reqBodyRef $ Done bs
58
- return bs
59
- Done bs -> do
60
- writeIORef reqBodyRef $ Called bs
61
- return B. empty
62
-
63
- ra request{ requestBody = memoReqBody } routingRespond
37
+ toApplication ra request respond = ra request routingRespond
64
38
where
65
39
routingRespond :: RouteResult Response -> IO ResponseReceived
66
40
routingRespond (Fail err) = respond $ responseServantErr err
You can’t perform that action at this time.
0 commit comments