1 files changed, 13 insertions, 11 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 2e3c0a37..362cc8a8 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -49,7 +49,7 @@ import Control.Monad
 import Control.Concurrent (forkIO)
 import Control.Concurrent.STM
 -- import Control.Concurrent.STM.TChan
-import Network.Socket
+import Network.SocketLike
 import Text.Printf
 import System.Posix.Signals
 import Data.ByteString (ByteString)
@@ -873,7 +873,7 @@ makePong namespace mid to from =
        ]
 
 
-xmppInbound :: Server ConnectionKey SockAddr
+xmppInbound :: Server ConnectionKey SockAddr ReleaseKey
                 -> XMPPServerParameters
                 -> ConnectionKey
                 -> SockAddr
@@ -1175,7 +1175,7 @@ presenceStanza stanza_type type_attr me jid =
                 ]
         , EventEndElement "{jabber:server}presence" ]
 
-forkConnection :: Server ConnectionKey SockAddr
+forkConnection :: Server ConnectionKey SockAddr ReleaseKey
                 -> XMPPServerParameters
                 -> ConnectionKey
                 -> SockAddr
@@ -1355,8 +1355,9 @@ data PeerState
     | PeerConnected (TChan Stanza)
 -}
 
-peerKey :: (Socket,SockAddr) -> IO (ConnectionKey,SockAddr)
-peerKey (sock,addr) = do
+peerKey :: SocketLike sock => sock -> IO (ConnectionKey,SockAddr)
+peerKey sock = do
+    addr <- getSocketName sock
     peer <- 
       sIsConnected sock >>= \c -> 
         if c then getPeerName sock -- addr is normally socketName
@@ -1364,8 +1365,9 @@ peerKey (sock,addr) = do
     laddr <- getSocketName sock
     return $ (PeerKey (peer `withPort` fromIntegral peerport),laddr)
 
-clientKey :: (Socket,SockAddr) -> IO (ConnectionKey,SockAddr)
-clientKey (sock,addr) = do
+clientKey :: SocketLike sock => sock -> IO (ConnectionKey,SockAddr)
+clientKey sock = do
+    addr <- getSocketName sock
     paddr <- getPeerName sock
     return $ (ClientKey addr,paddr)
 
@@ -1435,7 +1437,7 @@ sendRoster query xmpp replyto = do
     -}
 
 
-socketFromKey :: Server ConnectionKey SockAddr -> ConnectionKey -> IO SockAddr
+socketFromKey :: Server ConnectionKey SockAddr ReleaseKey -> ConnectionKey -> IO SockAddr
 socketFromKey sv k = do
     map <- atomically $ readTVar (conmap sv)
     let mcd = Map.lookup k map
@@ -1605,7 +1607,7 @@ makeErrorStanza stanza = do
            ]
 
 monitor ::
-    Server ConnectionKey SockAddr
+    Server ConnectionKey SockAddr ReleaseKey
     -> ConnectionParameters ConnectionKey SockAddr
     -> XMPPServerParameters
     -> IO b
@@ -1773,7 +1775,7 @@ monitor sv params xmpp = do
             _ = str :: String
 
 data XMPPServer
-    = XMPPServer { _xmpp_sv :: Server ConnectionKey SockAddr
+    = XMPPServer { _xmpp_sv :: Server ConnectionKey SockAddr ReleaseKey
                  , _xmpp_peer_params :: ConnectionParameters ConnectionKey SockAddr
                  }
 
@@ -1785,7 +1787,7 @@ xmppServer :: ( MonadResource m
               , MonadIO m
               ) => XMPPServerParameters -> m XMPPServer
 xmppServer xmpp = do
-    sv <- server
+    sv <- server allocate
     -- some fuzz helps avoid simultaneity
     pingfuzz <- liftIO $ do
         gen <- System.Random.getStdGen