9f8c87fc1cc2cca2ba1d0da98858b7d3e43bdb6b
[dead/harbl.git] / src / IPv4Pattern.hs
1 -- | An IPv4 address pattern has four fields separated by ".". Each
2 -- field is either a decimal number, or a sequence inside "[]" that
3 -- contains one or more ";"-separated decimal numbers or
4 -- number..number ranges.
5 --
6 -- Thus, any pattern field can be a sequence inside "[]", but a "[]"
7 -- sequence cannot span multiple address fields, and a pattern field
8 -- cannot contain both a number and a "[]" sequence at the same
9 -- time.
10 --
11 -- This means that the pattern 1.2.[3.4] is not valid (the sequence
12 -- [3.4] cannot span two address fields) and the pattern
13 -- 1.2.3.3[6..9] is also not valid (the last field cannot be both
14 -- number 3 and sequence [6..9] at the same time).
15 --
16 -- The syntax for IPv4 patterns is as follows:
17 --
18 -- v4pattern = v4field "." v4field "." v4field "." v4field
19 -- v4field = v4octet | "[" v4sequence "]"
20 -- v4octet = any decimal number in the range 0 through 255
21 -- v4sequence = v4seq_member | v4sequence ";" v4seq_member
22 -- v4seq_member = v4octet | v4octet ".." v4octet
23 --
24 module IPv4Pattern
25 where
26
27 import Test.Tasty ( TestTree, testGroup )
28 import Test.Tasty.HUnit ( (@?=), testCase )
29 import Text.Parsec
30 import Text.Parsec.String ( Parser )
31
32
33 newtype IPv4Octet = IPv4Octet Int
34 deriving (Eq, Show)
35
36 data IPv4SequenceMember =
37 IPv4SequenceMemberOctet IPv4Octet
38 | IPv4SequenceMemberOctetRange IPv4Octet IPv4Octet
39 deriving (Eq, Show)
40
41 data IPv4Sequence =
42 IPv4SequenceSingleMember IPv4SequenceMember
43 | IPv4SequenceOptions IPv4SequenceMember IPv4Sequence
44 deriving (Eq, Show)
45
46
47 data IPv4Field = IPv4FieldOctet IPv4Octet | IPv4FieldSequence IPv4Sequence
48 deriving (Eq, Show)
49
50 data IPv4Pattern =
51 IPv4Pattern IPv4Field IPv4Field IPv4Field IPv4Field
52 deriving (Eq, Show)
53
54
55 -- | Parse an IPv4 \"sequence member\". A sequence member is either an
56 -- octet, or a start..end sequence (like an enumeration, in Haskell).
57 --
58 -- ==== _Examples_
59 --
60 -- >>> parse v4seq_member "" "127"
61 -- Right (IPv4SequenceMemberOctet (IPv4Octet 127))
62 --
63 -- >>> parse v4seq_member "" "1..5"
64 -- Right (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 5))
65 --
66 v4seq_member :: Parser IPv4SequenceMember
67 v4seq_member = try both <|> just_one
68 where
69 both = do
70 oct1 <- v4octet
71 _ <- string ".."
72 oct2 <- v4octet
73 return $ IPv4SequenceMemberOctetRange oct1 oct2
74
75 just_one = fmap IPv4SequenceMemberOctet v4octet
76
77
78 -- | Parse an IPv4 \"sequence\". A sequence is whatever is allowed
79 -- within square brackets. Basically it can be three things:
80 --
81 -- * An octet (number).
82 -- * A range of addresses in start..end format.
83 -- * An alternative, separated by a semicolon, where each side
84 -- contains one of the previous two options.
85 --
86 -- ==== _Examples_
87 --
88 -- >>> parse v4sequence "" "1"
89 -- Right (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 1)))
90 --
91 -- >>> parse v4sequence "" "1..2"
92 -- Right (IPv4SequenceSingleMember (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 2)))
93 --
94 -- >>> parse v4sequence "" "1..2;8"
95 -- Right (IPv4SequenceOptions (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 2)) (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 8))))
96 --
97 v4sequence :: Parser IPv4Sequence
98 v4sequence = try both <|> just_one -- Maybe sepBy is appropriate here?
99 where
100 both = do
101 sm <- v4seq_member
102 _ <- char ';'
103 s <- v4sequence
104 return $ IPv4SequenceOptions sm s
105
106 just_one = fmap IPv4SequenceSingleMember v4seq_member
107
108
109 -- | Parse an IPv4 \"field\", which is either a boring old octet, or a
110 -- 'v4sequence' within square brackets.
111 --
112 -- ==== _Examples_
113 --
114 -- >>> parse v4field "" "127"
115 -- Right (IPv4FieldOctet (IPv4Octet 127))
116 --
117 -- >>> parse v4field "" "[127]"
118 -- Right (IPv4FieldSequence (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 127))))
119 --
120 v4field :: Parser IPv4Field
121 v4field = just_octet <|> brackets
122 where
123 just_octet = fmap IPv4FieldOctet v4octet
124
125 brackets = do
126 _ <- char '['
127 s <- v4sequence
128 _ <- char ']'
129 return $ IPv4FieldSequence s
130
131
132 -- | Parse an IPv4 octet, which should contain a string of digits.
133 --
134 -- ==== _Examples_
135 --
136 -- >>> parse v4octet "" "127"
137 -- Right (IPv4Octet 127)
138 --
139 v4octet :: Parser IPv4Octet
140 v4octet = fmap (IPv4Octet . read) $ many1 digit
141
142 v4pattern :: Parser IPv4Pattern
143 v4pattern = do
144 field1 <- v4field
145 _ <- char '.'
146 field2 <- v4field
147 _ <- char '.'
148 field3 <- v4field
149 _ <- char '.'
150 field4 <- v4field
151 return $ IPv4Pattern field1 field2 field3 field4
152
153
154 sequence_members :: IPv4SequenceMember -> [String]
155 sequence_members (IPv4SequenceMemberOctet (IPv4Octet i)) = [show i]
156 sequence_members (IPv4SequenceMemberOctetRange (IPv4Octet start) (IPv4Octet end)) =
157 [show x | x <- [start..end]]
158
159 sequences :: IPv4Sequence -> [String]
160 sequences (IPv4SequenceSingleMember sm) = sequence_members sm
161 sequences (IPv4SequenceOptions sm s) =
162 (sequence_members sm) ++ (sequences s)
163
164
165 fields :: IPv4Field -> [String]
166 fields (IPv4FieldOctet (IPv4Octet i)) = [show i]
167 fields (IPv4FieldSequence s) = sequences s
168
169
170 addresses :: IPv4Pattern -> [String]
171 addresses (IPv4Pattern field1 field2 field3 field4) = do
172 f1 <- fields field1
173 f2 <- fields field2
174 f3 <- fields field3
175 f4 <- fields field4
176 return $ f1 ++ "." ++ f2 ++ "." ++ f3 ++ "." ++ f4
177
178
179 -- Tests
180
181 v4octet_tests :: TestTree
182 v4octet_tests =
183 testGroup
184 "v4octet tests"
185 [ test_v4octet_single_digit_parsed ]
186
187 test_v4octet_single_digit_parsed :: TestTree
188 test_v4octet_single_digit_parsed =
189 testCase "a single digit is parsed as a v4octet" $ do
190 -- Whatever, it's a test.
191 let (Right actual) = parse v4octet "" "1"
192 let expected = IPv4Octet 1
193 actual @?= expected