X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=49317a99ea8343270f222b7061c8bdd8c00cb322;hp=fbc8551bac76a4f2a273ad323525a24613eb2031;hb=ea2b7838f1b3d9d4923a220a601be2e04cc559d7;hpb=17020e406a20cbef8ec17594868db559c4c5a5db

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index fbc8551..49317a9 100644
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -185,16 +185,14 @@ observeChunkedRequest ctx itr input remaining
          if isOver then
              return $ acceptRequest ctx input
          else
-             do wantedM ← readTVar $ itrReqBodyWanted itr
-                case wantedM of
-                  Nothing
-                      → do wasteAll ← readTVar $ itrReqBodyWasteAll itr
-                           if wasteAll then
-                               return $ wasteCurrentChunk ctx itr input remaining
-                           else
-                               retry
-                  Just wanted
-                      → return $ readCurrentChunk ctx itr input wanted remaining
+             do wanted ← readTVar $ itrReqBodyWanted itr
+                case wanted of
+                  0 → do wasteAll ← readTVar $ itrReqBodyWasteAll itr
+                         if wasteAll then
+                             return $ wasteCurrentChunk ctx itr input remaining
+                         else
+                             retry
+                  _ → return $ readCurrentChunk ctx itr input wanted remaining
 
 wasteCurrentChunk ∷ HandleLike h
                   ⇒ Context h
@@ -226,9 +224,7 @@ readCurrentChunk ctx itr input wanted remaining
         = do let bytesToRead     = fromIntegral $ min wanted remaining
                  (chunk, input') = Lazy.splitAt bytesToRead input
                  actualReadBytes = fromIntegral $ Lazy.length chunk
-                 newWanted       = case wanted - actualReadBytes of
-                                     0 → Nothing
-                                     n → Just n
+                 newWanted       = wanted - actualReadBytes
                  newRemaining    = remaining - actualReadBytes
                  chunk'          = S.fromList $ Lazy.toChunks chunk
                  updateStates    = atomically $
@@ -289,16 +285,14 @@ observeNonChunkedRequest ∷ HandleLike h
 observeNonChunkedRequest ctx itr input remaining
     = join $
       atomically $
-      do wantedM ← readTVar $ itrReqBodyWanted itr
-         case wantedM of
-           Nothing
-               → do wasteAll ← readTVar $ itrReqBodyWasteAll itr
-                    if wasteAll then
-                        return $ wasteNonChunkedRequestBody ctx itr input remaining
-                    else
-                        retry
-           Just wanted
-               → return $ readNonChunkedRequestBody ctx itr input wanted remaining
+      do wanted ← readTVar $ itrReqBodyWanted itr
+         case wanted of
+           0 → do wasteAll ← readTVar $ itrReqBodyWasteAll itr
+                  if wasteAll then
+                      return $ wasteNonChunkedRequestBody ctx itr input remaining
+                  else
+                      retry
+           _ → return $ readNonChunkedRequestBody ctx itr input wanted remaining
 
 wasteNonChunkedRequestBody ∷ HandleLike h
                            ⇒ Context h
@@ -322,12 +316,13 @@ readNonChunkedRequestBody ctx itr input wanted remaining
     = do let bytesToRead     = min wanted remaining
              (chunk, input') = Lazy.splitAt (fromIntegral bytesToRead) input
              actualReadBytes = fromIntegral $ Lazy.length chunk
+             newWanted       = wanted - actualReadBytes
              newRemaining    = remaining - actualReadBytes
              isOver          = actualReadBytes < bytesToRead ∨ newRemaining ≡ 0
              chunk'          = S.fromList $ Lazy.toChunks chunk
          atomically $
              do writeTVar (itrReqChunkIsOver  itr) isOver
-                writeTVar (itrReqBodyWanted   itr) Nothing
+                writeTVar (itrReqBodyWanted   itr) newWanted
                 writeTVar (itrReceivedBody    itr) chunk'
                 writeTVar (itrReceivedBodyLen itr) actualReadBytes
          if isOver then