5 files changed, 32 insertions, 17 deletions

diff --git a/dht/Presence/LocalPeerCred.hs b/dht/Presence/LocalPeerCred.hs
index f68557e8..a7344434 100644
--- a/dht/Presence/LocalPeerCred.hs
+++ b/dht/Presence/LocalPeerCred.hs
@@ -62,6 +62,7 @@ getLocalPeerCred' (unmap6mapped4 -> addr@(SockAddrUnix _)) =
     -- see also: Network.Socket.getPeerCred
     return Nothing
 
+{- // Removed due to no call-sites
 getLocalPeerCred :: SocketLike sock => sock -> IO (Maybe UserID)
 getLocalPeerCred sock = do
     addr <- getPeerName sock
@@ -72,6 +73,7 @@ getLocalPeerCred sock = do
                      where sndOf3 (pid,uid,gid) = uid
  where
     validate uid = Just uid -- TODO
+-}
 
 from16 :: Word16 -> Int
 from16 = fromEnum
diff --git a/dht/Presence/XMPPServer.hs b/dht/Presence/XMPPServer.hs
index fe099fb8..e98b9a2e 100644
--- a/dht/Presence/XMPPServer.hs
+++ b/dht/Presence/XMPPServer.hs
@@ -1101,7 +1101,7 @@ peerKey :: SocketLike sock => Maybe SockAddr -> sock -> IO (PeerAddress,Connecti
 peerKey bind_addr sock = do
     laddr <- getSocketName sock
     raddr <-
-      sIsConnected sock >>= \c ->
+      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.
diff --git a/dht/dht-client.cabal b/dht/dht-client.cabal
index 3569c6dd..168dd079 100644
--- a/dht/dht-client.cabal
+++ b/dht/dht-client.cabal
@@ -37,8 +37,7 @@ flag old-network-bsd
   description:         Use network-bsd package.
   default:             True
 
--- TODO: Due to removed functions, this flag doesn't actually build.
--- In the future, this flag should support network >3.0
+-- supports network >3.0
 flag new-network-bsd
   description:         Use newer network-bsd package.
   default:             False
diff --git a/dht/src/Network/SocketLike.hs b/dht/src/Network/SocketLike.hs
index 27f6f492..2c97ddd4 100644
--- a/dht/src/Network/SocketLike.hs
+++ b/dht/src/Network/SocketLike.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE CPP #-}
 -- |
 --
@@ -33,6 +34,7 @@ import Foreign.C.Types ( CUInt )
 
 import qualified Network.Socket as NS
 import System.IO (Handle,hClose,hIsOpen)
+import Control.Arrow
 
 -- | A safe (mostly read-only) interface to a 'NS.Socket'.  Note that despite
 -- how this class is named, it provides no access to typical 'NS.Socket' uses
@@ -43,22 +45,36 @@ class SocketLike sock where
     -- | See 'NS.getPeerName'
     getPeerName   :: sock -> IO SockAddr
     -- | See 'NS.getPeerCred'
-    getPeerCred   :: sock -> IO (CUInt, CUInt, CUInt)
+--  getPeerCred   :: sock -> IO (CUInt, CUInt, CUInt)
 
     -- | Is the socket still valid? Connected
-    sIsConnected  :: sock -> IO Bool
+    --
+    --   In order to give the instance writer
+    --   the option to do book-keeping in a pure
+    --   type, a conceptually modified version of
+    --   the 'SocketLike' is returned.
+    --
+    isValidSocket :: sock -> IO (sock,Bool)
 
 
 instance SocketLike NS.Socket where
     getSocketName = NS.getSocketName
     getPeerName   = NS.getPeerName
-    getPeerCred   = NS.getPeerCred
+--  getPeerCred   = NS.getPeerCred
+#if MIN_VERSION_network(3,1,0)
+    isValidSocket s = (s,) <$> NS.withFdSocket s (return . (/= (-1)))
+#else
+#if MIN_VERSION_network(3,0,0)
+    isValidSocket s = (s,) . (/= (-1)) <$> NS.fdSocket s
+#else
 #if MIN_VERSION_network(2,4,0)
-    sIsConnected  = NS.isConnected -- warning: this is always False if the socket
-                                   --          was converted to a Handle
+    isValidSocket s = (s,) . NS.isConnected s -- warning: this is always False if the socket
+                                              --          was converted to a Handle
 #else
-    sIsConnected  = NS.sIsConnected -- warning: this is always False if the socket
-                                    --          was converted to a Handle
+    isValidSocket  = (s,) . NS.sIsConnected s -- warning: this is always False if the socket
+                                              --          was converted to a Handle
+#endif
+#endif
 #endif
 
 -- | An encapsulated socket.  Data reads and writes are not possible.
@@ -67,12 +83,8 @@ data RestrictedSocket = Restricted (Maybe Handle) NS.Socket deriving Show
 instance SocketLike RestrictedSocket where
     getSocketName (Restricted mb sock) = NS.getSocketName sock
     getPeerName   (Restricted mb sock) = NS.getPeerName sock
-    getPeerCred   (Restricted mb sock) = NS.getPeerCred sock
-#if MIN_VERSION_network(2,4,0)
-    sIsConnected  (Restricted mb sock) = maybe (NS.isConnected sock) (hIsOpen) mb
-#else
-    sIsConnected  (Restricted mb sock) = maybe (NS.sIsConnected sock) (hIsOpen) mb
-#endif
+--  getPeerCred   (Restricted mb sock) = NS.getPeerCred sock
+    isValidSocket rs@(Restricted mb sock) = maybe (first (Restricted mb) <$> isValidSocket sock) (((rs,) <$>) .  hIsOpen) mb
 
 -- | Create a 'RestrictedSocket' that explicitly disallows sending or
 -- receiving data.
diff --git a/dht/src/Network/StreamServer.hs b/dht/src/Network/StreamServer.hs
index 79398e8e..9a5b8593 100644
--- a/dht/src/Network/StreamServer.hs
+++ b/dht/src/Network/StreamServer.hs
@@ -10,7 +10,7 @@ module Network.StreamServer
     , ServerConfig(..)
     , withSession
     , quitListening
-    , dummyServerHandle
+  --, dummyServerHandle
     , listenSocket
     ) where
 
@@ -52,6 +52,7 @@ data ServerHandle = ServerHandle Socket (Weak ThreadId)
 listenSocket :: ServerHandle -> RestrictedSocket
 listenSocket (ServerHandle sock _) = restrictSocket sock
 
+{- // Removed, bit-rotted and there are no call sites
 -- | Create a useless do-nothing 'ServerHandle'.
 dummyServerHandle :: IO ServerHandle
 dummyServerHandle = do
@@ -59,6 +60,7 @@ dummyServerHandle = do
     let sock = MkSocket 0 AF_UNSPEC NoSocketType 0 mvar
     thread <- mkWeakThreadId <=< forkIO $ return ()
     return (ServerHandle sock thread)
+-}
 
 removeSocketFile :: SockAddr -> IO ()
 removeSocketFile (SockAddrUnix fname) = removeFile fname