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: 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 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, diff --git a/src/Happstack/Server/FileServe/BuildingBlocks.hs b/src/Happstack/Server/FileServe/BuildingBlocks.hs --- a/src/Happstack/Server/FileServe/BuildingBlocks.hs +++ b/src/Happstack/Server/FileServe/BuildingBlocks.hs @@ -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 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 @@ -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