1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
{-# LANGUAGE CPP #-}
module Network.Wai.Handler.Warp.Date (
withDateCache
, getDate
, DateCache
, GMTDate
) where
import Control.Applicative
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.ByteString.Char8
import Data.IORef
#if WINDOWS
import Data.Time
import System.Locale
#else
import Network.HTTP.Date
import System.Posix (epochTime)
#endif
-- | The type of the Date header value.
type GMTDate = ByteString
-- | The type of the cache of the Date header value.
data DateCache = DateCache (IORef GMTDate)
-- | Creating 'DateCache' and executing the action.
withDateCache :: (DateCache -> IO a) -> IO a
withDateCache action = bracket initialize
(\(t,_) -> killThread t)
(\(_,dc) -> action dc)
initialize :: IO (ThreadId, DateCache)
initialize = do
dc <- DateCache <$> (getCurrentGMTDate >>= newIORef)
t <- forkIO $ forever $ do
threadDelay 1000000
update dc
return (t, dc)
-- | Getting 'GMTDate' based on 'DateCache'.
getDate :: DateCache -> IO GMTDate
getDate (DateCache ref) = readIORef ref
update :: DateCache -> IO ()
update (DateCache ref) = getCurrentGMTDate >>= writeIORef ref
getCurrentGMTDate :: IO GMTDate
#ifdef WINDOWS
getCurrentGMTDate = formatDate <$> getCurrentTime
where
formatDate = pack . formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT"
#else
getCurrentGMTDate = formatHTTPDate . epochTimeToHTTPDate <$> epochTime
#endif
|
