IPv6 addresses: verify the number of chunks + shortened representation.

src/GenericParser/BaseFunctions.purs

@@ -1,6 +1,6 @@
 module GenericParser.BaseFunctions where
 
-import Prelude (between, (<>), (==))
+import Prelude (between, (-), (<), (<>), (==), (||), ($))
 
 import Data.Array as A
 import Data.String.CodeUnits (singleton)
@@ -17,6 +17,9 @@ isLower = between 'a' 'z'
 isUpper :: Char -> Boolean
 isUpper = between 'A' 'Z'
 
+isHexaDecimal :: Char -> Boolean
+isHexaDecimal c = between '0' '9' c || between 'a' 'f' c || between 'A' 'F' c
+
 isAlpha :: Char -> Boolean
 isAlpha c = A.any (\f -> f c) [isLower, isUpper]
 
@@ -26,3 +29,6 @@ isAlphaNum c = A.any (\f -> f c) [isAlpha, isDigit]
 isSpace :: Char -> Boolean
 isSpace c = A.any (\v -> v == c) [' ', '\t', ' ', '\r', '\n']
 
+repeat :: forall a. Int -> a -> Array a
+repeat 0 _ = []
+repeat n v = if n < 0 then [] else A.cons v $ repeat (n - 1) v

src/GenericParser/IPAddress.purs

@@ -1,9 +1,9 @@
 -- | `IPAddress` is a parser for internet protocol addresses (both IPv4 and IPv6).
 module GenericParser.IPAddress where
 
-import Prelude (between, (||), bind, pure, ($), (<<<), (>), show, map)
+import Prelude (Ordering(..), compare, (+), (-), bind, pure, ($), (<<<), (>), show, map)
 
--- import Control.Alt ((<|>))
+import Control.Alt ((<|>))
 -- import Control.Lazy (defer)
 import Data.Array as A
 -- import Data.Either (Either(..))
@@ -12,23 +12,23 @@ import Data.Maybe (Maybe(..))
 import Data.String.CodeUnits as CU
 
 import GenericParser.Parser (Parser(..)
-                            , failureError
+                            , failureError, failure
                             , current_position
                             , tryMaybe
                             , many1
                             , sat, char, nat)
+import GenericParser.BaseFunctions (repeat, isHexaDecimal)
 
 data IPv6Error
   = InvalidCharacter
   | TooManyHexaDecimalCharacters
-
-isHexaDecimal :: Char -> Boolean
-isHexaDecimal c = between '0' '9' c || between 'a' 'f' c || between 'A' 'F' c
+  | NotEnoughChunks
+  | TooManyChunks
 
 hex :: forall e. Parser e Char
 hex = sat isHexaDecimal
 
--- | `ipv6_chunk` analyses just a nibble 
+-- | `ipv6_chunk` analyses just a nibble
 ipv6_chunk :: Parser IPv6Error String
 ipv6_chunk = do pos <- current_position
                 hexachars <- many1 hex
@@ -37,16 +37,34 @@ ipv6_chunk = do pos <- current_position
                 then Parser \_ -> failureError pos (Just TooManyHexaDecimalCharacters)
                 else pure $ CU.fromCharArray hexachars
 
--- | TODO: `ipv6` currently is oversimplistic and lacks shortened representation (with doubled ':' character).
--- |
--- | TODO: check for double ':'
--- |
+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_shortened :: Parser IPv6Error String
+ipv6_shortened =
+  do chunks_part1 <- many1 ipv6_chunk
+     _ <- char ':'
+     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])
+
 -- | TODO: verify the number of chunks (groups of hexadecimal characters).
 -- |
 -- | TODO: accept IPv6 addresses between brackets ([ipv6]).
 ipv6 :: Parser IPv6Error String
-ipv6 = do chunks <- many1 ipv6_chunk
-          pure $ A.fold (A.intersperse ":" chunks)
+ipv6 = ipv6_shortened <|> ipv6_full
 
 
 data IPv4Error

test/Main.purs

@@ -44,6 +44,8 @@ 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"
 
 test_ipv6 :: String -> Effect Unit
 test_ipv6 ipv6string = do
@@ -104,3 +106,4 @@ main = do
   log ""
   test_ipv6 "2001:0"
   test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334"
+  test_ipv6 "2001:0db8::8a2e:0370:7334"