+{-# LANGUAGE
+ BangPatterns
+ , UnboxedTuples
+ , UnicodeSyntax
+ #-}
module Network.HTTP.Lucu.RequestReader
( requestReader
)
where
-
import Control.Concurrent.STM
import Control.Exception
import Control.Monad
import Network.HTTP.Lucu.DefaultPage
import Network.HTTP.Lucu.HandleLike
import Network.HTTP.Lucu.Interaction
-import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Postprocess
import Network.HTTP.Lucu.Preprocess
import Network.HTTP.Lucu.Request
import Prelude hiding (catch)
import System.IO (stderr)
-
requestReader :: HandleLike h => Config -> ResTree -> [FallbackHandler] -> h -> PortNumber -> SockAddr -> InteractionQueue -> IO ()
requestReader !cnf !tree !fbs !h !port !addr !tQueue
= do input <- hGetLBS h
= do writeItr itr itrReqChunkRemaining newRemaining
writeItr itr itrReqBodyWanted newWanted
updateItr itr itrReceivedBody $ flip B.append chunk
+ updateItr itrReceivedBodyLen (+ actualReadBytes) itr
if newRemaining == Just 0 then
-- チャンクフッタを讀む
let wanted = fromJust wantedM
bytesToRead = fromIntegral $ maybe wanted (min wanted) remainingM
(chunk, input') = B.splitAt bytesToRead input
- newRemaining = fmap
- (\ x -> x - (fromIntegral $ B.length chunk))
- remainingM
- isOver = B.length chunk < bytesToRead || newRemaining == Just 0
+ actualReadBytes = fromIntegral $ B.length chunk
+ newRemaining = (- actualReadBytes) <$> remainingM
+ isOver = actualReadBytes < bytesToRead ∨ newRemaining ≡ Just 0
writeItr itr itrReqChunkRemaining newRemaining
writeItr itr itrReqChunkIsOver isOver
writeItr itr itrReqBodyWanted Nothing
writeItr itr itrReceivedBody chunk
+ writeItr itrReceivedBody actualReadBytes
if isOver then
return $ acceptRequest input'