{-# LANGUAGE RecordWildCards #-}
module Happstack.Lite
(
Request
, Response
, ServerPart
, ServerConfig(..)
, defaultServerConfig
, serve
, method
, Method(..)
, MatchMethod(..)
, dir
, path
, FromReqURI(..)
, nullDir
, guardRq
, ToMessage(..)
, toResponseBS
, ok
, internalServerError
, unauthorized
, notFound
, seeOther
, setResponseCode
, lookBS
, lookBSs
, lookText
, lookTexts
, lookFile
, ContentType(..)
, Cookie(..)
, CookieLife(..)
, mkCookie
, addCookies
, expireCookie
, lookCookieValue
, addHeaderM
, setHeaderM
, getHeaderM
, Browsing(..)
, serveDirectory
, serveFile
, asContentType
, MimeMap
, guessContentTypeM
, mimeTypes
, MonadPlus(..)
, msum
) where
import Control.Monad (MonadPlus(..), msum)
import Control.Monad.Trans (liftIO)
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, MimeMap, ToMessage(..), Cookie(..), CookieLife(..), Browsing, mimeTypes, mkCookie)
import Happstack.Server.SURI (ToSURI)
import qualified Happstack.Server as S
data ServerConfig =
ServerConfig { ServerConfig -> Int
port :: Int
, ServerConfig -> Int64
ramQuota :: Int64
, ServerConfig -> Int64
diskQuota :: Int64
, ServerConfig -> FilePath
tmpDir :: FilePath
}
defaultServerConfig :: ServerConfig
defaultServerConfig :: ServerConfig
defaultServerConfig =
ServerConfig :: Int -> Int64 -> Int64 -> FilePath -> ServerConfig
ServerConfig { port :: Int
port = Int
8000
, ramQuota :: Int64
ramQuota = Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6
, diskQuota :: Int64
diskQuota = Int64
20 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6
, tmpDir :: FilePath
tmpDir = FilePath
"/tmp/"
}
serve :: Maybe ServerConfig
-> ServerPart Response
-> IO ()
serve :: Maybe ServerConfig -> ServerPart Response -> IO ()
serve Maybe ServerConfig
mServerConf ServerPart Response
part =
let ServerConfig{Int
Int64
FilePath
tmpDir :: FilePath
diskQuota :: Int64
ramQuota :: Int64
port :: Int
tmpDir :: ServerConfig -> FilePath
diskQuota :: ServerConfig -> Int64
ramQuota :: ServerConfig -> Int64
port :: ServerConfig -> Int
..} = ServerConfig -> Maybe ServerConfig -> ServerConfig
forall a. a -> Maybe a -> a
fromMaybe ServerConfig
defaultServerConfig Maybe ServerConfig
mServerConf
in Conf -> ServerPart Response -> IO ()
forall a. ToMessage a => Conf -> ServerPartT IO a -> IO ()
S.simpleHTTP (Conf
S.nullConf { port :: Int
S.port = Int
port }) (ServerPart Response -> IO ()) -> ServerPart Response -> IO ()
forall a b. (a -> b) -> a -> b
$
do BodyPolicy -> ServerPartT IO ()
forall (m :: * -> *).
(ServerMonad m, MonadPlus m, MonadIO m, FilterMonad Response m,
WebMonad Response m) =>
BodyPolicy -> m ()
S.decodeBody (FilePath -> Int64 -> Int64 -> Int64 -> BodyPolicy
S.defaultBodyPolicy FilePath
tmpDir Int64
diskQuota Int64
ramQuota (Int64
ramQuota Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
10))
ServerPart Response
part
dir :: String -> ServerPart a -> ServerPart a
dir :: FilePath -> ServerPart a -> ServerPart a
dir = FilePath -> ServerPart a -> ServerPart a
forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
FilePath -> m a -> m a
S.dir
path :: (FromReqURI a) => (a -> ServerPart b) -> ServerPart b
path :: (a -> ServerPart b) -> ServerPart b
path = (a -> ServerPart b) -> ServerPart b
forall a (m :: * -> *) b.
(FromReqURI a, MonadPlus m, ServerMonad m) =>
(a -> m b) -> m b
S.path
nullDir :: ServerPart ()
nullDir :: ServerPartT IO ()
nullDir = ServerPartT IO ()
forall (m :: * -> *). (ServerMonad m, MonadPlus m) => m ()
S.nullDir
guardRq :: (Request -> Bool) -> ServerPart ()
guardRq :: (Request -> Bool) -> ServerPartT IO ()
guardRq = (Request -> Bool) -> ServerPartT IO ()
forall (m :: * -> *).
(ServerMonad m, MonadPlus m) =>
(Request -> Bool) -> m ()
S.guardRq
method :: (MatchMethod method) => method -> ServerPart ()
method :: method -> ServerPartT IO ()
method = method -> ServerPartT IO ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
S.method
toResponse :: (ToMessage a) => a -> Response
toResponse :: a -> Response
toResponse = a -> Response
forall a. ToMessage a => a -> Response
S.toResponse
toResponseBS :: B.ByteString
-> ByteString
-> Response
toResponseBS :: ByteString -> ByteString -> Response
toResponseBS = ByteString -> ByteString -> Response
S.toResponseBS
ok :: a -> ServerPart a
ok :: a -> ServerPart a
ok = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.ok
noContent :: a -> ServerPart a
noContent :: a -> ServerPart a
noContent = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.noContent
internalServerError :: a -> ServerPart a
internalServerError :: a -> ServerPart a
internalServerError = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.internalServerError
badGateway :: a -> ServerPart a
badGateway :: a -> ServerPart a
badGateway = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.badGateway
badRequest :: a -> ServerPart a
badRequest :: a -> ServerPart a
badRequest = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.badRequest
unauthorized :: a -> ServerPart a
unauthorized :: a -> ServerPart a
unauthorized = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.unauthorized
forbidden :: a -> ServerPart a
forbidden :: a -> ServerPart a
forbidden = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.forbidden
notFound :: a -> ServerPart a
notFound :: a -> ServerPart a
notFound = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.notFound
setResponseCode :: Int
-> ServerPart ()
setResponseCode :: Int -> ServerPartT IO ()
setResponseCode = Int -> ServerPartT IO ()
forall (m :: * -> *). FilterMonad Response m => Int -> m ()
S.setResponseCode
requestEntityTooLarge :: a -> ServerPart a
requestEntityTooLarge :: a -> ServerPart a
requestEntityTooLarge = a -> ServerPart a
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
S.requestEntityTooLarge
seeOther :: (ToSURI uri) => uri -> a -> ServerPart a
seeOther :: uri -> a -> ServerPart a
seeOther = uri -> a -> ServerPart a
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
S.seeOther
found :: (ToSURI uri) => uri -> a -> ServerPart a
found :: uri -> a -> ServerPart a
found = uri -> a -> ServerPart a
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
S.found
movedPermanently :: (ToSURI uri) => uri -> a -> ServerPart a
movedPermanently :: uri -> a -> ServerPart a
movedPermanently = uri -> a -> ServerPart a
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
S.movedPermanently
tempRedirect :: (ToSURI uri) => uri -> a -> ServerPart a
tempRedirect :: uri -> a -> ServerPart a
tempRedirect = uri -> a -> ServerPart a
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
S.tempRedirect
lookBS :: String -> ServerPart ByteString
lookBS :: FilePath -> ServerPart ByteString
lookBS = FilePath -> ServerPart ByteString
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
FilePath -> m ByteString
S.lookBS
lookBSs :: String -> ServerPart [ByteString]
lookBSs :: FilePath -> ServerPart [ByteString]
lookBSs = FilePath -> ServerPart [ByteString]
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
FilePath -> m [ByteString]
S.lookBSs
lookText :: String -> ServerPart Text
lookText :: FilePath -> ServerPart Text
lookText = FilePath -> ServerPart Text
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
FilePath -> m Text
S.lookText
lookTexts :: String -> ServerPart [Text]
lookTexts :: FilePath -> ServerPart [Text]
lookTexts = FilePath -> ServerPart [Text]
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
FilePath -> m [Text]
S.lookTexts
lookFile :: String
-> ServerPart (FilePath, FilePath, ContentType)
lookFile :: FilePath -> ServerPart (FilePath, FilePath, ContentType)
lookFile = FilePath -> ServerPart (FilePath, FilePath, ContentType)
forall (m :: * -> *).
(Monad m, HasRqData m) =>
FilePath -> m (FilePath, FilePath, ContentType)
S.lookFile
lookCookieValue :: String -> ServerPart String
lookCookieValue :: FilePath -> ServerPart FilePath
lookCookieValue = FilePath -> ServerPart FilePath
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
FilePath -> m FilePath
S.lookCookieValue
addCookies :: [(CookieLife, Cookie)] -> ServerPart ()
addCookies :: [(CookieLife, Cookie)] -> ServerPartT IO ()
addCookies = [(CookieLife, Cookie)] -> ServerPartT IO ()
forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
[(CookieLife, Cookie)] -> m ()
S.addCookies
expireCookie :: String -> ServerPart ()
expireCookie :: FilePath -> ServerPartT IO ()
expireCookie = FilePath -> ServerPartT IO ()
forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
FilePath -> m ()
S.expireCookie
getHeaderM :: String -> ServerPart (Maybe B.ByteString)
= FilePath -> ServerPart (Maybe ByteString)
forall (m :: * -> *).
ServerMonad m =>
FilePath -> m (Maybe ByteString)
S.getHeaderM
addHeaderM :: String -> String -> ServerPart ()
= FilePath -> FilePath -> ServerPartT IO ()
forall (m :: * -> *).
FilterMonad Response m =>
FilePath -> FilePath -> m ()
S.addHeaderM
setHeaderM :: String -> String -> ServerPart ()
= FilePath -> FilePath -> ServerPartT IO ()
forall (m :: * -> *).
FilterMonad Response m =>
FilePath -> FilePath -> m ()
S.setHeaderM
serveDirectory :: Browsing
-> [FilePath]
-> FilePath
-> ServerPart Response
serveDirectory :: Browsing -> [FilePath] -> FilePath -> ServerPart Response
serveDirectory = Browsing -> [FilePath] -> FilePath -> ServerPart Response
forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
MonadIO m, MonadPlus m) =>
Browsing -> [FilePath] -> FilePath -> m Response
S.serveDirectory
serveFile :: (FilePath -> ServerPart String)
-> FilePath
-> ServerPart Response
serveFile :: (FilePath -> ServerPart FilePath)
-> FilePath -> ServerPart Response
serveFile FilePath -> ServerPart FilePath
asContentType FilePath
fp = (FilePath -> ServerPart FilePath)
-> FilePath -> ServerPart Response
forall (m :: * -> *).
(ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m) =>
(FilePath -> m FilePath) -> FilePath -> m Response
S.serveFile FilePath -> ServerPart FilePath
asContentType FilePath
fp
asContentType :: String
-> (FilePath -> ServerPart String)
asContentType :: FilePath -> FilePath -> ServerPart FilePath
asContentType FilePath
ct = IO FilePath -> ServerPart FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ServerPart FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> ServerPart FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO FilePath
forall (m :: * -> *). Monad m => FilePath -> FilePath -> m FilePath
S.asContentType FilePath
ct
guessContentTypeM :: MimeMap
-> (FilePath -> ServerPart String)
guessContentTypeM :: MimeMap -> FilePath -> ServerPart FilePath
guessContentTypeM MimeMap
mm = IO FilePath -> ServerPart FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ServerPart FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> ServerPart FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MimeMap -> FilePath -> IO FilePath
forall (m :: * -> *). Monad m => MimeMap -> FilePath -> m FilePath
S.guessContentTypeM MimeMap
mm