{-# LANGUAGE CPP #-}
module Yesod.Core.Internal.Util
    ( putTime
    , getTime
    , formatW3
    , formatRFC1123
    , formatRFC822
    , getCurrentMaxExpiresRFC1123
    ) where

import           Data.Int       (Int64)
import           Data.Serialize (Get, Put, Serialize (..))
import qualified Data.Text      as T
import           Data.Time      (Day (ModifiedJulianDay, toModifiedJulianDay),
                                 DiffTime, UTCTime (..), formatTime,
                                 getCurrentTime, addUTCTime, defaultTimeLocale)

putTime :: UTCTime -> Put
putTime :: UTCTime -> Put
putTime (UTCTime Day
d DiffTime
t) =
  let d' :: Int64
d' = Integer -> Int64
forall a. Num a => Integer -> a
fromInteger  (Integer -> Int64) -> Integer -> Int64
forall a b. (a -> b) -> a -> b
$ Day -> Integer
toModifiedJulianDay Day
d
      t' :: Int64
t' = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ DiffTime -> Int
forall a. Enum a => a -> Int
fromEnum (DiffTime
t DiffTime -> DiffTime -> DiffTime
forall a. Fractional a => a -> a -> a
/ DiffTime
diffTimeScale)
  in Putter Int64
forall t. Serialize t => Putter t
put (Int64
d' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
posixDayLength_int64 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
posixDayLength_int64 Int64
t')

getTime :: Get UTCTime
getTime :: Get UTCTime
getTime = do
  Int64
val <- Get Int64
forall t. Serialize t => Get t
get
  let (Int64
d, Int64
t) = Int64
val Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
posixDayLength_int64
      d' :: Day
d' = Integer -> Day
ModifiedJulianDay (Integer -> Day) -> Integer -> Day
forall a b. (a -> b) -> a -> b
$! Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
d
      t' :: DiffTime
t' = Int64 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
t
  Day
d' Day -> Get UTCTime -> Get UTCTime
`seq` DiffTime
t' DiffTime -> Get UTCTime -> Get UTCTime
`seq` UTCTime -> Get UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> DiffTime -> UTCTime
UTCTime Day
d' DiffTime
t')

posixDayLength_int64 :: Int64
posixDayLength_int64 :: Int64
posixDayLength_int64 = Int64
86400

diffTimeScale :: DiffTime
diffTimeScale :: DiffTime
diffTimeScale = DiffTime
1e12

-- | Format a 'UTCTime' in W3 format.
formatW3 :: UTCTime -> T.Text
formatW3 :: UTCTime -> Text
formatW3 = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%X-00:00"

-- | Format as per RFC 1123.
formatRFC1123 :: UTCTime -> T.Text
formatRFC1123 :: UTCTime -> Text
formatRFC1123 = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%a, %d %b %Y %X %Z"

-- | Format as per RFC 822.
formatRFC822 :: UTCTime -> T.Text
formatRFC822 :: UTCTime -> Text
formatRFC822 = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%a, %d %b %Y %H:%M:%S %z"

{- | Get the time 365 days from now in RFC 1123 format. For use as an expiry
date on a resource that never expires. See RFC 2616 section 14.21 for details.
-}
getCurrentMaxExpiresRFC1123 :: IO T.Text
getCurrentMaxExpiresRFC1123 :: IO Text
getCurrentMaxExpiresRFC1123 = (UTCTime -> Text) -> IO UTCTime -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UTCTime -> Text
formatRFC1123 (UTCTime -> Text) -> (UTCTime -> UTCTime) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime
60NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
60NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
24NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
365)) IO UTCTime
getCurrentTime