{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

{-
   Portions of this file are copyright (c) 2009,  IIJ Innovation Institute Inc.
   The utcTimeToRfc1123 function was extracted from http-date, with slight
   modifications to operate on UTCTime values.
-}

module Airship.Internal.Date
    ( parseRfc1123Date
    , utcTimeToRfc1123) where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative         ((<$>))
#endif

import           Data.ByteString.Char8       ()
import           Data.ByteString.Internal
import           Data.Time.Calendar          (fromGregorian, toGregorian)
import           Data.Time.Calendar.WeekDate (toWeekDate)
import           Data.Time.Clock             (UTCTime (..), secondsToDiffTime)
import           Data.Word
import           Foreign.ForeignPtr
import           Foreign.Ptr
import           Foreign.Storable

import qualified Network.HTTP.Date           as HD

httpDateToUtc :: HD.HTTPDate -> UTCTime
httpDateToUtc :: HTTPDate -> UTCTime
httpDateToUtc HTTPDate
h = Day -> DiffTime -> UTCTime
UTCTime Day
days DiffTime
diffTime
    where days :: Day
days = Integer -> Int -> Int -> Day
fromGregorian (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ HTTPDate -> Int
HD.hdYear HTTPDate
h) (HTTPDate -> Int
HD.hdMonth HTTPDate
h) (HTTPDate -> Int
HD.hdDay HTTPDate
h)
          diffTime :: DiffTime
diffTime = Integer -> DiffTime
secondsToDiffTime Integer
seconds
          seconds :: Integer
seconds = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
hourS Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minS Int -> Int -> Int
forall a. Num a => a -> a -> a
+ HTTPDate -> Int
HD.hdSecond HTTPDate
h
          hourS :: Int
hourS = HTTPDate -> Int
HD.hdHour HTTPDate
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60
          minS :: Int
minS = HTTPDate -> Int
HD.hdMinute HTTPDate
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60

parseRfc1123Date :: ByteString -> Maybe UTCTime
parseRfc1123Date :: ByteString -> Maybe UTCTime
parseRfc1123Date ByteString
b = HTTPDate -> UTCTime
httpDateToUtc (HTTPDate -> UTCTime) -> Maybe HTTPDate -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe HTTPDate
HD.parseHTTPDate ByteString
b

utcTimeToRfc1123 :: UTCTime -> ByteString
utcTimeToRfc1123 :: UTCTime -> ByteString
utcTimeToRfc1123 (UTCTime Day
day DiffTime
offset) =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
29 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
        Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
cpy3 Ptr Word8
ptr ForeignPtr Word8
weekDays (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  Int
3) Word8
comma
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  Int
4) Word8
spc
        Ptr Word8 -> Int -> IO ()
int2 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  Int
5) Int
d
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  Int
7) Word8
spc
        Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
cpy3 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`  Int
8) ForeignPtr Word8
months (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
11) Word8
spc
        Ptr Word8 -> Int -> IO ()
int4 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) Int
y
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) Word8
spc
        Ptr Word8 -> Int -> IO ()
int2 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
17) Int
h
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
19) Word8
colon
        Ptr Word8 -> Int -> IO ()
int2 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20) Int
n
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
22) Word8
colon
        Ptr Word8 -> Int -> IO ()
int2 (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
23) Int
s
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
25) Word8
spc
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
26) (Word8
71 :: Word8)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
27) (Word8
77 :: Word8)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28) (Word8
84 :: Word8)
  where
    y :: Int
y = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y'
    offset' :: Int
offset' = DiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round DiffTime
offset
    h :: Int
h = Int
offset' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3600
    n :: Int
n = Int
offset' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
60
    s :: Int
s = Int
offset' Int -> Int -> Int
forall a. Num a => a -> a -> a
- (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)
    (Integer
y', Int
m, Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
day
    (Integer
_, Int
_, Int
w) = Day -> (Integer, Int, Int)
toWeekDate Day
day
    cpy3 :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
    cpy3 :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()
cpy3 Ptr Word8
ptr ForeignPtr Word8
p Int
o = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
p ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
fp ->
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
ptr (Ptr Word8
fp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) Int
3

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

int2 :: Ptr Word8 -> Int -> IO ()
int2 :: Ptr Word8 -> Int -> IO ()
int2 Ptr Word8
ptr Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = do
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
zero
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
i2w8 Int
n)
  | Bool
otherwise = do
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr               (Int -> Word8
i2w8 (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
10))
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
i2w8 (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
10))

int4 :: Ptr Word8 -> Int -> IO ()
int4 :: Ptr Word8 -> Int -> IO ()
int4 Ptr Word8
ptr Int
n0 = do
    let (Int
n1,Int
x1) = Int
n0 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
        (Int
n2,Int
x2) = Int
n1 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
        (Int
x4,Int
x3) = Int
n2 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr               (Int -> Word8
i2w8 Int
x4)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
i2w8 Int
x3)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Int -> Word8
i2w8 Int
x2)
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Int -> Word8
i2w8 Int
x1)

i2w8 :: Int -> Word8
i2w8 :: Int -> Word8
i2w8 Int
n = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
zero

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

months :: ForeignPtr Word8
months :: ForeignPtr Word8
months = let (PS ForeignPtr Word8
p Int
_ Int
_) = ByteString
"___JanFebMarAprMayJunJulAugSepOctNovDec" in ForeignPtr Word8
p

weekDays :: ForeignPtr Word8
weekDays :: ForeignPtr Word8
weekDays = let (PS ForeignPtr Word8
p Int
_ Int
_) = ByteString
"___MonTueWedThuFriSatSun" in ForeignPtr Word8
p

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

spc :: Word8
spc :: Word8
spc = Word8
32

comma :: Word8
comma :: Word8
comma = Word8
44

colon :: Word8
colon :: Word8
colon = Word8
58

zero :: Word8
zero :: Word8
zero = Word8
48