happstack-server 6.1.0 → 6.1.2
raw patch · 6 files changed
+53/−11 lines, 6 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Happstack.Server.Internal.LowLevel: listenOnIPv4 :: String -> Int -> IO Socket
+ Happstack.Server.Response: requestEntityTooLarge :: FilterMonad Response m => a -> m a
+ Happstack.Server.SimpleHTTP: bindIPv4 :: String -> Int -> IO Socket
- Happstack.Server.RqData: decodeBody :: (ServerMonad m, MonadPlus m, MonadIO m) => BodyPolicy -> m ()
+ Happstack.Server.RqData: decodeBody :: (ServerMonad m, MonadPlus m, MonadIO m, FilterMonad Response m, WebMonad Response m) => BodyPolicy -> m ()
Files
- happstack-server.cabal +1/−1
- src/Happstack/Server.hs +1/−0
- src/Happstack/Server/Internal/Listen.hs +17/−2
- src/Happstack/Server/Response.hs +8/−1
- src/Happstack/Server/RqData.hs +6/−5
- src/Happstack/Server/SimpleHTTP.hs +20/−2
happstack-server.cabal view
@@ -1,5 +1,5 @@ Name: happstack-server-Version: 6.1.0+Version: 6.1.2 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.hs view
@@ -76,6 +76,7 @@ , simpleHTTPWithSocket , simpleHTTPWithSocket' , bindPort+ , bindIPv4 , parseConfig) import Happstack.Server.FileServe import Happstack.Server.Monads
src/Happstack/Server/Internal/Listen.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}-module Happstack.Server.Internal.Listen(listen, listen',listenOn) where+module Happstack.Server.Internal.Listen(listen, listen',listenOn,listenOnIPv4) where import Happstack.Server.Internal.Types (Conf(..), Request, Response) import Happstack.Server.Internal.Handler (request)@@ -15,7 +15,7 @@ SocketOption(..), SockAddr(..), iNADDR_ANY, maxListenQueue, SocketType(..), bindSocket)-import qualified Network.Socket as Socket (listen)+import qualified Network.Socket as Socket (listen, inet_addr) import System.IO.Error (isFullError) {- #ifndef mingw32_HOST_OS@@ -48,6 +48,21 @@ return sock ) +listenOnIPv4 :: String -- ^ IP address to listen on (must be an IP address not a host name)+ -> Int -- ^ port number to listen on+ -> IO Socket+listenOnIPv4 ip portm = do+ proto <- getProtocolNumber "tcp"+ hostAddr <- Socket.inet_addr ip+ E.bracketOnError+ (socket AF_INET Stream proto)+ (sClose)+ (\sock -> do+ setSocketOption sock ReuseAddr 1+ bindSocket sock (SockAddrInet (fromIntegral portm) hostAddr)+ Socket.listen sock (max 1024 maxListenQueue)+ return sock+ ) -- | Bind and listen port listen :: Conf -> (Request -> IO Response) -> IO ()
src/Happstack/Server/Response.hs view
@@ -14,6 +14,7 @@ , unauthorized , forbidden , notFound+ , requestEntityTooLarge , seeOther , found , movedPermanently@@ -32,7 +33,7 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT-import Happstack.Server.Monads (FilterMonad(composeFilter))+import Happstack.Server.Internal.Monads (FilterMonad(composeFilter)) import Happstack.Server.Types (Response(..), Request(..), nullRsFlags, getHeader, noContentLength, redirect, result, setHeader, setHeaderBS) import Happstack.Server.SURI (ToSURI) import System.Locale (defaultTimeLocale)@@ -253,6 +254,12 @@ -- > main = simpleHTTP nullConf $ notFound "What you are looking for has not been found." notFound :: (FilterMonad Response m) => a -> m a notFound = resp 404++-- | Respond with @413 Request Entity Too Large@.+--+-- > main = simpleHTTP nullConf $ requestEntityTooLarge "That's too big for me to handle."+requestEntityTooLarge :: (FilterMonad Response m) => a -> m a+requestEntityTooLarge = resp 413 -- | Respond with @303 See Other@. --
src/Happstack/Server/RqData.hs view
@@ -70,9 +70,10 @@ import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.Encoding as Text import Happstack.Server.Cookie (Cookie (cookieValue))-import Happstack.Server.Internal.Monads (ServerMonad(askRq, localRq), ServerPartT)-import Happstack.Server.Types (ContentType(..), Input(inputValue, inputFilename, inputContentType), Request(rqInputsQuery, rqInputsBody, rqCookies, rqMethod), Method(POST,PUT), readInputsBody)+import Happstack.Server.Internal.Monads (ServerMonad(askRq, localRq), FilterMonad, WebMonad, ServerPartT, escape)+import Happstack.Server.Types (ContentType(..), Input(inputValue, inputFilename, inputContentType), Response, Request(rqInputsQuery, rqInputsBody, rqCookies, rqMethod), Method(POST,PUT), readInputsBody) import Happstack.Server.Internal.MessageWrap (BodyPolicy(..), bodyInput, defaultBodyPolicy)+import Happstack.Server.Response (internalServerError, requestEntityTooLarge, toResponse) newtype ReaderError r e a = ReaderError { unReaderError :: ReaderT r (Either e) a } deriving (Functor, Monad, MonadPlus)@@ -147,7 +148,7 @@ then readInputsBody rq else return (Just []) case mbi of- Nothing -> fail "askRqEnv failed because the request body has not been decoded yet. Try using 'decodeBody'."+ Nothing -> escape $ internalServerError (toResponse "askRqEnv failed because the request body has not been decoded yet. Try using 'decodeBody'.") (Just bi) -> return (rqInputsQuery rq, bi, rqCookies rq) rqDataError e = mzero localRqEnv f m =@@ -447,13 +448,13 @@ -- Only the first call to 'decodeBody' will have any effect. Calling -- it a second time, even with different quota values, will do -- nothing.-decodeBody :: (ServerMonad m, MonadPlus m, MonadIO m) => BodyPolicy -> m ()+decodeBody :: (ServerMonad m, MonadPlus m, MonadIO m, FilterMonad Response m, WebMonad Response m) => BodyPolicy -> m () decodeBody bp = do rq <- askRq (_, me) <- bodyInput bp rq case me of Nothing -> return ()- Just e -> fail e -- FIXME: is this the best way to report the error+ Just e -> escape $ requestEntityTooLarge (toResponse e) -- FIXME: is this the best way to report the error -- | run 'RqData' in a 'ServerMonad'. --
src/Happstack/Server/SimpleHTTP.hs view
@@ -42,6 +42,7 @@ , simpleHTTPWithSocket , simpleHTTPWithSocket' , bindPort+ , bindIPv4 , parseConfig -- * Re-exported modules -- ** Basic ServerMonad functionality@@ -84,7 +85,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Version as DV import Happstack.Server.Internal.Monads (FilterFun, WebT(..), UnWebT, unFilterFun, mapServerPartT, runServerPartT, ununWebT)-import qualified Happstack.Server.Internal.Listen as Listen (listen, listen',listenOn) -- So that we can disambiguate 'Writer.listen'+import qualified Happstack.Server.Internal.Listen as Listen (listen, listen',listenOn, listenOnIPv4) -- So that we can disambiguate 'Writer.listen' import Happstack.Server.Types (Conf(port, validator), Request, Response(rsBody, rsCode), nullConf, setHeader) import Network (Socket) import qualified Paths_happstack_server as Cabal@@ -153,6 +154,8 @@ -- -- Note: It's important to use the same conf (or at least the same -- port) for 'bindPort' and 'simpleHTTPWithSocket'.+--+-- see also: 'bindPort', 'bindIPv4' simpleHTTPWithSocket :: (ToMessage a) => Socket -> Conf -> ServerPartT IO a -> IO () simpleHTTPWithSocket = simpleHTTPWithSocket' id @@ -162,11 +165,26 @@ simpleHTTPWithSocket' toIO socket conf hs = Listen.listen' socket conf (\req -> runValidator (fromMaybe return (validator conf)) =<< (simpleHTTP'' (mapServerPartT toIO hs) req)) --- | Bind port and return the socket for 'simpleHTTPWithSocket'. This+-- | Bind port and return the socket for use with 'simpleHTTPWithSocket'. This -- function always binds to IPv4 ports until Network module is fixed -- to support IPv6 in a portable way. bindPort :: Conf -> IO Socket bindPort conf = Listen.listenOn (port conf)++-- | Bind to ip and port and return the socket for use with 'simpleHTTPWithSocket'.+-- >+-- > import Happstack.Server+-- >+-- > 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 ++ +-- > " and port " ++ show (port conf)+bindIPv4 :: String -- ^ IP address to bind to (must be an IP address and not a host name)+ -> Int -- ^ port number to bind to+ -> IO Socket+bindIPv4 addr prt = Listen.listenOnIPv4 addr prt -- | Takes your 'WebT', if it is 'mempty' it returns 'Nothing' else it -- converts the value to a 'Response' and applies your filter to it.