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