module WebGear.Types
(
Request
, remoteHost
, httpVersion
, isSecure
, requestMethod
, pathInfo
, queryString
, requestHeader
, requestHeaders
, requestBodyLength
, getRequestBodyChunk
, Response (..)
, responseHeader
, setResponseHeader
, waiResponse
, respond
, continue100
, switchingProtocols101
, ok200
, created201
, accepted202
, nonAuthoritative203
, noContent204
, resetContent205
, partialContent206
, multipleChoices300
, movedPermanently301
, found302
, seeOther303
, notModified304
, temporaryRedirect307
, permanentRedirect308
, badRequest400
, unauthorized401
, paymentRequired402
, forbidden403
, notFound404
, methodNotAllowed405
, notAcceptable406
, proxyAuthenticationRequired407
, requestTimeout408
, conflict409
, gone410
, lengthRequired411
, preconditionFailed412
, requestEntityTooLarge413
, requestURITooLong414
, unsupportedMediaType415
, requestedRangeNotSatisfiable416
, expectationFailed417
, imATeapot418
, unprocessableEntity422
, preconditionRequired428
, tooManyRequests429
, requestHeaderFieldsTooLarge431
, internalServerError500
, notImplemented501
, badGateway502
, serviceUnavailable503
, gatewayTimeout504
, httpVersionNotSupported505
, networkAuthenticationRequired511
, Handler'
, Handler
, Middleware'
, Middleware
, RequestMiddleware'
, RequestMiddleware
, ResponseMiddleware'
, ResponseMiddleware
, Router (..)
, MonadRouter (..)
, PathInfo (..)
, RouteError (..)
, transform
, runRoute
, toApplication
) where
import Control.Applicative (Alternative)
import Control.Arrow (Kleisli (..))
import Control.Monad (MonadPlus)
import Control.Monad.Except (ExceptT, MonadError, catchError, runExceptT, throwError)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.State.Strict (MonadState, StateT, evalStateT)
import Data.ByteString (ByteString)
import Data.ByteString.Conversion.To (ToByteString, toByteString)
import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup (..), stimesIdempotent)
import Data.String (fromString)
import Data.Text (Text)
import Data.Version (showVersion)
import GHC.Exts (fromList)
import Network.Wai (Request, getRequestBodyChunk, httpVersion, isSecure, pathInfo, queryString,
remoteHost, requestBodyLength, requestHeaders, requestMethod)
import Paths_webgear_server (version)
import WebGear.Trait (Linked, link)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
requestHeader :: HTTP.HeaderName -> Request -> Maybe ByteString
HeaderName
h Request
r = (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((HeaderName, ByteString) -> ByteString)
-> Maybe (HeaderName, ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HeaderName, ByteString) -> Bool)
-> [(HeaderName, ByteString)] -> Maybe (HeaderName, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
h) (HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) (Request -> [(HeaderName, ByteString)]
requestHeaders Request
r)
data Response a = Response
{ Response a -> Status
responseStatus :: HTTP.Status
, :: HM.HashMap HTTP.HeaderName ByteString
, Response a -> Maybe a
responseBody :: Maybe a
}
deriving stock (Response a -> Response a -> Bool
(Response a -> Response a -> Bool)
-> (Response a -> Response a -> Bool) -> Eq (Response a)
forall a. Eq a => Response a -> Response a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response a -> Response a -> Bool
$c/= :: forall a. Eq a => Response a -> Response a -> Bool
== :: Response a -> Response a -> Bool
$c== :: forall a. Eq a => Response a -> Response a -> Bool
Eq, Eq (Response a)
Eq (Response a)
-> (Response a -> Response a -> Ordering)
-> (Response a -> Response a -> Bool)
-> (Response a -> Response a -> Bool)
-> (Response a -> Response a -> Bool)
-> (Response a -> Response a -> Bool)
-> (Response a -> Response a -> Response a)
-> (Response a -> Response a -> Response a)
-> Ord (Response a)
Response a -> Response a -> Bool
Response a -> Response a -> Ordering
Response a -> Response a -> Response a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Response a)
forall a. Ord a => Response a -> Response a -> Bool
forall a. Ord a => Response a -> Response a -> Ordering
forall a. Ord a => Response a -> Response a -> Response a
min :: Response a -> Response a -> Response a
$cmin :: forall a. Ord a => Response a -> Response a -> Response a
max :: Response a -> Response a -> Response a
$cmax :: forall a. Ord a => Response a -> Response a -> Response a
>= :: Response a -> Response a -> Bool
$c>= :: forall a. Ord a => Response a -> Response a -> Bool
> :: Response a -> Response a -> Bool
$c> :: forall a. Ord a => Response a -> Response a -> Bool
<= :: Response a -> Response a -> Bool
$c<= :: forall a. Ord a => Response a -> Response a -> Bool
< :: Response a -> Response a -> Bool
$c< :: forall a. Ord a => Response a -> Response a -> Bool
compare :: Response a -> Response a -> Ordering
$ccompare :: forall a. Ord a => Response a -> Response a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Response a)
Ord, Int -> Response a -> ShowS
[Response a] -> ShowS
Response a -> String
(Int -> Response a -> ShowS)
-> (Response a -> String)
-> ([Response a] -> ShowS)
-> Show (Response a)
forall a. Show a => Int -> Response a -> ShowS
forall a. Show a => [Response a] -> ShowS
forall a. Show a => Response a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response a] -> ShowS
$cshowList :: forall a. Show a => [Response a] -> ShowS
show :: Response a -> String
$cshow :: forall a. Show a => Response a -> String
showsPrec :: Int -> Response a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Response a -> ShowS
Show, a -> Response b -> Response a
(a -> b) -> Response a -> Response b
(forall a b. (a -> b) -> Response a -> Response b)
-> (forall a b. a -> Response b -> Response a) -> Functor Response
forall a b. a -> Response b -> Response a
forall a b. (a -> b) -> Response a -> Response b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Response b -> Response a
$c<$ :: forall a b. a -> Response b -> Response a
fmap :: (a -> b) -> Response a -> Response b
$cfmap :: forall a b. (a -> b) -> Response a -> Response b
Functor)
responseHeader :: HTTP.HeaderName -> Response a -> Maybe ByteString
HeaderName
h = HeaderName -> HashMap HeaderName ByteString -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HeaderName
h (HashMap HeaderName ByteString -> Maybe ByteString)
-> (Response a -> HashMap HeaderName ByteString)
-> Response a
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> HashMap HeaderName ByteString
forall a. Response a -> HashMap HeaderName ByteString
responseHeaders
setResponseHeader :: HTTP.HeaderName -> ByteString -> Response a -> Response a
HeaderName
name ByteString
val Response a
r = Response a
r { responseHeaders :: HashMap HeaderName ByteString
responseHeaders = HeaderName
-> ByteString
-> HashMap HeaderName ByteString
-> HashMap HeaderName ByteString
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert HeaderName
name ByteString
val (Response a -> HashMap HeaderName ByteString
forall a. Response a -> HashMap HeaderName ByteString
responseHeaders Response a
r) }
waiResponse :: Response LBS.ByteString -> Wai.Response
waiResponse :: Response ByteString -> Response
waiResponse Response{Maybe ByteString
HashMap HeaderName ByteString
Status
responseBody :: Maybe ByteString
responseHeaders :: HashMap HeaderName ByteString
responseStatus :: Status
responseBody :: forall a. Response a -> Maybe a
responseHeaders :: forall a. Response a -> HashMap HeaderName ByteString
responseStatus :: forall a. Response a -> Status
..} = Status -> [(HeaderName, ByteString)] -> ByteString -> Response
Wai.responseLBS
Status
responseStatus
(HashMap HeaderName ByteString -> [(HeaderName, ByteString)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap HeaderName ByteString
responseHeaders)
(ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
responseBody)
respond :: HTTP.Status -> Maybe a -> Response a
respond :: Status -> Maybe a -> Response a
respond Status
s = Status -> HashMap HeaderName ByteString -> Maybe a -> Response a
forall a.
Status -> HashMap HeaderName ByteString -> Maybe a -> Response a
Response Status
s HashMap HeaderName ByteString
forall a. Monoid a => a
mempty
continue100 :: Response a
continue100 :: Response a
continue100 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.continue100 Maybe a
forall a. Maybe a
Nothing
switchingProtocols101 :: Response a
switchingProtocols101 :: Response a
switchingProtocols101 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.switchingProtocols101 Maybe a
forall a. Maybe a
Nothing
ok200 :: a -> Response a
ok200 :: a -> Response a
ok200 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.ok200 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
created201 :: a -> Response a
created201 :: a -> Response a
created201 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.created201 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
accepted202 :: a -> Response a
accepted202 :: a -> Response a
accepted202 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.accepted202 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
nonAuthoritative203 :: a -> Response a
nonAuthoritative203 :: a -> Response a
nonAuthoritative203 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.nonAuthoritative203 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
noContent204 :: Response a
noContent204 :: Response a
noContent204 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.noContent204 Maybe a
forall a. Maybe a
Nothing
resetContent205 :: Response a
resetContent205 :: Response a
resetContent205 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.resetContent205 Maybe a
forall a. Maybe a
Nothing
partialContent206 :: a -> Response a
partialContent206 :: a -> Response a
partialContent206 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.partialContent206 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
multipleChoices300 :: a -> Response a
multipleChoices300 :: a -> Response a
multipleChoices300 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.multipleChoices300 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
movedPermanently301 :: a -> Response a
movedPermanently301 :: a -> Response a
movedPermanently301 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.movedPermanently301 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
found302 :: a -> Response a
found302 :: a -> Response a
found302 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.found302 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
seeOther303 :: a -> Response a
seeOther303 :: a -> Response a
seeOther303 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.seeOther303 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
notModified304 :: Response a
notModified304 :: Response a
notModified304 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.notModified304 Maybe a
forall a. Maybe a
Nothing
temporaryRedirect307 :: a -> Response a
temporaryRedirect307 :: a -> Response a
temporaryRedirect307 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.temporaryRedirect307 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
permanentRedirect308 :: a -> Response a
permanentRedirect308 :: a -> Response a
permanentRedirect308 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.permanentRedirect308 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
badRequest400 :: a -> Response a
badRequest400 :: a -> Response a
badRequest400 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.badRequest400 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
unauthorized401 :: a -> Response a
unauthorized401 :: a -> Response a
unauthorized401 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.unauthorized401 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
paymentRequired402 :: a -> Response a
paymentRequired402 :: a -> Response a
paymentRequired402 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.paymentRequired402 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
forbidden403 :: a -> Response a
forbidden403 :: a -> Response a
forbidden403 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.forbidden403 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
notFound404 :: Response a
notFound404 :: Response a
notFound404 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.notFound404 Maybe a
forall a. Maybe a
Nothing
methodNotAllowed405 :: a -> Response a
methodNotAllowed405 :: a -> Response a
methodNotAllowed405 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.methodNotAllowed405 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
notAcceptable406 :: a -> Response a
notAcceptable406 :: a -> Response a
notAcceptable406 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.notAcceptable406 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
proxyAuthenticationRequired407 :: a -> Response a
proxyAuthenticationRequired407 :: a -> Response a
proxyAuthenticationRequired407 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.proxyAuthenticationRequired407 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
requestTimeout408 :: a -> Response a
requestTimeout408 :: a -> Response a
requestTimeout408 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.requestTimeout408 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
conflict409 :: a -> Response a
conflict409 :: a -> Response a
conflict409 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.conflict409 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
gone410 :: a -> Response a
gone410 :: a -> Response a
gone410 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.gone410 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
lengthRequired411 :: a -> Response a
lengthRequired411 :: a -> Response a
lengthRequired411 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.lengthRequired411 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
preconditionFailed412 :: a -> Response a
preconditionFailed412 :: a -> Response a
preconditionFailed412 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.preconditionFailed412 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
requestEntityTooLarge413 :: a -> Response a
requestEntityTooLarge413 :: a -> Response a
requestEntityTooLarge413 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.requestEntityTooLarge413 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
requestURITooLong414 :: a -> Response a
requestURITooLong414 :: a -> Response a
requestURITooLong414 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.requestURITooLong414 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
unsupportedMediaType415 :: a -> Response a
unsupportedMediaType415 :: a -> Response a
unsupportedMediaType415 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.unsupportedMediaType415 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
requestedRangeNotSatisfiable416 :: a -> Response a
requestedRangeNotSatisfiable416 :: a -> Response a
requestedRangeNotSatisfiable416 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.requestedRangeNotSatisfiable416 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
expectationFailed417 :: a -> Response a
expectationFailed417 :: a -> Response a
expectationFailed417 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.expectationFailed417 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
imATeapot418 :: a -> Response a
imATeapot418 :: a -> Response a
imATeapot418 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.imATeapot418 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
unprocessableEntity422 :: a -> Response a
unprocessableEntity422 :: a -> Response a
unprocessableEntity422 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.unprocessableEntity422 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
preconditionRequired428 :: a -> Response a
preconditionRequired428 :: a -> Response a
preconditionRequired428 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.preconditionRequired428 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
tooManyRequests429 :: a -> Response a
tooManyRequests429 :: a -> Response a
tooManyRequests429 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.tooManyRequests429 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
requestHeaderFieldsTooLarge431 :: a -> Response a
= Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.requestHeaderFieldsTooLarge431 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
internalServerError500 :: a -> Response a
internalServerError500 :: a -> Response a
internalServerError500 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.internalServerError500 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
notImplemented501 :: a -> Response a
notImplemented501 :: a -> Response a
notImplemented501 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.notImplemented501 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
badGateway502 :: a -> Response a
badGateway502 :: a -> Response a
badGateway502 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.badGateway502 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
serviceUnavailable503 :: a -> Response a
serviceUnavailable503 :: a -> Response a
serviceUnavailable503 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.serviceUnavailable503 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
gatewayTimeout504 :: a -> Response a
gatewayTimeout504 :: a -> Response a
gatewayTimeout504 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.gatewayTimeout504 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
httpVersionNotSupported505 :: a -> Response a
httpVersionNotSupported505 :: a -> Response a
httpVersionNotSupported505 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.httpVersionNotSupported505 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
networkAuthenticationRequired511 :: a -> Response a
networkAuthenticationRequired511 :: a -> Response a
networkAuthenticationRequired511 = Status -> Maybe a -> Response a
forall a. Status -> Maybe a -> Response a
respond Status
HTTP.networkAuthenticationRequired511 (Maybe a -> Response a) -> (a -> Maybe a) -> a -> Response a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
type Handler' m req a = Kleisli m (Linked req Request) (Response a)
type Handler req a = Handler' Router req a
type Middleware' m req req' a' a = Handler' m req' a' -> Handler' m req a
type Middleware req req' a' a = Middleware' Router req req' a' a
type RequestMiddleware' m req req' a = Middleware' m req req' a a
type RequestMiddleware req req' a = RequestMiddleware' Router req req' a
type ResponseMiddleware' m req a' a = Middleware' m req req a' a
type ResponseMiddleware req a' a = ResponseMiddleware' Router req a' a
transform :: (forall x. m x -> n x) -> Handler' m req a -> Handler' n req a
transform :: (forall x. m x -> n x) -> Handler' m req a -> Handler' n req a
transform forall x. m x -> n x
f (Kleisli Linked req Request -> m (Response a)
mf) = (Linked req Request -> n (Response a)) -> Handler' n req a
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((Linked req Request -> n (Response a)) -> Handler' n req a)
-> (Linked req Request -> n (Response a)) -> Handler' n req a
forall a b. (a -> b) -> a -> b
$ m (Response a) -> n (Response a)
forall x. m x -> n x
f (m (Response a) -> n (Response a))
-> (Linked req Request -> m (Response a))
-> Linked req Request
-> n (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Linked req Request -> m (Response a)
mf
newtype PathInfo = PathInfo [Text]
data RouteError = RouteMismatch
| ErrorResponse (Response LBS.ByteString)
deriving (RouteError -> RouteError -> Bool
(RouteError -> RouteError -> Bool)
-> (RouteError -> RouteError -> Bool) -> Eq RouteError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RouteError -> RouteError -> Bool
$c/= :: RouteError -> RouteError -> Bool
== :: RouteError -> RouteError -> Bool
$c== :: RouteError -> RouteError -> Bool
Eq, Eq RouteError
Eq RouteError
-> (RouteError -> RouteError -> Ordering)
-> (RouteError -> RouteError -> Bool)
-> (RouteError -> RouteError -> Bool)
-> (RouteError -> RouteError -> Bool)
-> (RouteError -> RouteError -> Bool)
-> (RouteError -> RouteError -> RouteError)
-> (RouteError -> RouteError -> RouteError)
-> Ord RouteError
RouteError -> RouteError -> Bool
RouteError -> RouteError -> Ordering
RouteError -> RouteError -> RouteError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RouteError -> RouteError -> RouteError
$cmin :: RouteError -> RouteError -> RouteError
max :: RouteError -> RouteError -> RouteError
$cmax :: RouteError -> RouteError -> RouteError
>= :: RouteError -> RouteError -> Bool
$c>= :: RouteError -> RouteError -> Bool
> :: RouteError -> RouteError -> Bool
$c> :: RouteError -> RouteError -> Bool
<= :: RouteError -> RouteError -> Bool
$c<= :: RouteError -> RouteError -> Bool
< :: RouteError -> RouteError -> Bool
$c< :: RouteError -> RouteError -> Bool
compare :: RouteError -> RouteError -> Ordering
$ccompare :: RouteError -> RouteError -> Ordering
$cp1Ord :: Eq RouteError
Ord, Int -> RouteError -> ShowS
[RouteError] -> ShowS
RouteError -> String
(Int -> RouteError -> ShowS)
-> (RouteError -> String)
-> ([RouteError] -> ShowS)
-> Show RouteError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteError] -> ShowS
$cshowList :: [RouteError] -> ShowS
show :: RouteError -> String
$cshow :: RouteError -> String
showsPrec :: Int -> RouteError -> ShowS
$cshowsPrec :: Int -> RouteError -> ShowS
Show)
instance Semigroup RouteError where
RouteError
RouteMismatch <> :: RouteError -> RouteError -> RouteError
<> RouteError
e = RouteError
e
RouteError
e <> RouteError
_ = RouteError
e
stimes :: Integral b => b -> RouteError -> RouteError
stimes :: b -> RouteError -> RouteError
stimes = b -> RouteError -> RouteError
forall b a. Integral b => b -> a -> a
stimesIdempotent
instance Monoid RouteError where
mempty :: RouteError
mempty = RouteError
RouteMismatch
newtype Router a = Router
{ Router a -> StateT PathInfo (ExceptT RouteError IO) a
unRouter :: StateT PathInfo (ExceptT RouteError IO) a }
deriving newtype ( a -> Router b -> Router a
(a -> b) -> Router a -> Router b
(forall a b. (a -> b) -> Router a -> Router b)
-> (forall a b. a -> Router b -> Router a) -> Functor Router
forall a b. a -> Router b -> Router a
forall a b. (a -> b) -> Router a -> Router b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Router b -> Router a
$c<$ :: forall a b. a -> Router b -> Router a
fmap :: (a -> b) -> Router a -> Router b
$cfmap :: forall a b. (a -> b) -> Router a -> Router b
Functor, Functor Router
a -> Router a
Functor Router
-> (forall a. a -> Router a)
-> (forall a b. Router (a -> b) -> Router a -> Router b)
-> (forall a b c.
(a -> b -> c) -> Router a -> Router b -> Router c)
-> (forall a b. Router a -> Router b -> Router b)
-> (forall a b. Router a -> Router b -> Router a)
-> Applicative Router
Router a -> Router b -> Router b
Router a -> Router b -> Router a
Router (a -> b) -> Router a -> Router b
(a -> b -> c) -> Router a -> Router b -> Router c
forall a. a -> Router a
forall a b. Router a -> Router b -> Router a
forall a b. Router a -> Router b -> Router b
forall a b. Router (a -> b) -> Router a -> Router b
forall a b c. (a -> b -> c) -> Router a -> Router b -> Router c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Router a -> Router b -> Router a
$c<* :: forall a b. Router a -> Router b -> Router a
*> :: Router a -> Router b -> Router b
$c*> :: forall a b. Router a -> Router b -> Router b
liftA2 :: (a -> b -> c) -> Router a -> Router b -> Router c
$cliftA2 :: forall a b c. (a -> b -> c) -> Router a -> Router b -> Router c
<*> :: Router (a -> b) -> Router a -> Router b
$c<*> :: forall a b. Router (a -> b) -> Router a -> Router b
pure :: a -> Router a
$cpure :: forall a. a -> Router a
$cp1Applicative :: Functor Router
Applicative, Applicative Router
Router a
Applicative Router
-> (forall a. Router a)
-> (forall a. Router a -> Router a -> Router a)
-> (forall a. Router a -> Router [a])
-> (forall a. Router a -> Router [a])
-> Alternative Router
Router a -> Router a -> Router a
Router a -> Router [a]
Router a -> Router [a]
forall a. Router a
forall a. Router a -> Router [a]
forall a. Router a -> Router a -> Router a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Router a -> Router [a]
$cmany :: forall a. Router a -> Router [a]
some :: Router a -> Router [a]
$csome :: forall a. Router a -> Router [a]
<|> :: Router a -> Router a -> Router a
$c<|> :: forall a. Router a -> Router a -> Router a
empty :: Router a
$cempty :: forall a. Router a
$cp1Alternative :: Applicative Router
Alternative, Applicative Router
a -> Router a
Applicative Router
-> (forall a b. Router a -> (a -> Router b) -> Router b)
-> (forall a b. Router a -> Router b -> Router b)
-> (forall a. a -> Router a)
-> Monad Router
Router a -> (a -> Router b) -> Router b
Router a -> Router b -> Router b
forall a. a -> Router a
forall a b. Router a -> Router b -> Router b
forall a b. Router a -> (a -> Router b) -> Router b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Router a
$creturn :: forall a. a -> Router a
>> :: Router a -> Router b -> Router b
$c>> :: forall a b. Router a -> Router b -> Router b
>>= :: Router a -> (a -> Router b) -> Router b
$c>>= :: forall a b. Router a -> (a -> Router b) -> Router b
$cp1Monad :: Applicative Router
Monad, Monad Router
Alternative Router
Router a
Alternative Router
-> Monad Router
-> (forall a. Router a)
-> (forall a. Router a -> Router a -> Router a)
-> MonadPlus Router
Router a -> Router a -> Router a
forall a. Router a
forall a. Router a -> Router a -> Router a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: Router a -> Router a -> Router a
$cmplus :: forall a. Router a -> Router a -> Router a
mzero :: Router a
$cmzero :: forall a. Router a
$cp2MonadPlus :: Monad Router
$cp1MonadPlus :: Alternative Router
MonadPlus
, MonadError RouteError
, MonadState PathInfo
, Monad Router
Monad Router -> (forall a. IO a -> Router a) -> MonadIO Router
IO a -> Router a
forall a. IO a -> Router a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Router a
$cliftIO :: forall a. IO a -> Router a
$cp1MonadIO :: Monad Router
MonadIO
)
class (MonadState PathInfo m, Alternative m, MonadPlus m) => MonadRouter m where
rejectRoute :: m a
errorResponse :: Response LBS.ByteString -> m a
catchErrorResponse :: m a -> (Response LBS.ByteString -> m a) -> m a
instance MonadRouter Router where
rejectRoute :: Router a
rejectRoute :: Router a
rejectRoute = RouteError -> Router a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RouteError
RouteMismatch
errorResponse :: Response LBS.ByteString -> Router a
errorResponse :: Response ByteString -> Router a
errorResponse = RouteError -> Router a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RouteError -> Router a)
-> (Response ByteString -> RouteError)
-> Response ByteString
-> Router a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> RouteError
ErrorResponse
catchErrorResponse :: Router a -> (Response LBS.ByteString -> Router a) -> Router a
catchErrorResponse :: Router a -> (Response ByteString -> Router a) -> Router a
catchErrorResponse Router a
action Response ByteString -> Router a
handle = Router a
action Router a -> (RouteError -> Router a) -> Router a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` RouteError -> Router a
f
where
f :: RouteError -> Router a
f RouteError
RouteMismatch = Router a
forall (m :: * -> *) a. MonadRouter m => m a
rejectRoute
f (ErrorResponse Response ByteString
res) = Response ByteString -> Router a
handle Response ByteString
res
runRoute :: ToByteString a => Handler '[] a -> (Wai.Request -> IO Wai.Response)
runRoute :: Handler '[] a -> Request -> IO Response
runRoute Handler '[] a
route Request
req = Response ByteString -> Response
waiResponse (Response ByteString -> Response)
-> (Either RouteError (Response ByteString) -> Response ByteString)
-> Either RouteError (Response ByteString)
-> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> Response ByteString
addServerHeader (Response ByteString -> Response ByteString)
-> (Either RouteError (Response ByteString) -> Response ByteString)
-> Either RouteError (Response ByteString)
-> Response ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RouteError -> Response ByteString)
-> (Response ByteString -> Response ByteString)
-> Either RouteError (Response ByteString)
-> Response ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RouteError -> Response ByteString
routeErrorToResponse Response ByteString -> Response ByteString
forall a. a -> a
id (Either RouteError (Response ByteString) -> Response)
-> IO (Either RouteError (Response ByteString)) -> IO Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either RouteError (Response ByteString))
runRouter
where
runRouter :: IO (Either RouteError (Response LBS.ByteString))
runRouter :: IO (Either RouteError (Response ByteString))
runRouter = (Either RouteError (Response a)
-> Either RouteError (Response ByteString))
-> IO (Either RouteError (Response a))
-> IO (Either RouteError (Response ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Response a -> Response ByteString)
-> Either RouteError (Response a)
-> Either RouteError (Response ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> ByteString) -> Response a -> Response ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString))
(IO (Either RouteError (Response a))
-> IO (Either RouteError (Response ByteString)))
-> IO (Either RouteError (Response a))
-> IO (Either RouteError (Response ByteString))
forall a b. (a -> b) -> a -> b
$ ExceptT RouteError IO (Response a)
-> IO (Either RouteError (Response a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(ExceptT RouteError IO (Response a)
-> IO (Either RouteError (Response a)))
-> ExceptT RouteError IO (Response a)
-> IO (Either RouteError (Response a))
forall a b. (a -> b) -> a -> b
$ (StateT PathInfo (ExceptT RouteError IO) (Response a)
-> PathInfo -> ExceptT RouteError IO (Response a))
-> PathInfo
-> StateT PathInfo (ExceptT RouteError IO) (Response a)
-> ExceptT RouteError IO (Response a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT PathInfo (ExceptT RouteError IO) (Response a)
-> PathInfo -> ExceptT RouteError IO (Response a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ([Text] -> PathInfo
PathInfo ([Text] -> PathInfo) -> [Text] -> PathInfo
forall a b. (a -> b) -> a -> b
$ Request -> [Text]
pathInfo Request
req)
(StateT PathInfo (ExceptT RouteError IO) (Response a)
-> ExceptT RouteError IO (Response a))
-> StateT PathInfo (ExceptT RouteError IO) (Response a)
-> ExceptT RouteError IO (Response a)
forall a b. (a -> b) -> a -> b
$ Router (Response a)
-> StateT PathInfo (ExceptT RouteError IO) (Response a)
forall a. Router a -> StateT PathInfo (ExceptT RouteError IO) a
unRouter
(Router (Response a)
-> StateT PathInfo (ExceptT RouteError IO) (Response a))
-> Router (Response a)
-> StateT PathInfo (ExceptT RouteError IO) (Response a)
forall a b. (a -> b) -> a -> b
$ Handler '[] a -> Linked '[] Request -> Router (Response a)
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Handler '[] a
route
(Linked '[] Request -> Router (Response a))
-> Linked '[] Request -> Router (Response a)
forall a b. (a -> b) -> a -> b
$ Request -> Linked '[] Request
forall a. a -> Linked '[] a
link Request
req
routeErrorToResponse :: RouteError -> Response LBS.ByteString
routeErrorToResponse :: RouteError -> Response ByteString
routeErrorToResponse RouteError
RouteMismatch = Response ByteString
forall a. Response a
notFound404
routeErrorToResponse (ErrorResponse Response ByteString
r) = Response ByteString
r
addServerHeader :: Response LBS.ByteString -> Response LBS.ByteString
addServerHeader :: Response ByteString -> Response ByteString
addServerHeader Response ByteString
r = Response ByteString
r { responseHeaders :: HashMap HeaderName ByteString
responseHeaders = Response ByteString -> HashMap HeaderName ByteString
forall a. Response a -> HashMap HeaderName ByteString
responseHeaders Response ByteString
r HashMap HeaderName ByteString
-> HashMap HeaderName ByteString -> HashMap HeaderName ByteString
forall a. Semigroup a => a -> a -> a
<> [Item (HashMap HeaderName ByteString)]
-> HashMap HeaderName ByteString
forall l. IsList l => [Item l] -> l
fromList [(HeaderName, ByteString)
Item (HashMap HeaderName ByteString)
serverHeader] }
serverHeader :: HTTP.Header
serverHeader :: (HeaderName, ByteString)
serverHeader = (HeaderName
HTTP.hServer, String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"WebGear/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version)
toApplication :: ToByteString a => Handler '[] a -> Wai.Application
toApplication :: Handler '[] a -> Application
toApplication Handler '[] a
route Request
request Response -> IO ResponseReceived
next = Handler '[] a -> Request -> IO Response
forall a. ToByteString a => Handler '[] a -> Request -> IO Response
runRoute Handler '[] a
route Request
request IO Response
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
next