Converted to SocketLike and quitListening interfaces.

Paving the way for conversion to conduits-based server over HaXml.

6 files changed, 25 insertions, 11 deletions

diff --git a/Presence/LocalPeerCred.hs b/Presence/LocalPeerCred.hs
index ee1a4a0f..d3b8d189 100644
--- a/Presence/LocalPeerCred.hs
+++ b/Presence/LocalPeerCred.hs
@@ -14,9 +14,9 @@ import System.IO ( withFile, IOMode(..))
 import Data.Maybe
 import Data.Binary
 import Data.Bits
-import Network.Socket
 import System.Posix.Types
 import Debug.Trace
+import SocketLike
 
 xs     ?? n | n < 0 =  Nothing
 []     ?? _         =  Nothing
diff --git a/Presence/Server.hs b/Presence/Server.hs
index 55a8b57b..80a6e4ba 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -35,6 +35,11 @@ newtype ConnectionFinalizer = ConnectionFinalizer (IO ())
 
 getPacket h = do { hWaitForInput h (-1) ; fmap (fromChunks . (:[])) $ hGetNonBlocking h 1024 }
 
+newtype ServerHandle = ServerHandle Socket
+
+quitListening :: ServerHandle -> IO ()
+quitListening (ServerHandle socket) = sClose socket
+
 doServer addrfamily port g startCon = do
     doServer' addrfamily port g startCon
 
@@ -68,7 +73,7 @@ doServer' family port g startCon = runServer2 port (runConn2 g)
         forkIO $ do
             mainLoop sock (ConnId 0) go
             -- L.putStrLn $ "quit accept loop"
-        return sock
+        return (ServerHandle sock)
      where
         mainLoop sock idnum@(ConnId n) go = do
             let doException ioerror = do
diff --git a/Presence/ServerC.hs b/Presence/ServerC.hs
index 881ce5d2..3933c812 100644
--- a/Presence/ServerC.hs
+++ b/Presence/ServerC.hs
@@ -5,6 +5,8 @@
 module ServerC
     ( doServer
     , ConnId(..)
+    , ServerHandle
+    , quitListening
     ) where
 
 import Network.Socket as Socket
@@ -46,6 +48,11 @@ import SocketLike
 newtype ConnId = ConnId Int
   deriving Eq
 
+newtype ServerHandle = ServerHandle Socket
+
+quitListening :: ServerHandle -> IO ()
+quitListening (ServerHandle socket) = sClose socket
+
 
 data AcceptResult =
   GotConnection (Socket,SockAddr)
@@ -59,7 +66,7 @@ doServer ::
         -> Source m S.ByteString 
         -> Sink S.ByteString m ()
         -> IO ())
-    -> IO Socket
+    -> IO ServerHandle
 doServer (HCons family port) g = runServer port (runConn g)
  where
     runServer (HCons port st) go = do
@@ -72,7 +79,7 @@ doServer (HCons family port) g = runServer port (runConn g)
         forkIO $ do
             mainLoop sock (ConnId 0) go
             -- L.putStrLn $ "quit accept loop"
-        return sock
+        return (ServerHandle sock)
      where
         mainLoop sock idnum@(ConnId n) go = do
             let doException ioerror = do
diff --git a/Presence/SocketLike.hs b/Presence/SocketLike.hs
index 12fa07a3..d2ff84f6 100644
--- a/Presence/SocketLike.hs
+++ b/Presence/SocketLike.hs
@@ -8,7 +8,7 @@ module SocketLike
     , RestrictedSocket
     , restrictSocket
     , PortNumber
-    , SockAddr
+    , SockAddr(..)
     , CUInt
     ) where
 
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 7ed16f6b..e8ab5490 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -4,7 +4,10 @@
 {-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE TypeFamilies        #-}
 -- {-# LANGUAGE GADTs               #-}
-module XMPPServer where -- ( listenForXmppClients ) where
+module XMPPServer 
+    ( module XMPPServer
+    , quitListening 
+    )  where
 
 import Data.Char (isSpace)
 import Data.HList.TypeEqGeneric1()
diff --git a/Presence/main.hs b/Presence/main.hs
index 74589a41..a0a80569 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -27,7 +27,6 @@ import UTmp
 import FGConsole
 import XMPPServer
 import Data.HList
-import Network.Socket (sClose)
 import Control.Exception
 import LocalPeerCred
 import System.Posix.User
@@ -223,16 +222,16 @@ start ip4or6 = do
             utmp_file
             dologin
 #endif
-    sockLocals <- listenForXmppClients ip4or6 (UnixSessions tracked) 5222 HNil
-    sockRemotes <- listenForRemotePeers ip4or6 (UnixSessions tracked) 5269 HNil
+    clients <- listenForXmppClients ip4or6 (UnixSessions tracked) 5222 HNil
+    peers   <- listenForRemotePeers ip4or6 (UnixSessions tracked) 5269 HNil
 
     threadDelay 1000 -- wait a moment to obtain current tty
     dologin ()
     putStrLn "\nHit enter to terminate...\n"
     getLine
     killThread remotes
-    sClose sockLocals
-    sClose sockRemotes
+    quitListening clients
+    quitListening peers
     -- threadDelay 1000
     putStrLn "closed listener."
     unmonitorTTY mtty