From: pho Date: Fri, 26 Mar 2010 09:10:20 +0000 (+0900) Subject: Lucu 0.6 X-Git-Tag: RELEASE-0_6 X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=e8b209ceb2e5892388fd314c15f9827cc50b4310;p=Lucu.git Lucu 0.6 Ignore-this: 99982303d853d8deaedc7a8962421d12 darcs-hash:20100326091020-62b54-bf02cb28ba61c5979693ad326d4ebfbd5f29a6bc.gz --- diff --git a/Lucu.cabal b/Lucu.cabal index d260616..c0c5660 100644 --- a/Lucu.cabal +++ b/Lucu.cabal @@ -8,7 +8,7 @@ Description: messing around FastCGI. It is also intended to be run behind a reverse-proxy so it doesn't have some facilities like logging, client filtering or such like. -Version: 0.5 +Version: 0.6 License: PublicDomain License-File: COPYING Author: PHO @@ -43,9 +43,22 @@ Flag build-lucu-implant-file Library Build-Depends: - HsOpenSSL, base >= 4 && < 5, bytestring, containers, dataenc, - filepath, directory, haskell-src, hxt, mtl, network, stm, - time, unix, zlib + HsOpenSSL == 0.8.*, + base == 4.2.*, + bytestring == 0.9.*, + containers == 0.3.*, + dataenc == 0.13.*, + filepath == 1.1.*, + directory == 1.0.*, + haskell-src == 1.0.*, + hxt == 8.5.*, + mtl == 1.1.*, + network == 2.2.*, + stm == 2.1.*, + time == 1.1.*, + time-http == 0.1.*, + unix == 2.4.*, + zlib == 0.5.* Exposed-Modules: Network.HTTP.Lucu @@ -60,7 +73,6 @@ Library Network.HTTP.Lucu.MIMEType.Guess Network.HTTP.Lucu.Parser Network.HTTP.Lucu.Parser.Http - Network.HTTP.Lucu.RFC1123DateTime Network.HTTP.Lucu.Request Network.HTTP.Lucu.Resource Network.HTTP.Lucu.Resource.Tree @@ -84,8 +96,12 @@ Library Network.HTTP.Lucu.SocketLike Extensions: - BangPatterns, DeriveDataTypeable, FlexibleContexts, - FlexibleInstances, ScopedTypeVariables, TypeFamilies, + BangPatterns + DeriveDataTypeable + FlexibleContexts + FlexibleInstances + ScopedTypeVariables + TypeFamilies UnboxedTuples ghc-options: @@ -101,7 +117,9 @@ Executable lucu-implant-file Main-Is: ImplantFile.hs Extensions: - BangPatterns, ScopedTypeVariables, UnboxedTuples + BangPatterns + ScopedTypeVariables + UnboxedTuples ghc-options: -Wall diff --git a/NEWS b/NEWS index c944072..aa4edb3 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,10 @@ +Changes from 0.5 to 0.6 +----------------------- +* New dependency: time-http == 0.1.* + +* Network.HTTP.Lucu.RFC1123DateTime: removed. + + Changes from 0.4.2 to 0.5 ------------------------- * Network.HTTP.Lucu.Config: (Suggested by Voker57) diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs index 489a4f9..0bd33ed 100644 --- a/Network/HTTP/Lucu/Postprocess.hs +++ b/Network/HTTP/Lucu/Postprocess.hs @@ -11,13 +11,13 @@ import qualified Data.ByteString.Char8 as C8 hiding (ByteString) import Data.IORef import Data.Maybe import Data.Time +import qualified Data.Time.HTTP as HTTP import GHC.Conc (unsafeIOToSTM) import Network.HTTP.Lucu.Abortion import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.HttpVersion import Network.HTTP.Lucu.Interaction -import Network.HTTP.Lucu.RFC1123DateTime import Network.HTTP.Lucu.Request import Network.HTTP.Lucu.Response import System.IO.Unsafe @@ -165,7 +165,7 @@ getCurrentDate = do now <- getCurrentTime if now `mostlyEq` cachedTime then return cachedStr else - do let dateStr = C8.pack $ formatHTTPDateTime now + do let dateStr = C8.pack $ HTTP.format now writeIORef cache (now, dateStr) return dateStr where diff --git a/Network/HTTP/Lucu/RFC1123DateTime.hs b/Network/HTTP/Lucu/RFC1123DateTime.hs deleted file mode 100644 index bc2c590..0000000 --- a/Network/HTTP/Lucu/RFC1123DateTime.hs +++ /dev/null @@ -1,109 +0,0 @@ --- |This module parses and prints RFC 1123 Date and Time string. --- --- In general you don't have to use this module directly. -module Network.HTTP.Lucu.RFC1123DateTime - ( formatRFC1123DateTime - , formatHTTPDateTime - , parseHTTPDateTime - ) - where - -import Control.Monad -import Data.Time -import Data.Time.Calendar.WeekDate -import qualified Data.ByteString.Lazy as Lazy (ByteString) -import Network.HTTP.Lucu.Format -import Network.HTTP.Lucu.Parser -import Prelude hiding (min) - - -monthStr :: [String] -monthStr = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"] - -weekStr :: [String] -weekStr = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"] - --- |Format a 'System.Time.CalendarTime' to RFC 1123 Date and Time --- string. -formatRFC1123DateTime :: ZonedTime -> String -formatRFC1123DateTime zonedTime - = let localTime = zonedTimeToLocalTime zonedTime - timeZone = zonedTimeZone zonedTime - (year, month, day) = toGregorian (localDay localTime) - (_, _, week) = toWeekDate (localDay localTime) - timeOfDay = localTimeOfDay localTime - in - id (weekStr !! (week - 1)) - ++ ", " ++ - fmtDec 2 day - ++ " " ++ - id (monthStr !! (month - 1)) - ++ " " ++ - fmtDec 4 (fromInteger year) - ++ " " ++ - fmtDec 2 (todHour timeOfDay) - ++ ":" ++ - fmtDec 2 (todMin timeOfDay) - ++ ":" ++ - fmtDec 2 (floor (todSec timeOfDay)) - ++ " " ++ - id (timeZoneName timeZone) - - --- |Format a 'System.Time.ClockTime' to HTTP Date and Time. Time zone --- will be always UTC but prints as GMT. -formatHTTPDateTime :: UTCTime -> String -formatHTTPDateTime utcTime - = let timeZone = TimeZone 0 False "GMT" - zonedTime = utcToZonedTime timeZone utcTime - in - formatRFC1123DateTime zonedTime - - --- |Parse an HTTP Date and Time. --- --- Limitation: RFC 2616 (HTTP\/1.1) says we must accept these three --- formats: --- --- * @Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123@ --- --- * @Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036@ --- --- * @Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() format@ --- --- ...but currently this function only supports the RFC 1123 --- format. This is a violation of RFC 2616 so this should be fixed --- later. What a bother! -parseHTTPDateTime :: Lazy.ByteString -> Maybe UTCTime -parseHTTPDateTime src - = case parse httpDateTime src of - (# Success ct, _ #) -> Just ct - (# _ , _ #) -> Nothing - - -httpDateTime :: Parser UTCTime -httpDateTime = do _ <- foldl (<|>) failP (map string weekStr) - _ <- char ',' - _ <- char ' ' - day <- liftM read (count 2 digit) - _ <- char ' ' - mon <- foldl (<|>) failP (map tryEqToFst (zip monthStr [1..])) - _ <- char ' ' - year <- liftM read (count 4 digit) - _ <- char ' ' - hour <- liftM read (count 2 digit) - _ <- char ':' - min <- liftM read (count 2 digit) - _ <- char ':' - sec <- liftM read (count 2 digit) :: Parser Int - _ <- char ' ' - _ <- string "GMT" - eof - let julianDay = fromGregorian year mon day - timeOfDay = TimeOfDay hour min (fromIntegral sec) - utcTime = UTCTime julianDay (timeOfDayToTime timeOfDay) - return utcTime - where - tryEqToFst :: (String, a) -> Parser a - tryEqToFst (str, a) = string str >> return a - \ No newline at end of file diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index ec5818c..08fb6f1 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -146,6 +146,7 @@ import Data.Char import Data.List import Data.Maybe import Data.Time +import qualified Data.Time.HTTP as HTTP import Network.HTTP.Lucu.Abortion import Network.HTTP.Lucu.Authorization import Network.HTTP.Lucu.Config @@ -158,7 +159,6 @@ import Network.HTTP.Lucu.Interaction import Network.HTTP.Lucu.MultipartForm import Network.HTTP.Lucu.Parser import Network.HTTP.Lucu.Postprocess -import Network.HTTP.Lucu.RFC1123DateTime import Network.HTTP.Lucu.Request import Network.HTTP.Lucu.Response import Network.HTTP.Lucu.MIMEType @@ -425,7 +425,7 @@ foundEntity tag timeStamp method <- getMethod when (method == GET || method == HEAD) - $ setHeader' (C8.pack "Last-Modified") (C8.pack $ formatHTTPDateTime timeStamp) + $ setHeader' (C8.pack "Last-Modified") (C8.pack $ HTTP.format timeStamp) when (method == POST) $ abort InternalServerError [] (Just "Illegal computation of foundEntity for POST request.") @@ -507,7 +507,7 @@ foundTimeStamp timeStamp method <- getMethod when (method == GET || method == HEAD) - $ setHeader' (C8.pack "Last-Modified") (C8.pack $ formatHTTPDateTime timeStamp) + $ setHeader' (C8.pack "Last-Modified") (C8.pack $ HTTP.format timeStamp) when (method == POST) $ abort InternalServerError [] (Just "Illegal computation of foundTimeStamp for POST request.") @@ -520,7 +520,7 @@ foundTimeStamp timeStamp -- If-Modified-Since があればそれを見る。 ifModSince <- getHeader (C8.pack "If-Modified-Since") case ifModSince of - Just str -> case parseHTTPDateTime (L8.fromChunks [str]) of + Just str -> case HTTP.parse (C8.unpack str) of Just lastTime -> when (timeStamp <= lastTime) $ abort statusForIfModSince [] @@ -532,7 +532,7 @@ foundTimeStamp timeStamp -- If-Unmodified-Since があればそれを見る。 ifUnmodSince <- getHeader (C8.pack "If-Unmodified-Since") case ifUnmodSince of - Just str -> case parseHTTPDateTime (L8.fromChunks [str]) of + Just str -> case HTTP.parse (C8.unpack str) of Just lastTime -> when (timeStamp > lastTime) $ abort PreconditionFailed []