Lucu 0.6

Ignore-this: 99982303d853d8deaedc7a8962421d12

darcs-hash:20100326091020-62b54-bf02cb28ba61c5979693ad326d4ebfbd5f29a6bc.gz

diff --git a/Lucu.cabal b/Lucu.cabal
index d260616e6b5fefda9d1f533a9fda4d9b3d019c82..c0c5660f21907d1604613c19ed50472b9578b884 100644 (file)
--- 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.
         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 <pho at cielonegro dot org>
 License: PublicDomain
 License-File: COPYING
 Author: PHO <pho at cielonegro dot org>


@@ -43,9 +43,22 @@ Flag build-lucu-implant-file
 
 Library
     Build-Depends:
 
 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
 
     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.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
         Network.HTTP.Lucu.Request
         Network.HTTP.Lucu.Resource
         Network.HTTP.Lucu.Resource.Tree


@@ -84,8 +96,12 @@ Library
         Network.HTTP.Lucu.SocketLike
 
     Extensions:
         Network.HTTP.Lucu.SocketLike
 
     Extensions:

-        BangPatterns, DeriveDataTypeable, FlexibleContexts,
-        FlexibleInstances, ScopedTypeVariables, TypeFamilies,
+        BangPatterns
+        DeriveDataTypeable
+        FlexibleContexts
+        FlexibleInstances
+        ScopedTypeVariables
+        TypeFamilies

         UnboxedTuples
 
     ghc-options:
         UnboxedTuples
 
     ghc-options:


@@ -101,7 +117,9 @@ Executable lucu-implant-file
     Main-Is: ImplantFile.hs
 
     Extensions:
     Main-Is: ImplantFile.hs
 
     Extensions:

-        BangPatterns, ScopedTypeVariables, UnboxedTuples
+        BangPatterns
+        ScopedTypeVariables
+        UnboxedTuples

 
     ghc-options:
         -Wall
 
     ghc-options:
         -Wall

diff --git a/NEWS b/NEWS
index c9440723921fd8e37b03d68636d16ac843a4ce19..aa4edb3879693226afe487ba357dbf62e352f459 100644 (file)
--- 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)
 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 489a4f9aa89c7c7ae74a7d557ddb28b4eab78d3e..0bd33ed1b00fc17b8f27a260cb57f88743e5972c 100644 (file)
--- 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           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           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
 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
                     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
                            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 (file)
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 ec5818c1e9cbbe877ad9106397abc5ee4a30c6e1..08fb6f19ce50b434457d42f0deef09710f6c31f1 100644 (file)
--- 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           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
 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.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
 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)
 
          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.")
          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)
 
          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.")
          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
          -- 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 []
                          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
          -- 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 []
                          Just lastTime
                              -> when (timeStamp > lastTime)
                                 $ abort PreconditionFailed []