Safe Haskell | None |
---|---|
Language | Haskell2010 |
Data structures to express IPv4, IPv6 and IP range.
Synopsis
- data IP
- data IPv4
- toIPv4 :: [Int] -> IPv4
- fromIPv4 :: IPv4 -> [Int]
- fromHostAddress :: HostAddress -> IPv4
- toHostAddress :: IPv4 -> HostAddress
- data IPv6
- toIPv6 :: [Int] -> IPv6
- toIPv6b :: [Int] -> IPv6
- fromIPv6 :: IPv6 -> [Int]
- fromIPv6b :: IPv6 -> [Int]
- fromHostAddress6 :: HostAddress6 -> IPv6
- toHostAddress6 :: IPv6 -> HostAddress6
- ipv4ToIPv6 :: IPv4 -> IPv6
- fromSockAddr :: SockAddr -> Maybe (IP, PortNumber)
- data IPRange
- data AddrRange a
- class Eq a => Addr a where
- makeAddrRange :: Addr a => a -> Int -> AddrRange a
- (>:>) :: Addr a => AddrRange a -> AddrRange a -> Bool
- isMatchedTo :: Addr a => a -> AddrRange a -> Bool
- addrRangePair :: Addr a => AddrRange a -> (a, Int)
- ipv4RangeToIPv6 :: AddrRange IPv4 -> AddrRange IPv6
IP data
A unified IP data for IP
and IP
.
To create this, use the data constructors. Or use read
"192.0.2.1"
:: IP
, for example. Also, "192.0.2.1"
can be used as literal with OverloadedStrings.
>>>
(read "192.0.2.1" :: IP) == IPv4 (read "192.0.2.1" :: IPv4)
True>>>
(read "2001:db8:00:00:00:00:00:01" :: IP) == IPv6 (read "2001:db8:00:00:00:00:00:01" :: IPv6)
True
Instances
Enum IP Source # | |
Eq IP Source # | Equality over IP addresses. Correctly compare IPv4 and IPv4-embedded-in-IPv6 addresses.
|
Data IP Source # | |
Defined in Data.IP.Addr gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IP -> c IP # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IP # dataTypeOf :: IP -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c IP) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP) # gmapT :: (forall b. Data b => b -> b) -> IP -> IP # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r # gmapQ :: (forall d. Data d => d -> u) -> IP -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> IP -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> IP -> m IP # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IP -> m IP # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IP -> m IP # | |
Ord IP Source # | |
Read IP Source # | |
Show IP Source # | |
IsString IP Source # | |
Defined in Data.IP.Addr fromString :: String -> IP # | |
Generic IP Source # | |
type Rep IP Source # | |
Defined in Data.IP.Addr type Rep IP = D1 (MetaData "IP" "Data.IP.Addr" "iproute-1.7.7-Bl4bYsnCshE2skMbTxGToc" False) (C1 (MetaCons "IPv4" PrefixI True) (S1 (MetaSel (Just "ipv4") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 IPv4)) :+: C1 (MetaCons "IPv6" PrefixI True) (S1 (MetaSel (Just "ipv6") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 IPv6))) |
IPv4
The abstract data type to express an IPv4 address.
To create this, use toIPv4
. Or use read
"192.0.2.1"
:: IP
, for example. Also, "192.0.2.1"
can be used as literal with OverloadedStrings.
>>>
read "192.0.2.1" :: IPv4
192.0.2.1
Instances
Bounded IPv4 Source # | |
Enum IPv4 Source # | |
Eq IPv4 Source # | |
Data IPv4 Source # | |
Defined in Data.IP.Addr gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IPv4 -> c IPv4 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IPv4 # dataTypeOf :: IPv4 -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c IPv4) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv4) # gmapT :: (forall b. Data b => b -> b) -> IPv4 -> IPv4 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r # gmapQ :: (forall d. Data d => d -> u) -> IPv4 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> IPv4 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> IPv4 -> m IPv4 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IPv4 -> m IPv4 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IPv4 -> m IPv4 # | |
Ord IPv4 Source # | |
Read IPv4 Source # | |
Show IPv4 Source # | |
IsString IPv4 Source # | |
Defined in Data.IP.Addr fromString :: String -> IPv4 # | |
Generic IPv4 Source # | |
Addr IPv4 Source # | |
Routable IPv4 Source # | |
Read (AddrRange IPv4) Source # | |
IsString (AddrRange IPv4) Source # | |
Defined in Data.IP.Range fromString :: String -> AddrRange IPv4 # | |
type Rep IPv4 Source # | |
Defined in Data.IP.Addr |
fromHostAddress :: HostAddress -> IPv4 Source #
The fromHostAddress
function converts HostAddress
to IP
.
toHostAddress :: IPv4 -> HostAddress Source #
The toHostAddress
function converts IP
to HostAddress
.
IPv6
The abstract data type to express an IPv6 address.
To create this, use toIPv6
. Or use read
"2001:DB8::1"
:: IP
, for example. Also, "2001:DB8::1"
can be used as literal with OverloadedStrings.
>>>
read "2001:db8:00:00:00:00:00:01" :: IPv6
2001:db8::1>>>
read "2001:db8:11e:c00::101" :: IPv6
2001:db8:11e:c00::101>>>
read "2001:db8:11e:c00:aa:bb:192.0.2.1" :: IPv6
2001:db8:11e:c00:aa:bb:c000:201>>>
read "2001:db8::192.0.2.1" :: IPv6
2001:db8::c000:201>>>
read "0::ffff:192.0.2.1" :: IPv6
::ffff:192.0.2.1>>>
read "0::0:c000:201" :: IPv6
::192.0.2.1>>>
read "::0.0.0.1" :: IPv6
::1
Instances
Bounded IPv6 Source # | |
Enum IPv6 Source # | |
Eq IPv6 Source # | |
Data IPv6 Source # | |
Defined in Data.IP.Addr gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IPv6 -> c IPv6 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IPv6 # dataTypeOf :: IPv6 -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c IPv6) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6) # gmapT :: (forall b. Data b => b -> b) -> IPv6 -> IPv6 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r # gmapQ :: (forall d. Data d => d -> u) -> IPv6 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> IPv6 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> IPv6 -> m IPv6 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IPv6 -> m IPv6 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IPv6 -> m IPv6 # | |
Ord IPv6 Source # | |
Read IPv6 Source # | |
Show IPv6 Source # | |
IsString IPv6 Source # | |
Defined in Data.IP.Addr fromString :: String -> IPv6 # | |
Generic IPv6 Source # | |
Addr IPv6 Source # | |
Routable IPv6 Source # | |
Read (AddrRange IPv6) Source # | |
IsString (AddrRange IPv6) Source # | |
Defined in Data.IP.Range fromString :: String -> AddrRange IPv6 # | |
type Rep IPv6 Source # | |
Defined in Data.IP.Addr |
fromHostAddress6 :: HostAddress6 -> IPv6 Source #
The fromHostAddress6
function converts HostAddress6
to IP
.
toHostAddress6 :: IPv6 -> HostAddress6 Source #
The toHostAddress6
function converts IP
to HostAddress6
.
Converters
ipv4ToIPv6 :: IPv4 -> IPv6 Source #
Convert IPv4 address to IPv4-embedded-in-IPv6
fromSockAddr :: SockAddr -> Maybe (IP, PortNumber) Source #
IP range data
A unified data for AddrRange
IP
and AddrRange
IP
.
To create this, use read
"192.0.2.0/24"
:: IPRange
.
Also, "192.0.2.0/24"
can be used as literal with OverloadedStrings.
>>>
(read "192.0.2.1/24" :: IPRange) == IPv4Range (read "192.0.2.0/24" :: AddrRange IPv4)
True>>>
(read "2001:db8:00:00:00:00:00:01/48" :: IPRange) == IPv6Range (read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6)
True
Instances
Eq IPRange Source # | |
Data IPRange Source # | |
Defined in Data.IP.Range gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IPRange -> c IPRange # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IPRange # toConstr :: IPRange -> Constr # dataTypeOf :: IPRange -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c IPRange) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPRange) # gmapT :: (forall b. Data b => b -> b) -> IPRange -> IPRange # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPRange -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPRange -> r # gmapQ :: (forall d. Data d => d -> u) -> IPRange -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> IPRange -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> IPRange -> m IPRange # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IPRange -> m IPRange # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IPRange -> m IPRange # | |
Ord IPRange Source # | |
Read IPRange Source # | |
Show IPRange Source # | |
IsString IPRange Source # | |
Defined in Data.IP.Range fromString :: String -> IPRange # | |
Generic IPRange Source # | |
type Rep IPRange Source # | |
Defined in Data.IP.Range type Rep IPRange = D1 (MetaData "IPRange" "Data.IP.Range" "iproute-1.7.7-Bl4bYsnCshE2skMbTxGToc" False) (C1 (MetaCons "IPv4Range" PrefixI True) (S1 (MetaSel (Just "ipv4range") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (AddrRange IPv4))) :+: C1 (MetaCons "IPv6Range" PrefixI True) (S1 (MetaSel (Just "ipv6range") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (AddrRange IPv6)))) |
The Addr range consists of an address, a contiguous mask, and mask length. The contiguous mask and the mask length are essentially same information but contained for pre calculation.
To create this, use makeAddrRange
or read
"192.0.2.0/24"
:: AddrRange
IP
.
Also, "192.0.2.0/24"
can be used as literal with OverloadedStrings.
>>>
read "192.0.2.1/24" :: AddrRange IPv4
192.0.2.0/24>>>
read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6
2001:db8::/48
Instances
Eq a => Eq (AddrRange a) Source # | |
Data a => Data (AddrRange a) Source # | |
Defined in Data.IP.Range gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> AddrRange a -> c (AddrRange a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (AddrRange a) # toConstr :: AddrRange a -> Constr # dataTypeOf :: AddrRange a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (AddrRange a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (AddrRange a)) # gmapT :: (forall b. Data b => b -> b) -> AddrRange a -> AddrRange a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AddrRange a -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AddrRange a -> r # gmapQ :: (forall d. Data d => d -> u) -> AddrRange a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> AddrRange a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> AddrRange a -> m (AddrRange a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> AddrRange a -> m (AddrRange a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> AddrRange a -> m (AddrRange a) # | |
Ord a => Ord (AddrRange a) Source # | |
Defined in Data.IP.Range | |
Read (AddrRange IPv6) Source # | |
Read (AddrRange IPv4) Source # | |
Show a => Show (AddrRange a) Source # | |
IsString (AddrRange IPv6) Source # | |
Defined in Data.IP.Range fromString :: String -> AddrRange IPv6 # | |
IsString (AddrRange IPv4) Source # | |
Defined in Data.IP.Range fromString :: String -> AddrRange IPv4 # | |
Generic (AddrRange a) Source # | |
type Rep (AddrRange a) Source # | |
Defined in Data.IP.Range type Rep (AddrRange a) = D1 (MetaData "AddrRange" "Data.IP.Range" "iproute-1.7.7-Bl4bYsnCshE2skMbTxGToc" False) (C1 (MetaCons "AddrRange" PrefixI True) (S1 (MetaSel (Just "addr") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 a) :*: (S1 (MetaSel (Just "mask") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 a) :*: S1 (MetaSel (Just "mlen") SourceUnpack SourceStrict DecidedStrict) (Rec0 Int)))) |
Address class
class Eq a => Addr a where Source #
>>>
toIPv4 [127,0,2,1] `masked` intToMask 7
126.0.0.0
masked :: a -> a -> a Source #
intToMask :: Int -> a Source #
The intToMask
function takes an Int
representing the number of bits to
be set in the returned contiguous mask. When this integer is positive the
bits will be starting from the MSB and from the LSB otherwise.
>>>
intToMask 16 :: IPv4
255.255.0.0
>>>
intToMask (-16) :: IPv4
0.0.255.255
>>>
intToMask 16 :: IPv6
ffff::
>>>
intToMask (-16) :: IPv6
::ffff
makeAddrRange :: Addr a => a -> Int -> AddrRange a Source #
The makeAddrRange
functions takes an Addr
address and a mask
length. It creates a bit mask from the mask length and masks
the Addr
address, then returns AddrRange
made of them.
>>>
makeAddrRange (toIPv4 [127,0,2,1]) 8
127.0.0.0/8>>>
makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 8
2000::/8
(>:>) :: Addr a => AddrRange a -> AddrRange a -> Bool Source #
The >:> operator takes two AddrRange
. It returns True
if
the first AddrRange
contains the second AddrRange
. Otherwise,
it returns False
.
>>>
makeAddrRange ("127.0.2.1" :: IPv4) 8 >:> makeAddrRange "127.0.2.1" 24
True>>>
makeAddrRange ("127.0.2.1" :: IPv4) 24 >:> makeAddrRange "127.0.2.1" 8
False>>>
makeAddrRange ("2001:DB8::1" :: IPv6) 16 >:> makeAddrRange "2001:DB8::1" 32
True>>>
makeAddrRange ("2001:DB8::1" :: IPv6) 32 >:> makeAddrRange "2001:DB8::1" 16
False
isMatchedTo :: Addr a => a -> AddrRange a -> Bool Source #
The toMatchedTo
function take an Addr
address and an AddrRange
,
and returns True
if the range contains the address.
>>>
("127.0.2.0" :: IPv4) `isMatchedTo` makeAddrRange "127.0.2.1" 24
True>>>
("127.0.2.0" :: IPv4) `isMatchedTo` makeAddrRange "127.0.2.1" 32
False>>>
("2001:DB8::1" :: IPv6) `isMatchedTo` makeAddrRange "2001:DB8::1" 32
True>>>
("2001:DB8::" :: IPv6) `isMatchedTo` makeAddrRange "2001:DB8::1" 128
False