-- |
-- Copyright        : (c) Raghu Kaippully, 2020
-- License          : MPL-2.0
-- Maintainer       : rkaippully@gmail.com
--
-- Common types and functions used throughout WebGear.
--
module WebGear.Types
  ( -- * WebGear Request
    Request
  , remoteHost
  , httpVersion
  , isSecure
  , requestMethod
  , pathInfo
  , queryString
  , requestHeader
  , requestHeaders
  , requestBodyLength
  , getRequestBodyChunk

    -- * WebGear Response
  , Response (..)
  , responseHeader
  , setResponseHeader
  , waiResponse

    -- * Creating responses
  , 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


-- | Get the value of a request header
requestHeader :: HTTP.HeaderName -> Request -> Maybe ByteString
requestHeader :: HeaderName -> Request -> Maybe ByteString
requestHeader 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)

-- | An HTTP response sent from the server to the client.
--
-- The response contains a status, optional headers and an optional
-- body of type @a@.
data Response a = Response
    { Response a -> Status
responseStatus  :: HTTP.Status                            -- ^ Response status code
    , Response a -> HashMap HeaderName ByteString
responseHeaders :: HM.HashMap HTTP.HeaderName ByteString  -- ^ Response headers
    , Response a -> Maybe a
responseBody    :: Maybe a                                -- ^ Optional response body
    }
    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)

-- | Looks up a response header
responseHeader :: HTTP.HeaderName -> Response a -> Maybe ByteString
responseHeader :: HeaderName -> Response a -> Maybe ByteString
responseHeader 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

-- | Set a response header value
setResponseHeader :: HTTP.HeaderName -> ByteString -> Response a -> Response a
setResponseHeader :: HeaderName -> ByteString -> Response a -> Response a
setResponseHeader 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) }

-- | Convert a WebGear response to a WAI Response.
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)


-- | Create a response with a given status and body
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

-- | Continue 100 response
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

-- | Switching Protocols 101 response
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

-- | OK 200 response
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

-- | Created 201 response
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

-- | Accepted 202 response
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

-- | Non-Authoritative 203 response
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

-- | No Content 204 response
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

-- | Reset Content 205 response
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

-- | Partial Content 206 response
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

-- | Multiple Choices 300 response
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

-- | Moved Permanently 301 response
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

-- | Found 302 response
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

-- | See Other 303 response
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

-- | Not Modified 304 response
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

-- | Temporary Redirect 307 response
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

-- | Permanent Redirect 308 response
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

-- | Bad Request 400 response
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

-- | Unauthorized 401 response
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

-- | Payment Required 402 response
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

-- | Forbidden 403 response
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

-- | Not Found 404 response
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

-- | Method Not Allowed 405 response
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

-- | Not Acceptable 406 response
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

-- | Proxy Authentication Required 407 response
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

-- | Request Timeout 408 response
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

-- | Conflict 409 response
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

-- | Gone 410 response
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

-- | Length Required 411 response
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

-- | Precondition Failed 412 response
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

-- | Request Entity Too Large 413 response
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

-- | Request URI Too Long 414 response
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

-- | Unsupported Media Type 415 response
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

-- | Requested Range Not Satisfiable 416 response
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

-- | Expectation Failed 417 response
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

-- | I'm A Teapot 418 response
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

-- | Unprocessable Entity 422 response
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

-- | Precondition Required 428 response
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

-- | Too Many Requests 429 response
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

-- | Request Header Fields Too Large 431 response
requestHeaderFieldsTooLarge431 :: a -> Response a
requestHeaderFieldsTooLarge431 :: a -> Response a
requestHeaderFieldsTooLarge431 = 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

-- | Internal Server Error 500 response
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

-- | Not Implemented 501 response
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

-- | Bad Gateway 502 response
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

-- | Service Unavailable 503 response
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

-- | Gateway Timeout 504 response
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

-- | HTTP Version Not Supported 505 response
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

-- | Network Authentication Required 511 response
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



-- | A handler is a function from a request to response in a monadic
-- context. Both the request and the response can have linked traits.
--
-- The type level list @req@ contains all the traits expected to be
-- present in the request.
type Handler' m req a = Kleisli m (Linked req Request) (Response a)

-- | A handler that runs on the 'Router' monad.
type Handler req a = Handler' Router req a

-- | A middleware takes a handler as input and produces another
-- handler that usually adds some functionality.
--
-- A middleware can do a number of things with the request
-- handling such as:
--
--   * Change the request traits before invoking the handler.
--   * Use the linked value of any of the request traits.
--   * Change the response body.
--
type Middleware' m req req' a' a = Handler' m req' a' -> Handler' m req a

-- | A middleware that runs on the 'Router' monad.
type Middleware req req' a' a = Middleware' Router req req' a' a

-- | A middleware that manipulates only the request traits and passes
-- the response through.
type RequestMiddleware' m req req' a = Middleware' m req req' a a

-- | A request middleware that runs on the 'Router' monad.
type RequestMiddleware req req' a = RequestMiddleware' Router req req' a

-- | A middleware that manipulates only the response and passes the
-- request through.
type ResponseMiddleware' m req a' a = Middleware' m req req a' a

-- | A response middleware that runs on the 'Router' monad.
type ResponseMiddleware req a' a = ResponseMiddleware' Router req a' a

-- | A natural transformation of handler monads.
--
-- This is useful if you want to run a handler in a monad other than
-- 'Router'.
--
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

-- | The path components to be matched by routing machinery
newtype PathInfo = PathInfo [Text]

-- | Responses that cause routes to abort execution
data RouteError = RouteMismatch
                  -- ^ A route did not match and the next one can be
                  -- tried
                | ErrorResponse (Response LBS.ByteString)
                  -- ^ A route matched but returned a short circuiting
                  -- error response
                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

-- | The monad for routing.
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
                   )

-- | HTTP request routing with short circuiting behavior.
class (MonadState PathInfo m, Alternative m, MonadPlus m) => MonadRouter m where
  -- | Mark the current route as rejected, alternatives can be tried
  rejectRoute :: m a

  -- | Short-circuit the current handler and return a response
  errorResponse :: Response LBS.ByteString -> m a

  -- | Handle an error response
  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


-- | Convert a routable handler into a plain function from request to response.
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)

-- | Convert a routable handler into a Wai application
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