import Control.Monad.Unicode
import Data.Ascii (Ascii, CIAscii)
import qualified Data.Ascii as A
-import qualified Data.ByteString as Strict (ByteString)
-import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
-import Data.IORef
import Data.Maybe
import Data.Monoid.Unicode
import Data.Time
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
import Prelude.Unicode
-import System.IO.Unsafe
{-
postprocess ∷ Interaction → STM ()
postprocess !itr
- = do reqM ← readItr itr itrRequest id
- res ← readItr itr itrResponse id
+ = do reqM ← readItr itrRequest id itr
+ res ← readItr itrResponse id itr
let sc = resStatus res
unless (any (\ p → p sc) [isSuccessful, isRedirection, isError])
⊕ printStatusCode sc
⊕ " but no Allow header." )
- when (sc /= NotModified ∧ isRedirection sc ∧ getHeader "Location" res ≡ Nothing)
+ when (sc ≢ NotModified ∧ isRedirection sc ∧ getHeader "Location" res ≡ Nothing)
$ abortSTM InternalServerError []
$ Just
$ A.toText ( "The status code was "
⊕ printStatusCode sc
⊕ " but no Location header." )
- when (reqM /= Nothing) relyOnRequest
+ when (reqM ≢ Nothing) relyOnRequest
-- itrResponse の内容は relyOnRequest によって變へられてゐる可
-- 能性が高い。
- do oldRes ← readItr itr itrResponse id
+ do oldRes ← readItr itrResponse id itr
newRes ← unsafeIOToSTM
$ completeUnconditionalHeaders (itrConfig itr) oldRes
- writeItr itr itrResponse newRes
+ writeItr itrResponse newRes itr
where
relyOnRequest ∷ STM ()
relyOnRequest
- = do status ← readItr itr itrResponse resStatus
- req ← readItr itr itrRequest fromJust
+ = do status ← readItr itrResponse resStatus itr
+ req ← readItr itrRequest fromJust itr
let reqVer = reqVersion req
canHaveBody = if reqMethod req ≡ HEAD then
if canHaveBody then
when (reqVer ≡ HttpVersion 1 1)
$ do updateRes $ setHeader "Transfer-Encoding" "chunked"
- writeItr itr itrWillChunkBody True
+ writeItr itrWillChunkBody True itr
else
-- body 関連のヘッダを削除。但し HEAD なら Content-* は殘す
- when (reqMethod req /= HEAD)
+ when (reqMethod req ≢ HEAD)
$ do updateRes $ deleteHeader "Content-Type"
updateRes $ deleteHeader "Etag"
updateRes $ deleteHeader "Last-Modified"
case conn of
Nothing → return ()
Just value → when (A.toCIAscii value ≡ "close")
- $ writeItr itr itrWillClose True
+ $ writeItr itrWillClose True itr
- willClose ← readItr itr itrWillClose id
+ willClose ← readItr itrWillClose id itr
when willClose
$ updateRes $ setHeader "Connection" "close"
readHeader ∷ CIAscii → STM (Maybe Ascii)
{-# INLINE readHeader #-}
- readHeader = readItr itr itrResponse ∘ getHeader
+ readHeader k = readItr itrResponse (getHeader k) itr
updateRes ∷ (Response → Response) → STM ()
{-# INLINE updateRes #-}
- updateRes = updateItr itr itrResponse
+ updateRes f = updateItr itrResponse f itr
completeUnconditionalHeaders ∷ Config → Response → IO Response
completeUnconditionalHeaders conf = (compDate =≪) ∘ compServer
Just _ → return res'
getCurrentDate ∷ IO Ascii
-getCurrentDate = HTTP.format <$> getCurrentTime
+getCurrentDate = HTTP.toAscii <$> getCurrentTime