diff --git a/servant-server/CHANGELOG.md b/servant-server/CHANGELOG.md index f45823eb..5ba871ee 100644 --- a/servant-server/CHANGELOG.md +++ b/servant-server/CHANGELOG.md @@ -7,9 +7,7 @@ HEAD * Remove matrix params. * Remove `RouteMismatch`. * Redefined constructors of `RouteResult`. -* Add `failFatallyWith`. -* Make all (framework-generated) HTTP errors except 404 and 405 not try other - handlers. +* Added `Delayed` and related functions (`addMethodCheck`, `addAcceptCheck`, `addBodyCheck`, `runDelayed`) 0.4.1 ----- diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 9b69d9c4..8d6beac4 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -95,6 +95,7 @@ test-suite spec Servant.Server.Internal.EnterSpec Servant.ServerSpec Servant.Utils.StaticFilesSpec + Servant.Server.ErrorSpec build-depends: base == 4.* , aeson diff --git a/servant-server/src/Servant/Server/Internal/Router.hs b/servant-server/src/Servant/Server/Internal/Router.hs index 63b05c05..6f4ebfbb 100644 --- a/servant-server/src/Servant/Server/Internal/Router.hs +++ b/servant-server/src/Servant/Server/Internal/Router.hs @@ -6,7 +6,6 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Text (Text) import Network.Wai (Request, Response, pathInfo) -import Servant.Server.Internal.PathInfo import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.ServantErr diff --git a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs index cc3f5965..4b27c688 100644 --- a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs +++ b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs @@ -8,9 +8,7 @@ module Servant.Server.Internal.RoutingApplication where #if !MIN_VERSION_base(4,8,0) -import Control.Applicative (Applicative, (<$>)) -import Data.Monoid (Monoid, mappend, mempty, - (<>)) +import Control.Applicative ((<$>)) #endif import Control.Monad.Trans.Except (ExceptT, runExceptT) import qualified Data.ByteString as B @@ -69,8 +67,6 @@ toApplication ra request respond = do routingRespond (FailFatal err) = respond $ responseServantErr err routingRespond (Route v) = respond v --- TODO: The above may not be quite right yet. --- -- We currently mix up the order in which we perform checks -- and the priority with which errors are reported. -- @@ -162,7 +158,8 @@ data Delayed :: * -> * where -> (a -> b -> RouteResult c) -> Delayed c -deriving instance Functor Delayed +instance Functor Delayed where + fmap f (Delayed a b c g) = Delayed a b c ((fmap.fmap.fmap) f g) -- | Add a capture to the end of the capture block. addCapture :: Delayed (a -> b) diff --git a/servant-server/test/Servant/Server/ErrorSpec.hs b/servant-server/test/Servant/Server/ErrorSpec.hs index 60212a4a..2e93cc2a 100644 --- a/servant-server/test/Servant/Server/ErrorSpec.hs +++ b/servant-server/test/Servant/Server/ErrorSpec.hs @@ -18,24 +18,6 @@ import Test.Hspec.Wai import Servant - --- The semantics of routing and handling requests should be as follows: --- --- 1) Check whether one or more endpoints have the right path. Otherwise --- return 404. --- 2) Check whether the one of those have the right method. Otherwise return --- 405. If so, pick the first. We've now committed to calling at most one --- handler. --- 3) Check whether the Content-Type is known. Otherwise return 415. --- 4) Check whether that one deserializes the body. Otherwise return 400. If --- there was no Content-Type, try the first one of the API content-type list. --- 5) Check whether the request is authorized. Otherwise return a 401. --- 6) Check whether the request is forbidden. If so return 403. --- 7) Check whether the request has a known Accept. Otherwise return 406. --- 8) Check whether Accept-Language, Accept-Charset and Accept-Encoding --- exist and match. We can follow the webmachine order here. --- 9) Call the handler. Whatever it returns, we return. - spec :: Spec spec = describe "HTTP Errors" $ do errorOrderSpec @@ -174,9 +156,7 @@ errorRetrySpec :: Spec errorRetrySpec = describe "Handler search" $ with (return $ serve errorRetryApi errorRetryServer) $ do - let plainCT = (hContentType, "text/plain") - plainAccept = (hAccept, "text/plain") - jsonCT = (hContentType, "application/json") + let jsonCT = (hContentType, "application/json") jsonAccept = (hAccept, "application/json") jsonBody = encode (1797 :: Int) diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 11816853..e017d399 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -33,21 +33,6 @@ import Network.Wai (Application, Request, pathInfo, import Network.Wai.Internal (Response(ResponseBuilder)) import Network.Wai.Test (defaultRequest, request, runSession, simpleBody) -import Servant.API ((:<|>) (..), (:>), Capture, Delete, - Get, Header (..), Headers, - HttpVersion, IsSecure (..), JSON, - MatrixFlag, MatrixParam, - MatrixParams, Patch, PlainText, - Post, Put, QueryFlag, QueryParam, - QueryParams, Raw, RemoteHost, - ReqBody, addHeader) -import Servant.Server (ServantErr (..), Server, err404, - serve) -import Test.Hspec (Spec, describe, it, shouldBe) -import Test.Hspec.Wai (get, liftIO, matchHeaders, - matchStatus, post, request, - shouldRespondWith, with, (<:>)) -<<<<<<< HEAD import Servant.API ((:<|>) (..), (:>), Capture, Delete, Get, Header (..), Headers, HttpVersion, IsSecure (..), JSON, @@ -56,9 +41,11 @@ import Servant.API ((:<|>) (..), (:>), Capture, Delete, Raw, RemoteHost, ReqBody, addHeader) import Servant.Server (Server, serve, ServantErr(..), err404) -======= +import Test.Hspec (Spec, describe, it, shouldBe) +import Test.Hspec.Wai (get, liftIO, matchHeaders, + matchStatus, post, request, + shouldRespondWith, with, (<:>)) import Servant.Server.Internal.RoutingApplication (toApplication, RouteResult(..)) ->>>>>>> Rebase cleanup and test fixes. import Servant.Server.Internal.Router (tweakResponse, runRouter, Router, Router'(LeafRouter))