- writeHeader :: Interaction -> IO ()
- writeHeader !itr
- = {-# SCC "writeHeader" #-}
- do res <- atomically $! do writeItr itr itrWroteHeader True
- readItr itr itrResponse id
- hPutResponse h res
- hFlush h
- awaitSomethingToWrite
-
- writeBodyChunk :: Interaction -> IO ()
- writeBodyChunk !itr
- = {-# SCC "writeBodyChunk" #-}
- do willDiscardBody <- atomically $! readItr itr itrWillDiscardBody id
- willChunkBody <- atomically $! readItr itr itrWillChunkBody id
- chunk <- atomically $! do chunk <- readItr itr itrBodyToSend id
- writeItr itr itrBodyToSend C8.empty
- return chunk
- unless willDiscardBody
- $ do if willChunkBody then
- do hPutStr h (fmtHex False 0 $! fromIntegral $! C8.length chunk)
- hPutLBS h (C8.pack "\r\n")
- hPutLBS h chunk
- hPutLBS h (C8.pack "\r\n")
- else
- hPutLBS h chunk
- hFlush h
- awaitSomethingToWrite
+writeContinue ∷ HandleLike h ⇒ Context h → Interaction → IO ()
+writeContinue ctx@(Context {..}) itr
+ = do let cont = Response {
+ resVersion = HttpVersion 1 1
+ , resStatus = Continue
+ , resHeaders = (∅)
+ }
+ cont' ← completeUnconditionalHeaders cConfig cont
+ hPutBuilder cHandle $ A.toBuilder $ printResponse cont'
+ hFlush cHandle
+ atomically $ writeItr itrWroteContinue True itr
+ awaitSomethingToWrite ctx