happstack-server 7.3.4 → 7.3.5

raw patch · 4 files changed

+19/−17 lines, 4 files

Files

happstack-server.cabal +1/−1
src/Happstack/Server/Internal/Handler.hs +4/−3
src/Happstack/Server/Internal/Monads.hs +7/−4
src/Happstack/Server/SimpleHTTP.hs +7/−9

happstack-server.cabal view

@@ -1,5 +1,5 @@ Name:                happstack-server-Version:             7.3.4+Version:             7.3.5 Synopsis:            Web related tools and services. Description:         Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course <http://happstack.com/docs/crashcourse/index.html> License:             BSD3

src/Happstack/Server/Internal/Handler.hs view

@@ -2,7 +2,7 @@  module Happstack.Server.Internal.Handler     ( request-    , parseResponse +    , parseResponse     , putRequest     ) where @@ -32,6 +32,7 @@ import Happstack.Server.SURI(SURI(..),path,query) import Happstack.Server.SURI.ParseURI import Happstack.Server.Internal.TimeoutIO (TimeoutIO(..))+import Happstack.Server.Internal.Monads (failResponse) import qualified Happstack.Server.Internal.TimeoutManager as TM import Numeric import System.Directory (removeFile)@@ -84,7 +85,7 @@                      let ioseq act = act >>= \x -> x `seq` return x                       (res, handlerKilled) <- ((, False) `liftM` ioseq (handler req))-                         `E.catch` \(e::E.SomeException) -> return (result 500 $ "Server error: " ++ show e, fromException e == Just ThreadKilled)+                         `E.catch` \(e::E.SomeException) -> return (failResponse (show e), fromException e == Just ThreadKilled)                       case mlog of                        Nothing -> return ()@@ -109,7 +110,7 @@  -- NOTE: if someone took the inputs and never put them back, then they are responsible for the cleanup cleanupTempFiles :: Request -> IO ()-cleanupTempFiles req = +cleanupTempFiles req =     do mInputs <- tryTakeMVar (rqInputsBody req)        case mInputs of          Nothing -> return ()

src/Happstack/Server/Internal/Monads.hs view

@@ -385,7 +385,7 @@     {-# INLINE (>>=) #-}     return a = WebT $ return a     {-# INLINE return #-}-    fail s = outputTraceMessage s (mkFailMessage s)+    fail s = lift (fail s)  -- | 'WebMonad' provides a means to end the current computation -- and return a 'Response' immediately.  This provides an@@ -527,9 +527,12 @@ mkFailMessage :: (FilterMonad Response m, WebMonad Response m) => String -> m b mkFailMessage s = do     ignoreFilters-    let res = setHeader "Content-Type" "text/html; charset=UTF-8" $-              resultBS 500 (LU.fromString (failHtml s))-    finishWith $ res+    finishWith (failResponse s)++failResponse :: String -> Response+failResponse s =+    setHeader "Content-Type" "text/html; charset=UTF-8" $+     resultBS 500 (LU.fromString (failHtml s))  failHtml:: String->String failHtml errString =

src/Happstack/Server/SimpleHTTP.hs view

@@ -26,7 +26,7 @@ -- run a 'ServerPart'. -- -- A very simple, \"Hello World!\" web app looks like:--- +-- -- > import Happstack.Server -- > main = simpleHTTP nullConf $ ok "Hello World!" --@@ -82,7 +82,6 @@ import Happstack.Server.Response import Happstack.Server.Validation - import Control.Monad import Data.Maybe                                (fromMaybe) import qualified Data.Version                    as DV@@ -127,7 +126,7 @@  -- | A combination of 'simpleHTTP''' and 'mapServerPartT'.  See -- 'mapServerPartT' for a discussion of the first argument of this--- function. +-- function. -- -- NOTE: This function always binds to IPv4 ports until Network -- module is fixed to support IPv6 in a portable way. Use@@ -138,7 +137,6 @@ simpleHTTP' toIO conf hs =     Listen.listen conf (\req -> runValidator (fromMaybe return (validator conf)) =<< (simpleHTTP'' (mapServerPartT toIO hs) req)) - -- | Generate a result from a 'ServerPartT' and a 'Request'. This is -- mainly used by CGI (and fast-cgi) wrappers. simpleHTTP'' :: (ToMessage b, Monad m, Functor m) => ServerPartT m b -> Request -> m Response@@ -186,8 +184,8 @@ -- > main = do let conf = nullConf -- >               addr = "127.0.0.1" -- >           s <- bindIPv4 addr (port conf)--- >           simpleHTTPWithSocket s conf $ ok $ toResponse $ --- >             "now listening on ip addr " ++ addr ++ +-- >           simpleHTTPWithSocket s conf $ ok $ toResponse $+-- >             "now listening on ip addr " ++ addr ++ -- >             " and port " ++ show (port conf) -- bindIPv4 :: String  -- ^ IP address to bind to (must be an IP address and not a host name)@@ -204,7 +202,7 @@       appFilterToResp (e, ff) = unFilterFun ff $ either id toResponse e  notFoundHtml :: String-notFoundHtml = +notFoundHtml =     "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"     ++ "<html><head><title>Happstack "     ++ ver ++ " File not found</title></head>"@@ -218,7 +216,7 @@  -- | Wait for a signal. --   On unix, a signal is sigINT or sigTERM (aka Control-C).---  +-- -- On windows, the signal is entering: e <return> waitForTermination :: IO () waitForTermination@@ -233,7 +231,7 @@            False -> return ()          takeMVar mv #else-         let loop 'e' = return () +         let loop 'e' = return ()              loop _   = getChar >>= loop          loop 'c' #endif