diff --git a/Network.hs b/Network.hs index a3d977e2..dd190da4 100644 --- a/Network.hs +++ b/Network.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Network @@ -25,7 +26,7 @@ #define IPV6_SOCKET_SUPPORT 1 #endif -module Network +module Network {-# DEPRECATED "The high level Network interface is no longer supported. Please use Network.Socket." #-} ( -- * Basic data types Socket diff --git a/Network/BSD.hsc b/Network/BSD.hsc index 8d38dabb..91a310bc 100644 --- a/Network/BSD.hsc +++ b/Network/BSD.hsc @@ -1,4 +1,6 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Network.BSD @@ -16,7 +18,7 @@ #include "HsNet.h" -module Network.BSD +module Network.BSD {-# DEPRECATED "This platform dependent module is no longer supported." #-} ( -- * Host names HostName diff --git a/Network/Socket.hsc b/Network/Socket.hsc index 09a02284..a8652d44 100644 --- a/Network/Socket.hsc +++ b/Network/Socket.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE CPP, ScopedTypeVariables, RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Network.Socket @@ -10,13 +11,9 @@ -- Stability : provisional -- Portability : portable -- --- The "Network.Socket" module is for when you want full control over --- sockets. Essentially the entire C socket API is exposed through --- this module; in general the operations follow the behaviour of the C --- functions of the same name (consult your favourite Unix networking book). --- --- A higher level interface to networking operations is provided --- through the module "Network". +-- This is the main module of the network package supposed to be +-- used with either "Network.Socket.ByteString" or +-- "Network.Socket.ByteString.Lazy" for sending/receiving. -- -- Here are two minimal example programs using the TCP/IP protocol: a -- server that echoes all data that it receives back (servicing only @@ -95,66 +92,78 @@ module Network.Socket ( - -- * Types - Socket(..) - , Family(..) - , isSupportedFamily + -- * Initialisation + withSocketsDo + -- * Address information + , getAddrInfo + -- ** Types + , HostName + , ServiceName + , AddrInfo(..) + , defaultHints + -- ** Flags + , AddrInfoFlag(..) + , addrInfoFlagImplemented + -- * Socket operations + , connect + , bind + , listen + , accept + -- ** Closing + , close + , shutdown + , ShutdownCmd(..) + -- * Socket options + , SocketOption(..) + , isSupportedSocketOption + , getSocketOption + , setSocketOption + -- * Socket + , Socket(..) + , socket + , fdSocket + , mkSocket + , socketToHandle + -- ** Types of Socket , SocketType(..) , isSupportedSocketType + -- ** Family + , Family(..) + , isSupportedFamily + -- ** Protocol number + , ProtocolNumber + , defaultProtocol + -- * Socket address , SockAddr(..) , isSupportedSockAddr - , SocketStatus(..) + , getPeerName + , getSocketName + -- ** Host address , HostAddress , hostAddressToTuple , tupleToHostAddress #if defined(IPV6_SOCKET_SUPPORT) + -- ** Host address6 , HostAddress6 , hostAddress6ToTuple , tupleToHostAddress6 + -- ** Flow Info , FlowInfo + -- ** Scope ID , ScopeID + -- fixme: ifNameToIndex and ifIndexToName #endif - , htonl - , ntohl - , ShutdownCmd(..) - , ProtocolNumber - , defaultProtocol + -- ** Port number , PortNumber(..) - -- PortNumber is used non-abstractly in Network.BSD. ToDo: remove - -- this use and make the type abstract. - - -- * Address operations - - , HostName - , ServiceName - -#if defined(IPV6_SOCKET_SUPPORT) - , AddrInfo(..) - - , AddrInfoFlag(..) - , addrInfoFlagImplemented - - , defaultHints - - , getAddrInfo - - , NameInfoFlag(..) - - , getNameInfo -#endif - - -- * Socket operations - , socket + , defaultPort + , socketPort #if defined(DOMAIN_SOCKET_SUPPORT) + -- * Unix domain socket , socketPair + , sendFd + , recvFd #endif - , connect - , bind - , listen - , accept - , getPeerName - , getSocketName - +-- fixme #if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID) -- get the credentials of our domain socket peer. , getPeerCred @@ -162,54 +171,48 @@ module Network.Socket , getPeerEid #endif #endif - - , socketPort - - , socketToHandle - - -- ** Sending and receiving data - -- *** Sending and receiving with String - -- $sendrecv +#if defined(IPV6_SOCKET_SUPPORT) + -- * Name information + , NameInfoFlag(..) + , getNameInfo +#endif + -- * Low level operations + , setNonBlockIfNeeded + -- * Sending and receiving data + , sendBuf + , recvBuf + , sendBufTo + , recvBufFrom + -- * Special constants + , maxListenQueue + -- * Deprecated + -- ** Deprecated sending and receiving , send , sendTo , recv , recvFrom , recvLen - - -- *** Sending and receiving with a buffer - , sendBuf - , recvBuf - , sendBufTo - , recvBufFrom - - -- ** Misc + -- ** Deprecated address functions + , htonl + , ntohl , inet_addr , inet_ntoa - - , shutdown - , close - - -- ** Predicates on sockets + -- ** Deprecated socket operations + , bindSocket + , sClose + -- ** Deprecated socket status + , SocketStatus(..) -- fixme , isConnected , isBound , isListening , isReadable , isWritable - - -- * Socket options - , SocketOption(..) - , isSupportedSocketOption - , getSocketOption - , setSocketOption - - -- * File descriptor transmission -#ifdef DOMAIN_SOCKET_SUPPORT - , sendFd - , recvFd - -#endif - - -- * Special constants + , sIsConnected + , sIsBound + , sIsListening + , sIsReadable + , sIsWritable + -- ** Deprecated special constants , aNY_PORT , iNADDR_ANY #if defined(IPV6_SOCKET_SUPPORT) @@ -220,32 +223,7 @@ module Network.Socket #ifdef SCM_RIGHTS , sCM_RIGHTS #endif - , maxListenQueue - - -- * Initialisation - , withSocketsDo - - -- * Very low level operations - -- in case you ever want to get at the underlying file descriptor.. - , fdSocket - , mkSocket - , setNonBlockIfNeeded - - -- * Deprecated aliases - -- $deprecated-aliases - , bindSocket - , sClose - , sIsConnected - , sIsBound - , sIsListening - , sIsReadable - , sIsWritable - - -- * Internal - - -- | The following are exported ONLY for use in the BSD module and - -- should not be used anywhere else. - + -- ** Decrecated internal functions , packFamily , unpackFamily , packSocketType @@ -350,6 +328,7 @@ mkSocket fd fam sType pNum stat = do withSocketsDo $ return () return $ MkSocket fd fam sType pNum mStat +-- | Obtaining the file descriptor from a socket. fdSocket :: Socket -> CInt fdSocket (MkSocket fd _ _ _ _) = fd @@ -405,11 +384,7 @@ instance Show SockAddr where -- -- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream } -- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "5000") --- >>> sock@(MkSocket _ fam stype _ _) <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) --- >>> fam --- AF_INET --- >>> stype --- Stream +-- >>> sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) -- >>> bind sock (addrAddress addr) -- >>> getSocketName sock -- 127.0.0.1:5000 @@ -479,7 +454,7 @@ setNonBlockIfNeeded fd = -- | Bind the socket to an address. The socket must not already be -- bound. The 'Family' passed to @bind@ must be the -- same as that passed to 'socket'. If the special port number --- 'aNY_PORT' is passed then the system assigns the next available +-- 'defaultPort' is passed then the system assigns the next available -- use port. bind :: Socket -- Unconnected Socket -> SockAddr -- Address to Bind to @@ -650,7 +625,7 @@ foreign import ccall unsafe "free" -- -- NOTE: blocking on Windows unless you compile with -threaded (see -- GHC ticket #1129) -{-# WARNING sendTo "Use sendTo defined in \"Network.Socket.ByteString\"" #-} +{-# DEPRECATED sendTo "Use sendTo defined in \"Network.Socket.ByteString\"" #-} sendTo :: Socket -- (possibly) bound/connected Socket -> String -- Data to send -> SockAddr @@ -682,7 +657,7 @@ sendBufTo sock@(MkSocket s _family _stype _protocol _status) ptr nbytes addr = d -- -- NOTE: blocking on Windows unless you compile with -threaded (see -- GHC ticket #1129) -{-# WARNING recvFrom "Use recvFrom defined in \"Network.Socket.ByteString\"" #-} +{-# DEPRECATED recvFrom "Use recvFrom defined in \"Network.Socket.ByteString\"" #-} recvFrom :: Socket -> Int -> IO (String, Int, SockAddr) recvFrom sock nbytes = allocaBytes nbytes $ \ptr -> do @@ -731,7 +706,7 @@ recvBufFrom sock@(MkSocket s family _stype _protocol _status) ptr nbytes -- responsible for ensuring that all data has been sent. -- -- Sending data to closed socket may lead to undefined behaviour. -{-# WARNING send "Use send defined in \"Network.Socket.ByteString\"" #-} +{-# DEPRECATED send "Use send defined in \"Network.Socket.ByteString\"" #-} send :: Socket -- Bound/Connected Socket -> String -- Data to send -> IO Int -- Number of Bytes sent @@ -779,11 +754,11 @@ sendBuf sock@(MkSocket s _family _stype _protocol _status) str len = do -- closed its half side of the connection. -- -- Receiving data from closed socket may lead to undefined behaviour. -{-# WARNING recv "Use recv defined in \"Network.Socket.ByteString\"" #-} +{-# DEPRECATED recv "Use recv defined in \"Network.Socket.ByteString\"" #-} recv :: Socket -> Int -> IO String recv sock l = fst <$> recvLen sock l -{-# WARNING recvLen "Use recv defined in \"Network.Socket.ByteString\" with \"Data.Bytestring.length\"" #-} +{-# DEPRECATED recvLen "Use recv defined in \"Network.Socket.ByteString\" with \"Data.Bytestring.length\"" #-} recvLen :: Socket -> Int -> IO (String, Int) recvLen sock nbytes = allocaBytes nbytes $ \ptr -> do @@ -1114,11 +1089,16 @@ foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt -- --------------------------------------------------------------------------- -- Utility Functions +{-# DEPRECATED aNY_PORT "Use defaultPort instead" #-} aNY_PORT :: PortNumber aNY_PORT = 0 +defaultPort :: PortNumber +defaultPort = 0 + -- | The IPv4 wild card address. +{-# DEPRECATED iNADDR_ANY "Use getAddrInfo instead" #-} iNADDR_ANY :: HostAddress iNADDR_ANY = htonl (#const INADDR_ANY) @@ -1127,20 +1107,27 @@ foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32 -- | Converts the from network byte order to host byte order. foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32 +{-# DEPRECATED htonl "Use getAddrInfo instead" #-} +{-# DEPRECATED ntohl "Use getAddrInfo instead" #-} + #if defined(IPV6_SOCKET_SUPPORT) -- | The IPv6 wild card address. +{-# DEPRECATED iN6ADDR_ANY "Use getAddrInfo instead" #-} iN6ADDR_ANY :: HostAddress6 iN6ADDR_ANY = (0, 0, 0, 0) #endif +{-# DEPRECATED sOMAXCONN "Use maxListenQueue instead" #-} sOMAXCONN :: Int sOMAXCONN = #const SOMAXCONN +{-# DEPRECATED sOL_SOCKET "This is not necessary anymore" #-} sOL_SOCKET :: Int sOL_SOCKET = #const SOL_SOCKET #ifdef SCM_RIGHTS +{-# DEPRECATED sCM_RIGHTS "This is not necessary anymore" #-} sCM_RIGHTS :: Int sCM_RIGHTS = #const SCM_RIGHTS #endif @@ -1199,6 +1186,7 @@ isConnected :: Socket -> IO Bool isConnected (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Connected) +{-# DEPRECATED isConnected "SocketStatus will be removed" #-} -- ----------------------------------------------------------------------------- -- Socket Predicates @@ -1207,19 +1195,23 @@ isBound :: Socket -> IO Bool isBound (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Bound) +{-# DEPRECATED isBound "SocketStatus will be removed" #-} isListening :: Socket -> IO Bool isListening (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening) +{-# DEPRECATED isListening "SocketStatus will be removed" #-} isReadable :: Socket -> IO Bool isReadable (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening || value == Connected) +{-# DEPRECATED isReadable "SocketStatus will be removed" #-} isWritable :: Socket -> IO Bool isWritable = isReadable -- sort of. +{-# DEPRECATED isWritable "SocketStatus will be removed" #-} isAcceptable :: Family -> SocketType -> SocketStatus -> Bool #if defined(DOMAIN_SOCKET_SUPPORT) @@ -1229,10 +1221,12 @@ isAcceptable AF_UNIX sockTyp status isAcceptable AF_UNIX _ _ = False #endif isAcceptable _ _ status = status == Connected || status == Listening +{-# DEPRECATED isAcceptable "SocketStatus will be removed" #-} -- ----------------------------------------------------------------------------- -- Internet address manipulation routines: +{-# DEPRECATED inet_addr "Use \"getNameInfo\" instead" #-} inet_addr :: String -> IO HostAddress inet_addr ipstr = withSocketsDo $ do withCString ipstr $ \str -> do @@ -1242,6 +1236,7 @@ inet_addr ipstr = withSocketsDo $ do "Network.Socket.inet_addr: Malformed address: " ++ ipstr else return had -- network byte order +{-# DEPRECATED inet_ntoa "Use \"getNameInfo\" instead" #-} inet_ntoa :: HostAddress -> IO String inet_ntoa haddr = withSocketsDo $ do pstr <- c_inet_ntoa haddr @@ -1319,8 +1314,8 @@ data AddrInfoFlag = | AI_NUMERICSERV -- | If no 'HostName' value is provided, the network -- address in each 'SockAddr' - -- will be left as a "wild card", i.e. as either 'iNADDR_ANY' - -- or 'iN6ADDR_ANY'. This is useful for server applications that + -- will be left as a "wild card". + -- This is useful for server applications that -- will accept connections from any client. | AI_PASSIVE -- | If an IPv6 lookup is performed, and no IPv6 @@ -1754,32 +1749,27 @@ bindSocket = bind sClose :: Socket -> IO () sClose = close -{-# DEPRECATED sIsConnected "use 'isConnected'" #-} +{-# DEPRECATED sIsConnected "SocketStatus will be removed" #-} --- | Deprecated alias for 'isConnected'. sIsConnected :: Socket -> IO Bool sIsConnected = isConnected -{-# DEPRECATED sIsBound "use 'isBound'" #-} +{-# DEPRECATED sIsBound "SocketStatus will be removed" #-} --- | Deprecated alias for 'isBound'. sIsBound :: Socket -> IO Bool sIsBound = isBound -{-# DEPRECATED sIsListening "use 'isListening'" #-} +{-# DEPRECATED sIsListening "SocketStatus will be removed" #-} --- | Deprecated alias for 'isListening'. sIsListening :: Socket -> IO Bool sIsListening = isListening -{-# DEPRECATED sIsReadable "use 'isReadable'" #-} +{-# DEPRECATED sIsReadable "SocketStatus will be removed" #-} --- | Deprecated alias for 'isReadable'. sIsReadable :: Socket -> IO Bool sIsReadable = isReadable -{-# DEPRECATED sIsWritable "use 'isWritable'" #-} +{-# DEPRECATED sIsWritable "SocketStatus will be removed" #-} --- | Deprecated alias for 'isWritable'. sIsWritable :: Socket -> IO Bool sIsWritable = isWritable diff --git a/Network/Socket/ByteString.hsc b/Network/Socket/ByteString.hsc index 95c9aae0..2b2e0645 100644 --- a/Network/Socket/ByteString.hsc +++ b/Network/Socket/ByteString.hsc @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE CPP, ForeignFunctionInterface #-} #include "HsNet.h" @@ -263,7 +264,7 @@ totalLength = sum . map B.length -- | @withIOVec cs f@ executes the computation @f@, passing as argument a pair -- consisting of a pointer to a temporarily allocated array of pointers to --- 'IOVec' made from @cs@ and the number of pointers (@length cs@). +-- IOVec made from @cs@ and the number of pointers (@length cs@). -- /Unix only/. withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a withIOVec cs f = diff --git a/Network/Socket/ByteString/Lazy/Posix.hs b/Network/Socket/ByteString/Lazy/Posix.hs index 19ad1fbf..5d78b97a 100644 --- a/Network/Socket/ByteString/Lazy/Posix.hs +++ b/Network/Socket/ByteString/Lazy/Posix.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE BangPatterns #-} module Network.Socket.ByteString.Lazy.Posix ( diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc index b6d76eaa..b3c2691d 100644 --- a/Network/Socket/Types.hsc +++ b/Network/Socket/Types.hsc @@ -72,18 +72,7 @@ import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable --- | Represents a socket. The fields are, respectively: --- --- * File descriptor --- * Socket family --- * Socket type --- * Protocol number --- * Status flag --- --- If you are calling the 'MkSocket' constructor directly you should ensure --- you have called 'Network.withSocketsDo' and that the file descriptor is --- in non-blocking mode. See 'Network.Socket.setNonBlockIfNeeded'. --- +-- | A socket data type. -- 'Socket's are not GCed unless they are closed by 'close'. data Socket = MkSocket @@ -94,6 +83,8 @@ data Socket (MVar SocketStatus) -- Status Flag deriving Typeable +{-# DEPRECATED MkSocket "'MkSocket' will not be available in version 3.0.0.0 or later. Use fdSocket instead" #-} + sockFd :: Socket -> CInt sockFd (MkSocket n _ _ _ _) = n @@ -133,6 +124,8 @@ data SocketStatus | Closed -- ^ Closed was closed by 'close' deriving (Eq, Show, Typeable) +{-# DEPRECATED SocketStatus "SocketStatus will be removed" #-} + ----------------------------------------------------------------------------- -- Socket types @@ -191,6 +184,8 @@ packSocketType' stype = case Just stype of #endif _ -> Nothing +{-# DEPRECATED packSocketType "packSocketType will not be available in version 3.0.0.0 or later." #-} + packSocketType :: SocketType -> CInt packSocketType stype = fromMaybe (error errMsg) (packSocketType' stype) where @@ -310,6 +305,8 @@ data Family | AF_CAN -- Controller Area Network deriving (Eq, Ord, Read, Show) +{-# DEPRECATED packFamily "packFamily will not be available in version 3.0.0.0 or later." #-} + packFamily :: Family -> CInt packFamily f = case packFamily' f of Just fam -> fam @@ -526,6 +523,8 @@ packFamily' f = case Just f of --------- ---------- +{-# DEPRECATED unpackFamily "unpackFamily will not be available in version 3.0.0.0 or later." #-} + unpackFamily :: CInt -> Family unpackFamily f = case f of (#const AF_UNSPEC) -> AF_UNSPEC diff --git a/configure.ac b/configure.ac index a9868087..b9a8c315 100644 --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -AC_INIT([Haskell network package], [2.6.3.4], [libraries@haskell.org], [network]) +AC_INIT([Haskell network package], [2.7.0.0], [libraries@haskell.org], [network]) ac_includes_default="$ac_includes_default #ifdef HAVE_SYS_SOCKET_H diff --git a/network.cabal b/network.cabal index ed3b45ff..710f5a19 100644 --- a/network.cabal +++ b/network.cabal @@ -1,5 +1,5 @@ name: network -version: 2.6.3.4 +version: 2.7.0.0 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto, Evan Borden