-defaultPageContentType ∷ Ascii
-defaultPageContentType = "application/xhtml+xml"
-
-newInteraction ∷ Config → PortNumber → SockAddr → Maybe X509 → Maybe Request → IO Interaction
-newInteraction !conf !port !addr !cert !req
- = do request ← newTVarIO req
- responce ← newTVarIO Response {
- resVersion = HttpVersion 1 1
- , resStatus = Ok
- , resHeaders = toHeaders [("Content-Type", defaultPageContentType)]
- }
-
- requestHasBody ← newTVarIO False
- requestIsChunked ← newTVarIO False
- expectedContinue ← newTVarIO False
-
- reqChunkLength ← newTVarIO Nothing -- 現在のチャンク長
- reqChunkRemaining ← newTVarIO Nothing -- 現在のチャンクの殘り
- reqChunkIsOver ← newTVarIO False -- 最後のチャンクを讀み終へた
- reqBodyWanted ← newTVarIO Nothing -- Resource が要求してゐるチャンク長
- reqBodyWasteAll ← newTVarIO False -- 殘りの body を讀み捨てよと云ふ要求
- receivedBody ← newTVarIO S.empty
- receivedBodyLen ← newTVarIO 0
-
- willReceiveBody ← newTVarIO False
- willChunkBody ← newTVarIO False
- willDiscardBody ← newTVarIO False
- willClose ← newTVarIO False
-
- bodyToSend ← newEmptyTMVarIO
- bodyIsNull ← newTVarIO True -- 一度でも bodyToSend が空でなくなったら False
-
- state ← newTVarIO ExaminingRequest
-
- wroteContinue ← newTVarIO False
- wroteHeader ← newTVarIO False
+newInteraction ∷ Config
+ → PortNumber
+ → SockAddr
+ → Maybe X509
+ → Either StatusCode Request
+ → IO Interaction
+newInteraction conf@(Config {..}) port addr cert request
+ = do let ar = preprocess cnfServerHost port request
+ res = Response {
+ resVersion = HttpVersion 1 1
+ , resStatus = arInitialStatus ar
+ , resHeaders = (∅)
+ }
+
+ receiveBodyReq ← newEmptyTMVarIO
+ receivedBody ← newEmptyTMVarIO
+
+ sendContinue ← newEmptyTMVarIO
+ response ← newTVarIO res
+ willChunkBody ← newTVarIO False
+ willDiscardBody ← newTVarIO (arWillDiscardBody ar)
+ willClose ← newTVarIO (arWillClose ar)
+ bodyToSend ← newEmptyTMVarIO
+ responseHasCType ← newTVarIO False
+
+ state ← newTVarIO ExaminingRequest