X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=7f48c9b0f4774ff853286bda721420dceb2fc678;hp=5a4559e1948e29c6015ff831231b9751b91521a5;hb=a362be1c8664306b970c32e1df9b62081498feb1;hpb=45e3770f440c9fa8668f7e33063d630d73bcbe55 diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs index 5a4559e..7f48c9b 100644 --- a/Network/HTTP/Lucu/RequestReader.hs +++ b/Network/HTTP/Lucu/RequestReader.hs @@ -17,7 +17,7 @@ import qualified Data.Attoparsec.Lazy as LP 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 ((∅)) @@ -96,7 +96,7 @@ acceptRequest ctx@(Context {..}) input -- リクエストを讀む。パースできない場合は直ちに 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 @@ -157,7 +157,7 @@ waitForReceiveBodyReq ∷ HandleLike h → 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 @@ -207,13 +207,13 @@ wasteAllChunks ctx rsrcTid = go 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 @@ -221,21 +221,21 @@ wasteAllChunks ctx rsrcTid = go 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 @@ -249,7 +249,7 @@ readCurrentChunk ctx ni@(NI {..}) rsrcTid wanted = go 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' @@ -257,7 +257,7 @@ readCurrentChunk ctx ni@(NI {..}) rsrcTid wanted = go → gotChunk input' chunkLen LP.Fail _ eCtx e → chunkWasMalformed rsrcTid eCtx e - "readCurrentChunk: chunkHeaderP" + "readCurrentChunk: chunkHeader" go input (InChunk chunkLen) = gotChunk input chunkLen @@ -270,24 +270,24 @@ readCurrentChunk ctx ni@(NI {..}) rsrcTid wanted = go 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