Better code for IPv4.

src/GenericParser.purs

@@ -4,6 +4,6 @@ module GenericParser
   , module GenericParser.DomainParser
   ) where
 
-import GenericParser.DomainParser.Common (DomainError(..), eof, ldh_str, let_dig, let_dig_hyp, max_domain_length, max_label_length, Size)
+import GenericParser.DomainParser.Common (DomainError(..), ldh_str, let_dig, let_dig_hyp, max_domain_length, max_label_length, Size)
 import GenericParser.DomainParser (domain, label, subdomain, sub_eof)
-import GenericParser.Parser (alphanum, char, current_position, digit, Error, failure, failureError, ident, identifier, Input, int, integer, item, letter, lower, many1, nat, natural, parse, Parser(..), Position, PositionString, Result, sat, space, string, success, symbol, token, try, tryMaybe, upper, Value)
+import GenericParser.Parser (alphanum, char, current_input, current_position, digit, eof, Error, failure, failureError, ident, identifier, Input, int, integer, item, letter, lower, many1, nat, natural, parse, parse_last_char, Parser(..), Position, PositionString, Result, sat, space, string, success, symbol, token, try, tryMaybe, upper, Value)

src/GenericParser/DomainParser.purs

@@ -18,7 +18,8 @@ import GenericParser.DomainParser.Common (DomainError(..), eof, ldh_str, let_dig
 import GenericParser.Parser (Parser(..)
                             , failureError
                             , current_position
-                            , char, letter, parse, string
+                            , char, letter, string
+                            , parse_last_char
                             , tryMaybe)
 
 -- | From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
@@ -39,18 +40,6 @@ label = do
       else if (S.length labelstr > 1 && not (parse_last_char labelstr let_dig))
            then Parser \_ -> failureError (lastpos - 1) (Just InvalidCharacter)
            else pure labelstr
-  where
-     -- Get the last character of a String.
-     last_char :: String -> Maybe Char
-     last_char = A.last <<< CU.toCharArray
-
-     -- Parse the last character of a String.
-     parse_last_char :: forall e. String -> Parser e Char -> Boolean
-     parse_last_char s p = case last_char s of
-       Nothing -> false
-       Just c -> case parse p { string: CU.singleton c, position: 0 } of
-         Left _  -> false
-         _       -> true
 
 -- | From RFC 1035: <subdomain> ::= <label> | <subdomain> "." <label>
 -- | For implementation details, this accepts a final dot "." as a suffix.

src/GenericParser/IPAddress.purs

@@ -1,7 +1,7 @@
 -- | `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)
@@ -60,16 +60,15 @@ ipv6_shortened =
          filling = A.fold (A.intersperse ":" $ repeat nb_zero_filling "0000")
      pure $ A.fold (A.intersperse ":" [part1, filling, part2])
 
--- | TODO: verify the number of chunks (groups of hexadecimal characters).
--- |
 -- | TODO: accept IPv6 addresses between brackets ([ipv6]).
 ipv6 :: Parser IPv6Error String
 ipv6 = ipv6_shortened <|> ipv6_full
 
-
 data IPv4Error
   = NumberTooBig Int
+  | IPv4UselessUseOfDoubleDots
 
+-- | `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
 ipv4_byte = do pos <- current_position
                number <- nat
@@ -77,16 +76,39 @@ ipv4_byte = do pos <- current_position
                then Parser \_ -> failureError pos ((Just <<< NumberTooBig) number)
                else pure number
 
+-- | `ipv4_byte'` is `ipv4_byte` with a leading '.'.
+ipv4_byte' :: Parser IPv4Error Int
+ipv4_byte' = do number <- ipv4_byte
+                _ <- char '.'
+                pure number
+
+-- | `ipv4_byte''` is `ipv4_byte` with an optional leading '.'.
+ipv4_byte'' :: Parser IPv4Error Int
+ipv4_byte'' = do number <- ipv4_byte
+                 _ <- tryMaybe $ char '.'
+                 pure number
+
 ipv4_generic4bytes :: Parser IPv4Error String
 ipv4_generic4bytes =
-  do b1 <- ipv4_byte
-     _ <- char '.'
-     b2 <- ipv4_byte
-     _ <- char '.'
-     b3 <- ipv4_byte
-     _ <- char '.'
+  do b1 <- ipv4_byte'
+     b2 <- ipv4_byte'
+     b3 <- ipv4_byte'
      b4 <- ipv4_byte
      pure $ A.fold (A.intersperse "." $ map show [b1,b2,b3,b4])
 
+ipv4_shortened :: Parser IPv4Error String
+ipv4_shortened =
+  do chunks_part1 <- many1 ipv4_byte'
+     pos <- current_position
+     _ <- char '.'
+     chunks_part2 <- many1 ipv4_byte''
+     let part1 = A.fold (A.intersperse "." (map show chunks_part1))
+         part2 = A.fold (A.intersperse "." (map show chunks_part2))
+         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)
+     else pure $ A.fold (A.intersperse "." [part1, filling, part2])
+
 ipv4 :: Parser IPv4Error String
-ipv4 = ipv4_generic4bytes
+ipv4 = ipv4_shortened <|> ipv4_generic4bytes

src/GenericParser/Parser.purs

@@ -10,7 +10,7 @@ import Data.Either (Either(..))
 import Data.Int as Int
 import Data.Maybe (Maybe(..))
 import Data.String as S
-import Data.String.CodeUnits (toCharArray, fromCharArray)
+import Data.String.CodeUnits (toCharArray, fromCharArray, singleton)
 
 import GenericParser.BaseFunctions (concat, isAlpha, isAlphaNum, isDigit, isLower, isSpace, isUpper)
 
@@ -27,9 +27,21 @@ newtype Parser e v = Parser (Input -> Result e v)
 parse :: forall e v. Parser e v -> (Input -> Result e v)
 parse (Parser p) = p
 
+-- | `current_position` provides the current position in the input.
+-- | This is used notably before actual parsing and to provide the
+-- | starting position where parsing failed, not just the last character position.
+-- |
+-- | This function cannot fail since no parsing is performed.
 current_position :: forall e. Parser e Position
 current_position = Parser \input -> success input input.position
 
+-- | `current_input` provides the current state of the input.
+-- | This is used notably to look ahead.
+-- |
+-- | This function cannot fail since no parsing is performed.
+current_input :: forall e. Parser e Input
+current_input = Parser \input -> success input input
+
 -- | Fail with a specified error.
 -- | When a parsing has a specified error, no alternative will be tried and the error is reported.
 failureError :: forall e v. Position -> Maybe e -> Result e v
@@ -199,3 +211,16 @@ many1 :: forall e v. Parser e v -> Parser e (Array v)
 many1 p = do first <- p
              rest <- A.many p
              pure $ A.cons first rest
+
+-- | Parse the last character of a String.
+-- | Return false in case the string is empty.
+parse_last_char :: forall e. String -> Parser e Char -> Boolean
+parse_last_char s p = case last_char s of
+  Nothing -> false
+  Just c -> case parse p { string: singleton c, position: 0 } of
+    Left _  -> false
+    _       -> true
+  where
+    -- Get the last character of a String.
+    last_char :: String -> Maybe Char
+    last_char = A.last <<< toCharArray

test/Main.purs

@@ -58,6 +58,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"
 
 test_ipv4 :: String -> Effect Unit
 test_ipv4 ipv4string = do
@@ -98,12 +99,17 @@ main = do
   test_series "ModernDomains.domain" ModernDomains.domain id showerror domains
 
   log ""
+  test_ipv4 "10..1"
+  test_ipv4 "1..2"
   test_ipv4 "1.2.3.4"
+  test_ipv4 "192.168..1"
   test_ipv4 "1..2.3.4"
   test_ipv4 "1.5.10.255"
   test_ipv4 "100.200.300.400"
 
   log ""
   test_ipv6 "2001:0"
+  test_ipv6 "2001::0"
+  test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3"
   test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334"
   test_ipv6 "2001:0db8::8a2e:0370:7334"