X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=7d0c57cd6a85228350160cf13a3c6b8cf08243e7;hp=f6fa769cbadf04cc90d5eac6d3426f4de7835e51;hb=73b5fba4907604681d778d3bd54cd65fd84b4454;hpb=c179f51aa7b15764807141c175f9fe8797424991 diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs index f6fa769..7d0c57c 100644 --- a/Network/HTTP/Lucu/RequestReader.hs +++ b/Network/HTTP/Lucu/RequestReader.hs @@ -16,6 +16,7 @@ import Network.Socket import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.Chunk 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 @@ -24,12 +25,12 @@ import Network.HTTP.Lucu.Request import Network.HTTP.Lucu.Response import Network.HTTP.Lucu.Resource.Tree import Prelude hiding (catch) -import System.IO +import System.IO (stderr) -requestReader :: Config -> ResTree -> [FallbackHandler] -> Handle -> SockAddr -> InteractionQueue -> IO () +requestReader :: HandleLike h => Config -> ResTree -> [FallbackHandler] -> h -> SockAddr -> InteractionQueue -> IO () requestReader !cnf !tree !fbs !h !addr !tQueue - = do input <- B.hGetContents h + = do input <- hGetLBS h acceptRequest input `catches` [ Handler (( \ _ -> return () ) :: IOException -> IO ()) @@ -58,7 +59,7 @@ requestReader !cnf !tree !fbs !h !addr !tQueue acceptNonparsableRequest :: StatusCode -> IO () acceptNonparsableRequest status = {-# SCC "acceptNonparsableRequest" #-} - do itr <- newInteraction cnf addr Nothing + do itr <- newInteraction cnf addr Nothing Nothing atomically $ do updateItr itr itrResponse $ \ res -> res { resStatus = status @@ -72,7 +73,8 @@ requestReader !cnf !tree !fbs !h !addr !tQueue acceptParsableRequest :: Request -> ByteString -> IO () acceptParsableRequest req input = {-# SCC "acceptParsableRequest" #-} - do itr <- newInteraction cnf addr (Just req) + do cert <- hGetPeerCert h + itr <- newInteraction cnf addr cert (Just req) action <- atomically $ do preprocess itr