import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import Data.List
-import qualified Data.Strict.Maybe as S
+import Data.Maybe
import Data.Monoid.Unicode
import qualified Data.Sequence as S
import Data.Sequence.Unicode hiding ((∅))
-- リクエストを讀む。パースできない場合は直ちに 400 Bad
-- Request 應答を設定し、それを出力してから切斷するやうに
-- ResponseWriter に通知する。
- case LP.parse requestP input of
+ case LP.parse request input of
LP.Done input' req → acceptParsableRequest ctx req input'
LP.Fail _ _ _ → acceptNonparsableRequest ctx
→ Lazy.ByteString
→ IO ()
waitForReceiveBodyReq ctx ni@(NI {..}) rsrcTid input
- = case S.fromJust niReqBodyLength of
+ = case fromJust niReqBodyLength of
Chunked
→ waitForReceiveChunkedBodyReqForTheFirstTime ctx ni rsrcTid input
Fixed len
where
go ∷ Lazy.ByteString → ChunkReceivingState → IO ()
go input Initial
- = case LP.parse chunkHeaderP input of
+ = case LP.parse chunkHeader input of
LP.Done input' chunkLen
| chunkLen ≡ 0 → gotFinalChunk input'
| otherwise → gotChunk input' chunkLen
LP.Fail _ eCtx e
→ chunkWasMalformed rsrcTid eCtx e
- "wasteAllChunks: chunkHeaderP"
+ "wasteAllChunks: chunkHeader"
go input (InChunk chunkLen)
= gotChunk input chunkLen
gotChunk input chunkLen
= let input' = Lazy.drop (fromIntegral chunkLen) input
in
- case LP.parse chunkFooterP input' of
+ case LP.parse chunkFooter input' of
LP.Done input'' _
→ go input'' Initial
LP.Fail _ eCtx e
→ chunkWasMalformed rsrcTid eCtx e
- "wasteAllChunks: chunkFooterP"
+ "wasteAllChunks: chunkFooter"
gotFinalChunk ∷ Lazy.ByteString → IO ()
gotFinalChunk input
- = case LP.parse chunkTrailerP input of
+ = case LP.parse chunkTrailer input of
LP.Done input' _
→ acceptRequest ctx input'
LP.Fail _ eCtx e
→ chunkWasMalformed rsrcTid eCtx e
- "wasteAllChunks: chunkTrailerP"
+ "wasteAllChunks: chunkTrailer"
readCurrentChunk ∷ HandleLike h
⇒ Context h
where
go ∷ Lazy.ByteString → ChunkReceivingState → IO ()
go input Initial
- = case LP.parse chunkHeaderP input of
+ = case LP.parse chunkHeader input of
LP.Done input' chunkLen
| chunkLen ≡ 0
→ gotFinalChunk input'
→ gotChunk input' chunkLen
LP.Fail _ eCtx e
→ chunkWasMalformed rsrcTid eCtx e
- "readCurrentChunk: chunkHeaderP"
+ "readCurrentChunk: chunkHeader"
go input (InChunk chunkLen)
= gotChunk input chunkLen
chunkLen' = chunkLen - actualReadBytes
atomically $ putTMVar niReceivedBody block'
if chunkLen' ≡ 0 then
- case LP.parse chunkFooterP input' of
+ case LP.parse chunkFooter input' of
LP.Done input'' _
→ waitForReceiveChunkedBodyReq ctx ni rsrcTid input'' Initial
LP.Fail _ eCtx e
→ chunkWasMalformed rsrcTid eCtx e
- "readCurrentChunk: chunkFooterP: "
+ "readCurrentChunk: chunkFooter"
else
waitForReceiveChunkedBodyReq ctx ni rsrcTid input' $ InChunk chunkLen'
gotFinalChunk ∷ Lazy.ByteString → IO ()
gotFinalChunk input
= do atomically $ putTMVar niReceivedBody (∅)
- case LP.parse chunkTrailerP input of
+ case LP.parse chunkTrailer input of
LP.Done input' _
→ acceptRequest ctx input'
LP.Fail _ eCtx e
→ chunkWasMalformed rsrcTid eCtx e
- "readCurrentChunk: chunkTrailerP"
+ "readCurrentChunk: chunkTrailer"
chunkWasMalformed ∷ ThreadId → [String] → String → String → IO ()
chunkWasMalformed tid eCtx e msg