many changes...

[Lucu.git] / Network / HTTP / Lucu / RequestReader.hs

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index cfc991a1ef5a70f415daf08ac40f6f4a10d17134..9307c8dcba499b1a3adeeb920ba0fe6238c59b37 100644 (file)
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -1,8 +1,12 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnboxedTuples
+  , UnicodeSyntax
+  #-}

 module Network.HTTP.Lucu.RequestReader
     ( requestReader
     )
     where
 module Network.HTTP.Lucu.RequestReader
     ( requestReader
     )
     where

-

 import           Control.Concurrent.STM
 import           Control.Exception
 import           Control.Monad
 import           Control.Concurrent.STM
 import           Control.Exception
 import           Control.Monad


@@ -18,7 +22,6 @@ import           Network.HTTP.Lucu.Chunk
 import           Network.HTTP.Lucu.DefaultPage
 import           Network.HTTP.Lucu.HandleLike
 import           Network.HTTP.Lucu.Interaction
 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           Network.HTTP.Lucu.Postprocess
 import           Network.HTTP.Lucu.Preprocess
 import           Network.HTTP.Lucu.Request


@@ -27,7 +30,6 @@ import           Network.HTTP.Lucu.Resource.Tree
 import           Prelude hiding (catch)
 import           System.IO (stderr)
 
 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
 requestReader :: HandleLike h => Config -> ResTree -> [FallbackHandler] -> h -> PortNumber -> SockAddr -> InteractionQueue -> IO ()
 requestReader !cnf !tree !fbs !h !port !addr !tQueue
     = do input <- hGetLBS h


@@ -188,6 +190,7 @@ requestReader !cnf !tree !fbs !h !port !addr !tQueue
                                                       = do writeItr itr itrReqChunkRemaining newRemaining
                                                            writeItr itr itrReqBodyWanted newWanted
                                                            updateItr itr itrReceivedBody $ flip B.append chunk
                                                       = 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
                                                   -- チャンクフッタを讀む
 
                                               if newRemaining == Just 0 then
                                                   -- チャンクフッタを讀む


@@ -274,15 +277,15 @@ requestReader !cnf !tree !fbs !h !port !addr !tQueue
                                   let wanted          = fromJust wantedM
                                       bytesToRead     = fromIntegral $ maybe wanted (min wanted) remainingM
                                       (chunk, input') = B.splitAt bytesToRead input
                                   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 itr itrReqChunkRemaining newRemaining
                                   writeItr itr itrReqChunkIsOver isOver
                                   writeItr itr itrReqBodyWanted Nothing
                                   writeItr itr itrReceivedBody chunk

+                                  writeItr itrReceivedBody actualReadBytes

 
                                   if isOver then
                                       return $ acceptRequest input'
 
                                   if isOver then
                                       return $ acceptRequest input'