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           Network.HTTP.Lucu.Format
  13 import           Network.HTTP.Lucu.Parser
  14 import           System.Time
  15
  16 month :: [String]
  17 month =  ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
  18
  19 week :: [String]
  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     = time `seq`
  26
  27       id       (week     !! fromEnum (ctWDay  time))
  28       ++ ", " ++
  29       fmtDec 2 (ctDay    time)
  30       ++ " "  ++
  31       id       (month    !! fromEnum (ctMonth time))
  32       ++ " "  ++
  33       fmtDec 4 (ctYear   time)
  34       ++ " "  ++
  35       fmtDec 2 (ctHour   time)
  36       ++ ":"  ++
  37       fmtDec 2 (ctMin    time)
  38       ++ ":"  ++
  39       fmtDec 2 (ctSec    time)
  40       ++ " "  ++
  41       id       (ctTZName time)
  42
  43
  44 -- |Format a @ClockTime@ to HTTP Date and Time. Time zone will be
  45 -- always UTC but prints as GMT.
  46 formatHTTPDateTime :: ClockTime -> String
  47 formatHTTPDateTime time
  48     = time `seq`
  49       formatRFC1123DateTime $! (\cal -> cal { ctTZName = "GMT" }) $! toUTCTime time
  50
  51 -- |Parse an HTTP Date and Time.
  52 --
  53 -- Limitation: RFC 2616 (HTTP\/1.1) says we must accept these three
  54 -- formats:
  55 --
  56 -- * @Sun, 06 Nov 1994 08:49:37 GMT  ; RFC 822, updated by RFC 1123@
  57 --
  58 -- * @Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036@
  59 --
  60 -- * @Sun Nov  6 08:49:37 1994       ; ANSI C's asctime() format@
  61 --
  62 -- ...but currently this function only supports the RFC 1123
  63 -- format. This is a violation of RFC 2616 so this should be fixed
  64 -- later. What a bother!
  65 parseHTTPDateTime :: String -> Maybe ClockTime
  66 parseHTTPDateTime src
  67     = case parseStr httpDateTime src of
  68         (Success ct, _) -> Just ct
  69         _               -> Nothing
  70
  71
  72 httpDateTime :: Parser ClockTime
  73 httpDateTime = do foldl (<|>) failP (map string week)
  74                   char ','
  75                   char ' '
  76                   day  <- liftM read (count 2 digit)
  77                   char ' '
  78                   mon  <- foldl (<|>) failP (map tryEqToFst (zip month [1..]))
  79                   char ' '
  80                   year <- liftM read (count 4 digit)
  81                   char ' '
  82                   hour <- liftM read (count 2 digit)
  83                   char ':'
  84                   min  <- liftM read (count 2 digit)
  85                   char ':'
  86                   sec  <- liftM read (count 2 digit)
  87                   char ' '
  88                   string "GMT"
  89                   eof
  90                   return $ toClockTime $ CalendarTime {
  91                                ctYear    = year
  92                              , ctMonth   = toEnum (mon - 1)
  93                              , ctDay     = day
  94                              , ctHour    = hour
  95                              , ctMin     = min
  96                              , ctSec     = sec
  97                              , ctPicosec = 0
  98                              , ctTZ      = 0
  99                              , ctWDay    = undefined
 100                              , ctYDay    = undefined
 101                              , ctTZName  = undefined
 102                              , ctIsDST   = undefined
 103                              }
 104     where
 105       tryEqToFst :: (String, a) -> Parser a
 106       tryEqToFst (str, a) = string str >> return a
 107