happstack-lite (empty) → 6.0.0

raw patch · 4 files changed

+510/−0 lines, 4 filesdep +basedep +bytestringdep +happstack-serversetup-changed

Dependencies added: base, bytestring, happstack-server, text

Files

Happstack/Lite.hs +455/−0
LICENSE +30/−0
Setup.hs +3/−0
happstack-lite.cabal +22/−0

+ Happstack/Lite.hs view

@@ -0,0 +1,455 @@+{-# LANGUAGE RecordWildCards #-}+module Happstack.Lite +     ( -- * Core Types+       Request+     , Response+     , ServerPart+     -- * Starting the Server+     , ServerConfig(..)+     , defaultServerConfig+     , serve+     -- * Routing an Incoming Request+     , method+     , Method(..)+     , MatchMethod(..)+     , dir+     , path+     , FromReqURI(..)+     , nullDir+     , guardRq+     -- * Creating a Response+     , ToMessage(..)+     , toResponseBS+     -- * Setting the Response Code+     , ok+     , internalServerError+     , unauthorized+     , notFound+     , seeOther+     , setResponseCode+     -- * Looking up Request Parameters+     , lookBS+     , lookBSs+     , lookText+     , lookTexts+     , lookFile+     , ContentType(..)+     -- * Cookies+     , Cookie(..)+     , CookieLife(..)+     , mkCookie  +     , addCookies+     , expireCookie+     , lookCookieValue+     -- * HTTP Headers+     , addHeaderM+     , setHeaderM+     , getHeaderM+     -- * File Serving+     , Browsing(..)+     , serveDirectory+     , serveFile+     , asContentType+     -- * Other+     , MonadPlus(..)+     ) where++import Control.Monad (MonadPlus(..))+import qualified Data.ByteString as B+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Int (Int64)+import Data.Maybe (fromMaybe)+import Data.Text.Lazy (Text)+import Happstack.Server (ContentType, Request, Response, ServerPart, FromReqURI, Method(..), MatchMethod, ToMessage(..), Cookie(..), CookieLife(..), Browsing, mkCookie)+import Happstack.Server.SURI (ToSURI)+import qualified Happstack.Server as S++-- * Starting the server++-- | configuration to be used with 'serve' function+data ServerConfig = +    ServerConfig { port      :: Int       -- ^ port to listen on+                 , ramQuota  :: Int64     -- ^ maximum amount of POST data (in bytes)+                 , diskQuota :: Int64     -- ^ maximum file upload size (in bytes)+                 , tmpDir    :: FilePath  -- ^ temporary directory for file uploads+                 }++-- | a reasonable default 'ServerConfig'+-- +-- > ServerConfig { port      = 8000+-- >              , ramQuota  = 1 * 10^6+-- >              , diskQuota = 20 * 10^6+-- >              , tmpDir    = "/tmp/"+-- >              }+defaultServerConfig :: ServerConfig+defaultServerConfig =+    ServerConfig { port      = 8000+                 , ramQuota  = 1 * 10^6+                 , diskQuota = 20 * 10^6+                 , tmpDir    = "/tmp/"+                 }++-- | start the server and handle requests using the supplied 'ServerPart'+serve :: Maybe ServerConfig  -- ^ if Nothing, then use 'defaultServerConfig'+      -> ServerPart Response -- ^ request handler+      -> IO ()+serve mServerConf part = +    let ServerConfig{..} = fromMaybe defaultServerConfig mServerConf+    in S.simpleHTTP (S.nullConf { S.port = port }) $+         do S.decodeBody (S.defaultBodyPolicy tmpDir diskQuota ramQuota (ramQuota `div` 10))+            part++-- * Routing on a URI path segment++-- | Pop a path element and run the supplied handler if it matches the+-- given string.+-- +-- > handler :: ServerPart Response+-- > handler = dir "foo" $ dir "bar" $ subHandler+-- +-- The path element can not contain \'/\'. See also 'dirs'.+dir :: String -> ServerPart a -> ServerPart a+dir = S.dir++-- | Pop a path element and parse it using the 'fromReqURI' in the+-- 'FromReqURI' class.+path :: (FromReqURI a) => (a -> ServerPart b) -> ServerPart b+path = S.path++-- | guard which only succeeds if there are no remaining path segments+--+-- Often used if you want to explicitly assign a route for '/'+-- +nullDir :: ServerPart ()+nullDir = S.nullDir++-- | Guard using an arbitrary function on the 'Request'.+guardRq :: (Request -> Bool) -> ServerPart ()+guardRq = S.guardRq++-- * Routing on the HTTP Request method++-- | Guard against the request method+--+-- Example:+--+-- > handler :: ServerPart Response+-- > handler =+-- >     do method [GET, HEAD]+-- >        ...+method :: (MatchMethod method) => method -> ServerPart ()+method = S.method++-- * Creating a Response++toResponse :: (ToMessage a) => a -> Response+toResponse = S.toResponse++-- | A low-level function to build a 'Response' from a content-type+-- and a 'ByteString'.+--+-- Creates a 'Response' in a manner similar to the 'ToMessage' class,+-- but without requiring an instance declaration.+-- +-- example:+-- +-- > import Data.ByteString.Char8 as C+-- > import Data.ByteString.Lazy.Char8 as L+-- > import Happstack.Lite+-- >+-- > main = serve Nothing $ ok $ toResponseBS (C.pack "text/plain") (L.pack "hello, world")+--+-- (note: 'C.pack' and 'L.pack' only work for ascii. For unicode strings you would need to use @utf8-string@, @text@, or something similar to create a valid 'ByteString').+toResponseBS :: B.ByteString -- ^ content-type+             -> ByteString -- ^ response body+             -> Response+toResponseBS = S.toResponseBS++-- * Response code++-- | Respond with @200 OK@.+-- +-- > main = serve Nothing $ ok "Everything is OK"+ok :: a -> ServerPart a+ok = S.ok++-- | Respond with @204 No Content@+--+-- A @204 No Content@ response may not contain a message-body. If you try to supply one, it will be dutifully ignored.+--+-- > main = serve Nothing $ noContent "This will be ignored."+noContent :: a -> ServerPart a+noContent = S.noContent++-- | Respond with @500 Internal Server Error@.+--+-- > main = serve Nothing $ internalServerError "Sorry, there was an internal server error."+internalServerError :: a -> ServerPart a+internalServerError = S.internalServerError++-- | Responds with @502 Bad Gateway@.+--+-- > main = serve Nothing $ badGateway "Bad Gateway."+badGateway :: a -> ServerPart a+badGateway = S.badGateway++-- | Respond with @400 Bad Request@.+--+-- > main = serve Nothing $ badRequest "Bad Request."+badRequest :: a -> ServerPart a+badRequest = S.badRequest++-- | Respond with @401 Unauthorized@.+--+-- > main = serve Nothing $ unauthorized "You are not authorized."+unauthorized :: a -> ServerPart a+unauthorized = S.unauthorized++-- | Respond with @403 Forbidden@.+--+-- > main = serve Nothing $ forbidden "Sorry, it is forbidden."+forbidden :: a -> ServerPart a+forbidden = S.forbidden++-- | Respond with @404 Not Found@.+-- +-- > main = serve Nothing $ notFound "What you are looking for has not been found."+notFound :: a -> ServerPart a+notFound = S.notFound++-- | Set an arbitrary return code in your response.+--+-- A filter for setting the response code. Generally you will use a+-- helper function like 'ok' or 'seeOther'.+-- +-- > main = serve Nothing $ do setResponseCode 200+-- >                           return "Everything is OK"+-- +setResponseCode :: Int -- ^ response code+                -> ServerPart ()+setResponseCode = S.setResponseCode++-- | Respond with @413 Request Entity Too Large@.+--+-- > main = serve Nothing $ requestEntityTooLarge "That's too big for me to handle."+requestEntityTooLarge :: a -> ServerPart a+requestEntityTooLarge = S.requestEntityTooLarge++-- | Respond with @303 See Other@.+--+-- > main = serve Nothing $ seeOther "http://example.org/" "What you are looking for is now at http://example.org/"+--+-- NOTE: The second argument of 'seeOther' is the message body which will sent to the browser. According to the HTTP 1.1 spec,+--+-- @the entity of the response SHOULD contain a short hypertext note with a hyperlink to the new URI(s).@+--+-- This is because pre-HTTP\/1.1 user agents do not support 303. However, in practice you can probably just use @\"\"@ as the second argument.+seeOther :: (ToSURI uri) => uri -> a -> ServerPart a+seeOther = S.seeOther++-- | Respond with @302 Found@.+-- +-- You probably want 'seeOther'. This method is not in popular use anymore, and is generally treated like 303 by most user-agents anyway.+found :: (ToSURI uri) => uri -> a -> ServerPart a+found = S.found++-- | Respond with @301 Moved Permanently@.+--+-- > main = serve Nothing $ movedPermanently "http://example.org/" "What you are looking for is now at http://example.org/"+movedPermanently :: (ToSURI uri) => uri -> a -> ServerPart a+movedPermanently = S.movedPermanently++-- | Respond with @307 Temporary Redirect@.+--+-- > main = serve Nothing $ tempRedirect "http://example.org/" "What you are looking for is temporarily at http://example.org/"+tempRedirect :: (ToSURI uri) => uri -> a -> ServerPart a+tempRedirect = S.tempRedirect++-- * Request Parameters++-- | Gets the first matching named input parameter as a lazy 'ByteString'+--+-- Searches the QUERY_STRING followed by the Request body.+--+-- see also: 'lookBSs'+lookBS :: String -> ServerPart ByteString+lookBS = S.lookBS++-- | Gets all matches for the named input parameter as lazy 'ByteString's+--+-- Searches the QUERY_STRING followed by the Request body.+--+-- see also: 'lookBS'+lookBSs :: String -> ServerPart [ByteString]+lookBSs = S.lookBSs++-- | Gets the first matching named input parameter as a lazy 'Text'+--+-- Searches the QUERY_STRING followed by the Request body.+--+-- This function assumes the underlying octets are UTF-8 encoded.+--+-- see also: 'lookTexts'+lookText :: String -> ServerPart Text+lookText = S.lookText++-- | Gets all matches for the named input parameter as lazy 'Text's+--+-- Searches the QUERY_STRING followed by the Request body.+--+-- This function assumes the underlying octets are UTF-8 encoded.+--+-- see also: 'lookText'+lookTexts :: String -> ServerPart [Text]+lookTexts = S.lookTexts++-- | Gets the first matching named file+--+-- Files can only appear in the request body. Additionally, the form+-- must set enctype=\"multipart\/form-data\".+--+-- This function returns a tuple consisting of:+-- +--  (1) The temporary location of the uploaded file+--+--  (2) The local filename supplied by the browser+--+--  (3) The content-type supplied by the browser+--+-- NOTE: You must move the file from the temporary location before the+-- 'Response' is sent. The temporary files are automatically removed+-- after the 'Response' is sent.+lookFile :: String -- ^ name of input field to search for+         -> ServerPart (FilePath, FilePath, ContentType) -- ^ (temporary file location, uploaded file name, content-type)+lookFile = S.lookFile++-- * Cookies++-- | gets the named cookie as a string+lookCookieValue :: String -> ServerPart String+lookCookieValue = S.lookCookieValue++-- | Add the list 'Cookie' to the 'Response'.+-- +addCookies :: [(CookieLife, Cookie)] -> ServerPart ()+addCookies = S.addCookies++-- | Expire the named cookie immediately and set the cookie value to @\"\"@+--+-- > main = serve Nothing $+-- >   do expireCookie "name"+-- >      ok $ "The cookie has been expired."++expireCookie :: String -> ServerPart () +expireCookie = S.expireCookie++-- * Headers++-- | Get a header out of the request.+getHeaderM :: String -> ServerPart (Maybe B.ByteString)+getHeaderM = S.getHeaderM++-- | Add headers into the response.  This method does not overwrite+-- any existing header of the same name, hence the name 'addHeaderM'.+-- If you want to replace a header use 'setHeaderM'.+addHeaderM :: String -> String -> ServerPart ()+addHeaderM = S.addHeaderM++-- | Set a header into the response.  This will replace an existing+-- header of the same name.  Use 'addHeaderM' if you want to add more+-- than one header of the same name.+setHeaderM :: String -> String -> ServerPart ()+setHeaderM = S.setHeaderM++-- * File Serving++-- | Serve files and directories from a directory and its subdirectories using 'sendFile'.+-- +-- Usage:+--+-- > serveDirectory EnableBrowsing ["index.html"] "path/to/files/on/disk"+--+-- If the requested path does not match a file or directory on the+-- disk, then 'serveDirectory' calls 'mzero'.+--+-- If the requested path is a file then the file is served normally. +--+-- If the requested path is a directory, then the result depends on+-- what the first two arguments to the function are.+--+-- The first argument controls whether directory browsing is+-- enabled.+--+-- The second argument is a list of index files (such as+-- index.html).+--+-- When a directory is requested, 'serveDirectory' will first try to+-- find one of the index files (in the order they are listed). If that+-- fails, it will show a directory listing if 'EnableBrowsing' is set,+-- otherwise it will return @forbidden \"Directory index forbidden\"@.+-- +-- Here is an explicit list of all the possible outcomes when the+-- argument is a (valid) directory:+--+-- [@'DisableBrowsing', empty index file list@]+--+--  This will always return, forbidden \"Directory index forbidden\"+--+-- [@'DisableBrowsing', non-empty index file list@]+--+-- 1. If an index file is found it will be shown.+--+-- 2. Otherwise returns, forbidden \"Directory index forbidden\"+--+-- [@'EnableBrowsing', empty index file list@] +--+-- Always shows a directory index.+--+-- [@'EnableBrowsing', non-empty index file list@]+--+-- 1. If an index file is found it will be shown+--+-- 2. Otherwise shows a directory index+--+-- see also: 'defaultIxFiles', 'serveFile'+serveDirectory :: Browsing    -- ^ allow directory browsing+               -> [FilePath]  -- ^ index file names, in case the requested path is a directory+               -> FilePath    -- ^ file/directory to serve+               -> ServerPart Response+serveDirectory = S.serveDirectory++-- | Serve a single, specified file. The name of the file being served is specified explicity. It is not derived automatically from the 'Request' url.+-- +-- example 1:+-- +--  Serve as a specific content-type:+--+-- > serveFile (asContentType "image/jpeg") "/srv/data/image.jpg"+--+--+-- example 2:+-- +--  Serve guessing the content-type from the extension:+-- +-- > serveFile (guessContentTypeM mimeTypes) "/srv/data/image.jpg"+--+-- If the specified path does not exist or is not a file, this function will return 'mzero'.+-- +-- WARNING: No security checks are performed.+--+-- NOTE: alias for 'serveFileUsing' 'filePathSendFile'+serveFile :: (FilePath -> ServerPart String)   -- ^ function for determining content-type of file. Typically 'asContentType'+          -> FilePath                 -- ^ path to the file to serve+          -> ServerPart Response+serveFile = S.serveFile+++-- | returns a specific content type, completely ignoring the 'FilePath' argument. +--+-- Use this with 'serveFile' if you want to explicitly specify the+-- content-type.+--+-- see also: 'serveFile'+asContentType :: String  -- ^ the content-type to return+              -> (FilePath -> IO String)+asContentType = S.asContentType

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Jeremy Shaw 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jeremy Shaw nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain

+ happstack-lite.cabal view

@@ -0,0 +1,22 @@+Name:                happstack-lite+Version:             6.0.0+Synopsis:            Happstack minus the useless stuff+Description:         This packages provides a subset of Happstack that is easier to learn but still very useful. It as 100% compatible with the full version of Happstack.+Homepage:            http://www.happstack.com/+License:             BSD3+License-file:        LICENSE+Author:              Jeremy Shaw+Maintainer:          jeremy@n-heptane.com+Stability:           Provisional+Category:            Web+Build-type:          Simple+Cabal-version:       >=1.6++Library+  Exposed-modules:+                 Happstack.Lite+  +  Build-depends: base < 5,+                 bytestring == 0.9.*,+                 happstack-server == 6.3.*,+                 text == 0.11.*