    {-# LANGUAGE CPP                   #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE GADTs                 #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE RecordWildCards       #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE TypeOperators         #-}
    {-# LANGUAGE UndecidableInstances  #-}
    module Servant.Server.Internal.Delayed where

    import           Control.Monad.IO.Class
                     (MonadIO (..))
    import           Control.Monad.Reader
                     (ask)
    import           Control.Monad.Trans.Resource
                     (ResourceT, runResourceT)
    import           Network.Wai
                     (Request, Response)

    import           Servant.Server.Internal.DelayedIO
    import           Servant.Server.Internal.Handler
    import           Servant.Server.Internal.RouteResult
    import           Servant.Server.Internal.ServerError

    -- | A 'Delayed' is a representation of a handler with scheduled
    -- delayed checks that can trigger errors.
    --
    -- Why would we want to delay checks?
    --
    -- There are two reasons:
    --
    -- 1. In a straight-forward implementation, the order in which we
    -- perform checks will determine the error we generate. This is
    -- because once an error occurs, we would abort and not perform
    -- any subsequent checks, but rather return the current error.
    --
    -- This is not a necessity: we could continue doing other checks,
    -- and choose the preferred error. However, that would in general
    -- mean more checking, which leads us to the other reason.
    --
    -- 2. We really want to avoid doing certain checks too early. For
    -- example, captures involve parsing, and are much more costly
    -- than static route matches. In particular, if several paths
    -- contain the "same" capture, we'd like as much as possible to
    -- avoid trying the same parse many times. Also tricky is the
    -- request body. Again, this involves parsing, but also, WAI makes
    -- obtaining the request body a side-effecting operation. We
    -- could/can work around this by manually caching the request body,
    -- but we'd rather keep the number of times we actually try to
    -- decode the request body to an absolute minimum.
    --
    -- We prefer to have the following relative priorities of error
    -- codes:
    --
    -- @
    -- 404
    -- 405 (bad method)
    -- 401 (unauthorized)
    -- 415 (unsupported media type)
    -- 406 (not acceptable)
    -- 400 (bad request)
    -- @
    --
    -- Therefore, while routing, we delay most checks so that they
    -- will ultimately occur in the right order.
    --
    -- A 'Delayed' contains many delayed blocks of tests, and
    -- the actual handler:
    --
    -- 1. Delayed captures. These can actually cause 404, and
    -- while they're costly, they should be done first among the
    -- delayed checks (at least as long as we do not decouple the
    -- check order from the error reporting, see above). Delayed
    -- captures can provide inputs to the actual handler.
    --
    -- 2. Method check(s). This can cause a 405. On success,
    -- it does not provide an input for the handler. Method checks
    -- are comparatively cheap.
    --
    -- 3. Authentication checks. This can cause 401.
    --
    -- 4. Accept and content type header checks. These checks
    -- can cause 415 and 406 errors.
    --
    -- 5. Query parameter checks. They require parsing and can cause 400 if the
    -- parsing fails. Query parameter checks provide inputs to the handler
    --
    -- 6. Header Checks. They also require parsing and can cause 400 if parsing fails.
    --
    -- 7. Body check. The request body check can cause 400.
    --
    data Delayed env c where
      Delayed :: { ()
    capturesD :: env -> DelayedIO captures
                 , forall env c. Delayed env c -> DelayedIO ()
    methodD   :: DelayedIO ()
                 , ()
    authD     :: DelayedIO auth
                 , forall env c. Delayed env c -> DelayedIO ()
    acceptD   :: DelayedIO ()
                 , ()
    contentD  :: DelayedIO contentType
                 , ()
    paramsD   :: DelayedIO params
                 , ()
    headersD  :: DelayedIO headers
                 , ()
    bodyD     :: contentType -> DelayedIO body
                 , ()
    serverD   :: captures
                             -> params
                             -> headers
                             -> auth
                             -> body
                             -> Request
                             -> RouteResult c
                 } -> Delayed env c

    instance Functor (Delayed env) where
      fmap :: forall a b. (a -> b) -> Delayed env a -> Delayed env b
    fmap a -> b
    f Delayed{DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    ..} =
        Delayed
          { serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult b
    serverD = \ captures
    c params
    p headers
    h auth
    a body
    b Request
    req -> a -> b
    f (a -> b) -> RouteResult a -> RouteResult b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    serverD captures
    c params
    p headers
    h auth
    a body
    b Request
    req
          , DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    ..
          } -- Note [Existential Record Update]

    -- | A 'Delayed' without any stored checks.
    emptyDelayed :: RouteResult a -> Delayed env a
    emptyDelayed :: forall a env. RouteResult a -> Delayed env a
    emptyDelayed RouteResult a
    result =
      (env -> DelayedIO ())
    -> DelayedIO ()
    -> DelayedIO ()
    -> DelayedIO ()
    -> DelayedIO ()
    -> DelayedIO ()
    -> DelayedIO ()
    -> (() -> DelayedIO ())
    -> (() -> () -> () -> () -> () -> Request -> RouteResult a)
    -> Delayed env a
    forall env captures auth contentType params headers body c.
    (env -> DelayedIO captures)
    -> DelayedIO ()
    -> DelayedIO auth
    -> DelayedIO ()
    -> DelayedIO contentType
    -> DelayedIO params
    -> DelayedIO headers
    -> (contentType -> DelayedIO body)
    -> (captures
        -> params -> headers -> auth -> body -> Request -> RouteResult c)
    -> Delayed env c
    Delayed (DelayedIO () -> env -> DelayedIO ()
    forall a b. a -> b -> a
    const DelayedIO ()
    r) DelayedIO ()
    r DelayedIO ()
    r DelayedIO ()
    r DelayedIO ()
    r DelayedIO ()
    r DelayedIO ()
    r (DelayedIO () -> () -> DelayedIO ()
    forall a b. a -> b -> a
    const DelayedIO ()
    r) (\ ()
    _ ()
    _ ()
    _ ()
    _ ()
    _ Request
    _ -> RouteResult a
    result)
      where
        r :: DelayedIO ()
    r = () -> DelayedIO ()
    forall a. a -> DelayedIO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

    -- | Add a capture to the end of the capture block.
    addCapture :: Delayed env (a -> b)
               -> (captured -> DelayedIO a)
               -> Delayed (captured, env) b
    addCapture :: forall env a b captured.
    Delayed env (a -> b)
    -> (captured -> DelayedIO a) -> Delayed (captured, env) b
    addCapture Delayed{DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    ..} captured -> DelayedIO a
    new =
      Delayed
        { capturesD :: (captured, env) -> DelayedIO (captures, a)
    capturesD = \ (captured
    txt, env
    env) -> (,) (captures -> a -> (captures, a))
    -> DelayedIO captures -> DelayedIO (a -> (captures, a))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> env -> DelayedIO captures
    capturesD env
    env DelayedIO (a -> (captures, a))
    -> DelayedIO a -> DelayedIO (captures, a)
    forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> captured -> DelayedIO a
    new captured
    txt
        , serverD :: (captures, a)
    -> params -> headers -> auth -> body -> Request -> RouteResult b
    serverD   = \ (captures
    x, a
    v) params
    p headers
    h auth
    a body
    b Request
    req -> ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    v) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    serverD captures
    x params
    p headers
    h auth
    a body
    b Request
    req
        , DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    contentType -> DelayedIO body
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    ..
        } -- Note [Existential Record Update]

    -- | Add a parameter check to the end of the params block
    addParameterCheck :: Delayed env (a -> b)
                      -> DelayedIO a
                      -> Delayed env b
    addParameterCheck :: forall env a b.
    Delayed env (a -> b) -> DelayedIO a -> Delayed env b
    addParameterCheck Delayed {DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    ..} DelayedIO a
    new =
      Delayed
        { paramsD :: DelayedIO (params, a)
    paramsD = (,) (params -> a -> (params, a))
    -> DelayedIO params -> DelayedIO (a -> (params, a))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> DelayedIO params
    paramsD DelayedIO (a -> (params, a))
    -> DelayedIO a -> DelayedIO (params, a)
    forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> DelayedIO a
    new
        , serverD :: captures
    -> (params, a)
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult b
    serverD = \captures
    c (params
    p, a
    pNew) headers
    h auth
    a body
    b Request
    req -> ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    pNew) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    serverD captures
    c params
    p headers
    h auth
    a body
    b Request
    req
        , DelayedIO auth
    DelayedIO contentType
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    ..
        }

    -- | Add a parameter check to the end of the params block
    addHeaderCheck :: Delayed env (a -> b)
                   -> DelayedIO a
                   -> Delayed env b
    addHeaderCheck :: forall env a b.
    Delayed env (a -> b) -> DelayedIO a -> Delayed env b
    addHeaderCheck Delayed {DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    ..} DelayedIO a
    new =
      Delayed
        { headersD :: DelayedIO (headers, a)
    headersD = (,) (headers -> a -> (headers, a))
    -> DelayedIO headers -> DelayedIO (a -> (headers, a))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> DelayedIO headers
    headersD DelayedIO (a -> (headers, a))
    -> DelayedIO a -> DelayedIO (headers, a)
    forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> DelayedIO a
    new
        , serverD :: captures
    -> params
    -> (headers, a)
    -> auth
    -> body
    -> Request
    -> RouteResult b
    serverD = \captures
    c params
    p (headers
    h, a
    hNew) auth
    a body
    b Request
    req -> ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    hNew) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    serverD captures
    c params
    p headers
    h auth
    a body
    b Request
    req
        , DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO ()
    env -> DelayedIO captures
    contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    bodyD :: contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    bodyD :: contentType -> DelayedIO body
    ..
        }

    -- | Add a method check to the end of the method block.
    addMethodCheck :: Delayed env a
                   -> DelayedIO ()
                   -> Delayed env a
    addMethodCheck :: forall env a. Delayed env a -> DelayedIO () -> Delayed env a
    addMethodCheck Delayed{DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    ..} DelayedIO ()
    new =
      Delayed
        { methodD :: DelayedIO ()
    methodD = DelayedIO ()
    methodD DelayedIO () -> DelayedIO () -> DelayedIO ()
    forall a b. DelayedIO a -> DelayedIO b -> DelayedIO a
    forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
    <* DelayedIO ()
    new
        , DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    capturesD :: env -> DelayedIO captures
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    ..
        } -- Note [Existential Record Update]

    -- | Add an auth check to the end of the auth block.
    addAuthCheck :: Delayed env (a -> b)
                 -> DelayedIO a
                 -> Delayed env b
    addAuthCheck :: forall env a b.
    Delayed env (a -> b) -> DelayedIO a -> Delayed env b
    addAuthCheck Delayed{DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    ..} DelayedIO a
    new =
      Delayed
        { authD :: DelayedIO (auth, a)
    authD   = (,) (auth -> a -> (auth, a))
    -> DelayedIO auth -> DelayedIO (a -> (auth, a))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> DelayedIO auth
    authD DelayedIO (a -> (auth, a)) -> DelayedIO a -> DelayedIO (auth, a)
    forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> DelayedIO a
    new
        , serverD :: captures
    -> params
    -> headers
    -> (auth, a)
    -> body
    -> Request
    -> RouteResult b
    serverD = \ captures
    c params
    p headers
    h (auth
    y, a
    v) body
    b Request
    req -> ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    v) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    serverD captures
    c params
    p headers
    h auth
    y body
    b Request
    req
        , DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    ..
        } -- Note [Existential Record Update]

    -- | 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.
    addBodyCheck :: Delayed env (a -> b)
                 -> DelayedIO c         -- ^ content type check
                 -> (c -> DelayedIO a)  -- ^ body check
                 -> Delayed env b
    addBodyCheck :: forall env a b c.
    Delayed env (a -> b)
    -> DelayedIO c -> (c -> DelayedIO a) -> Delayed env b
    addBodyCheck Delayed{DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    ..} DelayedIO c
    newContentD c -> DelayedIO a
    newBodyD =
      Delayed
        { contentD :: DelayedIO (contentType, c)
    contentD = (,) (contentType -> c -> (contentType, c))
    -> DelayedIO contentType -> DelayedIO (c -> (contentType, c))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> DelayedIO contentType
    contentD DelayedIO (c -> (contentType, c))
    -> DelayedIO c -> DelayedIO (contentType, c)
    forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> DelayedIO c
    newContentD
        , bodyD :: (contentType, c) -> DelayedIO (body, a)
    bodyD    = \(contentType
    content, c
    c) -> (,) (body -> a -> (body, a))
    -> DelayedIO body -> DelayedIO (a -> (body, a))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> contentType -> DelayedIO body
    bodyD contentType
    content DelayedIO (a -> (body, a)) -> DelayedIO a -> DelayedIO (body, a)
    forall a b. DelayedIO (a -> b) -> DelayedIO a -> DelayedIO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> c -> DelayedIO a
    newBodyD c
    c
        , serverD :: captures
    -> params
    -> headers
    -> auth
    -> (body, a)
    -> Request
    -> RouteResult b
    serverD  = \ captures
    c params
    p headers
    h auth
    a (body
    z, a
    v) Request
    req -> ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    v) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    serverD captures
    c params
    p headers
    h auth
    a body
    z Request
    req
        , DelayedIO auth
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    ..
        } -- Note [Existential Record Update]

    -- | 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).
    addAcceptCheck :: Delayed env a
                   -> DelayedIO ()
                   -> Delayed env a
    addAcceptCheck :: forall env a. Delayed env a -> DelayedIO () -> Delayed env a
    addAcceptCheck Delayed{DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    ..} DelayedIO ()
    new =
      Delayed
        { acceptD :: DelayedIO ()
    acceptD = DelayedIO ()
    acceptD DelayedIO () -> DelayedIO () -> DelayedIO ()
    forall a b. DelayedIO a -> DelayedIO b -> DelayedIO b
    forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
    *> DelayedIO ()
    new
        , DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    ..
        } -- Note [Existential Record Update]

    -- | Many combinators extract information that is passed to
    -- the handler without the possibility of failure. In such a
    -- case, 'passToServer' can be used.
    passToServer :: Delayed env (a -> b) -> (Request -> a) -> Delayed env b
    passToServer :: forall env a b.
    Delayed env (a -> b) -> (Request -> a) -> Delayed env b
    passToServer Delayed{DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    ..} Request -> a
    x =
      Delayed
        { serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult b
    serverD = \ captures
    c params
    p headers
    h auth
    a body
    b Request
    req -> ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ Request -> a
    x Request
    req) ((a -> b) -> b) -> RouteResult (a -> b) -> RouteResult b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> captures
    -> params
    -> headers
    -> auth
    -> body
    -> Request
    -> RouteResult (a -> b)
    serverD captures
    c params
    p headers
    h auth
    a body
    b Request
    req
        , DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    ..
        } -- Note [Existential Record Update]

    -- | 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.
    runDelayed :: Delayed env a
               -> env
               -> Request
               -> ResourceT IO (RouteResult a)
    runDelayed :: forall env a.
    Delayed env a -> env -> Request -> ResourceT IO (RouteResult a)
    runDelayed Delayed{DelayedIO auth
    DelayedIO contentType
    DelayedIO params
    DelayedIO headers
    DelayedIO ()
    env -> DelayedIO captures
    captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    contentType -> DelayedIO body
    capturesD :: ()
    methodD :: forall env c. Delayed env c -> DelayedIO ()
    authD :: ()
    acceptD :: forall env c. Delayed env c -> DelayedIO ()
    contentD :: ()
    paramsD :: ()
    headersD :: ()
    bodyD :: ()
    serverD :: ()
    capturesD :: env -> DelayedIO captures
    methodD :: DelayedIO ()
    authD :: DelayedIO auth
    acceptD :: DelayedIO ()
    contentD :: DelayedIO contentType
    paramsD :: DelayedIO params
    headersD :: DelayedIO headers
    bodyD :: contentType -> DelayedIO body
    serverD :: captures
    -> params -> headers -> auth -> body -> Request -> RouteResult a
    ..} env
    env = DelayedIO a -> Request -> ResourceT IO (RouteResult a)
    forall a. DelayedIO a -> Request -> ResourceT IO (RouteResult a)
    runDelayedIO (DelayedIO a -> Request -> ResourceT IO (RouteResult a))
    -> DelayedIO a -> Request -> ResourceT IO (RouteResult a)
    forall a b. (a -> b) -> a -> b
    $ do
        r <- DelayedIO Request
    forall r (m :: Type -> Type). MonadReader r m => m r
    ask
        c <- capturesD env
        methodD
        a <- authD
        acceptD
        content <- contentD
        p <- paramsD       -- Has to be before body parsing, but after content-type checks
        h <- headersD
        b <- bodyD content
        liftRouteResult (serverD c p h a b r)

    -- | Runs a delayed server and the resulting action.
    -- Takes a continuation that lets us send a response.
    -- Also takes a continuation for how to turn the
    -- result of the delayed server into a response.
    runAction :: Delayed env (Handler a)
              -> env
              -> Request
              -> (RouteResult Response -> IO r)
              -> (a -> RouteResult Response)
              -> IO r
    runAction :: forall env a r.
    Delayed env (Handler a)
    -> env
    -> Request
    -> (RouteResult Response -> IO r)
    -> (a -> RouteResult Response)
    -> IO r
    runAction Delayed env (Handler a)
    action env
    env Request
    req RouteResult Response -> IO r
    respond a -> RouteResult Response
    k = ResourceT IO r -> IO r
    forall (m :: Type -> Type) a.
    MonadUnliftIO m =>
    ResourceT m a -> m a
    runResourceT (ResourceT IO r -> IO r) -> ResourceT IO r -> IO r
    forall a b. (a -> b) -> a -> b
    $
        Delayed env (Handler a)
    -> env -> Request -> ResourceT IO (RouteResult (Handler a))
    forall env a.
    Delayed env a -> env -> Request -> ResourceT IO (RouteResult a)
    runDelayed Delayed env (Handler a)
    action env
    env Request
    req ResourceT IO (RouteResult (Handler a))
    -> (RouteResult (Handler a) -> ResourceT IO (RouteResult Response))
    -> ResourceT IO (RouteResult Response)
    forall a b.
    ResourceT IO a -> (a -> ResourceT IO b) -> ResourceT IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= RouteResult (Handler a) -> ResourceT IO (RouteResult Response)
    go ResourceT IO (RouteResult Response)
    -> (RouteResult Response -> ResourceT IO r) -> ResourceT IO r
    forall a b.
    ResourceT IO a -> (a -> ResourceT IO b) -> ResourceT IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO r -> ResourceT IO r
    forall a. IO a -> ResourceT IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO r -> ResourceT IO r)
    -> (RouteResult Response -> IO r)
    -> RouteResult Response
    -> ResourceT IO r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RouteResult Response -> IO r
    respond
      where
        go :: RouteResult (Handler a) -> ResourceT IO (RouteResult Response)
    go (Fail ServerError
    e)      = RouteResult Response -> ResourceT IO (RouteResult Response)
    forall a. a -> ResourceT IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (RouteResult Response -> ResourceT IO (RouteResult Response))
    -> RouteResult Response -> ResourceT IO (RouteResult Response)
    forall a b. (a -> b) -> a -> b
    $ ServerError -> RouteResult Response
    forall a. ServerError -> RouteResult a
    Fail ServerError
    e
        go (FailFatal ServerError
    e) = RouteResult Response -> ResourceT IO (RouteResult Response)
    forall a. a -> ResourceT IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (RouteResult Response -> ResourceT IO (RouteResult Response))
    -> RouteResult Response -> ResourceT IO (RouteResult Response)
    forall a b. (a -> b) -> a -> b
    $ ServerError -> RouteResult Response
    forall a. ServerError -> RouteResult a
    FailFatal ServerError
    e
        go (Route Handler a
    a)     = IO (RouteResult Response) -> ResourceT IO (RouteResult Response)
    forall a. IO a -> ResourceT IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO (RouteResult Response) -> ResourceT IO (RouteResult Response))
    -> IO (RouteResult Response) -> ResourceT IO (RouteResult Response)
    forall a b. (a -> b) -> a -> b
    $ do
          e <- Handler a -> IO (Either ServerError a)
    forall a. Handler a -> IO (Either ServerError a)
    runHandler Handler a
    a
          case e of
            Left ServerError
    err -> RouteResult Response -> IO (RouteResult Response)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (RouteResult Response -> IO (RouteResult Response))
    -> (Response -> RouteResult Response)
    -> Response
    -> IO (RouteResult Response)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Response -> RouteResult Response
    forall a. a -> RouteResult a
    Route (Response -> IO (RouteResult Response))
    -> Response -> IO (RouteResult Response)
    forall a b. (a -> b) -> a -> b
    $ ServerError -> Response
    responseServerError ServerError
    err
            Right a
    x  -> RouteResult Response -> IO (RouteResult Response)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (RouteResult Response -> IO (RouteResult Response))
    -> RouteResult Response -> IO (RouteResult Response)
    forall a b. (a -> b) -> a -> b
    $! a -> RouteResult Response
    k a
    x

    {- Note [Existential Record Update]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Due to GHC issue <https://ghc.haskell.org/trac/ghc/ticket/2595 2595>, we cannot
    do the more succinct thing - just update the records we actually change.
    -}