Network/HTTP/Lucu/RFC1123DateTime.hs

   1 -- |This module parses and prints RFC 1123 Date and Time string.
   2 --
   3 -- In general you don't have to use this module directly.
   4 module Network.HTTP.Lucu.RFC1123DateTime
   5     ( formatRFC1123DateTime
   6     , formatHTTPDateTime
   7     , parseHTTPDateTime
   8     )
   9     where
  10
  11 import           Control.Monad
  12 import qualified Data.ByteString.Lazy.Char8 as B
  13 import           Data.ByteString.Lazy.Char8 (ByteString)
  14 import           Network.HTTP.Lucu.Parser
  15 import           System.Time
  16 import           System.Locale
  17 import           Text.Printf
  18
  19 month = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
  20 week  = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
  21
  22 -- |Format a @CalendarTime@ to RFC 1123 Date and Time string.
  23 formatRFC1123DateTime :: CalendarTime -> String
  24 formatRFC1123DateTime time
  25     = printf "%s, %02d %s %04d %02d:%02d:%02d %s"
  26       (week     !! fromEnum (ctWDay  time))
  27       (ctDay    time)
  28       (month    !! fromEnum (ctMonth time))
  29       (ctYear   time)
  30       (ctHour   time)
  31       (ctMin    time)
  32       (ctSec    time)
  33       (ctTZName time)
  34
  35 -- |Format a @ClockTime@ to HTTP Date and Time. Time zone will be
  36 -- always UTC but prints as GMT.
  37 formatHTTPDateTime :: ClockTime -> String
  38 formatHTTPDateTime = formatRFC1123DateTime . (\cal -> cal { ctTZName = "GMT" }) . toUTCTime
  39
  40 -- |Parse an HTTP Date and Time.
  41 --
  42 -- Limitation: RFC 2616 (HTTP\/1.1) says we must accept these three
  43 -- formats:
  44 --
  45 -- * @Sun, 06 Nov 1994 08:49:37 GMT  ; RFC 822, updated by RFC 1123@
  46 --
  47 -- * @Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036@
  48 --
  49 -- * @Sun Nov  6 08:49:37 1994       ; ANSI C's asctime() format@
  50 --
  51 -- ...but currently this function only supports the RFC 1123
  52 -- format. This is a violation of RFC 2616 so this should be fixed
  53 -- later. What a bother!
  54 parseHTTPDateTime :: String -> Maybe ClockTime
  55 parseHTTPDateTime src
  56     = case parseStr httpDateTime src of
  57         (Success ct, _) -> Just ct
  58         _               -> Nothing
  59
  60
  61 httpDateTime :: Parser ClockTime
  62 httpDateTime = do foldl (<|>) (fail "") (map string week)
  63                   char ','
  64                   char ' '
  65                   day  <- liftM read (count 2 digit)
  66                   char ' '
  67                   mon  <- foldl (<|>) (fail "") (map tryEqToFst (zip month [1..]))
  68                   char ' '
  69                   year <- liftM read (count 4 digit)
  70                   char ' '
  71                   hour <- liftM read (count 2 digit)
  72                   char ':'
  73                   min  <- liftM read (count 2 digit)
  74                   char ':'
  75                   sec  <- liftM read (count 2 digit)
  76                   char ' '
  77                   string "GMT"
  78                   eof
  79                   return $ toClockTime $ CalendarTime {
  80                                ctYear    = year
  81                              , ctMonth   = toEnum (mon - 1)
  82                              , ctDay     = day
  83                              , ctHour    = hour
  84                              , ctMin     = min
  85                              , ctSec     = sec
  86                              , ctPicosec = 0
  87                              , ctTZ      = 0
  88                              , ctWDay    = undefined
  89                              , ctYDay    = undefined
  90                              , ctTZName  = undefined
  91                              , ctIsDST   = undefined
  92                              }
  93     where
  94       tryEqToFst :: (String, a) -> Parser a
  95       tryEqToFst (str, a) = string str >> return a
  96