-updateRes (Interaction {..}) f
- = do old ← readTVar itrResponse
- writeTVar itrResponse (f old)
-
-updateResIO ∷ Interaction → (Response → IO Response) → STM ()
-{-# INLINE updateResIO #-}
-updateResIO (Interaction {..}) f
- = do old ← readTVar itrResponse
- new ← unsafeIOToSTM $ f old
- writeTVar itrResponse new
-
--- FIXME: Narrow the use of IO monad!
-completeUnconditionalHeaders ∷ Config → Response → IO Response
-completeUnconditionalHeaders conf = (compDate =≪) ∘ compServer
- where
- compServer res'
- = case getHeader "Server" res' of
- Nothing → return $ setHeader "Server" (cnfServerSoftware conf) res'
- Just _ → return res'
-
- compDate res'
- = case getHeader "Date" res' of
- Nothing → do date ← getCurrentDate
- return $ setHeader "Date" date res'
- Just _ → return res'
-
-getCurrentDate ∷ IO Ascii
-getCurrentDate = HTTP.toAscii <$> getCurrentTime