]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/RequestReader.hs
Reimplement MultipartForm
[Lucu.git] / Network / HTTP / Lucu / RequestReader.hs
index 5a4559e1948e29c6015ff831231b9751b91521a5..7f48c9b0f4774ff853286bda721420dceb2fc678 100644 (file)
@@ -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