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