Proposal [Trac #1212]: add IPv6 support to network library

Here's the Trac ticket: http://hackage.haskell.org/trac/ghc/ticket/1212 This proposal adds two standard protocol-independent functions to Network.BSD to allow the networking code to work with both IPv6 and IPv4 addresses and protocols. getAddrInfo is the equivalent of getaddrinfo from RFC 2553. getNameInfo is the equivalent of getnameinfo from RFC 2553. These functions rely on a few new types: AddrInfo AddrInfoFlags NameInfoFlags Several global values provide mnemonics for query hints and flags. Both of these functions are available on all modern operating systems. They unify name and service lookup for IPv4 and IPv6. The code has been autoconfiscated so that it will not be compiled if IPv6 support is not available. I have not touched existing code in any way, save to add and extend the smallest possible number of types and functions so that IPv6 addresses can be accommodated. I would suggest a consideration period of one week, since my changes are non-intrusive in nature. Regards,

Bryan O'Sullivan wrote:
This proposal adds two standard protocol-independent functions to Network.BSD to allow the networking code to work with both IPv6 and IPv4 addresses and protocols.
There have been two comments so far. Sven Panne would like to see a portable (i.e. not platform dependent) set of constants defined in the package. I have no problem with this, so I'll trim the list down to ones that are known to work everywhere. Peter Simons suggests that in fact Network.Socket would be a better home for all of the new functionality, instead of Network.BSD, as the IPv6 entry points and constants do not have a BSD heritage (they're defined in RFC 2553, and available on all modern operating systems under the same names). I agree. Furthermore, adding this functionality to Network.Socket will mean that new code will never need to import Network.BSD. As a consequence, I'm going to redo the patch, and tender it for consideration again in a day or two, then extend the discussion period for another week.

On Friday 16 March 2007 04:07, Bryan O'Sullivan wrote:
Bryan O'Sullivan wrote: [...] Sven Panne would like to see a portable (i.e. not platform dependent) set of constants defined in the package. I have no problem with this, so I'll trim the list down to ones that are known to work everywhere.
Another option would be to export all constants on all platforms. If a constant is not supported by the underlying platform, use a value which is guaranteed to result in e.g. a usual I/O error when used with a network function. There are pros and cons for both ways, I don't know which one is more appropriate for the network library. Cheers, S.

Sven Panne wrote:
Another option would be to export all constants on all platforms. If a constant is not supported by the underlying platform, use a value which is guaranteed to result in e.g. a usual I/O error when used with a network function.
That's a possibility, but I think that the best place to start from is the portable constants from RFC 2553, which every platform supports. That way, the functionality becomes available reasonably soon in a useful form. Trying to figure out how to deal acceptably with constants that are not portable looks like a rathole, one I'd rather descend into later :-)

Bryan O'Sullivan wrote:
Peter Simons suggests that in fact Network.Socket would be a better home for all of the new functionality, instead of Network.BSD, as the IPv6 entry points and constants do not have a BSD heritage (they're defined in RFC 2553, and available on all modern operating systems under the same names). I agree.
It turns out there's a hitch with this notion. The HostName and ServiceName types are defined in Network.BSD, but they're desirable to use in the type signature of getAddrInfo. While it's possible to move these types into a hidden module such that they're re-exported by Network.BSD and Network.Socket, this has the nasty consequence of breaking pre-existing network code due to Network.Socket now exporting these types, causing the Haskell compiler to complain about the new ambiguities introduced. I can think of three ways around this. 1. Accept the breakage this causes. I'm not suggesting this as realistic or desirable, merely a possibility to consider. 2. Put getAddrInfo and getNameInfo into Network.BSD, as my original patch did. This doesn't break any existing code, but is a bit disappointing as we can no longer ignore and wholesale deprecate Network.BSD. 3. Introduce new, non-conflicting type synonyms in Network.Socket for the use of getAddrInfo and getNameInfo, and ignore the names in Network.BSD. I could see using NodeName instead of HostName, but I don't have a good replacement for ServiceName in mind. Furthermore, I don't know that introducing type synonyms in order to make one or two function signatures more readable is really desirable. Does anyone have any opinions? 4. Something else that I haven't thought of. Answers on the back of a postcard, please. Unless someone indicates a strong preference, I'll go with option #2.

On Sat, Mar 24, 2007 at 12:52:50PM -0700, Bryan O'Sullivan wrote:
It turns out there's a hitch with this notion. The HostName and ServiceName types are defined in Network.BSD, but they're desirable to use in the type signature of getAddrInfo.
While it's possible to move these types into a hidden module such that they're re-exported by Network.BSD and Network.Socket, this has the nasty consequence of breaking pre-existing network code due to Network.Socket now exporting these types, causing the Haskell compiler to complain about the new ambiguities introduced.
You shouldn't get ambiguity problems if you're importing the same thing from multiple modules, only if you import different things with the same name. I might have misunderstood what you mean, though. Thanks Ian

Ian Lynagh wrote:
You shouldn't get ambiguity problems if you're importing the same thing from multiple modules, only if you import different things with the same name.
Is this a required behaviour? Section 5.5.2 of the 98 report seems to say so, but it's not exactly given in ironclad terms. In other words, is it required for the compiler to provide enough information when compiling a module that when importing the module later, it can see that a name is being re-exported? If so, then we're in happy shape; the move of some definitions from Network.BSD to Network.Socket shouldn't be a problem. Thanks,

On Thu, Mar 29, 2007 at 12:04:16PM -0700, Bryan O'Sullivan wrote:
Ian Lynagh wrote:
You shouldn't get ambiguity problems if you're importing the same thing from multiple modules, only if you import different things with the same name.
Is this a required behaviour?
Yes.
Section 5.5.2 of the 98 report seems to say so, but it's not exactly given in ironclad terms.
I think the second bullet point (on "The reference to d") makes it clear.
In other words, is it required for the compiler to provide enough information when compiling a module that when importing the module later, it can see that a name is being re-exported?
Yup. Thanks Ian

Bryan O'Sullivan wrote:
Here's the Trac ticket:
I've uploaded a hopefully final version of the patch for consideration. It's considerably smaller and cleaner than the original patch after a few rounds of feedback, but the API remains the same. http://hackage.haskell.org/trac/ghc/attachment/ticket/1212/ipv6.2.patch I would like to suggest a comment period of one week. Thanks,

I've downloaded your darcs repo, and it built fine (openSUSE 10.2 x86_64). Two remarks: * You use an internal class HostAddr and make two type synonyms an instance of it. This has 2 drawbacks: It is not H98 and Haddock complains about a missing link destination. I think one could handle things easily without a class, because all possible instances are known at compile time. * The types and values of AddrInfoFlags/NameInfoFlags are not very Haskell-like. Using data AddrInfoFlag = Passive | CanonName | NumericHost | ... and [AddrInfoFlag] instead of AddrInfoFlags is much nicer. The only cost is that a tiny marshaling function has to be written. Same for NameInfoFlags. Interfaces writte this way are more type safe and one can easily see which alternatives are possible for a given set of flags in a single place. Alas, the X11 package is not nice regarding the last item, either... :-( Cheers, S.

Sven Panne wrote:
* You use an internal class HostAddr and make two type synonyms an instance of it.
You must have downloaded the first version of the patch that I posted a few weeks ago. The updated version doesn't have this rather unpleasant wart. Unfortunately, Trac won't let me drop old versions of a patch.
* The types and values of AddrInfoFlags/NameInfoFlags are not very Haskell-like. Using
data AddrInfoFlag = Passive | CanonName | NumericHost | ...
and [AddrInfoFlag] instead of AddrInfoFlags is much nicer.
OK, I'll update the interface to look like this. It would be nice if there were helper functions in Foreign.Marshal.Utils or Data.Bits to make this a more mindless operation: import Data.Bits import Data.List (foldl') packBits :: (Eq a, Bits b) => [(a, b)] -> [a] -> b packBits mapping xs = foldl' pack 0 mapping where pack acc (k, v) | k `elem` xs = acc .|. v | otherwise = acc unpackBits :: Bits b => [(a, b)] -> b -> [a] unpackBits mapping bits = foldl' unpack [] mapping where unpack acc (k, v) | bits .&. v == 0 = acc | otherwise = k:acc It's simple boilerplate, but nice not to need to write. This would make the conversion process very tidy: aiMapping = [(AI_PASSIVE, #const AI_PASSIVE), (AI_CANONNAME, #const AI_CANONNAME), ...and so on...] packAIFlags = packBits aiMapping unpackAIFlags = unpackBits aiMapping Assuming people like the interface, should I submit this as a separate proposal, or just fold it into Network.Socket?
Alas, the X11 package is not nice regarding the last item, either... :-(
True. But there's an SoC proposal to add XCB bindings, which could presumably use this bit-swizzling code :-)

Bryan O'Sullivan wrote:
unpackBits :: Bits b => [(a, b)] -> b -> [a]
unpackBits mapping bits = foldl' unpack [] mapping where unpack acc (k, v) | bits .&. v == 0 = acc | otherwise = k:acc
Of course, this is stricter than it needs to be, and should use foldr instead of foldl'. But I hope that the idea is useful nevertheless :-)

Sven Panne wrote:
I've downloaded your darcs repo, and it built fine (openSUSE 10.2 x86_64).
I've updated both the ticket and repo with the latest change, to use lists instead of bitmasks. I left flag names as AI_FOO etc due to name clashes. darcs get --partial http://darcs.serpentine.com/network6

On Tuesday 03 April 2007 09:18, Bryan O'Sullivan wrote:
I've updated both the ticket and repo with the latest change, to use lists instead of bitmasks. I left flag names as AI_FOO etc due to name clashes. [...]
Naming entities always has a slightly religious touch, but personally I don't like those C names in Haskell. Prefixing things in C is only necessary because you basically don't have any control over namespaces, but Haskell is quite different from it. 'NumericHost' looks much nicer and Haskell-like than 'AI_NUMERICHOST', and even in the unlikely case that there is a name clash, one could always use qualification. Anyway, the constructors of 'Family' have traditionally ugly names, too, so perhaps to keep the "consistency of unattractiveness", I can live with the 'AI_' and 'NI_' prefixes... :-P BTW, what's that' DummySocketOption__' thingy? If I see things correctly, you can't use it with {g,s}etSocketOption and it has no other visible use. Cheers, S.

Sven Panne wrote:
Naming entities always has a slightly religious touch, but personally I don't like those C names in Haskell.
I understand. In fact, I took a look at the prevailing uses of names in Network.Socket as I was redoing this patch, and before I committed it. When I tried to use the "more Haskelly" names like NumericHost and so on, I found that of the nine names I had, three of them clashed. "Datagram" clashed with a SocketType, and both AddrInfoFlag and NameInfoFlag had a NumericHost. (I mentioned the clashes in my message yesterday, but not in detail.) Rather than introduce a new naming scheme of NI_NumericHost and so on, I opted to be consistent with the other existing scheme in Network.Socket, of using the C-style names.
BTW, what's that' DummySocketOption__' thingy?
Not my fault :-)

Since we seem to have converged on an agreeable API and implementation for adding IPv6 support to Network.Socket, I've added another patch on top of this that transparently adds IPv6 support to the Network module. This required no API changes, merely a few modifications to the plumbing. I've attached the patch for review. If the Network.Socket change is to go in, I think this one ought to as well. That will leave Network.BSD as a legacy-only package that can only deal with IPv4. darcs get --partial http://darcs.serpentine.com/network6

Just a little nit: On Wed, Apr 04, 2007 at 03:44:24PM -0700, Bryan O'Sullivan wrote:
hunk ./Network.hs 1 -{-# OPTIONS_GHC -cpp #-} +{-# OPTIONS -cpp #-}
http://www.haskell.org/ghc/docs/latest/html/users_guide/pragmas.html#options... says: Previous versions of GHC accepted OPTIONS rather than OPTIONS_GHC, but that is now deprecated. and hugs (for one, not sure about other impls) doesn't support -cpp. I think {-# LANGUAGE CPP #-} is the prefered way of doing this. Thanks Ian

On Sat, Mar 31, 2007 at 01:47:09PM +0000, Bryan O'Sullivan wrote:
http://hackage.haskell.org/trac/ghc/attachment/ticket/1212/ipv6.2.patch
This contains: hunk ./network.cabal 2 -version: 2.0 +version: 2.0.1 I don't think patches should include changes to the version number, as they will then depend/conflict with every other patch. Instead, changes should accumulate in the darcs repo, and the version number incremented by a patch (that does nothing else) just before a release is made. Thanks Ian

On Sun, 2007-04-01 at 16:56 +0100, Ian Lynagh wrote:
On Sat, Mar 31, 2007 at 01:47:09PM +0000, Bryan O'Sullivan wrote:
I don't think patches should include changes to the version number, as they will then depend/conflict with every other patch. Instead, changes should accumulate in the darcs repo, and the version number incremented by a patch (that does nothing else) just before a release is made.
Indeed. It'd be nice to make cabal make it easier to work in this way, for example by making dated snapshot versions easier to make. cabal-setup sdist [release|snapshot] ? Duncan

On Mon, 2007-04-02 at 00:08 +0100, Ross Paterson wrote:
On Mon, Apr 02, 2007 at 09:05:00AM +1000, Duncan Coutts wrote:
It'd be nice to make cabal make it easier to work in this way, for example by making dated snapshot versions easier to make.
cabal-setup sdist [release|snapshot] ?
Like setup sdist --snapshot ?
You'd think that being Cabal release manager I'd know about this kind of thing wouldn't you? :-) Ah well. Duncan

Ian Lynagh wrote:
On Sat, Mar 31, 2007 at 01:47:09PM +0000, Bryan O'Sullivan wrote:
http://hackage.haskell.org/trac/ghc/attachment/ticket/1212/ipv6.2.patch
This contains:
hunk ./network.cabal 2 -version: 2.0 +version: 2.0.1
The perils of "darcs record -a" :) Thanks for spotting that; I'll drop that hunk when I submit a new patch that addresses Sven's comments.
participants (5)
-
Bryan O'Sullivan
-
Duncan Coutts
-
Ian Lynagh
-
Ross Paterson
-
Sven Panne