{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}

module Snap.Internal.Http.Server.Date
  ( getDateString
  , getLogDateString
  ) where

------------------------------------------------------------------------------
import           Control.Exception        (mask_)
import           Control.Monad            (when)
import           Data.ByteString          (ByteString)
import           Data.IORef               (IORef, newIORef, readIORef, writeIORef)
import           Foreign.C.Types          (CTime)
import           System.IO.Unsafe         (unsafePerformIO)
import           System.PosixCompat.Time  (epochTime)
------------------------------------------------------------------------------
import           Snap.Internal.Http.Types (formatHttpTime, formatLogTime)


------------------------------------------------------------------------------
data DateState = DateState {
      DateState -> IORef ByteString
_cachedDateString :: !(IORef ByteString)
    , DateState -> IORef ByteString
_cachedLogString  :: !(IORef ByteString)
    , DateState -> IORef EpochTime
_lastFetchTime    :: !(IORef CTime)
    }


------------------------------------------------------------------------------
dateState :: DateState
dateState :: DateState
dateState = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    (ByteString
s1, ByteString
s2, EpochTime
date) <- IO (ByteString, ByteString, EpochTime)
fetchTime
    IORef ByteString
bs1 <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$! ByteString
s1
    IORef ByteString
bs2 <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$! ByteString
s2
    IORef EpochTime
dt  <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$! EpochTime
date

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! IORef ByteString
-> IORef ByteString -> IORef EpochTime -> DateState
DateState IORef ByteString
bs1 IORef ByteString
bs2 IORef EpochTime
dt
{-# NOINLINE dateState #-}


------------------------------------------------------------------------------
fetchTime :: IO (ByteString,ByteString,CTime)
fetchTime :: IO (ByteString, ByteString, EpochTime)
fetchTime = do
    !EpochTime
now <- IO EpochTime
epochTime
    !ByteString
t1  <- EpochTime -> IO ByteString
formatHttpTime EpochTime
now
    !ByteString
t2  <- EpochTime -> IO ByteString
formatLogTime EpochTime
now
    let !out :: (ByteString, ByteString, EpochTime)
out = (ByteString
t1, ByteString
t2, EpochTime
now)
    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString, ByteString, EpochTime)
out


------------------------------------------------------------------------------
updateState :: DateState -> IO ()
updateState :: DateState -> IO ()
updateState (DateState IORef ByteString
dateString IORef ByteString
logString IORef EpochTime
time) = do
    (ByteString
s1, ByteString
s2, EpochTime
now) <- IO (ByteString, ByteString, EpochTime)
fetchTime
    forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
dateString forall a b. (a -> b) -> a -> b
$! ByteString
s1
    forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
logString  forall a b. (a -> b) -> a -> b
$! ByteString
s2
    forall a. IORef a -> a -> IO ()
writeIORef IORef EpochTime
time       forall a b. (a -> b) -> a -> b
$! EpochTime
now

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()


------------------------------------------------------------------------------
ensureFreshDate :: IO ()
ensureFreshDate :: IO ()
ensureFreshDate = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
    EpochTime
now <- IO EpochTime
epochTime
    EpochTime
old <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ DateState -> IORef EpochTime
_lastFetchTime DateState
dateState
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EpochTime
now forall a. Ord a => a -> a -> Bool
> EpochTime
old) forall a b. (a -> b) -> a -> b
$! DateState -> IO ()
updateState DateState
dateState


------------------------------------------------------------------------------
getDateString :: IO ByteString
getDateString :: IO ByteString
getDateString = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
    IO ()
ensureFreshDate
    forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ DateState -> IORef ByteString
_cachedDateString DateState
dateState


------------------------------------------------------------------------------
getLogDateString :: IO ByteString
getLogDateString :: IO ByteString
getLogDateString = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
    IO ()
ensureFreshDate
    forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ DateState -> IORef ByteString
_cachedLogString DateState
dateState