From 6894ac341a4e5691c72346bde9a26457d4e70460 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Wed, 16 Oct 2019 07:58:55 +0000 Subject: Successful builds against newer network package Built against both network-3.0.1.0 and network-3.1.0.0 Note, due to upstream issue, getting network-bsd-2.8.1.0 to cooperate with network-3.0.1.0 requires a little finessing. The network-bsd package expects a header(HsNetConfig.h) that network fails to provide. A simple work around is to copy the header after running a newer version of the network configure script from github. Similar for network-3.1.0.0, but this time the header is HsNetworkConfig.h. --- dht/src/Network/SocketLike.hs | 38 +++++++++++++++++++++++++------------- dht/src/Network/StreamServer.hs | 4 +++- 2 files changed, 28 insertions(+), 14 deletions(-) (limited to 'dht/src') 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 -- cgit v1.2.3