| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Web.Routes.Nested
- type Tries x s e e' = (RootedPredTrie Text x, RootedPredTrie Text x, RootedPredTrie Text s, RootedPredTrie Text e)
- newtype HandlerT x sec err errSym uploadSym m a = HandlerT {
- runHandlerT :: WriterT (Tries x sec err errSym) m a
- type ActionT u m a = VerbListenerT (FileExtListenerT Response m a) u m a
- type RoutesT u s e m a = HandlerT (ActionT u m a) (s, AuthScope) (e -> ActionT u m a) e u m a
- type ApplicationT m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived
- type MiddlewareT m = ApplicationT m -> ApplicationT m
- data AuthScope
- handle :: (Monad m, Functor m, cleanxs ~ CatMaybes xs, HasResult childContent (ActionT u m ()), HasResult childErr (e -> ActionT u m ()), ExpectArity cleanxs childContent, ExpectArity cleanxs childSec, ExpectArity cleanxs childErr, Singleton (UrlChunks xs) childContent (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childContent) (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childSec) (RootedPredTrie Text resultSec), Extrude (UrlChunks xs) (RootedPredTrie Text childErr) (RootedPredTrie Text resultErr), ArityMinusTypeList childContent cleanxs ~ resultContent, ArityMinusTypeList childSec cleanxs ~ resultSec, ArityMinusTypeList childErr cleanxs ~ resultErr, childContent ~ TypeListToArity cleanxs resultContent, childSec ~ TypeListToArity cleanxs resultSec, childErr ~ TypeListToArity cleanxs resultErr) => UrlChunks xs -> Maybe childContent -> Maybe (HandlerT childContent childSec childErr e u m ()) -> HandlerT resultContent resultSec resultErr e u m ()
- parent :: (Monad m, Functor m, cleanxs ~ CatMaybes xs, Singleton (UrlChunks xs) childContent (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childContent) (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childErr) (RootedPredTrie Text resultErr), Extrude (UrlChunks xs) (RootedPredTrie Text childSec) (RootedPredTrie Text resultSec), ArityMinusTypeList childContent cleanxs ~ resultContent, ArityMinusTypeList childSec cleanxs ~ resultSec, ArityMinusTypeList childErr cleanxs ~ resultErr, childContent ~ TypeListToArity cleanxs resultContent, childSec ~ TypeListToArity cleanxs resultSec, childErr ~ TypeListToArity cleanxs resultErr) => UrlChunks xs -> HandlerT childContent childSec childErr e u m () -> HandlerT resultContent resultSec resultErr e u m ()
- auth :: (Monad m, Functor m) => sec -> err -> AuthScope -> HandlerT content (sec, AuthScope) err e u m ()
- notFound :: (Monad m, Functor m, cleanxs ~ CatMaybes xs, HasResult childContent (ActionT u m ()), HasResult childErr (e -> ActionT u m ()), ExpectArity cleanxs childContent, ExpectArity cleanxs childSec, ExpectArity cleanxs childErr, Singleton (UrlChunks xs) childContent (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childContent) (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childSec) (RootedPredTrie Text resultSec), Extrude (UrlChunks xs) (RootedPredTrie Text childErr) (RootedPredTrie Text resultErr), ArityMinusTypeList childContent cleanxs ~ resultContent, ArityMinusTypeList childSec cleanxs ~ resultSec, ArityMinusTypeList childErr cleanxs ~ resultErr, childContent ~ TypeListToArity cleanxs resultContent, childSec ~ TypeListToArity cleanxs resultSec, childErr ~ TypeListToArity cleanxs resultErr) => UrlChunks xs -> Maybe childContent -> Maybe (HandlerT childContent childSec childErr e u m ()) -> HandlerT resultContent resultSec resultErr e u m ()
- route :: (Functor m, Monad m, MonadIO m) => HandlerT (ActionT u m ()) sec err e u m a -> MiddlewareT m
- routeAuth :: (Functor m, Monad m, MonadIO m) => (Request -> [sec] -> ExceptT e m (Response -> Response)) -> RoutesT u sec e m () -> MiddlewareT m
- extractContent :: (Functor m, Monad m, MonadIO m) => HandlerT (ActionT u m ()) sec err e u m a -> MiddlewareT m
- extractNotFound :: (Functor m, Monad m, MonadIO m) => HandlerT (ActionT u m ()) sec err e u m a -> MiddlewareT m
- extractAuthSym :: (Functor m, Monad m) => HandlerT x (sec, AuthScope) err e u m a -> Request -> m [sec]
- extractAuth :: (Functor m, Monad m, MonadIO m) => (Request -> [sec] -> ExceptT e m (Response -> Response)) -> HandlerT x (sec, AuthScope) (e -> ActionT u m ()) e u m a -> MiddlewareT m
- extractNearestVia :: (Functor m, Monad m, MonadIO m) => (HandlerT (ActionT u m ()) sec err e u m a -> m (RootedPredTrie Text (ActionT u m ()))) -> HandlerT (ActionT u m ()) sec err e u m a -> MiddlewareT m
- actionToMiddleware :: MonadIO m => Maybe AcceptHeader -> FileExt -> Verb -> ActionT u m () -> MiddlewareT m
- lookupVerb :: Verb -> Request -> Verbs u m r -> Maybe (m (Maybe u), Maybe u -> r)
- lookupFileExt :: Maybe AcceptHeader -> FileExt -> FileExts a -> Maybe a
- lookupUpload :: Monad m => Verb -> Request -> VerbListenerT r u m () -> m (Maybe (m (Maybe u), Maybe u -> r))
- lookupResponse :: Monad m => Maybe AcceptHeader -> FileExt -> FileExtListenerT a m () -> m (Maybe a)
- possibleFileExts :: FileExt -> AcceptHeader -> [FileExt]
- trimFileExt :: Text -> Text
- getFileExt :: Request -> FileExt
- httpMethodToMSym :: Method -> Maybe Verb
Types
type Tries x s e e' = (RootedPredTrie Text x, RootedPredTrie Text x, RootedPredTrie Text s, RootedPredTrie Text e) Source
newtype HandlerT x sec err errSym uploadSym m a Source
Constructors
| HandlerT | |
Fields
| |
Instances
| Monad m => MonadWriter (Tries k x sec err errSym) (HandlerT k k x sec err errSym uploadSym m) Source | |
| MonadTrans (HandlerT k k x sec err errSym uploadSym) Source | |
| Monad m => Monad (HandlerT k k x sec err errSym uploadSym m) Source | |
| Functor m => Functor (HandlerT k k x sec err errSym uploadSym m) Source | |
| Applicative m => Applicative (HandlerT k k x sec err errSym uploadSym m) Source | |
| MonadIO m => MonadIO (HandlerT k k x sec err errSym uploadSym m) Source |
type ActionT u m a = VerbListenerT (FileExtListenerT Response m a) u m a Source
type RoutesT u s e m a = HandlerT (ActionT u m a) (s, AuthScope) (e -> ActionT u m a) e u m a Source
type ApplicationT m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived Source
type MiddlewareT m = ApplicationT m -> ApplicationT m Source
Constructors
| ProtectParent | |
| ProtectChildren |
Combinators
handle :: (Monad m, Functor m, cleanxs ~ CatMaybes xs, HasResult childContent (ActionT u m ()), HasResult childErr (e -> ActionT u m ()), ExpectArity cleanxs childContent, ExpectArity cleanxs childSec, ExpectArity cleanxs childErr, Singleton (UrlChunks xs) childContent (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childContent) (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childSec) (RootedPredTrie Text resultSec), Extrude (UrlChunks xs) (RootedPredTrie Text childErr) (RootedPredTrie Text resultErr), ArityMinusTypeList childContent cleanxs ~ resultContent, ArityMinusTypeList childSec cleanxs ~ resultSec, ArityMinusTypeList childErr cleanxs ~ resultErr, childContent ~ TypeListToArity cleanxs resultContent, childSec ~ TypeListToArity cleanxs resultSec, childErr ~ TypeListToArity cleanxs resultErr) => UrlChunks xs -> Maybe childContent -> Maybe (HandlerT childContent childSec childErr e u m ()) -> HandlerT resultContent resultSec resultErr e u m () Source
For routes ending with a literal.
parent :: (Monad m, Functor m, cleanxs ~ CatMaybes xs, Singleton (UrlChunks xs) childContent (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childContent) (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childErr) (RootedPredTrie Text resultErr), Extrude (UrlChunks xs) (RootedPredTrie Text childSec) (RootedPredTrie Text resultSec), ArityMinusTypeList childContent cleanxs ~ resultContent, ArityMinusTypeList childSec cleanxs ~ resultSec, ArityMinusTypeList childErr cleanxs ~ resultErr, childContent ~ TypeListToArity cleanxs resultContent, childSec ~ TypeListToArity cleanxs resultSec, childErr ~ TypeListToArity cleanxs resultErr) => UrlChunks xs -> HandlerT childContent childSec childErr e u m () -> HandlerT resultContent resultSec resultErr e u m () Source
auth :: (Monad m, Functor m) => sec -> err -> AuthScope -> HandlerT content (sec, AuthScope) err e u m () Source
Sets the security role and error handler for a scope of routes.
notFound :: (Monad m, Functor m, cleanxs ~ CatMaybes xs, HasResult childContent (ActionT u m ()), HasResult childErr (e -> ActionT u m ()), ExpectArity cleanxs childContent, ExpectArity cleanxs childSec, ExpectArity cleanxs childErr, Singleton (UrlChunks xs) childContent (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childContent) (RootedPredTrie Text resultContent), Extrude (UrlChunks xs) (RootedPredTrie Text childSec) (RootedPredTrie Text resultSec), Extrude (UrlChunks xs) (RootedPredTrie Text childErr) (RootedPredTrie Text resultErr), ArityMinusTypeList childContent cleanxs ~ resultContent, ArityMinusTypeList childSec cleanxs ~ resultSec, ArityMinusTypeList childErr cleanxs ~ resultErr, childContent ~ TypeListToArity cleanxs resultContent, childSec ~ TypeListToArity cleanxs resultSec, childErr ~ TypeListToArity cleanxs resultErr) => UrlChunks xs -> Maybe childContent -> Maybe (HandlerT childContent childSec childErr e u m ()) -> HandlerT resultContent resultSec resultErr e u m () Source
Entry Point
Arguments
| :: (Functor m, Monad m, MonadIO m) | |
| => HandlerT (ActionT u m ()) sec err e u m a | Assembled |
| -> MiddlewareT m |
Turns a HandlerT into a Wai Application
Arguments
| :: (Functor m, Monad m, MonadIO m) | |
| => (Request -> [sec] -> ExceptT e m (Response -> Response)) | authorize |
| -> RoutesT u sec e m () | Assembled |
| -> MiddlewareT m |
Given a security verification function which returns an updating function, turn a set of routes into a middleware, where a session is secured before responding.
Extraction
Arguments
| :: (Functor m, Monad m, MonadIO m) | |
| => HandlerT (ActionT u m ()) sec err e u m a | Assembled |
| -> MiddlewareT m |
Turn the trie carrying the main content into a middleware.
extractNotFound :: (Functor m, Monad m, MonadIO m) => HandlerT (ActionT u m ()) sec err e u m a -> MiddlewareT m Source
Turns the not-found trie into a final application, matching all routes under
each notFound node. If there is no nearest parent (querying above the head
of the tree), control is passed down the middlware chain.
extractAuthSym :: (Functor m, Monad m) => HandlerT x (sec, AuthScope) err e u m a -> Request -> m [sec] Source
Manually fetch the security tokens / authorization roles affiliated with a request and your routing system.
extractAuth :: (Functor m, Monad m, MonadIO m) => (Request -> [sec] -> ExceptT e m (Response -> Response)) -> HandlerT x (sec, AuthScope) (e -> ActionT u m ()) e u m a -> MiddlewareT m Source
extractNearestVia :: (Functor m, Monad m, MonadIO m) => (HandlerT (ActionT u m ()) sec err e u m a -> m (RootedPredTrie Text (ActionT u m ()))) -> HandlerT (ActionT u m ()) sec err e u m a -> MiddlewareT m Source
Only return content, do not handle uploads. Also, the extraction should be
flat, in that the values contained in our trie are only ActionT, without arity.
Utilities
actionToMiddleware :: MonadIO m => Maybe AcceptHeader -> FileExt -> Verb -> ActionT u m () -> MiddlewareT m Source
Turn an ActionT into a Middleware by providing a FileExt and Verb
to lookup, returning the response and utilizing the upload handler encoded
in the action.
lookupFileExt :: Maybe AcceptHeader -> FileExt -> FileExts a -> Maybe a Source
Given a possible Accept header and file extension key, lookup the contents
of a map.
lookupUpload :: Monad m => Verb -> Request -> VerbListenerT r u m () -> m (Maybe (m (Maybe u), Maybe u -> r)) Source
lookupResponse :: Monad m => Maybe AcceptHeader -> FileExt -> FileExtListenerT a m () -> m (Maybe a) Source
File Extensions
possibleFileExts :: FileExt -> AcceptHeader -> [FileExt] Source
Takes a subject file extension and an Accept header, and returns the other
types of file types handleable, in order of prescedence.
trimFileExt :: Text -> Text Source
Removes .txt from foo.txt
getFileExt :: Request -> FileExt Source
httpMethodToMSym :: Method -> Maybe Verb Source
Turns a ByteString into a StdMethod.