- observeNonChunkedRequest :: Interaction -> ByteString -> IO ()
- observeNonChunkedRequest itr input
- = {-# SCC "observeNonChunkedRequest" #-}
- do action
- <- atomically $
- do wantedM <- readItr itr itrReqBodyWanted id
- if wantedM == Nothing then
- do wasteAll <- readItr itr itrReqBodyWasteAll id
- if wasteAll then
- -- 破棄要求が來た
- do remainingM <- readItr itr itrReqChunkRemaining id
-
- let (_, input') = if remainingM == Nothing then
- (B.takeWhile (\ _ -> True) input, B.empty)
- else
- B.splitAt (fromIntegral $ fromJust remainingM) input
+readCurrentChunk ∷ HandleLike h
+ ⇒ Context h
+ → Interaction
+ → Lazy.ByteString
+ → Int
+ → Int
+ → IO ()
+readCurrentChunk ctx itr input wanted remaining
+ | remaining > 0
+ = do let bytesToRead = fromIntegral $ min wanted remaining
+ (chunk, input') = Lazy.splitAt bytesToRead input
+ actualReadBytes = fromIntegral $ Lazy.length chunk
+ newWanted = wanted - actualReadBytes
+ newRemaining = remaining - actualReadBytes
+ chunk' = S.fromList $ Lazy.toChunks chunk
+ updateStates = atomically $
+ do writeTVar (itrReqBodyWanted itr) newWanted
+ oldBody ← readTVar $ itrReceivedBody itr
+ oldBodyLen ← readTVar $ itrReceivedBodyLen itr
+ writeTVar (itrReceivedBody itr) $ oldBody ⋈ chunk'
+ writeTVar (itrReceivedBodyLen itr) $ oldBodyLen + actualReadBytes
+ if newRemaining ≡ 0 then
+ case LP.parse chunkFooterP input' of
+ LP.Done input'' _
+ → do updateStates
+ observeChunkedRequest ctx itr input'' 0
+ LP.Fail _ _ _
+ → chunkWasMalformed itr
+ else
+ do updateStates
+ observeChunkedRequest ctx itr input' newRemaining
+ | otherwise
+ = seekNextChunk ctx itr input