{-# LANGUAGE OverloadedStrings #-}

module Network.HTTP.Date.Parser (parseHTTPDate) where

import Control.Applicative
import Control.Monad
import Data.Attoparsec.ByteString
import Data.Attoparsec.ByteString.Char8
import Data.ByteString
import Data.Char
import Network.HTTP.Date.Types

----------------------------------------------------------------

-- |
-- Parsing HTTP Date. Currently only RFC1123 style is supported.
--
-- >>> :set -XOverloadedStrings
-- >>> parseHTTPDate "Tue, 15 Nov 1994 08:12:31 GMT"
-- Just (HTTPDate {hdYear = 1994, hdMonth = 11, hdDay = 15, hdHour = 8, hdMinute = 12, hdSecond = 31, hdWkday = 2})
parseHTTPDate :: ByteString -> Maybe HTTPDate
parseHTTPDate :: ByteString -> Maybe HTTPDate
parseHTTPDate ByteString
bs = case Parser HTTPDate -> ByteString -> Either String HTTPDate
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser HTTPDate
rfc1123Date ByteString
bs of
    Right HTTPDate
ut -> HTTPDate -> Maybe HTTPDate
forall a. a -> Maybe a
Just HTTPDate
ut
    Either String HTTPDate
_ -> Maybe HTTPDate
forall a. Maybe a
Nothing

rfc1123Date :: Parser HTTPDate
rfc1123Date :: Parser HTTPDate
rfc1123Date = do
    Int
w <- Parser Int
wkday
    Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ByteString ())
-> Parser ByteString ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
string ByteString
", "
    (Int
y, Int
m, Int
d) <- Parser (Int, Int, Int)
date1
    Parser ByteString ()
sp
    (Int
h, Int
n, Int
s) <- Parser (Int, Int, Int)
time
    Parser ByteString ()
sp
    -- RFC 2616 defines GMT only but there are actually ill-formed ones such
    -- as "+0000" and "UTC" in the wild.
    Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ByteString ())
-> Parser ByteString ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
string ByteString
"GMT" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"+0000" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
"UTC"
    HTTPDate -> Parser HTTPDate
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (HTTPDate -> Parser HTTPDate) -> HTTPDate -> Parser HTTPDate
forall a b. (a -> b) -> a -> b
$
        HTTPDate
defaultHTTPDate
            { hdYear = y
            , hdMonth = m
            , hdDay = d
            , hdHour = h
            , hdMinute = n
            , hdSecond = s
            , hdWkday = w
            }

wkday :: Parser Int
wkday :: Parser Int
wkday =
    Int
1 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Mon"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
2 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Tue"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
3 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Wed"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
4 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Thu"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
5 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Fri"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
6 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Sat"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
7 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Sun"

date1 :: Parser (Int, Int, Int)
date1 :: Parser (Int, Int, Int)
date1 = do
    Int
d <- Parser Int
day
    Parser ByteString ()
sp
    Int
m <- Parser Int
month
    Parser ByteString ()
sp
    Int
y <- Parser Int
year
    (Int, Int, Int) -> Parser (Int, Int, Int)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
y, Int
m, Int
d)
  where
    day :: Parser Int
day = Parser Int
digit2
    year :: Parser Int
year = Parser Int
digit4

sp :: Parser ()
sp :: Parser ByteString ()
sp = () () -> Parser ByteString Char -> Parser ByteString ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
char Char
' '

time :: Parser (Int, Int, Int)
time :: Parser (Int, Int, Int)
time = do
    Int
h <- Parser Int
digit2
    Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ByteString ())
-> Parser ByteString Char -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
char Char
':'
    Int
m <- Parser Int
digit2
    Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ByteString ())
-> Parser ByteString Char -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
char Char
':'
    Int
s <- Parser Int
digit2
    (Int, Int, Int) -> Parser (Int, Int, Int)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
h, Int
m, Int
s)

month :: Parser Int
month :: Parser Int
month =
    Int
1 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Jan"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
2 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Feb"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
3 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Mar"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
4 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Apr"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
5 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"May"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
6 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Jun"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
7 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Jul"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
8 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Aug"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
9 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Sep"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
10 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Oct"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
11 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Nov"
        Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int
12 Int -> Parser ByteString ByteString -> Parser Int
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string ByteString
"Dec"

digit2 :: Parser Int
digit2 :: Parser Int
digit2 = do
    Int
x1 <- Char -> Int
toInt (Char -> Int) -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
digit
    Int
x2 <- Char -> Int
toInt (Char -> Int) -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
digit
    Int -> Parser Int
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2

digit4 :: Parser Int
digit4 :: Parser Int
digit4 = do
    Int
x1 <- Char -> Int
toInt (Char -> Int) -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
digit
    Int
x2 <- Char -> Int
toInt (Char -> Int) -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
digit
    Int
x3 <- Char -> Int
toInt (Char -> Int) -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
digit
    Int
x4 <- Char -> Int
toInt (Char -> Int) -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
digit
    Int -> Parser Int
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x4

toInt :: Char -> Int
toInt :: Char -> Int
toInt Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'