salvia-1.0.0: Modular web application framework.

Network.Salvia.Handlers

Contents

Synopsis

Fundamental protocol handlers.

Default handler environments.

hDefaultEnvSource

Arguments

:: (MonadIO m, HandleM m, RawHttpM' m, HttpM' m, QueueM m, SendM m, FlushM Response m) 
=> m ()

Handler to run in the default environment.

-> m () 

This is the default handler environment. It takes care of request parsing (hRequestParser), response printing (hResponsePrinter), connection keep-alives (hKeepAlive), handling HEAD requests (hHead) and printing the `salvia-httpd` server banner (hBanner).

hEnvNoKeepAliveSource

Arguments

:: (MonadIO m, HandleM m, RawHttpM' m, HttpM' m, QueueM m, SendM m, FlushM Response m) 
=> m ()

Handler to run in this environment.

-> m () 

Like hDefaultEnv but only serves one request per connection.

Parse client requests.

hRequestParserSource

Arguments

:: (HandleM m, RawHttpM Request m, HttpM Request m, MonadIO m) 
=> Int

Timeout in milliseconds.

-> (String -> m a)

The fail handler.

-> m a

The success handler.

-> m (Maybe a) 

Like the hParser but always parses HTTP Requestss.

hResponseParserSource

Arguments

:: (HandleM m, RawHttpM Response m, HttpM Response m, MonadIO m) 
=> Int

Timeout in milliseconds.

-> (String -> m a)

The fail handler.

-> m a

The success handler.

-> m (Maybe a) 

Like the hParser but always parses HTTP Responses.

hParserSource

Arguments

:: (HandleM m, MonadIO m) 
=> (Http d -> m b)

What to do with message.

-> (String -> Either String (Http d))

Custom message parser.

-> Int

Timeout in milliseconds.

-> (String -> m a)

The fail handler.

-> m a

The success handler.

-> m (Maybe a) 

The hParser handler is used to parse the raw HTTP message into the Message data type. This handler is generally used as (one of) the first handlers in a client or server environment. The first handler argument is executed when the message is invalid, possibly due to parser errors, and is parametrized with the error string. The second handler argument is executed when the message is valid. When the message could not be parsed within the time specified with the first argument the function silently returns.

Print server responses.

hResponsePrinter :: FlushM Response m => m ()Source

The hResponsePrinter handler prints the entire HTTP response including the headers and the body to the socket towards the client. This handler is generally used as (one of) the last handler in a client environment.

hRequestPrinter :: FlushM Request m => m ()Source

The hRequestPrinter handler prints the entire HTTP request including the headers and the body to the socket towards the server. This handler is generally used as (one of) the last handler in a server environment.

hFlushHeaders :: forall m d. (Show (Http d), HandleM m, QueueM m, MonadIO m, HttpM d m) => d -> m ()Source

Send all the message headers directly over the socket.

todo: printer for rawResponse over response!!

hFlushHeadersOnly :: forall m d. (Show (Http d), HandleM m, QueueM m, MonadIO m, HttpM d m) => d -> m ()Source

Like hFlushHeaders but does not print status line, can be useful for CGI mode.

hFlushRequestHeaders :: FlushM Request m => m ()Source

Like hFlushHeaders but specifically for the request headers.

hFlushResponseHeaders :: FlushM Response m => m ()Source

Like hFlushHeaders but specifically for the response headers.

hFlushQueue :: (QueueM m, HandleM m, SocketM m, MonadIO m) => m ()Source

One by one apply all enqueued send actions to the socket.

Accessing request and response bodies.

hRawRequestBody :: BodyM Request m => m ByteStringSource

Like hRawBody but specifically for Http Requests.

hRawResponseBody :: BodyM Response m => m ByteStringSource

Like hRawBody but specifically for Http Requests.

hRawBody :: forall m d. (MonadIO m, HandleM m, HttpM d m) => d -> m ByteStringSource

First (possibly naive) handler to retreive the client request or server response body as a raw lazy ByteString. This probably does not handle all the quirks that the HTTP protocol specifies, but it does the job for now. When a contentLength header field is available only this fixed number of bytes will read from the socket. When neither the keepAlive and contentLength header fields are available the entire payload of the request will be read from the socket. The function is parametrized with a the direction of the HTTP message, client request or server response.

hRequestBodyText :: (BodyM Request m, HttpM Request m) => String -> m TextSource

Like hBodyText but specifically for Http Requests.

hResponseBodyText :: (BodyM Response m, HttpM Response m) => String -> m TextSource

Like hBodyText but specifically for Http Responses.

hBodyText :: forall m dir. (BodyM dir m, HttpM dir m) => dir -> String -> m TextSource

Like the hRawBody but is will handle proper decoding based on the charset part of the contentType header line. When a valid encoding is found in the Http message it will be decoded with using the encodings package. The default encoding supplied as the function's argument can be used to specify what encoding to use in the absence of a proper encoding in the HTTP message itself.

hBodyStringUTF8 :: BodyM dir m => dir -> m StringSource

Like the hRawBody but decodes it as UTF-8 to a String.

hRequestParameters :: (BodyM Request m, HttpM Request m) => String -> m ParametersSource

Like hParameters but specifically for HTTP Requests.

hResponseParameters :: (BodyM Response m, HttpM Response m) => String -> m ParametersSource

Like hParameters but specifically for HTTP Responses.

hParameters :: (BodyM d m, HttpM d m) => d -> String -> m ParametersSource

Try to parse the message body, as a result of hBodyText, as URI encoded POST parameters. Returns as a URI Parameter type or nothing when parsing fails.

HTTP header banner.

hBannerSource

Arguments

:: (MonadIO m, HttpM Response m) 
=> String

The name to include as the Server header line.

-> m () 

The hBanner handler adds the current date-/timestamp and a custom server name to the response headers.

Closing or keeping alive connections.

hCloseConn :: (HandleM m, MonadIO m) => m a -> m ()Source

Run a handler once and close the connection afterwards.

hKeepAlive :: (QueueM m, HandleM m, HttpM' m, MonadIO m) => m a -> m ()Source

Run a handler and keep the connection open for potential consecutive requests. The connection will only be closed after a request finished and one or more of the following criteria are met:

  • There is no contentLength set in the response headers. When this is the case the connection cannot be kept alive.
  • The client has set the connection header field to close.
  • The connection has already been closed, possible due to IO errors.
  • The HTTP version is HTTP/1.0.

Enable HTTP HEAD requests.

hHead :: (MonadIO m, QueueM m, HttpM Request m) => m a -> m aSource

The hHead handler makes sure no HTTP Response body is sent to the client when the request is an HTTP HEAD request. In the case of a HEAD request the specified sub handler will be executed under the assumption that the request was a GET request, otherwise this handler will act as the identify function.

Error handling and logging.

Default error handlers.

hError :: (HttpM Response m, SendM m) => Status -> m ()Source

The hError handler enables the creation of a default style of error responses for the specified HTTP Status code.

hCustomError :: (HttpM Response m, SendM m) => Status -> String -> m ()Source

Like hError but with a custom error message.

hIOError :: (HttpM Response m, SendM m) => IOError -> m ()Source

Map an IOError to a default style error response.

The mapping from an IO error to an error response is rather straightforward:

  | isDoesNotExistError e = hError NotFound
  | isAlreadyInUseError e = hError ServiceUnavailable
  | isPermissionError   e = hError Forbidden
  | True                  = hError InternalServerError

hSafeIO :: (MonadIO m, HttpM Response m, SendM m) => IO a -> (a -> m ()) -> m ()Source

Execute an handler with the result of an IO action. When the IO actions fails a default error handler will be executed.

Logging of client requests.

hLog :: (AddressM' m, MonadIO m, HttpM' m) => Handle -> m ()Source

A simple logger that prints a summery of the request information to the specified file handle.

hDumpRequest :: (HttpM Request m, MonadIO m) => m ()Source

Dump the request headers to the standard output, useful for debugging.

hDumpResponse :: (HttpM Response m, MonadIO m) => m ()Source

Dump the response headers to the standard output, useful for debugging.

Redirecting and rewriting.

Redirecting the client.

hRedirect :: HttpM Response m => String -> m ()Source

Redirect a client to another location by creating a MovedPermanently response message with the specified URI in the location header.

Request URI rewriting.

hRewrite :: HttpM Request m => (Uri -> Uri) -> m a -> m aSource

Run an handler in a modified context in which the request Uri has been changed by the specified modifier function. After the handler completes the Uri remains untouched.

hRewriteHost :: HttpM Request m => (String -> String) -> m a -> m aSource

Run handler in a context with a modified host.

hRewritePath :: HttpM Request m => (FilePath -> FilePath) -> m a -> m aSource

Run handler in a context with a modified path.

hRewriteExt :: HttpM Request m => (Maybe String -> Maybe String) -> m a -> m aSource

Run handler in a context with a modified file extension.

hWithDir :: HttpM Request m => String -> m a -> m aSource

Run handler in a context with a modified path. The specified prefix will be prepended to the path.

hWithoutDir :: HttpM Request m => String -> m a -> m aSource

Run handler in a context with a modified path. The specified prefix will be stripped from the path.

File and directory serving.

Serve static file resources.

hFileResource :: (MonadIO m, HttpM' m, SendM m) => FilePath -> m ()Source

Serve a file from the filesystem indicated by the specified filepath. When there is some kind of IOError the hSafeIO function will be used to produce a corresponding error response. The contentType will be the mime-type based on the filename extension using the mimetype function. The contentLength will be set the file's size.

hFileResourceFilter :: (MonadIO m, HttpM Response m, SendM m) => (String -> String) -> FilePath -> m ()Source

Like the hFileResource handler, but with a custom filter over the content. This function will assume the content is an UTF-8 encoded text file. Because of the possibly unpredictable behavior of the filter, no contentLength header will be set using this handler.

hResource :: HttpM Request m => (FilePath -> m a) -> m aSource

Turn a handler that is parametrized by a file resources into a regular handler that utilizes the path part of the request URI as the resource identifier.

hUri :: HttpM Request m => (Uri -> m a) -> m aSource

Turn a handler that is parametrized by a URI into a regular handler that utilizes the request URI as the resource identifier.

hFile :: (MonadIO m, HttpM' m, SendM m) => m ()Source

Like hFileResource but uses the path of the current request URI.

hFileFilter :: (MonadIO m, HttpM' m, SendM m) => (String -> String) -> m ()Source

Like hFileResourceFilter but uses the path of the current request URI.

Serve directory indices.

hDirectory :: (MonadIO m, HttpM' m, SendM m) => m ()Source

Like hDirectoryResource but uses the path from the current request URI.

hDirectoryResourceSource

Arguments

:: (MonadIO m, HttpM' m, SendM m) 
=> FilePath

Directory to produce a listing for.

-> m () 

Serve a simple HTML directory listing for the specified directory on the filesystem.

Serve file system directory.

hFileTypeDispatcherSource

Arguments

:: (MonadIO m, HttpM' m, SendM m) 
=> (FilePath -> m ())

Handler to invoke in case of directory.

-> (FilePath -> m ())

Handler to invoke in case of regular files.

-> FilePath

Directory to serve.

-> m () 

Dispatch based on file type; regular files or directories. The first handler specified will be invoked in case the resource to be served is an directory, the second handler otherwise. The path from the request URI will be appended to the directory resource specified as a parameter, this new path will be used to lookup the real resource on the file system. Every request will be jailed in the specified directory resource to prevent users from requesting arbitrary parts of the file system.

hFileSystemSource

Arguments

:: (MonadIO m, HttpM' m, SendM m) 
=> FilePath

Directory to serve.

-> m () 

Serve single directory by combining the hDirectoryResource and hFileResource handlers in the hFileTypeDispatcher.

hFileSystemNoIndexesSource

Arguments

:: (MonadIO m, HttpM' m, SendM m) 
=> FilePath

Directory to serve.

-> m () 

Serve single directory like hFileSystem but do not show directory indices. Instead of an directory index an Forbidden response will be created.

Enable PUTing resources to the files ystem.

hPutFileSystem :: (MonadIO m, HttpM' m, SendM m, BodyM Request m) => FilePath -> m ()Source

Create a browseable filesystem handler (like hFileSystem) but make all files writeable by a PUT request. Files that do not exists will be created as long as the directory in which they will be created exists.

hPutResource :: (MonadIO m, BodyM Request m, HttpM' m, SendM m) => (FilePath -> m ()) -> FilePath -> m ()Source

Invokes the hStore handler when the request is a PUT request and invokes the fallback handler otherwiser.

hStore :: (MonadIO m, BodyM Request m, HttpM Response m, SendM m) => FilePath -> m ()Source

This handler takes a FilePath and will try to store the entire request body in that file. When the request body could for some reason not be fetch a BadRequest error response will be created. When an IO error occurs the hIOError function is used to setup an apropriate response.

Support for HTTP ranges.

data Range Source

HTTP Range datatype.

Instances

contentRange :: Http Response :-> Maybe RangeSource

Access the Content-Range header field.

range :: Http Request :-> Maybe RangeSource

Access the Range header field.

rangeL :: String :<->: RangeSource

Lens containing parser and pretty-printer for HTTP ranges.

Serving CGI scripts.

hCGI :: (MonadIO m, HttpM' m, BodyM Request m, SendM m, HandleQueueM m, ServerM m, AddressM' m) => FilePath -> m ()Source

Handler to run CGI scripts.

Dispatching.

Custom request dispatchers.

type Dispatcher a m b = a -> m b -> m b -> m bSource

The dispatcher type takes one value to dispatch on and two handlers. The first handler will be used when the predicate on the dispatch value returned True, the second (default) handler will be used when the predicate returs False.

type ListDispatcher a m b = [(a, m b)] -> m b -> m bSource

A list dispatcher takes a mapping from dispatch values to handlers and one default fallback handler.

hDispatch :: forall a b c d m. HttpM d m => d -> (Http d :-> b) -> (c -> b -> Bool) -> Dispatcher c m aSource

Dispatch on an arbitrary part of the context using an arbitrary predicate. When the predicate returns true on the value selected with the Label the first handler will be invoked, otherwise the second handler will be used.

hRequestDispatch :: HttpM Request m => (Http Request :-> b) -> (t -> b -> Bool) -> Dispatcher t m cSource

Like the hDispatch but always dispatches on a (part of) the `HTTP Request' part of the context.

hListDispatch :: Dispatcher a m b -> ListDispatcher a m bSource

Turns a dispatcher function into a list dispatcher. This enables handler routing based on arbitrary values from the context. When non of the predicates in the ListDispatcher type hold the default handler will be invoked.

Dispatch based on request method.

hMethod :: HttpM Request m => Dispatcher Method m aSource

Request dispatcher based on the HTTP request Method.

hMethodRouter :: HttpM Request m => ListDispatcher Method m ()Source

Request list dispatcher based on the hMethod dispatcher.

Dispatch based on request path.

hPath :: HttpM Request m => Dispatcher String m aSource

Request dispatcher based on the request path.

hPathRouter :: HttpM Request m => ListDispatcher String m aSource

List dispatcher version of hPath.

hPrefix :: HttpM Request m => Dispatcher String m aSource

Request dispatcher based on a prefix of the request path.

hPrefixRouter :: HttpM Request m => ListDispatcher String m aSource

List dispatcher version of hPrefix.

hQueryParameters :: HttpM Request m => m ParametersSource

Helper function to fetch the URI parameters from the request.

Dispatch based on filename extension.

hExtension :: HttpM Request m => Dispatcher (Maybe String) m aSource

Request dispatcher based on the request path file extenstion.

hExtensionRouter :: HttpM Request m => ListDispatcher (Maybe String) m aSource

List dispatcher version of hExtension.

Dispatch based on host name.

hVirtualHosting :: HttpM Request m => ListDispatcher String m bSource

Dispatcher based on the host part of the hostname request header. Everything not part of the real hostname (like the port number) will be ignored. When the expected hostname starts with a dot (like .mydomain.com) this indicates that all sub-domains of this domain will match as well.

hPortRouter :: HttpM Request m => ListDispatcher Int m bSource

Dispatcher based on the port number of the hostname request header. When no port number is available in the hostname header port 80 will be assumed.

Cookie management.

hSetCookie :: HttpM Response m => Cookies -> m ()Source

Set the `Set-Cookie` HTTP response header with the specified Cookies.

hCookie :: HttpM Request m => m (Maybe Cookies)Source

Try to get the cookies from the HTTP cookie request header.

hDelCookie :: HttpM Response m => String -> m ()Source

Delete one cookie by removing it from the `Set-Cookie' header.

hNewCookie :: (ServerM m, ServerAddressM m, FormatTime t) => t -> Bool -> m CookieSource

Convenient method for creating cookies that expire in the near future and are bound to the domain and port this server runs on. The path will be locked to root. If the second argument is set, the cookie will be valid for all subdomains.