HAppS-Server-0.9.2.1: Web related tools and services.ContentsIndex
HAppS.Server.SimpleHTTP
Portabilityrequires mtl
Stabilityprovisional
Maintainerlemmih@vo.com
Contents
SimpleHTTP
ServerPart primitives.
Creating Results.
Parsing input and cookies
XSLT
Description

SimpleHTTP provides a back-end independent API for handling HTTP requests.

By default, the built-in HTTP server will be used. However, other back-ends like CGI/FastCGI can used if so desired.

Synopsis
module HAppS.Server.HTTP.Types
module HAppS.Server.Cookie
simpleHTTP :: ToMessage a => Conf -> [ServerPartT IO a] -> IO ()
parseConfig :: [String] -> Either [String] Conf
class FromReqURI a where
fromReqURI :: String -> Maybe a
type RqData a = ReaderT ([(String, Input)], [(String, Cookie)]) Maybe a
class FromData a where
fromData :: RqData a
class ToMessage a where
toContentType :: a -> ByteString
toMessage :: a -> ByteString
toResponse :: a -> Response
type ServerPart a = ServerPartT IO a
newtype ServerPartT m a = ServerPartT {
unServerPartT :: Request -> WebT m a
}
type Web a = WebT IO a
newtype WebT m a = WebT {
unWebT :: m (Result a)
}
data Result a
= NoHandle
| Ok Response -> Response a
| Escape Response
noHandle :: Monad m => WebT m a
escape :: (Monad m, ToMessage resp) => WebT m resp -> WebT m a
webQuery :: (MonadIO m, QueryEvent ev res) => ev -> WebT m res
webUpdate :: (MonadIO m, UpdateEvent ev res) => ev -> WebT m res
flatten :: (ToMessage a, Monad m) => ServerPartT m a -> ServerPartT m Response
localContext :: Monad m => (WebT m a -> WebT m' a) -> [ServerPartT m a] -> ServerPartT m' a
dir :: Monad m => String -> [ServerPartT m a] -> ServerPartT m a
method :: (MatchMethod method, Monad m) => method -> WebT m a -> ServerPartT m a
methodSP :: (MatchMethod method, Monad m) => method -> ServerPartT m a -> ServerPartT m a
path :: (FromReqURI a, Monad m) => (a -> [ServerPartT m r]) -> ServerPartT m r
proxyServe :: MonadIO m => [String] -> ServerPartT m Response
rproxyServe :: MonadIO m => String -> [(String, String)] -> ServerPartT m Response
uriRest :: Monad m => (String -> ServerPartT m a) -> ServerPartT m a
withData :: (FromData a, Monad m) => (a -> [ServerPartT m r]) -> ServerPartT m r
withDataFn :: Monad m => RqData a -> (a -> [ServerPartT m r]) -> ServerPartT m r
require :: MonadIO m => IO (Maybe a) -> (a -> [ServerPartT m r]) -> ServerPartT m r
multi :: Monad m => [ServerPartT m a] -> ServerPartT m a
withRequest :: (Request -> WebT m a) -> ServerPartT m a
anyRequest :: Monad m => WebT m a -> ServerPartT m a
modifyResponse :: Monad m => (Response -> Response) -> WebT m ()
setResponseCode :: Monad m => Int -> WebT m ()
basicAuth :: MonadIO m => String -> Map String String -> [ServerPartT m a] -> ServerPartT m a
ok :: Monad m => a -> WebT m a
badGateway :: Monad m => a -> WebT m a
internalServerError :: Monad m => a -> WebT m a
badRequest :: Monad m => a -> WebT m a
unauthorized :: Monad m => a -> WebT m a
forbidden :: Monad m => a -> WebT m a
notFound :: Monad m => a -> WebT m a
seeOther :: (Monad m, ToSURI uri) => uri -> res -> WebT m res
found :: (Monad m, ToSURI uri) => uri -> res -> WebT m res
movedPermanently :: (Monad m, ToSURI a) => a -> res -> WebT m res
tempRedirect :: (Monad m, ToSURI a) => a -> res -> WebT m res
addCookie :: Monad m => Seconds -> Cookie -> WebT m ()
addCookies :: Monad m => [(Seconds, Cookie)] -> WebT m ()
lookInput :: String -> RqData Input
lookBS :: String -> RqData ByteString
look :: String -> RqData String
lookCookie :: String -> RqData Cookie
lookCookieValue :: String -> RqData String
readCookieValue :: Read a => String -> RqData a
lookRead :: Read a => String -> RqData a
lookPairs :: RqData [(String, String)]
xslt :: (MonadIO m, ToMessage r) => XSLTCmd -> XSLPath -> [ServerPartT m r] -> ServerPartT m Response
Documentation
module HAppS.Server.HTTP.Types
module HAppS.Server.Cookie
SimpleHTTP
simpleHTTP :: ToMessage a => Conf -> [ServerPartT IO a] -> IO ()
Use the built-in web-server to serve requests according to list of ServerParts.
parseConfig :: [String] -> Either [String] Conf
class FromReqURI a where
Methods
fromReqURI :: String -> Maybe a
show/hide Instances
type RqData a = ReaderT ([(String, Input)], [(String, Cookie)]) Maybe a
class FromData a where
Methods
fromData :: RqData a
show/hide Instances
class ToMessage a where
Minimal definition: toMessage
Methods
toContentType :: a -> ByteString
toMessage :: a -> ByteString
toResponse :: a -> Response
show/hide Instances
type ServerPart a = ServerPartT IO a
newtype ServerPartT m a
Constructors
ServerPartT
unServerPartT :: Request -> WebT m a
show/hide Instances
type Web a = WebT IO a
newtype WebT m a
Constructors
WebT
unWebT :: m (Result a)
show/hide Instances
data Result a
Constructors
NoHandle
Ok Response -> Response a
Escape Response
show/hide Instances
Show a => Show (Result a)
noHandle :: Monad m => WebT m a
escape :: (Monad m, ToMessage resp) => WebT m resp -> WebT m a
ServerPart primitives.
webQuery :: (MonadIO m, QueryEvent ev res) => ev -> WebT m res
webUpdate :: (MonadIO m, UpdateEvent ev res) => ev -> WebT m res
flatten :: (ToMessage a, Monad m) => ServerPartT m a -> ServerPartT m Response
localContext :: Monad m => (WebT m a -> WebT m' a) -> [ServerPartT m a] -> ServerPartT m' a
dir :: Monad m => String -> [ServerPartT m a] -> ServerPartT m a
Pop a path element and run the [ServerPart] if it matches the given string.
method :: (MatchMethod method, Monad m) => method -> WebT m a -> ServerPartT m a
Guard against the method. Note, this function also guards against any remaining path segments. See anyRequest.
methodSP :: (MatchMethod method, Monad m) => method -> ServerPartT m a -> ServerPartT m a
Guard against the method. Note, this function also guards against any remaining path segments. See anyRequest.
path :: (FromReqURI a, Monad m) => (a -> [ServerPartT m r]) -> ServerPartT m r
Pop a path element and parse it.
proxyServe :: MonadIO m => [String] -> ServerPartT m Response
rproxyServe :: MonadIO m => String -> [(String, String)] -> ServerPartT m Response
uriRest :: Monad m => (String -> ServerPartT m a) -> ServerPartT m a
withData :: (FromData a, Monad m) => (a -> [ServerPartT m r]) -> ServerPartT m r
Retrieve date from the input query or the cookies.
withDataFn :: Monad m => RqData a -> (a -> [ServerPartT m r]) -> ServerPartT m r
require :: MonadIO m => IO (Maybe a) -> (a -> [ServerPartT m r]) -> ServerPartT m r
Run an IO action and, if it returns Just, pass it to the second argument.
multi :: Monad m => [ServerPartT m a] -> ServerPartT m a
withRequest :: (Request -> WebT m a) -> ServerPartT m a
anyRequest :: Monad m => WebT m a -> ServerPartT m a
modifyResponse :: Monad m => (Response -> Response) -> WebT m ()
setResponseCode :: Monad m => Int -> WebT m ()
basicAuth :: MonadIO m => String -> Map String String -> [ServerPartT m a] -> ServerPartT m a
Creating Results.
ok :: Monad m => a -> WebT m a
Respond with 200 OK.
badGateway :: Monad m => a -> WebT m a
internalServerError :: Monad m => a -> WebT m a
badRequest :: Monad m => a -> WebT m a
Respond with 400 Bad Request.
unauthorized :: Monad m => a -> WebT m a
Respond with 401 Unauthorized.
forbidden :: Monad m => a -> WebT m a
Respond with 403 Forbidden.
notFound :: Monad m => a -> WebT m a
Respond with 404 Not Found.
seeOther :: (Monad m, ToSURI uri) => uri -> res -> WebT m res
Respond with 303 See Other.
found :: (Monad m, ToSURI uri) => uri -> res -> WebT m res
Respond with 302 Found.
movedPermanently :: (Monad m, ToSURI a) => a -> res -> WebT m res
Respond with 301 Moved Permanently.
tempRedirect :: (Monad m, ToSURI a) => a -> res -> WebT m res
Respond with 307 Temporary Redirect.
addCookie :: Monad m => Seconds -> Cookie -> WebT m ()
addCookies :: Monad m => [(Seconds, Cookie)] -> WebT m ()
Parsing input and cookies
lookInput :: String -> RqData Input
lookBS :: String -> RqData ByteString
look :: String -> RqData String
lookCookie :: String -> RqData Cookie
lookCookieValue :: String -> RqData String
readCookieValue :: Read a => String -> RqData a
lookRead :: Read a => String -> RqData a
lookPairs :: RqData [(String, String)]
XSLT
xslt
:: (MonadIO m, ToMessage r)
=> XSLTCmdXSLT preprocessor. Usually xsltproc or saxon.
-> XSLPathPath to xslt stylesheet.
-> [ServerPartT m r]Affected ServerParts.
-> ServerPartT m Response
Use cmd to transform XML against xslPath. This function only acts if the content-type is application/xml.
Produced by Haddock version 2.1.0