3 , MultiParamTypeClasses
9 -- |This module provides functions to parse and format HTTP\/1.1 date
11 -- (<http://tools.ietf.org/html/rfc2616#section-3.3>).
13 -- The HTTP\/1.1 specification (RFC 2616) says that HTTP\/1.1 clients
14 -- and servers which parse the date value MUST accept all the
15 -- following formats, though they MUST only generate the RFC 1123
16 -- format for representing HTTP-date values in header fields:
18 -- > Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123
19 -- > Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036
20 -- > Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() format
22 -- It also says that all HTTP date\/time stamps MUST be represented in
23 -- Greenwich Mean Time (GMT), without exception. For the purposes of
24 -- HTTP, GMT is exactly equal to UTC (Coordinated Universal
25 -- Time). This is indicated in the first two formats by the inclusion
26 -- of @\"GMT\"@ as the three-letter abbreviation for time zone, and
27 -- MUST be assumed when reading the asctime format.
29 -- > HTTP-date = rfc1123-date | rfc850-date | asctime-date
30 -- > rfc1123-date = wkday "," SP date1 SP time SP "GMT"
31 -- > rfc850-date = weekday "," SP date2 SP time SP "GMT"
32 -- > asctime-date = wkday SP date3 SP time SP 4DIGIT
33 -- > date1 = 2DIGIT SP month SP 4DIGIT
34 -- > ; day month year (e.g., 02 Jun 1982)
35 -- > date2 = 2DIGIT "-" month "-" 2DIGIT
36 -- > ; day-month-year (e.g., 02-Jun-82)
37 -- > date3 = month SP ( 2DIGIT | ( SP 1DIGIT ))
38 -- > ; month day (e.g., Jun 2)
39 -- > time = 2DIGIT ":" 2DIGIT ":" 2DIGIT
40 -- > ; 00:00:00 - 23:59:59
41 -- > wkday = "Mon" | "Tue" | "Wed"
42 -- > | "Thu" | "Fri" | "Sat" | "Sun"
43 -- > weekday = "Monday" | "Tuesday" | "Wednesday"
44 -- > | "Thursday" | "Friday" | "Saturday" | "Sunday"
45 -- > month = "Jan" | "Feb" | "Mar" | "Apr"
46 -- > | "May" | "Jun" | "Jul" | "Aug"
47 -- > | "Sep" | "Oct" | "Nov" | "Dec"
48 module Data.Time.Format.HTTP
52 import Control.Applicative
53 import Data.Ascii (Ascii, AsciiBuilder)
54 import qualified Data.Ascii as A
55 import Data.Attoparsec.Char8
56 import Data.Convertible.Base
60 import Data.Time.Format.C
61 import Data.Time.Format.HTTP.Common
62 import Data.Time.Format.RFC733
63 import Data.Time.Format.RFC822
64 import Data.Time.Format.RFC1123
65 import Prelude.Unicode
67 -- |The phantom type for conversions between HTTP/1.1 date and time
68 -- strings and 'UTCTime'.
70 -- >>> convertSuccess (Tagged (UTCTime (ModifiedJulianDay 49662) 31777) :: Tagged HTTP UTCTime)
71 -- "Sun, 06 Nov 1994 08:49:37 GMT"
74 instance ConvertSuccess (Tagged HTTP UTCTime) Ascii where
75 {-# INLINE convertSuccess #-}
76 convertSuccess = A.fromAsciiBuilder ∘ cs
78 instance ConvertSuccess (Tagged HTTP UTCTime) AsciiBuilder where
79 {-# INLINE convertSuccess #-}
80 convertSuccess = toAsciiBuilder
82 instance ConvertAttempt Ascii (Tagged HTTP UTCTime) where
83 {-# INLINE convertAttempt #-}
84 convertAttempt = parseAttempt' def
86 -- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850
87 -- and ANSI C's asctime() formats.
89 -- This parser is even more permissive than what HTTP\/1.1 (RFC 2616)
90 -- specifies. That is, it accepts 2-digit years in RFC 822, omitted
91 -- separator symbols in RFC 850, omitted sec fields, and non-GMT time
92 -- zones. I believe this behavior will not cause a problem though.
93 instance Default (Parser (Tagged HTTP UTCTime)) where
94 {-# INLINEABLE def #-}
97 choice [ (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC1123 ZonedTime))
98 , (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC733 ZonedTime))
99 , (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC822 ZonedTime))
100 , (localTimeToUTC utc ∘ untag) <$> (def ∷ Parser (Tagged C LocalTime))
103 toAsciiBuilder ∷ Tagged HTTP UTCTime → AsciiBuilder
104 {-# INLINEABLE toAsciiBuilder #-}
105 toAsciiBuilder = cs ∘ (ut2zt <$>) ∘ retag'
107 ut2zt ∷ UTCTime → ZonedTime
109 ut2zt = utcToZonedTime gmt
112 {-# INLINE CONLIKE gmt #-}
113 gmt = TimeZone 0 False "GMT"
115 retag' ∷ Tagged τ α → Tagged RFC1123 α
116 {-# INLINE retag' #-}
119 deriveAttempts [ ([t| Tagged HTTP UTCTime |], [t| Ascii |])
120 , ([t| Tagged HTTP UTCTime |], [t| AsciiBuilder |])