From 7ea7672ecf923896a8006c576b38f3751359f6aa Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Wed, 24 Jan 2024 04:21:25 +0100 Subject: [PATCH] Simplification + check for useless use of short representation (IP v4 & v6) --- src/GenericParser/IPAddress.purs | 64 ++++++++++++++++++++------------ test/Main.purs | 11 +++--- 2 files changed, 47 insertions(+), 28 deletions(-) diff --git a/src/GenericParser/IPAddress.purs b/src/GenericParser/IPAddress.purs index 966abb4..8b75750 100644 --- a/src/GenericParser/IPAddress.purs +++ b/src/GenericParser/IPAddress.purs @@ -1,18 +1,15 @@ -- | `IPAddress` is a parser for internet protocol addresses (both IPv4 and IPv6). module GenericParser.IPAddress where -import Prelude (Ordering(..), compare, (<), (+), (-), bind, pure, ($), (<<<), (>), show, map) +import Prelude (Ordering(..), compare, (<>), (<), (+), (-), bind, pure, ($), (<<<), (>), show, map) import Control.Alt ((<|>)) --- import Control.Lazy (defer) import Data.Array as A --- import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) --- import Data.String as S import Data.String.CodeUnits as CU import GenericParser.Parser (Parser(..) - , failureError, failure + , failureError , current_position , tryMaybe , many1 @@ -24,41 +21,59 @@ data IPv6Error | TooManyHexaDecimalCharacters | NotEnoughChunks | TooManyChunks + | IPv6UnrelevantShortRepresentation hex :: forall e. Parser e Char hex = sat isHexaDecimal --- | `ipv6_chunk` analyses just a nibble +-- | `ipv6_chunk` parses just a group of hexadecimal characters. +-- | Return an error (TooManyHexaDecimalCharacters) in case the group has more than 4 characters. ipv6_chunk :: Parser IPv6Error String ipv6_chunk = do pos <- current_position hexachars <- many1 hex - _ <- tryMaybe $ char ':' if A.length hexachars > 4 then Parser \_ -> failureError pos (Just TooManyHexaDecimalCharacters) else pure $ CU.fromCharArray hexachars -ipv6_full :: Parser IPv6Error String -ipv6_full = do chunks <- many1 ipv6_chunk - pos <- current_position - followup <- tryMaybe $ char ':' - case followup of - Just _ -> Parser \_ -> failure pos - Nothing -> do - case compare (A.length chunks) 8 of - LT -> Parser \_ -> failureError pos (Just NotEnoughChunks) - EQ -> pure $ A.fold (A.intersperse ":" chunks) - GT -> Parser \_ -> failureError pos (Just TooManyChunks) +-- | `ipv6_chunk'` is `ipv6_chunk` with a following ':' character. +-- | This last character is dropped and the result of `ipv6_chunk` is propagated. +ipv6_chunk' :: Parser IPv6Error String +ipv6_chunk' = do chunk <- ipv6_chunk + _ <- char ':' + pure chunk +-- | `ipv6_chunk''` is `ipv6_chunk` with a following *optional* ':' character. +-- | This last character is dropped and the result of `ipv6_chunk` is propagated. +ipv6_chunk'' :: Parser IPv6Error String +ipv6_chunk'' = do chunk <- ipv6_chunk + _ <- tryMaybe $ char ':' + pure chunk + +ipv6_full :: Parser IPv6Error String +ipv6_full = do chunks <- many1 ipv6_chunk' + pos <- current_position + lastchunk <- ipv6_chunk + case compare (A.length chunks) 7 of + LT -> Parser \_ -> failureError pos (Just NotEnoughChunks) + EQ -> pure $ A.fold (A.intersperse ":" (chunks <> [lastchunk])) + GT -> Parser \_ -> failureError pos (Just TooManyChunks) + +-- | `ipv6_shortened` parses a shortened representation of an IPv6 address. +-- | +-- | TODO: `ipv6_shortened` allows an invalid following ':' character. ipv6_shortened :: Parser IPv6Error String ipv6_shortened = - do chunks_part1 <- many1 ipv6_chunk + do chunks_part1 <- many1 ipv6_chunk' + pos <- current_position _ <- char ':' - chunks_part2 <- many1 ipv6_chunk + chunks_part2 <- many1 ipv6_chunk'' let part1 = A.fold (A.intersperse ":" (chunks_part1)) part2 = A.fold (A.intersperse ":" (chunks_part2)) nb_zero_filling = 8 - (A.length chunks_part1 + A.length chunks_part2) filling = A.fold (A.intersperse ":" $ repeat nb_zero_filling "0000") - pure $ A.fold (A.intersperse ":" [part1, filling, part2]) + if nb_zero_filling < 1 + then Parser \_ -> failureError pos (Just IPv6UnrelevantShortRepresentation) + else pure $ A.fold (A.intersperse ":" [part1, filling, part2]) -- | TODO: accept IPv6 addresses between brackets ([ipv6]). ipv6 :: Parser IPv6Error String @@ -66,7 +81,7 @@ ipv6 = ipv6_shortened <|> ipv6_full data IPv4Error = NumberTooBig Int - | IPv4UselessUseOfDoubleDots + | IPv4UnrelevantShortRepresentation -- | `ipv4_byte` a parser for 0 to 255 natural integers, which is part of the representation of an IPv4 address. ipv4_byte :: Parser IPv4Error Int @@ -96,6 +111,9 @@ ipv4_generic4bytes = b4 <- ipv4_byte pure $ A.fold (A.intersperse "." $ map show [b1,b2,b3,b4]) +-- | `ipv4_shortened` parses a short representation of an IPv4 address, such as '127..1'. +-- | +-- | TODO: `ipv4_shortened` allows an invalid following '.' character. ipv4_shortened :: Parser IPv4Error String ipv4_shortened = do chunks_part1 <- many1 ipv4_byte' @@ -107,7 +125,7 @@ ipv4_shortened = nb_zero_filling = 4 - (A.length chunks_part1 + A.length chunks_part2) filling = A.fold (A.intersperse "." $ repeat nb_zero_filling "0") if nb_zero_filling < 1 - then Parser \_ -> failureError pos (Just IPv4UselessUseOfDoubleDots) + then Parser \_ -> failureError pos (Just IPv4UnrelevantShortRepresentation) else pure $ A.fold (A.intersperse "." [part1, filling, part2]) ipv4 :: Parser IPv4Error String diff --git a/test/Main.purs b/test/Main.purs index 6161d6c..a258285 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -42,10 +42,11 @@ test_series :: forall e v test_series l p v e a = foreachE a (\s -> logtest l p s v e) showerror_ipv6 :: IP.IPv6Error -> String -showerror_ipv6 (IP.InvalidCharacter) = "InvalidCharacter" -showerror_ipv6 (IP.TooManyHexaDecimalCharacters) = "TooManyHexaDecimalCharacters" -showerror_ipv6 (IP.NotEnoughChunks) = "NotEnoughChunks" -showerror_ipv6 (IP.TooManyChunks) = "TooManyChunks" +showerror_ipv6 (IP.InvalidCharacter) = "InvalidCharacter" +showerror_ipv6 (IP.TooManyHexaDecimalCharacters) = "TooManyHexaDecimalCharacters" +showerror_ipv6 (IP.NotEnoughChunks) = "NotEnoughChunks" +showerror_ipv6 (IP.TooManyChunks) = "TooManyChunks" +showerror_ipv6 IP.IPv6UnrelevantShortRepresentation = "useless double dots" test_ipv6 :: String -> Effect Unit test_ipv6 ipv6string = do @@ -58,7 +59,7 @@ test_ipv6 ipv6string = do showerror_ipv4 :: IP.IPv4Error -> String showerror_ipv4 (NumberTooBig x) = "value '" <> show x <> "' is > 255" -showerror_ipv4 IPv4UselessUseOfDoubleDots = "useless double dots" +showerror_ipv4 IPv4UnrelevantShortRepresentation = "useless double dots" test_ipv4 :: String -> Effect Unit test_ipv4 ipv4string = do