{-# LANGUAGE CPP #-}

module Network.Wai.Handler.Warp.Date (
    withDateCache,
    GMTDate,
) where

import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction)
import Data.ByteString
import Network.HTTP.Date

#if WINDOWS
import Data.Time (UTCTime, getCurrentTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Foreign.C.Types (CTime(..))
#else
import System.Posix (epochTime)
#endif

-- | The type of the Date header value.
type GMTDate = ByteString

-- | Creating 'DateCache' and executing the action.
withDateCache :: (IO GMTDate -> IO a) -> IO a
withDateCache :: forall a. (IO GMTDate -> IO a) -> IO a
withDateCache IO GMTDate -> IO a
action = IO (IO GMTDate)
initialize IO (IO GMTDate) -> (IO GMTDate -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO GMTDate -> IO a
action

initialize :: IO (IO GMTDate)
initialize :: IO (IO GMTDate)
initialize =
    UpdateSettings GMTDate -> IO (IO GMTDate)
forall a. UpdateSettings a -> IO (IO a)
mkAutoUpdate
        UpdateSettings ()
defaultUpdateSettings
            { updateAction = formatHTTPDate <$> getCurrentHTTPDate
            }

#ifdef WINDOWS
uToH :: UTCTime -> HTTPDate
uToH = epochTimeToHTTPDate . CTime . truncate . utcTimeToPOSIXSeconds

getCurrentHTTPDate :: IO HTTPDate
getCurrentHTTPDate =  uToH <$> getCurrentTime
#else
getCurrentHTTPDate :: IO HTTPDate
getCurrentHTTPDate :: IO HTTPDate
getCurrentHTTPDate = EpochTime -> HTTPDate
epochTimeToHTTPDate (EpochTime -> HTTPDate) -> IO EpochTime -> IO HTTPDate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO EpochTime
epochTime
#endif