-
-newInteraction :: HostName -> Maybe Request -> IO Interaction
-newInteraction host req
- = do responce <- newTVarIO Nothing
-
- requestHasBody <- newTVarIO False
- requestBodyLength <- newTVarIO Nothing
- requestIsChunked <- newTVarIO False
- receivedBody <- newTVarIO B.empty
-
- expectedContinue <- newTVarIO False
-
- willChunkBody <- newTVarIO False
- willDiscardBody <- newTVarIO False
- willClose <- newTVarIO False
- bodyToSend <- newTVarIO B.empty
-
- state <- newTVarIO undefined
-
- wroteContinue <- newTVarIO False
- wroteHeader <- newTVarIO False
-
- return $ Interaction {
- itrRemoteHost = host
- , itrRequest = req
- , itrResponse = responce
-
- , itrRequestHasBody = requestHasBody
- , itrRequestBodyLength = requestBodyLength
- , itrRequestIsChunked = requestIsChunked
- , itrReceivedBody = receivedBody
-
- , itrExpectedContinue = expectedContinue
-
+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 = (∅)
+ }
+
+ reqBodyWanted ← newTVarIO 0
+ reqBodyWasteAll ← newTVarIO False
+ reqChunkIsOver ← newTVarIO False
+ receivedBody ← newTVarIO S.empty
+ receivedBodyLen ← newTVarIO 0
+
+ response ← newTVarIO res
+ willChunkBody ← newTVarIO False
+ willDiscardBody ← newTVarIO (arWillDiscardBody ar)
+ willClose ← newTVarIO (arWillClose ar)
+ bodyToSend ← newEmptyTMVarIO
+ responseHasCType ← newTVarIO False
+
+ state ← newTVarIO ExaminingRequest
+
+ return Interaction {
+ itrConfig = conf
+ , itrLocalPort = port
+ , itrRemoteAddr = addr
+ , itrRemoteCert = cert
+ , itrResourcePath = Nothing
+ , itrRequest = arRequest ar
+
+ , itrExpectedContinue = arExpectedContinue ar
+ , itrReqBodyLength = arReqBodyLength ar
+
+ , itrReqBodyWanted = reqBodyWanted
+ , itrReqBodyWasteAll = reqBodyWasteAll
+ , itrReqChunkIsOver = reqChunkIsOver
+ , itrReceivedBody = receivedBody
+ , itrReceivedBodyLen = receivedBodyLen
+
+ , itrResponse = response