1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.IP.Range where
import Data.Bits
import Data.Char
import Data.Data (Data)
import Data.IP.Addr
import Data.IP.Mask
import Data.String
import Data.Typeable (Typeable)
import GHC.Generics
import Text.Appar.String
----------------------------------------------------------------
-- |
-- A unified data for 'AddrRange' 'IPv4' and 'AddrRange' 'IPv6'.
-- 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
data IPRange
= IPv4Range {ipv4range :: AddrRange IPv4}
| IPv6Range {ipv6range :: AddrRange IPv6}
deriving (Eq, Ord, Data, Generic, Typeable)
----------------------------------------------------------------
--
-- Range
--
-- |
-- 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' 'IPv4'.
-- 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
data AddrRange a = AddrRange
{ addr :: !a
-- ^ The 'addr' function returns an address from 'AddrRange'.
, mask :: !a
-- ^ The 'mask' function returns a contiguous 'IP' mask from 'AddrRange'.
, mlen :: {-# UNPACK #-} !Int
-- ^ The 'mlen' function returns a mask length from 'AddrRange'.
}
deriving (Eq, Ord, Data, Generic, Typeable)
----------------------------------------------------------------
--
-- Show
--
instance Show a => Show (AddrRange a) where
show x = show (addr x) ++ "/" ++ show (mlen x)
instance Show IPRange where
show (IPv4Range ip) = show ip
show (IPv6Range ip) = show ip
----------------------------------------------------------------
--
-- Read
--
instance Read IPRange where
readsPrec _ = parseIPRange
parseIPRange :: String -> [(IPRange, String)]
parseIPRange cs = case runParser ip4range cs of
(Just ip, rest) -> [(IPv4Range ip, rest)]
(Nothing, _) -> case runParser ip6range cs of
(Just ip, rest) -> [(IPv6Range ip, rest)]
(Nothing, _) -> []
instance Read (AddrRange IPv4) where
readsPrec _ = parseIPv4Range
instance Read (AddrRange IPv6) where
readsPrec _ = parseIPv6Range
parseIPv4Range :: String -> [(AddrRange IPv4, String)]
parseIPv4Range cs = case runParser ip4range cs of
(Nothing, _) -> []
(Just a4, rest) -> [(a4, rest)]
parseIPv6Range :: String -> [(AddrRange IPv6, String)]
parseIPv6Range cs = case runParser ip6range cs of
(Nothing, _) -> []
(Just a6, rest) -> [(a6, rest)]
maskLen :: Int -> Parser Int
maskLen maxLen = do
hasSlash <- option False $ True <$ char '/'
if hasSlash
then
0 <$ char '0'
<|> (toInt =<< (:) <$> oneOf ['1' .. '9'] <*> many digit)
else return maxLen
where
toInt ds = maybe (fail "mask length") pure $ foldr go Just ds 0
go !d !f !n =
let n' = n * 10 + ord d - 48
in if n' <= maxLen then f n' else Nothing
ip4range :: Parser (AddrRange IPv4)
ip4range = do
skipSpaces
ip <- toIPv4 <$> ip4' False
len <- maskLen 32
let msk = maskIPv4 len
adr = ip `maskedIPv4` msk
return $ AddrRange adr msk len
maskedIPv4 :: IPv4 -> IPv4 -> IPv4
IP4 a `maskedIPv4` IP4 m = IP4 (a .&. m)
ip6range :: Parser (AddrRange IPv6)
ip6range = do
ip <- ip6' False
len <- maskLen 128
let msk = maskIPv6 len
adr = ip `maskedIPv6` msk
return $ AddrRange adr msk len
maskedIPv6 :: IPv6 -> IPv6 -> IPv6
IP6 (a1, a2, a3, a4) `maskedIPv6` IP6 (m1, m2, m3, m4) = IP6 (a1 .&. m1, a2 .&. m2, a3 .&. m3, a4 .&. m4)
----------------------------------------------------------------
--
-- IsString
--
instance IsString IPRange where
fromString = read
instance IsString (AddrRange IPv4) where
fromString = read
instance IsString (AddrRange IPv6) where
fromString = read
|
