- compServer res
- = case getHeader "Server" res of
- Nothing -> return $ addHeader "Server" (cnfServerSoftware conf) res
- Just _ -> return res
-
- compDate res
- = case getHeader "Date" res of
- Nothing -> do time <- getClockTime
- return $ addHeader "Date" (formatHTTPDateTime time) res
- Just _ -> return res
\ No newline at end of file
+ compServer res'
+ = case getHeader (C8.pack "Server") res' of
+ Nothing -> return $ setHeader (C8.pack "Server") (cnfServerSoftware conf) res'
+ Just _ -> return res'
+
+ compDate res'
+ = case getHeader (C8.pack "Date") res' of
+ Nothing -> do date <- getCurrentDate
+ return $ setHeader (C8.pack "Date") date res'
+ Just _ -> return res'
+
+
+cache :: IORef (UTCTime, Strict.ByteString)
+cache = unsafePerformIO $
+ newIORef (UTCTime (ModifiedJulianDay 0) 0, undefined)
+{-# NOINLINE cache #-}
+
+getCurrentDate :: IO Strict.ByteString
+getCurrentDate = do now <- getCurrentTime
+ (cachedTime, cachedStr) <- readIORef cache
+
+ if now `mostlyEq` cachedTime then
+ return cachedStr
+ else
+ do let dateStr = C8.pack $ HTTP.format now
+ writeIORef cache (now, dateStr)
+ return dateStr
+ where
+ mostlyEq :: UTCTime -> UTCTime -> Bool
+ mostlyEq a b
+ = (utctDay a == utctDay b)
+ &&
+ (fromEnum (utctDayTime a) == fromEnum (utctDayTime b))