happstack-server 7.0.7 → 7.1.0
raw patch · 3 files changed
+18/−18 lines, 3 filesdep −old-timedep ~directory
Dependencies removed: old-time
Dependency ranges changed: directory
Files
- happstack-server.cabal +2/−3
- src/Happstack/Server/FileServe/BuildingBlocks.hs +13/−12
- src/Happstack/Server/Response.hs +3/−3
happstack-server.cabal view
@@ -1,5 +1,5 @@ Name: happstack-server-Version: 7.0.7+Version: 7.1.0 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@@ -72,7 +72,7 @@ blaze-html == 0.5.*, bytestring, containers,- directory,+ directory >= 1.2, extensible-exceptions, filepath, hslogger >= 1.0.2,@@ -80,7 +80,6 @@ monad-control >= 0.3 && < 0.4, mtl >= 2 && < 2.2, old-locale,- old-time, parsec < 4, process, sendfile >= 0.7.1 && < 0.8,
src/Happstack/Server/FileServe/BuildingBlocks.hs view
@@ -54,6 +54,7 @@ isDot ) where +import Control.Applicative ((<$>)) import Control.Exception.Extensible (IOException, bracket, catch) import Control.Monad (MonadPlus(mzero), msum) import Control.Monad.Trans (MonadIO(liftIO))@@ -64,6 +65,7 @@ import Data.Maybe (fromMaybe) import Data.Map (Map) import qualified Data.Map as Map+import Data.Time (UTCTime, formatTime) import Filesystem.Path.CurrentOS (commonPrefix, encodeString, decodeString, collapse, append) import Happstack.Server.Monads (ServerMonad(askRq), FilterMonad, WebMonad) import Happstack.Server.Response (ToMessage(toResponse), ifModifiedSince, forbidden, ok, seeOther)@@ -74,7 +76,6 @@ import System.IO (IOMode(ReadMode), hFileSize, hClose, openBinaryFile, withBinaryFile) import System.Locale (defaultTimeLocale) import System.Log.Logger (Priority(DEBUG), logM)-import System.Time (CalendarTime, formatCalendarTime, toCalendarTime, toUTCTime) import Text.Blaze.Html ((!)) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A@@ -157,7 +158,7 @@ -- | Use sendFile to send the contents of a Handle sendFileResponse :: String -- ^ content-type string -> FilePath -- ^ file path for content to send- -> Maybe (CalendarTime, Request) -- ^ mod-time for the handle (MUST NOT be later than server's time of message origination), incoming request (used to check for if-modified-since header)+ -> Maybe (UTCTime, Request) -- ^ mod-time for the handle (MUST NOT be later than server's time of message origination), incoming request (used to check for if-modified-since header) -> Integer -- ^ offset into Handle -> Integer -- ^ number of bytes to send -> Response@@ -173,7 +174,7 @@ -- lazyByteStringResponse :: String -- ^ content-type string (e.g. @\"text/plain; charset=utf-8\"@) -> L.ByteString -- ^ lazy bytestring content to send- -> Maybe (CalendarTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)+ -> Maybe (UTCTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header) -> Integer -- ^ offset into the bytestring -> Integer -- ^ number of bytes to send (offset + count must be less than or equal to the length of the bytestring) -> Response@@ -188,7 +189,7 @@ -- | Send the contents of a Lazy ByteString strictByteStringResponse :: String -- ^ content-type string (e.g. @\"text/plain; charset=utf-8\"@) -> S.ByteString -- ^ lazy bytestring content to send- -> Maybe (CalendarTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)+ -> Maybe (UTCTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header) -> Integer -- ^ offset into the bytestring -> Integer -- ^ number of bytes to send (offset + count must be less than or equal to the length of the bytestring) -> Response@@ -213,7 +214,7 @@ do count <- liftIO $ withBinaryFile fp ReadMode hFileSize -- garbage collection should close this modtime <- liftIO $ getModificationTime fp rq <- askRq- return $ sendFileResponse contentType fp (Just (toUTCTime modtime, rq)) 0 count+ return $ sendFileResponse contentType fp (Just (modtime, rq)) 0 count -- | Send the specified file with the specified mime-type using lazy ByteStrings --@@ -230,7 +231,7 @@ modtime <- liftIO $ getModificationTime fp count <- liftIO $ hFileSize handle rq <- askRq- return $ lazyByteStringResponse contentType contents (Just (toUTCTime modtime, rq)) 0 count+ return $ lazyByteStringResponse contentType contents (Just (modtime, rq)) 0 count -- | Send the specified file with the specified mime-type using strict ByteStrings --@@ -246,7 +247,7 @@ modtime <- liftIO $ getModificationTime fp count <- liftIO $ withBinaryFile fp ReadMode hFileSize rq <- askRq- return $ strictByteStringResponse contentType contents (Just (toUTCTime modtime, rq)) 0 count+ return $ strictByteStringResponse contentType contents (Just (modtime, rq)) 0 count -- * High-level functions for serving files @@ -566,7 +567,7 @@ -- a new page template to wrap around this HTML. -- -- see also: 'getMetaData', 'renderDirectoryContents'-renderDirectoryContentsTable :: [(FilePath, Maybe CalendarTime, Maybe Integer, EntryKind)] -- ^ list of files+meta data, see 'getMetaData'+renderDirectoryContentsTable :: [(FilePath, Maybe UTCTime, Maybe Integer, EntryKind)] -- ^ list of files+meta data, see 'getMetaData' -> H.Html renderDirectoryContentsTable fps = H.table $ do H.thead $ do H.th $ H.toHtml ""@@ -575,13 +576,13 @@ H.th $ H.toHtml "Size" H.tbody $ mapM_ mkRow (zip fps $ cycle [False, True]) where- mkRow :: ((FilePath, Maybe CalendarTime, Maybe Integer, EntryKind), Bool) -> H.Html+ mkRow :: ((FilePath, Maybe UTCTime, Maybe Integer, EntryKind), Bool) -> H.Html mkRow ((fp, modTime, count, kind), alt) = (if alt then (! A.class_ (H.toValue "alt")) else id) $ H.tr $ do H.td (mkKind kind) H.td (H.a ! A.href (H.toValue fp) $ H.toHtml fp)- H.td ! A.class_ (H.toValue "date") $ (H.toHtml $ maybe "-" (formatCalendarTime defaultTimeLocale "%d-%b-%Y %X %Z") modTime)+ H.td ! A.class_ (H.toValue "date") $ (H.toHtml $ maybe "-" (formatTime defaultTimeLocale "%d-%b-%Y %X %Z") modTime) (maybe id (\c -> (! A.title (H.toValue (show c)))) count) (H.td ! A.class_ (H.toValue "size") $ (H.toHtml $ maybe "-" prettyShow count)) mkKind :: EntryKind -> H.Html mkKind File = return ()@@ -605,10 +606,10 @@ -- | look up the meta data associated with a file getMetaData :: FilePath -- ^ path to directory on disk containing the entry -> FilePath -- ^ entry in that directory- -> IO (FilePath, Maybe CalendarTime, Maybe Integer, EntryKind)+ -> IO (FilePath, Maybe UTCTime, Maybe Integer, EntryKind) getMetaData localPath fp = do let localFp = localPath </> fp- modTime <- (fmap Just . toCalendarTime =<< getModificationTime localFp) `catch`+ modTime <- (Just <$> getModificationTime localFp) `catch` (\(_ :: IOException) -> return Nothing) count <- do de <- doesDirectoryExist localFp if de
src/Happstack/Server/Response.hs view
@@ -34,11 +34,11 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT+import Data.Time (UTCTime, formatTime) 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)-import System.Time (CalendarTime, formatCalendarTime) import qualified Text.Blaze.Html as Blaze import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze import Text.Html (Html, renderHtml)@@ -174,12 +174,12 @@ -- If the 'Request' includes the @if-modified-since@ header and the -- 'Response' has not been modified, then return 304 (Not Modified), -- otherwise return the 'Response'.-ifModifiedSince :: CalendarTime -- ^ mod-time for the 'Response' (MUST NOT be later than server's time of message origination)+ifModifiedSince :: UTCTime -- ^ mod-time for the 'Response' (MUST NOT be later than server's time of message origination) -> Request -- ^ incoming request (used to check for if-modified-since) -> Response -- ^ Response to send if there are modifications -> Response ifModifiedSince modTime request response =- let repr = formatCalendarTime defaultTimeLocale "%a, %d %b %Y %X GMT" modTime+ let repr = formatTime defaultTimeLocale "%a, %d %b %Y %X GMT" modTime notmodified = getHeader "if-modified-since" request == Just (B.pack $ repr) in if notmodified then noContentLength $ result 304 "" -- Not Modified