+{-# LANGUAGE
+ BangPatterns
+ , UnicodeSyntax
+ #-}
module Network.HTTP.Lucu.Postprocess
( postprocess
, completeUnconditionalHeaders
import Data.IORef
import Data.Maybe
import Data.Time
+import qualified Data.Time.HTTP as HTTP
import GHC.Conc (unsafeIOToSTM)
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.HttpVersion
import Network.HTTP.Lucu.Interaction
-import Network.HTTP.Lucu.RFC1123DateTime
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
import System.IO.Unsafe
-}
postprocess :: Interaction -> STM ()
-postprocess itr
- = itr `seq`
- do reqM <- readItr itr itrRequest id
+postprocess !itr
+ = do reqM <- readItr itr itrRequest id
res <- readItr itr itrResponse id
let sc = resStatus res
- when (not $ any (\ p -> p sc) [isSuccessful, isRedirection, isError])
+ unless (any (\ p -> p sc) [isSuccessful, isRedirection, isError])
$ abortSTM InternalServerError []
$ Just ("The status code is not good for a final status: "
++ show sc)
conn <- readHeader (C8.pack "Connection")
case conn of
Nothing -> return ()
- Just value -> if value `noCaseEq` C8.pack "close" then
- writeItr itr itrWillClose True
- else
- return ()
+ Just value -> when (value `noCaseEq` C8.pack "close")
+ $ writeItr itr itrWillClose True
willClose <- readItr itr itrWillClose id
when willClose
$ writeTVar (itrWillDiscardBody itr) True
readHeader :: Strict.ByteString -> STM (Maybe Strict.ByteString)
- readHeader name
- = name `seq`
- readItr itr itrResponse $ getHeader name
+ readHeader !name
+ = readItr itr itrResponse $ getHeader name
updateRes :: (Response -> Response) -> STM ()
- updateRes updator
- = updator `seq`
- updateItr itr itrResponse updator
+ updateRes !updator
+ = updateItr itr itrResponse updator
completeUnconditionalHeaders :: Config -> Response -> IO Response
-completeUnconditionalHeaders conf res
- = conf `seq` res `seq`
- return res >>= compServer >>= compDate >>= return
+completeUnconditionalHeaders !conf !res
+ = compServer res >>= compDate
where
compServer res'
= case getHeader (C8.pack "Server") res' of
if now `mostlyEq` cachedTime then
return cachedStr
else
- do let dateStr = C8.pack $ formatHTTPDateTime now
+ do let dateStr = C8.pack $ HTTP.format now
writeIORef cache (now, dateStr)
return dateStr
where
mostlyEq :: UTCTime -> UTCTime -> Bool
mostlyEq a b
- = if utctDay a == utctDay b then
- fromEnum (utctDayTime a) == fromEnum (utctDayTime b)
- else
- False
+ = (utctDay a == utctDay b)
+ &&
+ (fromEnum (utctDayTime a) == fromEnum (utctDayTime b))