Code cleanup (preparation for ditz/lucu-1)

Ignore-this: 9b0edd70726ed97ba72b9cca637f575f

darcs-hash:20100303082051-62b54-fc2e901fab9b9a2a7fd424c3b888d847bc23d8c3.gz

diff --git a/Lucu.cabal b/Lucu.cabal
index d2db94e67422efc6aecc6bd07aa07389806ecf8a..891efa249095bf5f3c451492c107acfced6c108d 100644 (file)
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@ -81,9 +81,12 @@ Library
         Network.HTTP.Lucu.Preprocess
         Network.HTTP.Lucu.RequestReader
         Network.HTTP.Lucu.ResponseWriter
+        Network.HTTP.Lucu.SocketLike
 
     Extensions:
-        BangPatterns, DeriveDataTypeable, ScopedTypeVariables, UnboxedTuples
+        BangPatterns, DeriveDataTypeable, FlexibleContexts,
+        FlexibleInstances, ScopedTypeVariables, TypeFamilies,
+        UnboxedTuples
 
     ghc-options:
         -Wall

diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs
index c5f3f3eb7edd4764283fcd888f9de3627209034a..d2b0f60eea84a8adf33946df02163285f54e1e53 100644 (file)
--- a/Network/HTTP/Lucu/Config.hs
+++ b/Network/HTTP/Lucu/Config.hs
@@ -18,35 +18,44 @@ import           System.IO.Unsafe
 -- |Configuration record for the Lucu httpd. You need to use
 -- 'defaultConfig' or setup your own configuration to run the httpd.
 data Config = Config {
+
     -- |A string which will be sent to clients as \"Server\" field.
       cnfServerSoftware :: !Strict.ByteString
+
     -- |The host name of the server. This value will be used in
     -- built-in pages like \"404 Not Found\".
     , cnfServerHost :: !Strict.ByteString
+
     -- |A port ID to listen to HTTP clients.
     , cnfServerPort :: !PortID
+
     -- |Configuration for HTTPS connections. Set this 'Nothing' to
     -- disable HTTPS.
     , cnfSSLConfig :: !(Maybe SSLConfig)
+
     -- |The maximum number of requests to accept in one connection
     -- simultaneously. If a client exceeds this limitation, its last
     -- request won't be processed until a response for its earliest
     -- pending request is sent back to the client.
     , cnfMaxPipelineDepth :: !Int
+
     -- |The maximum length of request entity to accept in bytes. Note
     -- that this is nothing but the default value which is used when
     -- 'Network.HTTP.Lucu.Resource.input' and such like are applied to
     -- 'Network.HTTP.Lucu.Resource.defaultLimit', so there is no
     -- guarantee that this value always constrains all the requests.
     , cnfMaxEntityLength :: !Int
+
     -- |The maximum length of chunk to output. This value is used by
     -- 'Network.HTTP.Lucu.Resource.output' and such like to limit the
     -- chunk length so you can safely output an infinite string (like
     -- a lazy stream of \/dev\/random) using those actions.
     , cnfMaxOutputChunkLength :: !Int
+
     -- | Whether to dump too late abortion to the stderr or not. See
     -- 'Network.HTTP.Lucu.Abortion.abort'.
     , cnfDumpTooLateAbortionToStderr :: !Bool
+
     -- |A mapping from extension to MIME Type. This value is used by
     -- 'Network.HTTP.Lucu.StaticFile.staticFile' to guess the MIME
     -- Type of static files. Note that MIME Types are currently

diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs
index bab8d72ff5639362d1aee310ef7e189c5fc4bf84..1d0f2b8a5c626d3aa8175c7d07927b88fdeff1cc 100644 (file)
--- a/Network/HTTP/Lucu/Httpd.hs
+++ b/Network/HTTP/Lucu/Httpd.hs
@@ -6,15 +6,13 @@ module Network.HTTP.Lucu.Httpd
     where
 
 import           Control.Concurrent
-import           Network
-import qualified Network.Socket as So
+import           Network hiding (accept)
 import           Network.HTTP.Lucu.Config
 import           Network.HTTP.Lucu.Interaction
 import           Network.HTTP.Lucu.RequestReader
 import           Network.HTTP.Lucu.Resource.Tree
 import           Network.HTTP.Lucu.ResponseWriter
-import qualified OpenSSL.Session as SSL
-import           System.IO
+import           Network.HTTP.Lucu.SocketLike
 import           System.Posix.Signals
 
 -- |This is the entry point of Lucu httpd. It listens to a socket and
@@ -60,36 +58,15 @@ runHttpd cnf tree fbs
                -> return ()
            Just scnf
                -> do so       <- listenOn (sslServerPort scnf)
-                     _loopTID <- forkIO $ httpsLoop (sslContext scnf) so
+                     _loopTID <- forkIO $ httpLoop (sslContext scnf, so)
                      return ()
          
          httpLoop =<< listenOn (cnfServerPort cnf)
     where
-      httpLoop :: Socket -> IO ()
+      httpLoop :: SocketLike s => s -> IO ()
       httpLoop so
-          = do (h, addr)  <- acceptHTTP so
+          = do (h, addr)  <- accept so
                tQueue     <- newInteractionQueue
                readerTID  <- forkIO $ requestReader cnf tree fbs h addr tQueue
                _writerTID <- forkIO $ responseWriter cnf h tQueue readerTID
                httpLoop so
-
-      httpsLoop :: SSL.SSLContext -> Socket -> IO ()
-      httpsLoop ctx so
-          = do (ssl, addr) <- acceptHTTPS ctx so
-               tQueue      <- newInteractionQueue
-               readerTID   <- forkIO $ requestReader cnf tree fbs ssl addr tQueue
-               _writerTID  <- forkIO $ responseWriter cnf ssl tQueue readerTID
-               httpsLoop ctx so
-
-      acceptHTTP :: Socket -> IO (Handle, So.SockAddr)
-      acceptHTTP soSelf
-          = do (soPeer, addr) <- So.accept soSelf
-               hPeer          <- So.socketToHandle soPeer ReadWriteMode
-               return (hPeer, addr)
-
-      acceptHTTPS :: SSL.SSLContext -> Socket -> IO (SSL.SSL, So.SockAddr)
-      acceptHTTPS ctx so
-          = do (so', addr) <- So.accept so
-               ssl         <- SSL.connection ctx so'
-               SSL.accept ssl
-               return (ssl, addr)

diff --git a/Network/HTTP/Lucu/SocketLike.hs b/Network/HTTP/Lucu/SocketLike.hs
new file mode 100644 (file)
index 0000000..f64e24b
--- /dev/null
+++ b/Network/HTTP/Lucu/SocketLike.hs
@@ -0,0 +1,31 @@
+module Network.HTTP.Lucu.SocketLike
+    ( SocketLike(..)
+    )
+    where
+
+import qualified Network.Socket as So
+import           Network.HTTP.Lucu.HandleLike
+import qualified OpenSSL.Session as SSL
+import qualified System.IO as I
+
+
+class (HandleLike (Handle s)) => SocketLike s where
+    type Handle s :: *
+    accept :: s -> IO (Handle s, So.SockAddr)
+
+
+instance SocketLike So.Socket where
+    type Handle So.Socket = I.Handle
+    accept soSelf
+        = do (soPeer, addr) <- So.accept soSelf
+             hPeer          <- So.socketToHandle soPeer I.ReadWriteMode
+             return (hPeer, addr)
+
+
+instance SocketLike (SSL.SSLContext, So.Socket) where
+    type Handle (SSL.SSLContext, So.Socket) = SSL.SSL
+    accept (ctx, soSelf)
+        = do (soPeer, addr) <- So.accept soSelf
+             ssl            <- SSL.connection ctx soPeer
+             SSL.accept ssl
+             return (ssl, addr)