module Network.HTTP.Date.Converter (
    epochTimeToHTTPDate,
    httpDateToUTC,
    httpDateToUTCValid,
    utcToHTTPDate,
) where

import Data.Time
import Data.Time.Calendar.WeekDate
import Foreign.C.Types (CTime (..))
import Network.HTTP.Date.Types
import System.Posix.Types

-- |
--   Translating 'EpochTime' to 'HTTPDate'.
--
-- >>> epochTimeToHTTPDate 784887151
-- HTTPDate {hdYear = 1994, hdMonth = 11, hdDay = 15, hdHour = 8, hdMinute = 12, hdSecond = 31, hdWkday = 2}
epochTimeToHTTPDate :: EpochTime -> HTTPDate
epochTimeToHTTPDate :: EpochTime -> HTTPDate
epochTimeToHTTPDate (CTime Int64
i) =
    HTTPDate
defaultHTTPDate
        { hdYear = y
        , hdMonth = m
        , hdDay = d
        , hdHour = h
        , hdMinute = n
        , hdSecond = s
        , hdWkday = w
        }
  where
    (Int
days, Int
secs) = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
86400
    -- 1970/1/1 is Thu (4)
    w :: Int
w = (Int
days Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    (Int
y, Int
m, Int
d) = Int -> (Int, Int, Int)
civilFromDays Int
days
    (Int
hhmm, Int
s) = Int
secs Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60
    (Int
h, Int
n) = Int
hhmm Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60

-- Howard Hinnant's civil_from_days: days since 1970-01-01 to (y, m, d)
-- in constant time, for any sign. See:
-- http://howardhinnant.github.io/date_algorithms.html#civil_from_days
civilFromDays :: Int -> (Int, Int, Int)
civilFromDays :: Int -> (Int, Int, Int)
civilFromDays Int
z0 = (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 then Int
1 else Int
0, Int
m, Int
d)
  where
    z :: Int
z = Int
z0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
719468
    era :: Int
era = Int
z Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
146097
    doe :: Int
doe = Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
era Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
146097
    yoe :: Int
yoe = (Int
doe Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
doe Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
1460 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
doe Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
36524 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
doe Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
146096) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
365
    y :: Int
y = Int
yoe Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
era Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
400
    doy :: Int
doy = Int
doe Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
365 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
yoe Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yoe Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yoe Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
100)
    mp :: Int
mp = (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
doy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
153
    d :: Int
d = Int
doy Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
153 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    m :: Int
m = if Int
mp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 then Int
mp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 else Int
mp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9

-- | Translating 'HTTPDate' to 'UTCTime'.
--
--   Out-of-range fields are clipped to the nearest valid value, as
--   'fromGregorian' does. 'hdWkday' is ignored. A second of 60 is kept
--   as a leap second only at 23:59. Use 'httpDateToUTCValid' to reject
--   invalid values instead.
--
-- >>> httpDateToUTC defaultHTTPDate {hdMonth = 2, hdDay = 31, hdHour = 25}
-- 1970-02-28 23:00:00 UTC
--
--   Since 0.0.7.
httpDateToUTC :: HTTPDate -> UTCTime
httpDateToUTC :: HTTPDate -> UTCTime
httpDateToUTC HTTPDate
x = Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
y Int
m Int
d) (Year -> DiffTime
secondsToDiffTime Year
s)
  where
    y :: Year
y = Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ HTTPDate -> Int
hdYear HTTPDate
x
    m :: Int
m = HTTPDate -> Int
hdMonth HTTPDate
x
    d :: Int
d = HTTPDate -> Int
hdDay HTTPDate
x
    h :: Int
h = Int -> Int -> Int -> Int
forall {b}. Ord b => b -> b -> b -> b
clip Int
0 Int
23 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ HTTPDate -> Int
hdHour HTTPDate
x
    n :: Int
n = Int -> Int -> Int -> Int
forall {b}. Ord b => b -> b -> b -> b
clip Int
0 Int
59 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ HTTPDate -> Int
hdMinute HTTPDate
x
    s0 :: Int
s0 = Int -> Int -> Int -> Int
forall {b}. Ord b => b -> b -> b -> b
clip Int
0 Int
60 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ HTTPDate -> Int
hdSecond HTTPDate
x
    s0' :: Int
s0'
        | Int
s0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
60 Bool -> Bool -> Bool
&& (Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
23 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
59) = Int
59
        | Bool
otherwise = Int
s0
    s :: Year
s = Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3600 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s0'
    clip :: b -> b -> b -> b
clip b
lo b
hi b
v = b -> b -> b
forall a. Ord a => a -> a -> a
max b
lo (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a. Ord a => a -> a -> a
min b
hi b
v

-- | Translating 'HTTPDate' to 'UTCTime' if all fields except
--   'hdWkday' are valid. A second of 60 is accepted only at 23:59.
--
-- >>> httpDateToUTCValid defaultHTTPDate {hdMonth = 2, hdDay = 31}
-- Nothing
--
--   Since 0.0.13.
httpDateToUTCValid :: HTTPDate -> Maybe UTCTime
httpDateToUTCValid :: HTTPDate -> Maybe UTCTime
httpDateToUTCValid HTTPDate
x
    | Int -> Int -> Int -> Bool
validTime (HTTPDate -> Int
hdHour HTTPDate
x) (HTTPDate -> Int
hdMinute HTTPDate
x) (HTTPDate -> Int
hdSecond HTTPDate
x) = do
        day <- Year -> Int -> Int -> Maybe Day
fromGregorianValid (Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ HTTPDate -> Int
hdYear HTTPDate
x) (HTTPDate -> Int
hdMonth HTTPDate
x) (HTTPDate -> Int
hdDay HTTPDate
x)
        return $ UTCTime day $ secondsToDiffTime s
    | Bool
otherwise = Maybe UTCTime
forall a. Maybe a
Nothing
  where
    s :: Year
s = Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ HTTPDate -> Int
hdHour HTTPDate
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3600 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ HTTPDate -> Int
hdMinute HTTPDate
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ HTTPDate -> Int
hdSecond HTTPDate
x

validTime :: Int -> Int -> Int -> Bool
validTime :: Int -> Int -> Int -> Bool
validTime Int
h Int
n Int
s =
    Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h
        Bool -> Bool -> Bool
&& Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
23
        Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
        Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
59
        Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
s
        Bool -> Bool -> Bool
&& (Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
59 Bool -> Bool -> Bool
|| Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
60 Bool -> Bool -> Bool
&& Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
23 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
59)

-- | Translating 'UTCTime' to 'HTTPDate'.
--
--   Since 0.0.7.
utcToHTTPDate :: UTCTime -> HTTPDate
utcToHTTPDate :: UTCTime -> HTTPDate
utcToHTTPDate UTCTime
x =
    HTTPDate
defaultHTTPDate
        { hdYear = fromIntegral y
        , hdMonth = m
        , hdDay = d
        , hdHour = h
        , hdMinute = n
        , hdSecond = truncate s
        , hdWkday = w
        }
  where
    (Year
y, Int
m, Int
d) = Day -> (Year, Int, Int)
toGregorian Day
day
    (Int
h, Int
n, Pico
s) = (TimeOfDay -> Int
todHour TimeOfDay
tod, TimeOfDay -> Int
todMin TimeOfDay
tod, TimeOfDay -> Pico
todSec TimeOfDay
tod)
    (Year
_, Int
_, Int
w) = Day -> (Year, Int, Int)
toWeekDate Day
day
    day :: Day
day = LocalTime -> Day
localDay LocalTime
time
    tod :: TimeOfDay
tod = LocalTime -> TimeOfDay
localTimeOfDay LocalTime
time
    time :: LocalTime
time = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
x