Code clean-up (and close ditz/lucu-1)

Ignore-this: 62467b5a26cdb109e1dc244adb0d1547

darcs-hash:20100303164940-62b54-079229fe102c0f0d2456679115713ca0bc032c77.gz

diff --git a/Lucu.cabal b/Lucu.cabal
index 891efa249095bf5f3c451492c107acfced6c108d..39fa14b6da7e148ff7687aca9e34393600670843 100644 (file)
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@ -16,7 +16,7 @@ Maintainer: PHO <pho at cielonegro dot org>
 Stability: experimental
 Homepage: http://cielonegro.org/Lucu.html
 Category: Network
 Stability: experimental
 Homepage: http://cielonegro.org/Lucu.html
 Category: Network

-Tested-With: GHC == 6.10.1
+Tested-With: GHC == 6.12.1

 Cabal-Version: >= 1.6
 Build-Type: Simple
 Extra-Source-Files:
 Cabal-Version: >= 1.6
 Build-Type: Simple
 Extra-Source-Files:

diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs
index d9f28f110e5f1c668a3fc9f539b9f2c4981e3959..0bb92b1635c74a1498b1ee2936f807d6153d356d 100644 (file)
--- a/Network/HTTP/Lucu/Httpd.hs
+++ b/Network/HTTP/Lucu/Httpd.hs
@@ -8,6 +8,7 @@ module Network.HTTP.Lucu.Httpd
 import           Control.Concurrent
 import           Control.Exception
 import           Control.Monad
 import           Control.Concurrent
 import           Control.Exception
 import           Control.Monad

+import           Data.Maybe

 import           Network.BSD
 import           Network.Socket
 import           Network.HTTP.Lucu.Config
 import           Network.BSD
 import           Network.Socket
 import           Network.HTTP.Lucu.Config


@@ -56,55 +57,37 @@ runHttpd cnf tree fbs
     = withSocketsDo $
       do _ <- installHandler sigPIPE Ignore Nothing
 
     = withSocketsDo $
       do _ <- installHandler sigPIPE Ignore Nothing
 

-         -- FIXME: TERRIBLE CODE. NEED MAJOR REWRITE.
-         case cnfSSLConfig cnf of
-           Nothing
-               -> return ()
-           Just scnf
-               -> do case cnfServerV4Addr cnf of
-                       Nothing
-                           -> return ()
-                       Just v4addr
-                           -> do so <- listenOn AF_INET v4addr (sslServerPort scnf)
-                                 p  <- socketPort so
-                                 -- FIXME: Don't throw away the thread
-                                 -- ID as we can't kill it later
-                                 -- then. [1]
-                                 _  <- forkIO $ httpLoop p (sslContext scnf, so)
-                                 return ()
-
-                     case cnfServerV6Addr cnf of
-                       Nothing
-                           -> return ()
-                       Just v6addr
-                           -> do so <- listenOn AF_INET6 v6addr (sslServerPort scnf)
-                                 p  <- socketPort so
-                                 -- FIXME: [1]
-                                 _  <- forkIO $ httpLoop p (sslContext scnf, so)
-                                 return ()
-         
-         case cnfServerV4Addr cnf of
-           Nothing
-               -> return ()
-           Just v4addr
-               -> do so <- listenOn AF_INET v4addr (cnfServerPort cnf)
-                     p  <- socketPort so
-                     -- FIXME: [1]
-                     _  <- forkIO $ httpLoop p so
-                     return ()
-
-         case cnfServerV6Addr cnf of
-           Nothing
-               -> return ()
-           Just v6addr
-               -> do so <- listenOn AF_INET6 v6addr (cnfServerPort cnf)
-                     p  <- socketPort so
-                     -- FIXME: [1]
-                     _  <- forkIO $ httpLoop p so
-                     return ()
+         let launchers
+                 = catMaybes
+                   [ do scnf <- cnfSSLConfig    cnf
+                        addr <- cnfServerV4Addr cnf
+                        return ( do so <- listenOn AF_INET addr (sslServerPort scnf)
+                                    launchListener (sslContext scnf, so)
+                               )
+                   , do scnf <- cnfSSLConfig    cnf
+                        addr <- cnfServerV6Addr cnf
+                        return ( do so <- listenOn AF_INET6 addr (sslServerPort scnf)
+                                    launchListener (sslContext scnf, so)
+                               )
+                   , do addr <- cnfServerV4Addr cnf
+                        return ( launchListener =<< listenOn AF_INET addr (cnfServerPort cnf)
+                               )
+                   , do addr <- cnfServerV6Addr cnf
+                        return ( launchListener =<< listenOn AF_INET6 addr (cnfServerPort cnf)
+                               )
+                   ]

 
 

+         sequence_ launchers

          waitForever
     where
          waitForever
     where

+      launchListener :: SocketLike s => s -> IO ()
+      launchListener so
+          = do p <- SL.socketPort so
+               -- FIXME: Don't throw away the thread ID as we can't
+               -- kill it later then. [1]
+               _ <- forkIO $ httpLoop p so
+               return ()
+

       listenOn :: Family -> HostName -> ServiceName -> IO Socket
       listenOn fam host srv
           = do proto <- getProtocolNumber "tcp"
       listenOn :: Family -> HostName -> ServiceName -> IO Socket
       listenOn fam host srv
           = do proto <- getProtocolNumber "tcp"

diff --git a/Network/HTTP/Lucu/SocketLike.hs b/Network/HTTP/Lucu/SocketLike.hs
index f64e24bcad680f86d4ec3067f4f9d583558fcd68..b99811f3bba095f5fc6a586f7b5a00bb2750c23d 100644 (file)
--- a/Network/HTTP/Lucu/SocketLike.hs
+++ b/Network/HTTP/Lucu/SocketLike.hs
@@ -11,21 +11,28 @@ import qualified System.IO as I
 
 class (HandleLike (Handle s)) => SocketLike s where
     type Handle s :: *
 
 class (HandleLike (Handle s)) => SocketLike s where
     type Handle s :: *

-    accept :: s -> IO (Handle s, So.SockAddr)
+    accept        :: s -> IO (Handle s, So.SockAddr)
+    socketPort    :: s -> IO So.PortNumber

 
 
 instance SocketLike So.Socket where
     type Handle So.Socket = I.Handle
 
 
 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)
 
     accept soSelf
         = do (soPeer, addr) <- So.accept soSelf
              hPeer          <- So.socketToHandle soPeer I.ReadWriteMode
              return (hPeer, addr)
 

+    socketPort = So.socketPort
+

 
 instance SocketLike (SSL.SSLContext, So.Socket) where
     type Handle (SSL.SSLContext, So.Socket) = SSL.SSL
 
 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)
     accept (ctx, soSelf)
         = do (soPeer, addr) <- So.accept soSelf
              ssl            <- SSL.connection ctx soPeer
              SSL.accept ssl
              return (ssl, addr)

+
+    socketPort = So.socketPort . snd
\ No newline at end of file

diff --git a/bugs/issue-d2a0818803927d05bfdd5c0d4b074d042589edc1.yaml b/bugs/issue-d2a0818803927d05bfdd5c0d4b074d042589edc1.yaml
index dce7ca1c3e1ddba913576731ec63e2e6e309a4be..7ead2e00ec5ba4f4bf860bcc0ae6460280863b7d 100644 (file)
--- a/bugs/issue-d2a0818803927d05bfdd5c0d4b074d042589edc1.yaml
+++ b/bugs/issue-d2a0818803927d05bfdd5c0d4b074d042589edc1.yaml
@@ -10,10 +10,10 @@ desc: |-
   Thanks
 type: :feature
 component: Lucu
   Thanks
 type: :feature
 component: Lucu

-release: 0.4.3
+release: "0.5"

 reporter: PHO <pho@cielonegro.org>
 reporter: PHO <pho@cielonegro.org>

-status: :unstarted
-disposition: 
+status: :closed
+disposition: :fixed

 creation_time: 2010-03-02 12:09:26.521388 Z
 references: []
 
 creation_time: 2010-03-02 12:09:26.521388 Z
 references: []
 


@@ -27,3 +27,15 @@ log_events:
   - PHO <pho@cielonegro.org>
   - assigned to release 0.4.3 from unassigned
   - ""
   - PHO <pho@cielonegro.org>
   - assigned to release 0.4.3 from unassigned
   - ""

+- - 2010-03-03 16:43:24.865175 Z
+  - PHO <pho@cielonegro.org>
+  - unassigned from release 0.4.3
+  - This change should bump version to 0.5
+- - 2010-03-03 16:46:04.795565 Z
+  - PHO <pho@cielonegro.org>
+  - assigned to release 0.5 from unassigned
+  - ""
+- - 2010-03-03 16:47:55.250708 Z
+  - PHO <pho@cielonegro.org>
+  - closed with disposition fixed
+  - Seems working now.

diff --git a/bugs/project.yaml b/bugs/project.yaml
index f9e955787515638812da2dd490ed0e96b001886f..d0978a622c22653651f3519ca2e8b56ce5344248 100644 (file)
--- a/bugs/project.yaml
+++ b/bugs/project.yaml
@@ -6,11 +6,11 @@ components:
   name: Lucu
 releases: 
 - !ditz.rubyforge.org,2008-03-06/release 
   name: Lucu
 releases: 
 - !ditz.rubyforge.org,2008-03-06/release 

-  name: 0.4.3
+  name: "0.5"

   status: :unreleased
   release_time: 
   log_events: 
   status: :unreleased
   release_time: 
   log_events: 

-  - - 2010-03-02 12:12:26.585821 Z
+  - - 2010-03-03 16:45:31.176635 Z

     - PHO <pho@cielonegro.org>
     - created
     - ""
     - PHO <pho@cielonegro.org>
     - created
     - ""

diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs
index 71916f3203bf0e3bdf8a30073a74376a92550d9a..dacd4c363604b4694430c6dcf68e91e0ea91d7b9 100644 (file)
--- a/examples/HelloWorld.hs
+++ b/examples/HelloWorld.hs
@@ -29,6 +29,8 @@ helloWorld
                       setContentType $ read "text/hello"
                       outputChunk "Hello, "
                       outputChunk "World!\n"
                       setContentType $ read "text/hello"
                       outputChunk "Hello, "
                       outputChunk "World!\n"

+                      outputChunk =<< getRemoteAddr'
+                      

       , resPost
           = Just $ do str1 <- inputChunk 3
                       str2 <- inputChunk 3
       , resPost
           = Just $ do str1 <- inputChunk 3
                       str2 <- inputChunk 3