Data/Time/Format/HTTP.hs

   1 {-# LANGUAGE
   2     FlexibleInstances
   3   , MultiParamTypeClasses
   4   , OverloadedStrings
   5   , TemplateHaskell
   6   , UnicodeSyntax
   7   #-}
   8 -- |This module provides functions to parse and format HTTP\/1.1 date
   9 -- and time strings
  10 -- (<http://tools.ietf.org/html/rfc2616#section-3.3>).
  11 --
  12 -- The HTTP\/1.1 specification (RFC 2616) says that HTTP\/1.1 clients
  13 -- and servers which parse the date value MUST accept all the
  14 -- following formats, though they MUST only generate the RFC 1123
  15 -- format for representing HTTP-date values in header fields:
  16 --
  17 -- > Sun, 06 Nov 1994 08:49:37 GMT  ; RFC 822, updated by RFC 1123
  18 -- > Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036
  19 -- > Sun Nov  6 08:49:37 1994       ; ANSI C's asctime() format
  20 --
  21 -- It also says that all HTTP date\/time stamps MUST be represented in
  22 -- Greenwich Mean Time (GMT), without exception. For the purposes of
  23 -- HTTP, GMT is exactly equal to UTC (Coordinated Universal
  24 -- Time). This is indicated in the first two formats by the inclusion
  25 -- of @\"GMT\"@ as the three-letter abbreviation for time zone, and
  26 -- MUST be assumed when reading the asctime format.
  27 --
  28 -- > HTTP-date    = rfc1123-date | rfc850-date | asctime-date
  29 -- > rfc1123-date = wkday "," SP date1 SP time SP "GMT"
  30 -- > rfc850-date  = weekday "," SP date2 SP time SP "GMT"
  31 -- > asctime-date = wkday SP date3 SP time SP 4DIGIT
  32 -- > date1        = 2DIGIT SP month SP 4DIGIT
  33 -- >                ; day month year (e.g., 02 Jun 1982)
  34 -- > date2        = 2DIGIT "-" month "-" 2DIGIT
  35 -- >                ; day-month-year (e.g., 02-Jun-82)
  36 -- > date3        = month SP ( 2DIGIT | ( SP 1DIGIT ))
  37 -- >                ; month day (e.g., Jun  2)
  38 -- > time         = 2DIGIT ":" 2DIGIT ":" 2DIGIT
  39 -- >                ; 00:00:00 - 23:59:59
  40 -- > wkday        = "Mon" | "Tue" | "Wed"
  41 -- >              | "Thu" | "Fri" | "Sat" | "Sun"
  42 -- > weekday      = "Monday" | "Tuesday" | "Wednesday"
  43 -- >              | "Thursday" | "Friday" | "Saturday" | "Sunday"
  44 -- > month        = "Jan" | "Feb" | "Mar" | "Apr"
  45 -- >              | "May" | "Jun" | "Jul" | "Aug"
  46 -- >              | "Sep" | "Oct" | "Nov" | "Dec"
  47 module Data.Time.Format.HTTP
  48     ( HTTP
  49     , httpDateAndTime
  50     )
  51     where
  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
  57 import Data.Proxy
  58 import Data.Tagged
  59 import Data.Time
  60 import Data.Time.Format.Asctime
  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
  66
  67 -- |The phantom type for conversions between HTTP/1.1 date and time
  68 -- strings and 'UTCTime'.
  69 --
  70 -- >>> convertSuccess (UTCTime (ModifiedJulianDay 49662) 31777)
  71 -- Tagged "Sun, 06 Nov 1994 08:49:37 GMT"
  72 data HTTP
  73
  74 instance ConvertSuccess UTCTime (Tagged HTTP Ascii) where
  75     {-# INLINE convertSuccess #-}
  76     convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
  77
  78 instance ConvertSuccess UTCTime (Tagged HTTP AsciiBuilder) where
  79     {-# INLINE convertSuccess #-}
  80     convertSuccess = Tagged ∘ toAsciiBuilder
  81
  82 instance ConvertAttempt (Tagged HTTP Ascii) UTCTime where
  83     {-# INLINE convertAttempt #-}
  84     convertAttempt = parseAttempt' httpDateAndTime ∘ untag
  85
  86 -- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850
  87 -- and ANSI C's asctime() formats.
  88 --
  89 -- This function is even more permissive than what HTTP\/1.1 (RFC
  90 -- 2616) specifies. That is, it accepts 2-digit years in RFC 822,
  91 -- omitted separator symbols in RFC 850, omitted sec fields, and
  92 -- non-GMT time zones. I believe this behavior will not cause a
  93 -- problem though.
  94 httpDateAndTime ∷ Parser UTCTime
  95 httpDateAndTime
  96     = choice [ zonedTimeToUTC     <$> try rfc1123DateAndTime
  97              , zonedTimeToUTC     <$> try rfc733DateAndTime
  98              , zonedTimeToUTC     <$> try rfc822DateAndTime
  99              , localTimeToUTC utc <$> asctime
 100              ]
 101
 102 toAsciiBuilder ∷ UTCTime → AsciiBuilder
 103 {-# INLINE toAsciiBuilder #-}
 104 toAsciiBuilder = flip proxy rfc1123 ∘ cs ∘ ut2zt
 105     where
 106       rfc1123 ∷ Proxy RFC1123
 107       {-# INLINE CONLIKE rfc1123 #-}
 108       rfc1123 = Proxy
 109
 110       ut2zt ∷ UTCTime → ZonedTime
 111       {-# INLINE ut2zt #-}
 112       ut2zt = utcToZonedTime gmt
 113
 114       gmt ∷ TimeZone
 115       {-# INLINE CONLIKE gmt #-}
 116       gmt = TimeZone 0 False "GMT"
 117
 118 deriveAttempts [ ([t| UTCTime |], [t| Tagged HTTP Ascii        |])
 119                , ([t| UTCTime |], [t| Tagged HTTP AsciiBuilder |])
 120                ]