-import Prelude hiding (catch)
-import System.IO
-
-
-requestReader :: Config -> ResTree -> [FallbackHandler] -> Handle -> SockAddr -> InteractionQueue -> IO ()
-requestReader cnf tree fbs h addr tQueue
- = cnf `seq` tree `seq` fbs `seq` h `seq` addr `seq` tQueue `seq`
- do catch (do input <- B.hGetContents h
- acceptRequest input) $ \ exc ->
- case exc of
- IOException _ -> return ()
- AsyncException ThreadKilled -> return ()
- BlockedIndefinitely -> putStrLn "requestReader: blocked indefinitely"
- _ -> print exc
- where
- acceptRequest :: ByteString -> IO ()
- acceptRequest input
- -- キューに最大パイプライン深度以上のリクエストが溜まってゐる
- -- 時は、それが限度以下になるまで待つ。
- = {-# SCC "acceptRequest" #-}
- do atomically $ do queue <- readTVar tQueue
- when (S.length queue >= cnfMaxPipelineDepth cnf)
- retry
-
- -- リクエストを讀む。パースできない場合は直ちに 400 Bad
- -- Request 應答を設定し、それを出力してから切斷するやう
- -- に ResponseWriter に通知する。
- case parse requestP input of
- (# Success req , input' #) -> acceptParsableRequest req input'
- (# IllegalInput, _ #) -> acceptNonparsableRequest BadRequest
- (# ReachedEOF , _ #) -> acceptNonparsableRequest BadRequest