lots of bugfixes regarding SSL support

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

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 5ef7acc296ed18f68736d4cc802ce6730ce4e70e..8830b5c010f8adf9d562207dfb1b43a33543a7d9 100644 (file)
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -21,7 +21,6 @@ import Data.List
 import Data.Maybe
 import Data.Monoid.Unicode
 import qualified Data.Sequence as S
-import Data.Sequence.Unicode hiding ((∅))
 import qualified Data.Text as T
 import Network.HTTP.Lucu.Abortion
 import Network.HTTP.Lucu.Config
@@ -33,6 +32,7 @@ import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Resource.Tree
+import Network.HTTP.Lucu.Utils
 import Network.Socket
 import Prelude.Unicode
 import System.IO (hPutStrLn, stderr)
@@ -88,18 +88,21 @@ requestReader cnf tree fbs h port addr tQueue
 
 acceptRequest ∷ HandleLike h ⇒ Context h → Lazy.ByteString → IO ()
 acceptRequest ctx@(Context {..}) input
-    -- キューに最大パイプライン深度以上のリクエストが溜まってゐる時は、
-    -- それが限度以下になるまで待つ。
     = do atomically $
              do queue ← readTVar cQueue
-                when (S.length queue ≥ cnfMaxPipelineDepth cConfig) $
+                when (S.length queue ≥ cnfMaxPipelineDepth cConfig)
+                    -- Too many requests in the pipeline...
                     retry
-         -- リクエストを讀む。パースできない場合は直ちに 400 Bad
-         -- Request 應答を設定し、それを出力してから切斷するやうに
-         -- ResponseWriter に通知する。
-         case LP.parse request input of
-           LP.Done input' req → acceptParsableRequest ctx req input'
-           LP.Fail _ _ _      → acceptNonparsableRequest ctx
+         if Lazy.null input then
+             endOfRequests ctx
+         else
+             case LP.parse request input of
+               LP.Done input' req → acceptParsableRequest ctx req input'
+               LP.Fail _ _ _      → acceptNonparsableRequest ctx
+
+endOfRequests ∷ HandleLike h ⇒ Context h → IO ()
+endOfRequests ctx
+    = enqueue ctx EndOfInteraction
 
 acceptNonparsableRequest ∷ HandleLike h ⇒ Context h → IO ()
 acceptNonparsableRequest ctx@(Context {..})