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