Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type RoutingApplication m = Request -> (RouteResult Response -> m Response) -> m Response
- data RouteResult a
- = Fail ServantErr
- | FailFatal !ServantErr
- | Route !a
- toApplication :: forall m. MonadSnap m => RoutingApplication m -> Application m
- responseLBS :: Status -> [(CI ByteString, ByteString)] -> ByteString -> Response
- runAction :: MonadSnap m => Delayed m env (m a) -> env -> Request -> (RouteResult Response -> m r) -> (a -> RouteResult Response) -> m r
- data Delayed m env c where
- newtype DelayedM m a = DelayedM {
- runDelayedM :: Request -> m (RouteResult a)
- emptyDelayed :: Monad m => Proxy (m :: * -> *) -> RouteResult a -> Delayed m env a
- delayedFail :: Monad m => ServantErr -> DelayedM m a
- delayedFailFatal :: Monad m => ServantErr -> DelayedM m a
- withRequest :: (Request -> DelayedM m a) -> DelayedM m a
- addCapture :: forall env a b captured m. Monad m => Delayed m env (a -> b) -> (captured -> DelayedM m a) -> Delayed m (captured, env) b
- addParameterCheck :: Monad m => Delayed m env (a -> b) -> DelayedM m a -> Delayed m env b
- addHeaderCheck :: Monad m => Delayed m env (a -> b) -> DelayedM m a -> Delayed m env b
- addMethodCheck :: Monad m => Delayed m env a -> DelayedM m () -> Delayed m env a
- addAuthCheck :: Monad m => Delayed m env (a -> b) -> DelayedM m a -> Delayed m env b
- addBodyCheck :: Monad m => Delayed m env (a -> b) -> DelayedM m c -> (c -> DelayedM m a) -> Delayed m env b
- addAcceptCheck :: Monad m => Delayed m env a -> DelayedM m () -> Delayed m env a
- passToServer :: Delayed m env (a -> b) -> (Request -> a) -> Delayed m env b
- runDelayed :: Monad m => Delayed m env a -> env -> Request -> m (RouteResult a)
Documentation
type RoutingApplication m Source #
= Request | the request, the field |
-> (RouteResult Response -> m Response) | |
-> m Response |
data RouteResult a Source #
The result of matching against a path in the route tree.
Fail ServantErr | Keep trying other paths. The |
FailFatal !ServantErr | Don't try other paths. |
Route !a |
Instances
Functor RouteResult Source # | |
Defined in Servant.Server.Internal.RoutingApplication fmap :: (a -> b) -> RouteResult a -> RouteResult b # (<$) :: a -> RouteResult b -> RouteResult a # | |
Eq a => Eq (RouteResult a) Source # | |
Defined in Servant.Server.Internal.RoutingApplication (==) :: RouteResult a -> RouteResult a -> Bool # (/=) :: RouteResult a -> RouteResult a -> Bool # | |
Read a => Read (RouteResult a) Source # | |
Defined in Servant.Server.Internal.RoutingApplication readsPrec :: Int -> ReadS (RouteResult a) # readList :: ReadS [RouteResult a] # readPrec :: ReadPrec (RouteResult a) # readListPrec :: ReadPrec [RouteResult a] # | |
Show a => Show (RouteResult a) Source # | |
Defined in Servant.Server.Internal.RoutingApplication showsPrec :: Int -> RouteResult a -> ShowS # show :: RouteResult a -> String # showList :: [RouteResult a] -> ShowS # |
toApplication :: forall m. MonadSnap m => RoutingApplication m -> Application m Source #
responseLBS :: Status -> [(CI ByteString, ByteString)] -> ByteString -> Response Source #
runAction :: MonadSnap m => Delayed m env (m a) -> env -> Request -> (RouteResult Response -> m r) -> (a -> RouteResult Response) -> m r Source #
data Delayed m env c where Source #
Delayed | |
|
DelayedM | |
|
Instances
MonadTrans DelayedM Source # | |
Defined in Servant.Server.Internal.RoutingApplication | |
Monad m => Monad (DelayedM m) Source # | |
Monad m => Functor (DelayedM m) Source # | |
Monad m => Applicative (DelayedM m) Source # | |
Defined in Servant.Server.Internal.RoutingApplication | |
(Monad m, MonadSnap m) => Alternative (DelayedM m) Source # | |
MonadIO m => MonadIO (DelayedM m) Source # | |
Defined in Servant.Server.Internal.RoutingApplication |
emptyDelayed :: Monad m => Proxy (m :: * -> *) -> RouteResult a -> Delayed m env a Source #
A Delayed
without any stored checks.
delayedFail :: Monad m => ServantErr -> DelayedM m a Source #
Fail with the option to recover.
delayedFailFatal :: Monad m => ServantErr -> DelayedM m a Source #
Fail fatally, i.e., without any option to recover.
withRequest :: (Request -> DelayedM m a) -> DelayedM m a Source #
Gain access to the incoming request.
addCapture :: forall env a b captured m. Monad m => Delayed m env (a -> b) -> (captured -> DelayedM m a) -> Delayed m (captured, env) b Source #
Add a capture to the end of the capture block.
addParameterCheck :: Monad m => Delayed m env (a -> b) -> DelayedM m a -> Delayed m env b Source #
Add a parameter check to the end of the params block
addHeaderCheck :: Monad m => Delayed m env (a -> b) -> DelayedM m a -> Delayed m env b Source #
Add a header check to the end of the headers block
addMethodCheck :: Monad m => Delayed m env a -> DelayedM m () -> Delayed m env a Source #
Add a method check to the end of the method block.
addAuthCheck :: Monad m => Delayed m env (a -> b) -> DelayedM m a -> Delayed m env b Source #
Add an auth check to the end of the auth block.
:: Monad m | |
=> Delayed m env (a -> b) | |
-> DelayedM m c | content type check |
-> (c -> DelayedM m a) | body check |
-> Delayed m env b |
Add a content type and body checks around parameter checks.
We'll report failed content type check (415), before trying to parse query parameters (400). Which, in turn, happens before request body parsing.
addAcceptCheck :: Monad m => Delayed m env a -> DelayedM m () -> Delayed m env a Source #
Add an accept header check before handling parameters. In principle, we'd like to take a bad body (400) response take precedence over a failed accept check (406). BUT to allow streaming the body, we cannot run the body check and then still backtrack. We therefore do the accept check before the body check, when we can still backtrack. There are other solutions to this, but they'd be more complicated (such as delaying the body check further so that it can still be run in a situation where we'd otherwise report 406).
passToServer :: Delayed m env (a -> b) -> (Request -> a) -> Delayed m env b Source #
Many combinators extract information that is passed to
the handler without the possibility of failure. In such a
case, passToServer
can be used.
runDelayed :: Monad m => Delayed m env a -> env -> Request -> m (RouteResult a) Source #
Run a delayed server. Performs all scheduled operations in order, and passes the results from the capture and body blocks on to the actual handler.
This should only be called once per request; otherwise the guarantees about effect and HTTP error ordering break down.