diff --git a/happstack-server.cabal b/happstack-server.cabal --- a/happstack-server.cabal +++ b/happstack-server.cabal @@ -1,5 +1,5 @@ Name: happstack-server -Version: 6.5.3 +Version: 6.5.4 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 License: BSD3 diff --git a/src/Happstack/Server/Internal/Compression.hs b/src/Happstack/Server/Internal/Compression.hs --- a/src/Happstack/Server/Internal/Compression.hs +++ b/src/Happstack/Server/Internal/Compression.hs @@ -178,7 +178,7 @@ encoding <- many1 (alphaNum <|> char '-') <|> string "*" ws quality<-optionMaybe qual - return (encoding, fmap readDec' quality) + return (encoding, fmap read quality) qual :: GenParser Char st String qual = do diff --git a/src/Happstack/Server/Response.hs b/src/Happstack/Server/Response.hs --- a/src/Happstack/Server/Response.hs +++ b/src/Happstack/Server/Response.hs @@ -159,7 +159,7 @@ -- | alias for: @fmap toResponse@ -- --- turns @m a@ into @m 'Response'@ using 'toResponse'. +-- turns @m a@ icd n-heptane/pnto @m 'Response'@ using 'toResponse'. -- -- > main = simpleHTTP nullConf $ flatten $ do return "flatten me." flatten :: (ToMessage a, Functor f) => f a -> f Response @@ -227,18 +227,40 @@ noContent :: (FilterMonad Response m) => a -> m a noContent val = composeFilter (\r -> noContentLength (r { rsCode = 204, rsBody = L.empty })) >> return val --- | Respond with @500 Internal Server Error@. +-- | Respond with @301 Moved Permanently@. -- --- > main = simpleHTTP nullConf $ internalServerError "Sorry, there was an internal server error." -internalServerError :: (FilterMonad Response m) => a -> m a -internalServerError = resp 500 +-- > main = simpleHTTP nullConf $ movedPermanently "http://example.org/" "What you are looking for is now at http://example.org/" +movedPermanently :: (FilterMonad Response m, ToSURI a) => a -> res -> m res +movedPermanently uri res = do modifyResponse $ redirect 301 uri + return res --- | Responds with @502 Bad Gateway@. +-- | 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 :: (FilterMonad Response m, ToSURI uri) => uri -> res -> m res +found uri res = do modifyResponse $ redirect 302 uri + return res + +-- | Respond with @303 See Other@. -- --- > main = simpleHTTP nullConf $ badGateway "Bad Gateway." -badGateway :: (FilterMonad Response m) => a -> m a -badGateway = resp 502 +-- > main = simpleHTTP nullConf $ 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 :: (FilterMonad Response m, ToSURI uri) => uri -> res -> m res +seeOther uri res = do modifyResponse $ redirect 303 uri + return res +-- | Respond with @307 Temporary Redirect@. +-- +-- > main = simpleHTTP nullConf $ tempRedirect "http://example.org/" "What you are looking for is temporarily at http://example.org/" +tempRedirect :: (FilterMonad Response m, ToSURI a) => a -> res -> m res +tempRedirect val res = do modifyResponse $ redirect 307 val + return res + -- | Respond with @400 Bad Request@. -- -- > main = simpleHTTP nullConf $ badRequest "Bad Request." @@ -269,39 +291,17 @@ requestEntityTooLarge :: (FilterMonad Response m) => a -> m a requestEntityTooLarge = resp 413 --- | Respond with @303 See Other@. --- --- > main = simpleHTTP nullConf $ 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 :: (FilterMonad Response m, ToSURI uri) => uri -> res -> m res -seeOther uri res = do modifyResponse $ redirect 303 uri - return res - --- | 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 :: (FilterMonad Response m, ToSURI uri) => uri -> res -> m res -found uri res = do modifyResponse $ redirect 302 uri - return res - --- | Respond with @301 Moved Permanently@. +-- | Respond with @500 Internal Server Error@. -- --- > main = simpleHTTP nullConf $ movedPermanently "http://example.org/" "What you are looking for is now at http://example.org/" -movedPermanently :: (FilterMonad Response m, ToSURI a) => a -> res -> m res -movedPermanently uri res = do modifyResponse $ redirect 301 uri - return res +-- > main = simpleHTTP nullConf $ internalServerError "Sorry, there was an internal server error." +internalServerError :: (FilterMonad Response m) => a -> m a +internalServerError = resp 500 --- | Respond with @307 Temporary Redirect@. +-- | Responds with @502 Bad Gateway@. -- --- > main = simpleHTTP nullConf $ tempRedirect "http://example.org/" "What you are looking for is temporarily at http://example.org/" -tempRedirect :: (FilterMonad Response m, ToSURI a) => a -> res -> m res -tempRedirect val res = do modifyResponse $ redirect 307 val - return res +-- > main = simpleHTTP nullConf $ badGateway "Bad Gateway." +badGateway :: (FilterMonad Response m) => a -> m a +badGateway = resp 502 -- | A nicely formatted rendering of a 'Response' prettyResponse :: Response -> String