happstack-server 7.1.6 → 7.1.7

raw patch · 5 files changed

+48/−22 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• happstack-server.cabal +1/−1
• src/Happstack/Server/FileServe/BuildingBlocks.hs +3/−4
• src/Happstack/Server/Internal/TimeoutSocket.hs +2/−3
• src/Happstack/Server/Internal/Types.hs +1/−1
• src/Happstack/Server/SURI.hs +41/−13

@@ -1,5 +1,5 @@ Name:                happstack-server-Version:             7.1.6+Version:             7.1.7 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

@@ -55,7 +55,7 @@     ) where  import Control.Applicative          ((<$>))-import Control.Exception.Extensible (IOException, bracket, catch)+import Control.Exception.Extensible as E (IOException, bracket, catch) import Control.Monad                (MonadPlus(mzero), msum) import Control.Monad.Trans          (MonadIO(liftIO)) import qualified Data.ByteString.Lazy.Char8 as L@@ -71,7 +71,6 @@ import Happstack.Server.Monads      (ServerMonad(askRq), FilterMonad, WebMonad) import Happstack.Server.Response    (ToMessage(toResponse), ifModifiedSince, forbidden, ok, seeOther) import Happstack.Server.Types       (Length(ContentLength), Request(rqPaths, rqUri), Response(SendFile), RsFlags(rsfLength), nullRsFlags, result, resultBS, setHeader)-import Prelude                      hiding (catch) import System.Directory             (doesDirectoryExist, doesFileExist, getDirectoryContents, getModificationTime) import System.FilePath              ((</>), addTrailingPathSeparator, hasDrive, isPathSeparator, joinPath, takeExtension, isValid) import System.IO                    (IOMode(ReadMode), hFileSize, hClose, openBinaryFile, withBinaryFile)@@ -610,13 +609,13 @@             -> IO (FilePath, Maybe UTCTime, Maybe Integer, EntryKind) getMetaData localPath fp =      do let localFp = localPath </> fp-        modTime <- (Just . toUTCTime <$> getModificationTime localFp) `catch`+        modTime <- (Just . toUTCTime <$> getModificationTime localFp) `E.catch`                    (\(_ :: IOException) -> return Nothing)         count <- do de <- doesDirectoryExist localFp                     if de                       then do return Nothing                       else do bracket (openBinaryFile localFp ReadMode) hClose (fmap Just . hFileSize)-                                          `catch` (\(_e :: IOException) -> return Nothing)+                                          `E.catch` (\(_e :: IOException) -> return Nothing)         kind <- do fe <- doesFileExist localFp                    if fe                       then return File

@@ -5,7 +5,7 @@ module Happstack.Server.Internal.TimeoutSocket where  import           Control.Concurrent            (threadWaitWrite)-import           Control.Exception             (catch, throw)+import           Control.Exception             as E (catch, throw) import           Control.Monad                 (liftM, when) import qualified Data.ByteString.Char8         as B import qualified Data.ByteString.Lazy.Char8    as L@@ -18,7 +18,6 @@ import           Network.Socket (Socket, ShutdownCmd(..), shutdown) import           Network.Socket.SendFile (Iter(..), ByteCount, Offset, sendFileIterWith') import           Network.Socket.ByteString (sendAll)-import           Prelude hiding (catch) import           System.IO.Error (isDoesNotExistError) import           System.IO.Unsafe (unsafeInterleaveIO) @@ -42,7 +41,7 @@     s <- N.recv sock 65536     TM.tickle handle     if S.null s-      then do shutdown sock ShutdownReceive `catch` (\e -> when (not $ isDoesNotExistError e) (throw e))+      then do shutdown sock ShutdownReceive `E.catch` (\e -> when (not $ isDoesNotExistError e) (throw e))               return L.Empty       else L.Chunk s `liftM` loop 

@@ -81,7 +81,7 @@        (rsfLength (rsFlags rs) /= NoContentLength || isNoMessageBodyResponse rs))   where     isNoMessageBodyCode code = (code >= 100 && code <= 199) || code == 204 || code == 304-    isNoMessageBodyResponse rs = isNoMessageBodyCode (rsCode rs) && L.null (rsBody rs)+    isNoMessageBodyResponse rs' = isNoMessageBodyCode (rsCode rs') && L.null (rsBody rs')  -- | function to log access requests (see also: 'logMAccess') -- type LogAccess time =

@@ -1,13 +1,32 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances #-}--- | A wrapper and type class so that functions like 'seeOther' can take a URI which is represented by a 'String', 'URI.URI', or other instance of 'ToSURI'. -module Happstack.Server.SURI where+-- | A wrapper and type class so that functions like 'seeOther' can take a URI which is represented by a 'String', 'URI.URI', or other instance of 'ToSURI'.+module Happstack.Server.SURI+    ( path+    , query+    , scheme+    , u_scheme+    , u_path+    , a_scheme+    , a_path+    , percentDecode+    , unEscape+    , unEscapeQS+    , isAbs+    , SURI(..)+    , render+    , parse+    , ToSURI(..)+    , FromPath(..)+    )+    where  import Control.Arrow (first)-import Data.Maybe-import Data.Generics-import qualified Data.Text as Text+import Data.Char     (chr, digitToInt, isHexDigit)+import Data.Maybe    (fromJust, isJust)+import Data.Generics (Data, Typeable)+import qualified Data.Text      as Text import qualified Data.Text.Lazy as LazyText-import qualified Network.URI as URI+import qualified Network.URI    as URI  -- | Retrieves the path component from the URI path :: SURI -> String@@ -37,11 +56,20 @@ a_path :: String -> SURI -> SURI a_path a (SURI u) = SURI $ u {URI.uriPath=a} -escape, unEscape, unEscapeQS :: String -> String-unEscapeQS = URI.unEscapeString . map (\x->if x=='+' then ' ' else x)-unEscape = URI.unEscapeString-escape = URI.escapeURIString URI.isAllowedInURI+-- | percent decode a String+--+-- e.g. @\"hello%2Fworld\"@ -> @\"hello/world\"@+percentDecode :: String -> String+percentDecode [] = ""+percentDecode ('%':x1:x2:s) | isHexDigit x1 && isHexDigit x2 =+    chr (digitToInt x1 * 16 + digitToInt x2) : percentDecode s+percentDecode (c:s) = c : percentDecode s +unEscape, unEscapeQS :: String -> String+unEscapeQS = percentDecode . map (\x->if x=='+' then ' ' else x)+unEscape   = percentDecode+-- escape     = URI.escapeURIString URI.isAllowedInURI+ -- | Returns true if the URI is absolute isAbs :: SURI -> Bool isAbs = not . null . URI.uriScheme . suri@@ -50,7 +78,7 @@ instance Show SURI where     showsPrec d (SURI uri) = showsPrec d $ show uri instance Read SURI where-    readsPrec d = mapFst fromJust .  filter (isJust . fst) . mapFst parse . readsPrec d +    readsPrec d = mapFst fromJust .  filter (isJust . fst) . mapFst parse . readsPrec d       where         mapFst :: (a -> b) -> [(a,x)] -> [(b,x)]         mapFst = map . first@@ -64,14 +92,14 @@  -- | Parses a URI from a String.  Returns Nothing on failure. parse :: String -> Maybe SURI-parse =  fmap SURI . URI.parseURIReference +parse =  fmap SURI . URI.parseURIReference  -- | Convenience class for converting data types to URIs class ToSURI x where toSURI::x->SURI  instance ToSURI SURI where toSURI=id instance ToSURI URI.URI where toSURI=SURI-instance ToSURI String where +instance ToSURI String where     toSURI = maybe (SURI $ URI.URI "" Nothing "" "" "") id . parse instance ToSURI Text.Text where toSURI = toSURI . Text.unpack instance ToSURI LazyText.Text where toSURI = toSURI . LazyText.unpack