git.iko.soy/servant
on master help sign in
introduce InvalidBody as the 'stickiest' route mismatch reason. code review changes too, to close #14 close #11 close #10
9ade9a4Alp Mestanogullari
src/Servant/API/Union.hs+3−5
compare with master
unifiedsplit
@@ -16,11 +16,9 @@ instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
16 type Server (a :<|> b) = Server a :<|> Server b
16 type Server (a :<|> b) = Server a :<|> Server b
17 route Proxy (a :<|> b) request respond =
17 route Proxy (a :<|> b) request respond =
18 route pa a request $ \ mResponse ->
18 route pa a request $ \ mResponse ->
19− case isMismatch mResponse of
19+ if isMismatch mResponse
20− True -> route pb b request $ \mResponse' ->
21− respond (mResponse <> mResponse')
20+ then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
22− False -> respond mResponse
21+ else respond mResponse
23−
24
22
25 where pa = Proxy :: Proxy a
23 where pa = Proxy :: Proxy a
26 pb = Proxy :: Proxy b
24 pb = Proxy :: Proxy b
src/Servant/Server.hs+13−4
@@ -27,6 +27,8 @@ toApplication ra request respond = do
27 respond $ responseLBS notFound404 [] "not found"
27 respond $ responseLBS notFound404 [] "not found"
28 routingRespond (Left WrongMethod) =
28 routingRespond (Left WrongMethod) =
29 respond $ responseLBS methodNotAllowed405 [] "method not allowed"
29 respond $ responseLBS methodNotAllowed405 [] "method not allowed"
30+ routingRespond (Left InvalidBody) =
31+ respond $ responseLBS badRequest400 [] "Invalid JSON in request body"
30 routingRespond (Right response) =
32 routingRespond (Right response) =
31 respond response
33 respond response
32
34
@@ -34,18 +36,25 @@ toApplication ra request respond = do
34data RouteMismatch =
36data RouteMismatch =
35 NotFound -- ^ the usual "not found" error
37 NotFound -- ^ the usual "not found" error
36 | WrongMethod -- ^ a more informative "you just got the HTTP method wrong" error
38 | WrongMethod -- ^ a more informative "you just got the HTTP method wrong" error
39+ | InvalidBody -- ^ an even more informative "you json request body wasn't valid" error
37 deriving (Eq, Show)
40 deriving (Eq, Show)
38
41
39-- |
42-- |
40-- @
43-- @
44+-- > mempty = NotFound
45+-- >
41−-- 'NotFound' <> x = x
46+-- > NotFound `mappend` x = x
47+-- > WrongMethod `mappend` InvalidBody = InvalidBody
42−-- 'WrongMethod' <> _ = 'WrongMethod'
48+-- > WrongMethod `mappend` _ = WrongMethod
49+-- > InvalidBody `mappend` _ = InvalidBody
43-- @
50-- @
44instance Monoid RouteMismatch where
51instance Monoid RouteMismatch where
45 mempty = NotFound
52 mempty = NotFound
46
53
47− NotFound `mappend` x = x
54+ NotFound `mappend` x = x
48− WrongMethod `mappend` _ = WrongMethod
55+ WrongMethod `mappend` InvalidBody = InvalidBody
56+ WrongMethod `mappend` _ = WrongMethod
57+ InvalidBody `mappend` _ = InvalidBody
49
58
50-- | A wrapper around @'Either' 'RouteMismatch' a@.
59-- | A wrapper around @'Either' 'RouteMismatch' a@.
51newtype RouteResult a =
60newtype RouteResult a =