1{-# LANGUAGE OverloadedStrings #-}
2
3module Network.HTTP.Date.Parser (parseHTTPDate) where
4
5import Control.Applicative
6import Control.Monad
7import Data.Attoparsec.ByteString
8import Data.Attoparsec.ByteString.Char8
9import Data.ByteString
10import Data.Char
11import Network.HTTP.Date.Types
12
13----------------------------------------------------------------
14
15-- |
16-- Parsing HTTP Date. Currently only RFC1123 style is supported.
17--
18-- >>> parseHTTPDate "Tue, 15 Nov 1994 08:12:31 GMT"
19-- Just (HTTPDate {hdYear = 1994, hdMonth = 11, hdDay = 15, hdHour = 8, hdMinute = 12, hdSecond = 31, hdWkday = 2})
20
21parseHTTPDate :: ByteString -> Maybe HTTPDate
22parseHTTPDate bs = case parseOnly rfc1123Date bs of
23    Right ut -> Just ut
24    _        -> Nothing
25
26rfc1123Date :: Parser HTTPDate
27rfc1123Date = do
28    w <- wkday
29    void $ string ", "
30    (y,m,d) <- date1
31    sp
32    (h,n,s) <- time
33    sp
34    -- RFC 2616 defines GMT only but there are actually ill-formed ones such
35    -- as "+0000" and "UTC" in the wild.
36    void $ string "GMT" <|> string "+0000" <|> string "UTC"
37    return $ defaultHTTPDate {
38        hdYear   = y
39      , hdMonth  = m
40      , hdDay    = d
41      , hdHour   = h
42      , hdMinute = n
43      , hdSecond = s
44      , hdWkday  = w
45      }
46
47wkday :: Parser Int
48wkday = 1 <$ string "Mon"
49    <|> 2 <$ string "Tue"
50    <|> 3 <$ string "Wed"
51    <|> 4 <$ string "Thu"
52    <|> 5 <$ string "Fri"
53    <|> 6 <$ string "Sat"
54    <|> 7 <$ string "Sun"
55
56date1 :: Parser (Int,Int,Int)
57date1 = do
58    d <- day
59    sp
60    m <- month
61    sp
62    y <- year
63    return (y,m,d)
64 where
65   day = digit2
66   year = digit4
67
68sp :: Parser ()
69sp = () <$ char ' '
70
71time :: Parser (Int,Int,Int)
72time = do
73    h <- digit2
74    void $ char ':'
75    m <- digit2
76    void $ char ':'
77    s <- digit2
78    return (h,m,s)
79
80month :: Parser Int
81month =  1 <$ string "Jan"
82    <|>  2 <$ string "Feb"
83    <|>  3 <$ string "Mar"
84    <|>  4 <$ string "Apr"
85    <|>  5 <$ string "May"
86    <|>  6 <$ string "Jun"
87    <|>  7 <$ string "Jul"
88    <|>  8 <$ string "Aug"
89    <|>  9 <$ string "Sep"
90    <|> 10 <$ string "Oct"
91    <|> 11 <$ string "Nov"
92    <|> 12 <$ string "Dec"
93
94digit2 :: Parser Int
95digit2 = do
96    x1 <- toInt <$> digit
97    x2 <- toInt <$> digit
98    return $ x1 * 10 + x2
99
100digit4 :: Parser Int
101digit4 = do
102    x1 <- toInt <$> digit
103    x2 <- toInt <$> digit
104    x3 <- toInt <$> digit
105    x4 <- toInt <$> digit
106    return $ x1 * 1000 + x2 * 100 + x3 * 10 + x4
107
108toInt :: Char -> Int
109toInt c = ord c - ord '0'
110