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>
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
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.SocketLike
Extensions:
- BangPatterns, DeriveDataTypeable, FlexibleContexts,
- FlexibleInstances, ScopedTypeVariables, TypeFamilies,
+ BangPatterns
+ DeriveDataTypeable
+ FlexibleContexts
+ FlexibleInstances
+ ScopedTypeVariables
+ TypeFamilies
UnboxedTuples
ghc-options:
Main-Is: ImplantFile.hs
Extensions:
- BangPatterns, ScopedTypeVariables, UnboxedTuples
+ BangPatterns
+ ScopedTypeVariables
+ UnboxedTuples
ghc-options:
-Wall
+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)
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
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
+++ /dev/null
--- |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
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.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
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.")
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.")
-- 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 []
-- 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 []
projects / Lucu.git / commitdiff