--- 'inputBS', not at the lazy evaluation of the ByteString. The same
--- goes for 'inputChunkBS'.
-inputBS :: Int -> Resource ByteString
-inputBS limit
- = do driftTo GettingBody
- itr <- ask
- hasBody <- liftIO $ atomically $ readItr itr itrRequestHasBody id
- chunk <- if hasBody then
- askForInput itr
- else
- do driftTo DecidingHeader
- return B.empty
- return chunk
- where
- askForInput :: Interaction -> Resource ByteString
- askForInput itr
- = do let defaultLimit = cnfMaxEntityLength $ itrConfig itr
- actualLimit = if limit <= 0 then
- defaultLimit
- else
- limit
- when (actualLimit <= 0)
- $ fail ("inputBS: limit must be positive: " ++ show actualLimit)
- -- Reader にリクエスト
- liftIO $ atomically
- $ do chunkLen <- readItr itr itrReqChunkLength id
- writeItr itr itrWillReceiveBody True
- if fmap (> actualLimit) chunkLen == Just True then
- -- 受信前から多過ぎる事が分かってゐる
- tooLarge actualLimit
- else
- writeItr itr itrReqBodyWanted $ Just actualLimit
- -- 應答を待つ。トランザクションを分けなければ當然デッドロック。
- chunk <- liftIO $ atomically
- $ do chunk <- readItr itr itrReceivedBody id
- chunkIsOver <- readItr itr itrReqChunkIsOver id
- if B.length chunk < fromIntegral actualLimit then
- -- 要求された量に滿たなくて、まだ殘り
- -- があるなら再試行。
- unless chunkIsOver
- $ retry
- else
- -- 制限値一杯まで讀むやうに指示したの
- -- にまだ殘ってゐるなら、それは多過ぎ
- -- る。
- unless chunkIsOver
- $ tooLarge actualLimit
- -- 成功。itr 内にチャンクを置いたままにす
- -- るとメモリの無駄になるので除去。
- writeItr itr itrReceivedBody B.empty
- return chunk
- driftTo DecidingHeader
- return chunk
-
- tooLarge :: Int -> STM ()
- tooLarge lim = abortSTM RequestEntityTooLarge []
- $ Just ("Request body must be smaller than "
- ++ show lim ++ " bytes.")
-
--- | Computation of @'inputChunk' limit@ attempts to read a part of
--- request body up to @limit@ bytes. You can read any large request by
--- repeating computation of this action. When you've read all the
--- request body, 'inputChunk' returns an empty string and then make
--- the 'Resource' transit to /Deciding Header/ state.
---
--- @limit@ may be less than or equal to zero. In this case, the
--- default limitation value
--- ('Network.HTTP.Lucu.Config.cnfMaxEntityLength') is used. See
--- 'defaultLimit'.
---
--- Note that 'inputChunkBS' is more efficient than 'inputChunk' so you
--- should use it whenever possible.
-inputChunk :: Int -> Resource String
-inputChunk limit = inputChunkBS limit >>= return . B.unpack
-
-
--- | This is mostly the same as 'inputChunk' but is more
--- efficient. See 'inputBS'.
-inputChunkBS :: Int -> Resource ByteString
-inputChunkBS limit
- = do driftTo GettingBody
- itr <- ask
- hasBody <- liftIO $ atomically $ readItr itr itrRequestHasBody id
- chunk <- if hasBody then
- askForInput itr
- else
- do driftTo DecidingHeader
- return B.empty
- return chunk