--- Note that 'outputChunkLBS' is more efficient than 'outputChunk' so
--- you should use it whenever possible.
-outputChunk :: String -> Resource ()
-outputChunk str = outputChunkLBS $! B.pack str
-{-# INLINE outputChunk #-}
-
--- | This is mostly the same as 'outputChunk' but is more efficient.
-outputChunkLBS :: LazyByteString -> Resource ()
-outputChunkLBS str
- = str `seq`
- do driftTo DecidingBody
- itr <- getInteraction
-
- let limit = cnfMaxOutputChunkLength $ itrConfig itr
- when (limit <= 0)
- $ fail ("cnfMaxOutputChunkLength must be positive: "
- ++ show limit)
-
- discardBody <- liftIO $ atomically $
- readItr itr itrWillDiscardBody id
-
- unless (discardBody)
- $ sendChunks str limit
-
- unless (B.null str)
- $ liftIO $ atomically $
- writeItr itr itrBodyIsNull False
- where
- -- チャンクの大きさは Config で制限されてゐる。もし例へば
- -- "/dev/zero" を B.readFile して作った LazyByteString をそのまま
- -- ResponseWriter に渡したりすると大變な事が起こる。何故なら
- -- ResponseWriter は Transfer-Encoding: chunked の時、ヘッダを書
- -- く爲にチャンクの大きさを測る。
- sendChunks :: LazyByteString -> Int -> Resource ()
- sendChunks str limit
- | B.null str = return ()
- | otherwise = do let (chunk, remaining) = B.splitAt (fromIntegral limit) str
- itr <- getInteraction
- liftIO $ atomically $
- do buf <- readItr itr itrBodyToSend id
- if B.null buf then
- -- バッファが消化された
- writeItr itr itrBodyToSend chunk
- else
- -- 消化されるのを待つ
- retry
- -- 殘りのチャンクについて繰り返す
- sendChunks remaining limit
-
-{-
-
- [GettingBody からそれ以降の状態に遷移する時]
-
- body を讀み終へてゐなければ、殘りの body を讀み捨てる。
-
-
- [DecidingHeader からそれ以降の状態に遷移する時]
-
- postprocess する。
-
-
- [Done に遷移する時]
-
- bodyIsNull が False ならば何もしない。True だった場合は出力補完す
- る。
-
--}
+-- Note that you must first set the \"Content-Type\" response header
+-- before applying this function. See: 'setContentType'
+outputChunk ∷ Lazy.ByteString → Resource ()
+outputChunk str
+ = do driftTo DecidingBody
+ itr ← getInteraction
+ liftIO $ atomically
+ $ do hasCType ← readTVar $ itrResponseHasCType itr
+ unless hasCType
+ $ abortSTM InternalServerError []
+ $ Just "outputChunk: Content-Type has not been set."
+ putTMVar (itrBodyToSend itr) (BB.fromLazyByteString str)