Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module provides the IPv6 data type and functions for working with it.
Synopsis
- ipv6 :: Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> IPv6
- fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> IPv6
- fromWord16s :: Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> IPv6
- fromWord32s :: Word32 -> Word32 -> Word32 -> Word32 -> IPv6
- fromTupleWord16s :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16) -> IPv6
- fromTupleWord32s :: (Word32, Word32, Word32, Word32) -> IPv6
- toWord16s :: IPv6 -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
- toWord32s :: IPv6 -> (Word32, Word32, Word32, Word32)
- any :: IPv6
- loopback :: IPv6
- localhost :: IPv6
- encode :: IPv6 -> Text
- encodeShort :: IPv6 -> ShortText
- decode :: Text -> Maybe IPv6
- decodeShort :: ShortText -> Maybe IPv6
- parser :: Parser IPv6
- parserUtf8Bytes :: e -> Parser e s IPv6
- decodeUtf8Bytes :: Bytes -> Maybe IPv6
- boundedBuilderUtf8 :: IPv6 -> Builder 39
- print :: IPv6 -> IO ()
- range :: IPv6 -> Word8 -> IPv6Range
- fromBounds :: IPv6 -> IPv6 -> IPv6Range
- normalize :: IPv6Range -> IPv6Range
- contains :: IPv6Range -> IPv6 -> Bool
- member :: IPv6 -> IPv6Range -> Bool
- lowerInclusive :: IPv6Range -> IPv6
- upperInclusive :: IPv6Range -> IPv6
- encodeRange :: IPv6Range -> Text
- decodeRange :: Text -> Maybe IPv6Range
- parserRange :: Parser IPv6Range
- printRange :: IPv6Range -> IO ()
- parserRangeUtf8Bytes :: e -> Parser e s IPv6Range
- parserRangeUtf8BytesLenient :: e -> Parser e s IPv6Range
- newtype IPv6 = IPv6 {}
- data IPv6Range = IPv6Range {
- ipv6RangeBase :: !IPv6
- ipv6RangeLength :: !Word8
Convert
ipv6 :: Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> IPv6 Source #
Create an IPv6
address from the eight 16-bit fragments that make
it up. This closely resembles the standard IPv6 notation, so
is used for the Show
instance. Note that this lacks the formatting
feature for suppress zeroes in an IPv6
address, but it should be
readable enough for hacking in GHCi.
>>>
let addr = ipv6 0x3124 0x0 0x0 0xDEAD 0xCAFE 0xFF 0xFE00 0x1
>>>
addr
ipv6 0x3124 0x0000 0x0000 0xdead 0xcafe 0x00ff 0xfe00 0x0001>>>
T.putStrLn (encode addr)
3124::dead:cafe:ff:fe00:1
fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> IPv6 Source #
This could be useful for the rare occasion
in which one could construct an IPv6
from
octets.
Note that while Net.IPv4.
,
fromOctets
= Net.IPv4.ipv4
Net.IPv6.fromOctets /= Net.IPv6.ipv6
. While this should be obvious
from their types, it is worth mentioning since the similarity in naming
might be confusing.
fromWord16s :: Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> Word16 -> IPv6 Source #
An alias for the ipv6
smart constructor.
fromWord32s :: Word32 -> Word32 -> Word32 -> Word32 -> IPv6 Source #
Build an IPv6
from four 32-bit words. The leftmost argument
is the high word and the rightword is the low word.
fromTupleWord16s :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16) -> IPv6 Source #
Uncurried variant of fromWord16s
.
fromTupleWord32s :: (Word32, Word32, Word32, Word32) -> IPv6 Source #
Uncurried variant of fromWord32s
.
toWord16s :: IPv6 -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16) Source #
Convert an IPv6
to eight 16-bit words.
Special IP Addresses
The IP address representing any host.
>>>
any
ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000
The local loopback IP address.
>>>
loopback
ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001
A useful alias for loopback
.
>>>
localhost
ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001
Textual Conversion
Text
encode :: IPv6 -> Text Source #
Encodes the IPv6
address using zero-compression on the leftmost longest
string of zeroes in the address.
Per RFC 5952 Section 5,
this uses mixed notation when encoding an IPv4-mapped IPv6 address:
>>>
T.putStrLn $ encode $ fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234
dead:beef::1234>>>
T.putStrLn $ encode $ fromWord16s 0x0 0x0 0x0 0x0 0x0 0xFFFF 0x6437 0xA5B4
::ffff:100.55.165.180>>>
T.putStrLn $ encode $ fromWord16s 0x0 0x0 0x0 0x0 0x0 0x0 0x0 0x0
::
Per Section 4.2.2 of the
same RFC, this does not use ::
to shorten a single 16-bit 0 field. Only
runs of multiple 0 fields are considered.
encodeShort :: IPv6 -> ShortText Source #
Encodes the IPv6
address as ShortText
using zero-compression on
the leftmost longest string of zeroes in the address.
Per RFC 5952 Section 5,
this uses mixed notation when encoding an IPv4-mapped IPv6 address.
>>>
encodeShort $ fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0ABC 0x0 0x1234
"dead:beef::abc:0:1234"
decode :: Text -> Maybe IPv6 Source #
Decode an IPv6
address. This accepts both standard IPv6
notation (with zero compression) and mixed notation for
IPv4-mapped IPv6 addresses. For a decoding function that
additionally accepts dot-decimal-encoded IPv4 addresses,
see Net.IP.decode
.
UTF-8 Bytes
parserUtf8Bytes :: e -> Parser e s IPv6 Source #
Parse UTF-8-encoded Bytes
as an IPv6
address. This accepts
both uppercase and lowercase characters in the hexadecimal components.
>>>
let str = "dead:beef:3240:a426:ba68:1cd0:4263:109b -> alive"
>>>
Parser.parseBytes (parserUtf8Bytes ()) (Bytes.fromAsciiString str)
Success (Slice {offset = 39, length = 9, value = ipv6 0xdead 0xbeef 0x3240 0xa426 0xba68 0x1cd0 0x4263 0x109b})
This does not currently support parsing embedded IPv4 address
(e.g. ff00:8000:abc::224.1.2.3
).
decodeUtf8Bytes :: Bytes -> Maybe IPv6 Source #
Decode UTF-8-encoded Bytes
into an IPv6
address.
>>>
decodeUtf8Bytes (Bytes.fromAsciiString "::cab:1")
Just (ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0cab 0x0001)
boundedBuilderUtf8 :: IPv6 -> Builder 39 Source #
Encodes the IPv6
address using zero-compression on the
leftmost longest string of zeroes in the address.
>>>
BB.run Nat.constant $ boundedBuilderUtf8 $ fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234
[0x64, 0x65, 0x61, 0x64, 0x3a, 0x62, 0x65, 0x65, 0x66, 0x3a, 0x3a, 0x31, 0x32, 0x33, 0x34]
Printing
IPv6 Ranges
Range functions
fromBounds :: IPv6 -> IPv6 -> IPv6Range Source #
Given an inclusive lower and upper ip address, create the smallest IPv6Range
that contains the two. This is helpful in situations where input is given as a
range, like
.
This makes the range broader if it cannot be represented in CIDR notation.
>>>
addrLower = ipv6 0xDEAD 0xBE80 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000
>>>
addrUpper = ipv6 0xDEAD 0xBEFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF
>>>
printRange $ fromBounds addrLower addrUpper
dead:be80::/25
normalize :: IPv6Range -> IPv6Range Source #
Normalize an IPv6Range
. The first result of this is that the
IPv6
inside the IPv6Range
is changed so that the insignificant
bits are zeroed out. For example:
>>>
addr1 = ipv6 0x0192 0x0168 0x0001 0x0019 0x0000 0x0000 0x0000 0x0000
>>>
addr2 = ipv6 0x0192 0x0168 0x0001 0x0163 0x0000 0x0000 0x0000 0x0000
>>>
printRange $ normalize $ IPv6Range addr1 24
192:100::/24>>>
printRange $ normalize $ IPv6Range addr2 28
192:160::/28
The second effect of this is that the mask length is lowered to be 128
or smaller. Working with IPv6Range
s that have not been normalized does
not cause any issues for this library, although other applications may
reject such ranges (especially those with a mask length above 128).
Note that 'normalize is idempotent, that is:
normalize r == (normalize . normalize) r
contains :: IPv6Range -> IPv6 -> Bool Source #
Checks to see if an IPv6
address belongs in the IPv6Range
.
>>>
let ip = ipv6 0x2001 0x0db8 0x0db8 0x1094 0x2051 0x0000 0x0000 0x0001
>>>
let iprange mask = IPv6Range (ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) mask
>>>
contains (iprange 8) ip
True>>>
contains (iprange 48) ip
False
Typically, element-testing functions are written to take the element as the first argument and the set as the second argument. This is intentionally written the other way for better performance when iterating over a collection. For example, you might test elements in a list for membership like this:
>>>
let r = IPv6Range (ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) 64
>>>
fmap (contains r) (take 5 $ iterate succ $ ipv6 0x2001 0x0db8 0x0000 0x0000 0xffff 0xffff 0xffff 0xfffe)
[True,True,False,False,False]
The implementation of contains
ensures that (with GHC), the bitmask
creation and range normalization only occur once in the above example.
They are reused as the list is iterated.
member :: IPv6 -> IPv6Range -> Bool Source #
This is provided to mirror the interface provided by Data.Set
. It
behaves just like contains
but with flipped arguments.
member ip r == contains r ip
lowerInclusive :: IPv6Range -> IPv6 Source #
The inclusive lower bound of an IPv6Range
. This is conventionally
understood to be the broadcast address of a subnet. For example:
>>>
T.putStrLn $ encode $ lowerInclusive $ IPv6Range (ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) 25
2001:d80::
Note that the lower bound of a normalized IPv6Range
is simply the
ip address of the range:
lowerInclusive r == ipv6RangeBase (normalize r)
upperInclusive :: IPv6Range -> IPv6 Source #
The inclusive upper bound of an IPv6Range
.
>>>
let addr = ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B
>>>
T.putStrLn $ encode $ upperInclusive $ IPv6Range addr 25
dead:beff:ffff:ffff:ffff:ffff:ffff:ffff
Textual Conversion
Text
encodeRange :: IPv6Range -> Text Source #
UTF-8 Bytes
parserRangeUtf8Bytes :: e -> Parser e s IPv6Range Source #
Parse UTF-8-encoded Bytes
into an IPv4Range
.
This requires the mask to be present.
>>>
maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "1b02:f001:5:200b::/80")
1b02:f001:5:200b::/80>>>
maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "abcd::")
nope
See parserRangeUtf8BytesLenient
for a variant that treats
a missing mask as a /32
mask.
parserRangeUtf8BytesLenient :: e -> Parser e s IPv6Range Source #
Variant of parserRangeUtf8Bytes
that allows the mask
to be omitted. An omitted mask is treated as a /128
mask.
>>>
maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "1b02:f001:5:200b::/80")
1b02:f001:5:200b::/80>>>
maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "abcd::")
abcd::/128
Types
A 128-bit Internet Protocol version 6 address.
Instances
IPv6Range | |
|
Instances
Eq IPv6Range Source # | |
Data IPv6Range Source # | |
Defined in Net.IPv6 gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IPv6Range -> c IPv6Range # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IPv6Range # toConstr :: IPv6Range -> Constr # dataTypeOf :: IPv6Range -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c IPv6Range) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6Range) # gmapT :: (forall b. Data b => b -> b) -> IPv6Range -> IPv6Range # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6Range -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6Range -> r # gmapQ :: (forall d. Data d => d -> u) -> IPv6Range -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> IPv6Range -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range # | |
Ord IPv6Range Source # | |
Defined in Net.IPv6 | |
Read IPv6Range Source # | |
Show IPv6Range Source # | |
Generic IPv6Range Source # | |
ToJSON IPv6Range Source # | |
FromJSON IPv6Range Source # | |
NFData IPv6Range Source # | |
type Rep IPv6Range Source # | |
Defined in Net.IPv6 type Rep IPv6Range = D1 (MetaData "IPv6Range" "Net.IPv6" "ip-1.7.2-Kyhs4fvYrBO6Z4SWmTQ3kV" False) (C1 (MetaCons "IPv6Range" PrefixI True) (S1 (MetaSel (Just "ipv6RangeBase") SourceUnpack SourceStrict DecidedStrict) (Rec0 IPv6) :*: S1 (MetaSel (Just "ipv6RangeLength") SourceUnpack SourceStrict DecidedStrict) (Rec0 Word8))) |