SSL Support

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

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index f6fa769cbadf04cc90d5eac6d3426f4de7835e51..7d0c57cd6a85228350160cf13a3c6b8cf08243e7 100644 (file)
--- 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