{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Checked.Exceptions.Internal.Servant.Server where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Functor.Identity
import Data.Maybe
import Data.Proxy (Proxy(Proxy))
import Data.WorldPeace (OpenUnion, Union(That, This))
import GHC.TypeLits (KnownNat, natVal)
import Network.HTTP.Types
import Network.Wai
import Servant.API.ContentTypes
( AcceptHeader(AcceptHeader)
, AllCTRender
, AllMime
, canHandleAcceptH
, handleAcceptH
)
import Servant.Server.Internal (ct_wildcard)
import Servant.Server.Internal.Router (Router, Router', leafRouter)
import Servant.Server.Internal.RouteResult (RouteResult(FailFatal, Route))
import Servant.Server.Internal.DelayedIO (DelayedIO, delayedFail)
import Servant.Server.Internal.Delayed
( Delayed
, addAcceptCheck
, addMethodCheck
, runAction
)
import Servant
( (:<|>)(..)
, (:>)
, Context
, Handler
, HasServer(..)
, ReflectMethod
, ServerT
, Verb
, err405
, err406
, reflectMethod
)
import Servant.Checked.Exceptions.Internal.Envelope (Envelope, envelope)
import Servant.Checked.Exceptions.Internal.Servant.API
( AllErrStatus
, ErrStatus(toErrStatus)
, NoThrow
, Throwing
, ThrowingNonterminal
, Throws
)
import Servant.Checked.Exceptions.Verbs (VerbWithErr)
instance (HasServer (Throwing '[e] :> api) context) =>
HasServer (Throws e :> api) context where
type ServerT (Throws e :> api) m =
ServerT (Throwing '[e] :> api) m
hoistServerWithContext :: Proxy (Throws e :> api)
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (Throws e :> api) m
-> ServerT (Throws e :> api) n
hoistServerWithContext Proxy (Throws e :> api)
_ =
Proxy (Throwing '[e] :> api)
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (Throwing '[e] :> api) m
-> ServerT (Throwing '[e] :> api) n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy (Throwing '[e] :> api)
forall k (t :: k). Proxy t
Proxy :: Proxy (Throwing '[e] :> api))
route
:: Proxy (Throws e :> api)
-> Context context
-> Delayed env (ServerT (Throwing '[e] :> api) Handler)
-> Router env
route :: Proxy (Throws e :> api)
-> Context context
-> Delayed env (ServerT (Throwing '[e] :> api) Handler)
-> Router env
route Proxy (Throws e :> api)
_ = Proxy (Throwing '[e] :> api)
-> Context context
-> Delayed env (ServerT (Throwing '[e] :> api) Handler)
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (Proxy (Throwing '[e] :> api)
forall k (t :: k). Proxy t
Proxy :: Proxy (Throwing '[e] :> api))
instance (HasServer (VerbWithErr method status ctypes es a) context) =>
HasServer (Throwing es :> Verb method status ctypes a) context where
type ServerT (Throwing es :> Verb method status ctypes a) m =
ServerT (VerbWithErr method status ctypes es a) m
hoistServerWithContext :: Proxy (Throwing es :> Verb method status ctypes a)
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (Throwing es :> Verb method status ctypes a) m
-> ServerT (Throwing es :> Verb method status ctypes a) n
hoistServerWithContext Proxy (Throwing es :> Verb method status ctypes a)
_ =
Proxy (VerbWithErr method status ctypes es a)
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (VerbWithErr method status ctypes es a) m
-> ServerT (VerbWithErr method status ctypes es a) n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy (VerbWithErr method status ctypes es a)
forall k (t :: k). Proxy t
Proxy :: Proxy (VerbWithErr method status ctypes es a))
route
:: Proxy (Throwing es :> Verb method status ctypes a)
-> Context context
-> Delayed env
(ServerT (VerbWithErr method status ctypes es a) Handler)
-> Router env
route :: Proxy (Throwing es :> Verb method status ctypes a)
-> Context context
-> Delayed
env (ServerT (VerbWithErr method status ctypes es a) Handler)
-> Router env
route Proxy (Throwing es :> Verb method status ctypes a)
_ =
Proxy (VerbWithErr method status ctypes es a)
-> Context context
-> Delayed
env (ServerT (VerbWithErr method status ctypes es a) Handler)
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route
(Proxy (VerbWithErr method status ctypes es a)
forall k (t :: k). Proxy t
Proxy :: Proxy (VerbWithErr method status ctypes es a))
instance
( HasServer (VerbWithErr method status ctypes '[] a) context
) =>
HasServer (NoThrow :> Verb method status ctypes a) context where
type ServerT (NoThrow :> Verb method status ctypes a) m =
ServerT (VerbWithErr method status ctypes '[] a) m
hoistServerWithContext :: Proxy (NoThrow :> Verb method status ctypes a)
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (NoThrow :> Verb method status ctypes a) m
-> ServerT (NoThrow :> Verb method status ctypes a) n
hoistServerWithContext Proxy (NoThrow :> Verb method status ctypes a)
_ =
Proxy (VerbWithErr method status ctypes '[] a)
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (VerbWithErr method status ctypes '[] a) m
-> ServerT (VerbWithErr method status ctypes '[] a) n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy (VerbWithErr method status ctypes '[] a)
forall k (t :: k). Proxy t
Proxy :: Proxy (VerbWithErr method status ctypes '[] a))
route
:: Proxy (NoThrow :> Verb method status ctypes a)
-> Context context
-> Delayed env (ServerT (VerbWithErr method status ctypes '[] a) Handler)
-> Router env
route :: Proxy (NoThrow :> Verb method status ctypes a)
-> Context context
-> Delayed
env (ServerT (VerbWithErr method status ctypes '[] a) Handler)
-> Router env
route Proxy (NoThrow :> Verb method status ctypes a)
_ = Proxy (VerbWithErr method status ctypes '[] a)
-> Context context
-> Delayed
env (ServerT (VerbWithErr method status ctypes '[] a) Handler)
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (Proxy (VerbWithErr method status ctypes '[] a)
forall k (t :: k). Proxy t
Proxy :: Proxy (VerbWithErr method status ctypes '[] a))
instance HasServer ((Throwing es :> api1) :<|> (Throwing es :> api2)) context =>
HasServer (Throwing es :> (api1 :<|> api2)) context where
type ServerT (Throwing es :> (api1 :<|> api2)) m =
ServerT ((Throwing es :> api1) :<|> (Throwing es :> api2)) m
hoistServerWithContext :: Proxy (Throwing es :> (api1 :<|> api2))
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (Throwing es :> (api1 :<|> api2)) m
-> ServerT (Throwing es :> (api1 :<|> api2)) n
hoistServerWithContext Proxy (Throwing es :> (api1 :<|> api2))
_ =
Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2))
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT ((Throwing es :> api1) :<|> (Throwing es :> api2)) m
-> ServerT ((Throwing es :> api1) :<|> (Throwing es :> api2)) n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2))
forall k (t :: k). Proxy t
Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
route
:: Proxy (Throwing es :> (api1 :<|> api2))
-> Context context
-> Delayed env (ServerT ((Throwing es :> api1) :<|> (Throwing es :> api2)) Handler)
-> Router env
route :: Proxy (Throwing es :> (api1 :<|> api2))
-> Context context
-> Delayed
env
(ServerT
((Throwing es :> api1) :<|> (Throwing es :> api2)) Handler)
-> Router env
route Proxy (Throwing es :> (api1 :<|> api2))
_ = Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2))
-> Context context
-> Delayed
env
(ServerT
((Throwing es :> api1) :<|> (Throwing es :> api2)) Handler)
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2))
forall k (t :: k). Proxy t
Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
instance HasServer ((NoThrow :> api1) :<|> (NoThrow :> api2)) context =>
HasServer (NoThrow :> (api1 :<|> api2)) context where
type ServerT (NoThrow :> (api1 :<|> api2)) m =
ServerT ((NoThrow :> api1) :<|> (NoThrow :> api2)) m
hoistServerWithContext :: Proxy (NoThrow :> (api1 :<|> api2))
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (NoThrow :> (api1 :<|> api2)) m
-> ServerT (NoThrow :> (api1 :<|> api2)) n
hoistServerWithContext Proxy (NoThrow :> (api1 :<|> api2))
_ =
Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2))
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT ((NoThrow :> api1) :<|> (NoThrow :> api2)) m
-> ServerT ((NoThrow :> api1) :<|> (NoThrow :> api2)) n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2))
forall k (t :: k). Proxy t
Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))
route
:: Proxy (NoThrow :> (api1 :<|> api2))
-> Context context
-> Delayed env (ServerT ((NoThrow :> api1) :<|> (NoThrow :> api2)) Handler)
-> Router env
route :: Proxy (NoThrow :> (api1 :<|> api2))
-> Context context
-> Delayed
env (ServerT ((NoThrow :> api1) :<|> (NoThrow :> api2)) Handler)
-> Router env
route Proxy (NoThrow :> (api1 :<|> api2))
_ = Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2))
-> Context context
-> Delayed
env (ServerT ((NoThrow :> api1) :<|> (NoThrow :> api2)) Handler)
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2))
forall k (t :: k). Proxy t
Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))
instance HasServer (ThrowingNonterminal (Throwing es :> api :> apis)) context =>
HasServer (Throwing es :> api :> apis) context where
type ServerT (Throwing es :> api :> apis) m =
ServerT (ThrowingNonterminal (Throwing es :> api :> apis)) m
hoistServerWithContext :: Proxy (Throwing es :> (api :> apis))
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (Throwing es :> (api :> apis)) m
-> ServerT (Throwing es :> (api :> apis)) n
hoistServerWithContext Proxy (Throwing es :> (api :> apis))
_ =
Proxy (ThrowingNonterminal (Throwing es :> (api :> apis)))
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (ThrowingNonterminal (Throwing es :> (api :> apis))) m
-> ServerT (ThrowingNonterminal (Throwing es :> (api :> apis))) n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy (ThrowingNonterminal (Throwing es :> (api :> apis)))
forall k (t :: k). Proxy t
Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))
route
:: Proxy (Throwing es :> api :> apis)
-> Context context
-> Delayed env (ServerT (ThrowingNonterminal (Throwing es :> api :> apis)) Handler)
-> Router env
route :: Proxy (Throwing es :> (api :> apis))
-> Context context
-> Delayed
env
(ServerT
(ThrowingNonterminal (Throwing es :> (api :> apis))) Handler)
-> Router env
route Proxy (Throwing es :> (api :> apis))
_ = Proxy (ThrowingNonterminal (Throwing es :> (api :> apis)))
-> Context context
-> Delayed
env
(ServerT
(ThrowingNonterminal (Throwing es :> (api :> apis))) Handler)
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (Proxy (ThrowingNonterminal (Throwing es :> (api :> apis)))
forall k (t :: k). Proxy t
Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))
instance HasServer (api :> NoThrow :> apis) context =>
HasServer (NoThrow :> api :> apis) context where
type ServerT (NoThrow :> api :> apis) m =
ServerT (api :> NoThrow :> apis) m
hoistServerWithContext :: Proxy (NoThrow :> (api :> apis))
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (NoThrow :> (api :> apis)) m
-> ServerT (NoThrow :> (api :> apis)) n
hoistServerWithContext Proxy (NoThrow :> (api :> apis))
_ =
Proxy (api :> (NoThrow :> apis))
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (api :> (NoThrow :> apis)) m
-> ServerT (api :> (NoThrow :> apis)) n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy (api :> (NoThrow :> apis))
forall k (t :: k). Proxy t
Proxy :: Proxy (api :> NoThrow :> apis))
route
:: Proxy (NoThrow :> api :> apis)
-> Context context
-> Delayed env (ServerT (api :> NoThrow :> apis) Handler)
-> Router env
route :: Proxy (NoThrow :> (api :> apis))
-> Context context
-> Delayed env (ServerT (api :> (NoThrow :> apis)) Handler)
-> Router env
route Proxy (NoThrow :> (api :> apis))
_ = Proxy (api :> (NoThrow :> apis))
-> Context context
-> Delayed env (ServerT (api :> (NoThrow :> apis)) Handler)
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (Proxy (api :> (NoThrow :> apis))
forall k (t :: k). Proxy t
Proxy :: Proxy (api :> NoThrow :> apis))
instance
{-# OVERLAPPABLE #-}
( AllCTRender ctypes (Envelope es a)
, AllErrStatus es
, KnownNat successStatus
, ReflectMethod method
) =>
HasServer (VerbWithErr method successStatus ctypes es a) context where
type ServerT (VerbWithErr method successStatus ctypes es a) m =
m (Envelope es a)
hoistServerWithContext :: Proxy (VerbWithErr method successStatus ctypes es a)
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (VerbWithErr method successStatus ctypes es a) m
-> ServerT (VerbWithErr method successStatus ctypes es a) n
hoistServerWithContext Proxy (VerbWithErr method successStatus ctypes es a)
_ Proxy context
_ forall x. m x -> n x
nt = ServerT (VerbWithErr method successStatus ctypes es a) m
-> ServerT (VerbWithErr method successStatus ctypes es a) n
forall x. m x -> n x
nt
route
:: Proxy (VerbWithErr method successStatus ctypes es a)
-> Context context
-> Delayed env (Handler (Envelope es a))
-> Router' env
( Request ->
(RouteResult Response -> IO ResponseReceived) ->
IO ResponseReceived
)
route :: Proxy (VerbWithErr method successStatus ctypes es a)
-> Context context
-> Delayed env (Handler (Envelope es a))
-> Router'
env
(Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived)
route Proxy (VerbWithErr method successStatus ctypes es a)
Proxy Context context
_ = Method
-> Status
-> Proxy ctypes
-> Delayed env (Handler (Envelope es a))
-> Router'
env
(Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived)
forall (ctypes :: [*]) a (es :: [*]) env.
(AllCTRender ctypes (Envelope es a), AllErrStatus es) =>
Method
-> Status
-> Proxy ctypes
-> Delayed env (Handler (Envelope es a))
-> Router'
env
(Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived)
methodRouter Method
method Status
successStatus (Proxy ctypes
forall k (t :: k). Proxy t
Proxy :: Proxy ctypes)
where
method :: Method
method :: Method
method = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
successStatus :: Status
successStatus :: Status
successStatus =
Int -> Status
forall a. Enum a => Int -> a
toEnum (Int -> Status) -> (Integer -> Int) -> Integer -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Status) -> Integer -> Status
forall a b. (a -> b) -> a -> b
$ Proxy successStatus -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy successStatus
forall k (t :: k). Proxy t
Proxy :: Proxy successStatus)
methodRouter ::
forall ctypes a es env.
(AllCTRender ctypes (Envelope es a), AllErrStatus es)
=> Method
-> Status
-> Proxy ctypes
-> Delayed env (Handler (Envelope es a))
-> Router' env
( Request ->
(RouteResult Response -> IO ResponseReceived)->
IO ResponseReceived
)
methodRouter :: Method
-> Status
-> Proxy ctypes
-> Delayed env (Handler (Envelope es a))
-> Router'
env
(Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived)
methodRouter Method
method Status
successStatus Proxy ctypes
proxy Delayed env (Handler (Envelope es a))
action = (env
-> Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived)
-> Router'
env
(Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived)
forall env a. (env -> a) -> Router' env a
leafRouter env
-> Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived
route'
where
route'
:: env
-> Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived
route' :: env
-> Request
-> (RouteResult Response -> IO ResponseReceived)
-> IO ResponseReceived
route' env
env Request
request RouteResult Response -> IO ResponseReceived
respond = do
let accH :: Method
accH = Method -> Maybe Method -> Method
forall a. a -> Maybe a -> a
fromMaybe Method
ct_wildcard (Maybe Method -> Method) -> Maybe Method -> Method
forall a b. (a -> b) -> a -> b
$ HeaderName -> [(HeaderName, Method)] -> Maybe Method
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hAccept ([(HeaderName, Method)] -> Maybe Method)
-> [(HeaderName, Method)] -> Maybe Method
forall a b. (a -> b) -> a -> b
$ Request -> [(HeaderName, Method)]
requestHeaders Request
request
let theAction :: Delayed env (Handler (Envelope es a))
theAction =
Delayed env (Handler (Envelope es a))
action
Delayed env (Handler (Envelope es a))
-> DelayedIO () -> Delayed env (Handler (Envelope es a))
forall env a. Delayed env a -> DelayedIO () -> Delayed env a
`addMethodCheck` Method -> Request -> DelayedIO ()
methodCheck Method
method Request
request
Delayed env (Handler (Envelope es a))
-> DelayedIO () -> Delayed env (Handler (Envelope es a))
forall env a. Delayed env a -> DelayedIO () -> Delayed env a
`addAcceptCheck` Proxy ctypes -> Method -> DelayedIO ()
forall (list :: [*]).
AllMime list =>
Proxy list -> Method -> DelayedIO ()
acceptCheck Proxy ctypes
proxy Method
accH
Delayed env (Handler (Envelope es a))
-> env
-> Request
-> (RouteResult Response -> IO ResponseReceived)
-> (Envelope es a -> RouteResult Response)
-> IO ResponseReceived
forall env a r.
Delayed env (Handler a)
-> env
-> Request
-> (RouteResult Response -> IO r)
-> (a -> RouteResult Response)
-> IO r
runAction Delayed env (Handler (Envelope es a))
theAction env
env Request
request RouteResult Response -> IO ResponseReceived
respond ((Envelope es a -> RouteResult Response) -> IO ResponseReceived)
-> (Envelope es a -> RouteResult Response) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Request -> Method -> Envelope es a -> RouteResult Response
go Request
request Method
accH
go :: Request -> ByteString -> Envelope es a -> RouteResult Response
go :: Request -> Method -> Envelope es a -> RouteResult Response
go Request
request Method
accH Envelope es a
envel = do
let status :: Status
status = (OpenUnion es -> Status)
-> (a -> Status) -> Envelope es a -> Status
forall (es :: [*]) c a.
(OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope OpenUnion es -> Status
forall (es :: [*]). AllErrStatus es => OpenUnion es -> Status
getErrStatus (Status -> a -> Status
forall a b. a -> b -> a
const Status
successStatus) Envelope es a
envel
let handleA :: Maybe (ByteString, ByteString)
handleA = Proxy ctypes
-> AcceptHeader -> Envelope es a -> Maybe (ByteString, ByteString)
forall (list :: [*]) a.
AllCTRender list a =>
Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)
handleAcceptH Proxy ctypes
proxy (Method -> AcceptHeader
AcceptHeader Method
accH) Envelope es a
envel
Maybe (ByteString, ByteString)
-> Status
-> Method
-> Maybe [(HeaderName, Method)]
-> Request
-> RouteResult Response
processMethodRouter Maybe (ByteString, ByteString)
handleA Status
status Method
method Maybe [(HeaderName, Method)]
forall a. Maybe a
Nothing Request
request
allowedMethod :: Method -> Request -> Bool
allowedMethod :: Method -> Request -> Bool
allowedMethod Method
method Request
request =
Method -> Request -> Bool
allowedMethodHead Method
method Request
request Bool -> Bool -> Bool
|| Request -> Method
requestMethod Request
request Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
method
allowedMethodHead :: Method -> Request -> Bool
allowedMethodHead :: Method -> Request -> Bool
allowedMethodHead Method
method Request
request =
Method
method Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
methodGet Bool -> Bool -> Bool
&& Request -> Method
requestMethod Request
request Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
methodHead
methodCheck :: Method -> Request -> DelayedIO ()
methodCheck :: Method -> Request -> DelayedIO ()
methodCheck Method
method Request
request
| Method -> Request -> Bool
allowedMethod Method
method Request
request = () -> DelayedIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = ServerError -> DelayedIO ()
forall a. ServerError -> DelayedIO a
delayedFail ServerError
err405
acceptCheck :: (AllMime list) => Proxy list -> ByteString -> DelayedIO ()
acceptCheck :: Proxy list -> Method -> DelayedIO ()
acceptCheck Proxy list
proxy Method
accH
| Proxy list -> AcceptHeader -> Bool
forall (list :: [*]).
AllMime list =>
Proxy list -> AcceptHeader -> Bool
canHandleAcceptH Proxy list
proxy (Method -> AcceptHeader
AcceptHeader Method
accH) = () -> DelayedIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = ServerError -> DelayedIO ()
forall a. ServerError -> DelayedIO a
delayedFail ServerError
err406
getErrStatus :: AllErrStatus es => OpenUnion es -> Status
getErrStatus :: OpenUnion es -> Status
getErrStatus (This (Identity a
e)) = a -> Status
forall e. ErrStatus e => e -> Status
toErrStatus a
e
getErrStatus (That Union Identity as1
es) = Union Identity as1 -> Status
forall (es :: [*]). AllErrStatus es => OpenUnion es -> Status
getErrStatus Union Identity as1
es
processMethodRouter
:: Maybe (LBS.ByteString, LBS.ByteString)
-> Status
-> Method
-> Maybe [(HeaderName, ByteString)]
-> Request -> RouteResult Response
processMethodRouter :: Maybe (ByteString, ByteString)
-> Status
-> Method
-> Maybe [(HeaderName, Method)]
-> Request
-> RouteResult Response
processMethodRouter Maybe (ByteString, ByteString)
handleA Status
status Method
method Maybe [(HeaderName, Method)]
headers Request
request = case Maybe (ByteString, ByteString)
handleA of
Maybe (ByteString, ByteString)
Nothing -> ServerError -> RouteResult Response
forall a. ServerError -> RouteResult a
FailFatal ServerError
err406
Just (ByteString
contentT, ByteString
body) -> Response -> RouteResult Response
forall a. a -> RouteResult a
Route (Response -> RouteResult Response)
-> Response -> RouteResult Response
forall a b. (a -> b) -> a -> b
$ Status -> [(HeaderName, Method)] -> ByteString -> Response
responseLBS Status
status [(HeaderName, Method)]
hdrs ByteString
bdy
where
bdy :: ByteString
bdy = if Method -> Request -> Bool
allowedMethodHead Method
method Request
request then ByteString
"" else ByteString
body
hdrs :: [(HeaderName, Method)]
hdrs = (HeaderName
hContentType, ByteString -> Method
LBS.toStrict ByteString
contentT) (HeaderName, Method)
-> [(HeaderName, Method)] -> [(HeaderName, Method)]
forall a. a -> [a] -> [a]
: [(HeaderName, Method)]
-> Maybe [(HeaderName, Method)] -> [(HeaderName, Method)]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(HeaderName, Method)]
headers