Avoid calling getSocketName after socketToHandle.

1 files changed, 11 insertions, 11 deletions

diff --git a/dht/Presence/XMPPServer.hs b/dht/Presence/XMPPServer.hs
index 272f6efe..3bafd33c 100644
--- a/dht/Presence/XMPPServer.hs
+++ b/dht/Presence/XMPPServer.hs
@@ -65,7 +65,7 @@ import Control.Monad.Trans (lift)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Fix (fix)
 import Control.Monad
-import Control.Concurrent.ThreadUtil (forkIO,myThreadId,forkLabeled,labelThread,ThreadId,MVar,putMVar,takeMVar,newMVar)
+import Control.Concurrent.ThreadUtil (forkIO,myThreadId,forkLabeled,labelThread,ThreadId,MVar,putMVar,takeMVar,newMVar,threadDelay)
 import Control.Concurrent.STM
 import Data.List hiding ((\\))
 -- import Control.Concurrent.STM.TChan
@@ -107,6 +107,7 @@ import Stanza.Parse
 import Stanza.Types
 import MUC
 import Chat
+import Network.StreamServer (Local(..), Remote(..))
 
 -- peerport :: PortNumber
 -- peerport = 5269
@@ -117,9 +118,6 @@ my_uuid :: Text
 my_uuid = "154ae29f-98f2-4af4-826d-a40c8a188574"
 
 
-newtype Local a = Local a deriving (Eq,Ord,Show)
-newtype Remote a = Remote a deriving (Eq,Ord,Show)
-
 data XMPPServerParameters =
     XMPPServerParameters
     { -- | Called when a client requests a resource id.  The first Maybe indicates
@@ -1090,13 +1088,15 @@ data PeerState
     | PeerConnected (TChan Stanza)
 -}
 
-peerKey :: SocketLike sock => Maybe SockAddr -> sock -> IO (PeerAddress,ConnectionData)
-peerKey bind_addr sock = do
+peerKey :: SocketLike sock => Maybe SockAddr -> (sock, (Local SockAddr, Remote SockAddr)) -> IO (PeerAddress,ConnectionData)
+peerKey bind_addr (sock,(laddr,Remote raddr)) = do
+    {-
     laddr <- getSocketName sock
     raddr <-
       isValidSocket sock >>= \(sock,c) ->
         if c then getPeerName sock -- addr is normally socketName
              else return laddr     -- Weird hack: addr is would-be peer name
+    -}
     -- Assume remote peers are listening on the same port that we do.
     let peerport = fromIntegral $ fromMaybe 5269 $ do
                         p <- bind_addr >>= sockAddrPort
@@ -1106,15 +1106,15 @@ peerKey bind_addr sock = do
     rname <- atomically $ newTVar Nothing
     -- dput XMan $ "peerKey " ++ show (PeerAddress $ raddr `withPort` peerport,laddr)
     return $ ( PeerAddress $ raddr `withPort` peerport
-             , ConnectionData { cdAddr       = Left (Local laddr)
+             , ConnectionData { cdAddr       = Left laddr
                               , cdType       = XMPP
                               , cdProfile    = "."
                               , cdRemoteName = rname } )
 
-clientKey :: SocketLike sock => sock -> IO (PeerAddress,ConnectionData)
-clientKey sock = do
-    laddr <- getSocketName sock -- [::1]:5222  bind address, same for all clients
-    raddr <- getPeerName sock   -- [::1]:????? unique key
+clientKey :: SocketLike sock => (sock, (Local SockAddr,Remote SockAddr)) -> IO (PeerAddress,ConnectionData)
+clientKey (sock,(laddr,Remote raddr)) = do
+    -- laddr <- getSocketName sock -- [::1]:5222  bind address, same for all clients
+    -- raddr <- getPeerName sock   -- [::1]:????? unique key
     when (Just 0 == sockAddrPort raddr) $ do
         dput XMan $ unwords [ "BUG: XMPP Client"
                             , show (laddr,raddr)