diff --git a/src/GenericParser/BaseFunctions.purs b/src/GenericParser/BaseFunctions.purs index af1f428..ab58dea 100644 --- a/src/GenericParser/BaseFunctions.purs +++ b/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 diff --git a/src/GenericParser/IPAddress.purs b/src/GenericParser/IPAddress.purs index be6ee23..33eb3d9 100644 --- a/src/GenericParser/IPAddress.purs +++ b/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 diff --git a/test/Main.purs b/test/Main.purs index 3477bd1..8fb67a2 100644 --- a/test/Main.purs +++ b/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"