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.Tagged
  58 import Data.Time
  59 import Data.Time.Format.Asctime
  60 import Data.Time.Format.HTTP.Common
  61 import Data.Time.Format.RFC733
  62 import Data.Time.Format.RFC822
  63 import Data.Time.Format.RFC1123
  64 import Prelude.Unicode
  65
  66 -- |The phantom type for conversions between HTTP/1.1 date and time
  67 -- strings and 'UTCTime'.
  68 --
  69 -- >>> convertSuccess (UTCTime (ModifiedJulianDay 49662) 31777)
  70 -- Tagged "Sun, 06 Nov 1994 08:49:37 GMT"
  71 data HTTP
  72
  73 instance ConvertSuccess UTCTime (Tagged HTTP Ascii) where
  74     {-# INLINE convertSuccess #-}
  75     convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
  76
  77 instance ConvertSuccess UTCTime (Tagged HTTP AsciiBuilder) where
  78     {-# INLINE convertSuccess #-}
  79     convertSuccess = Tagged ∘ toAsciiBuilder
  80
  81 instance ConvertAttempt (Tagged HTTP Ascii) UTCTime where
  82     {-# INLINE convertAttempt #-}
  83     convertAttempt = parseAttempt' httpDateAndTime ∘ untag
  84
  85 -- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850
  86 -- and ANSI C's asctime() formats.
  87 --
  88 -- This function is even more permissive than what HTTP\/1.1 (RFC
  89 -- 2616) specifies. That is, it accepts 2-digit years in RFC 822,
  90 -- omitted separator symbols in RFC 850, omitted sec fields, and
  91 -- non-GMT time zones. I believe this behavior will not cause a
  92 -- problem though.
  93 httpDateAndTime ∷ Parser UTCTime
  94 httpDateAndTime
  95     = choice [ zonedTimeToUTC     <$> try rfc1123DateAndTime
  96              , zonedTimeToUTC     <$> try rfc733DateAndTime
  97              , zonedTimeToUTC     <$> try rfc822DateAndTime
  98              , localTimeToUTC utc <$> asctime
  99              ]
 100
 101 toAsciiBuilder ∷ UTCTime → AsciiBuilder
 102 toAsciiBuilder = untag' ∘ cs ∘ ut2zt
 103     where
 104       untag' ∷ Tagged RFC1123 AsciiBuilder → AsciiBuilder
 105       {-# INLINE CONLIKE untag' #-}
 106       untag' = untag
 107
 108       ut2zt ∷ UTCTime → ZonedTime
 109       {-# INLINE ut2zt #-}
 110       ut2zt = utcToZonedTime gmt
 111
 112       gmt ∷ TimeZone
 113       {-# INLINE CONLIKE gmt #-}
 114       gmt = TimeZone 0 False "GMT"
 115
 116 deriveAttempts [ ([t| UTCTime |], [t| Tagged HTTP Ascii        |])
 117                , ([t| UTCTime |], [t| Tagged HTTP AsciiBuilder |])
 118                ]