parser/src/GenericParser/IPAddress.purs

-- | `IPAddress` is a parser for internet protocol addresses (both IPv4 and IPv6).
module GenericParser.IPAddress where

import Prelude (Ordering(..), compare, (==), (<>), (<), (+), (-), between, bind, pure, ($), (<<<), (>), show, map, unit)

import Control.Alt ((<|>))
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.String.CodeUnits as CU

import GenericParser.Parser (Parser(..)
                            , failureError
                            , current_position
                            , string
                            , read_input, many1, lookahead
                            , char)
import GenericParser.BaseFunctions (repeat)
import GenericParser.SomeParsers (nat)
import GenericParser.RFC5234 (hexdig)

data IPv6Error
  = IP6TooManyHexaDecimalCharacters
  | IP6NotEnoughChunks
  | IP6TooManyChunks
  | IP6IrrelevantShortRepresentation
  | IP6InvalidRange

-- | `ipv6_chunk` parses just a group of hexadecimal characters.
-- | Return an error (IP6TooManyHexaDecimalCharacters) in case the group has more than 4 characters.
ipv6_chunk :: Parser IPv6Error String
ipv6_chunk = do pos <- current_position
                hexachars <- many1 hexdig
                if A.length hexachars > 4
                then Parser \_ -> failureError pos (Just IP6TooManyHexaDecimalCharacters)
                else pure $ CU.fromCharArray hexachars

-- | `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 prefix ':' character.
ipv6_chunk'' :: Parser IPv6Error String
ipv6_chunk'' = do _ <- char ':'
                  ipv6_chunk

-- | `ipv6_full''` parses a representation without shortcuts ("::").
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 IP6NotEnoughChunks)
                 EQ -> pure $ A.fold (A.intersperse ":" (chunks <> [lastchunk]))
                 GT -> Parser \_ -> failureError pos (Just IP6TooManyChunks)

-- | `ipv6_shortened` parses a shortened representation of an IPv6 address.
ipv6_shortened :: Parser IPv6Error String
ipv6_shortened =
  do chunks_part1 <- A.many ipv6_chunk'
     _ <- if A.length chunks_part1 == 0
          then do _ <- lookahead (string "::")
                  char ':'
          else do lookahead (char ':')
     pos <- current_position
     chunks_part2 <- A.many ipv6_chunk''
     _ <- if A.length chunks_part2 == 0
          then do _ <- char ':'
                  pure unit
          else pure unit
     let nb_zero_filling = 8 - (A.length chunks_part1 + A.length chunks_part2)
         filling = repeat nb_zero_filling "0000"
     if nb_zero_filling < 1
     then Parser \_ -> failureError pos (Just IP6IrrelevantShortRepresentation)
     else pure $ A.fold (A.intersperse ":" $ A.concat [chunks_part1, filling, chunks_part2])

-- | TODO: accept IPv6 addresses between brackets ([ipv6]).
ipv6 :: Parser IPv6Error String
ipv6 = ipv6_shortened <|> ipv6_full

-- | `ipv6_range` parses an ipv6 range, such as "2001::1/56".
-- | If the parsing succeed, the whole string is returned.
ipv6_range :: Parser IPv6Error String
ipv6_range =
  read_input do _ <- ipv6
                _ <- char '/'
                pos <- current_position
                n <- nat
                if between 0 128 n
                then pure ""
                else Parser \_ -> failureError pos (Just IP6InvalidRange)

data IPv4Error
  = IP4NumberTooBig Int
  | IP4IrrelevantShortRepresentation
  | IP4InvalidRange

-- | `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
               if number > 255
               then Parser \_ -> failureError pos ((Just <<< IP4NumberTooBig) 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 a prefix '.'.
ipv4_byte'' :: Parser IPv4Error Int
ipv4_byte'' = do _ <- char '.'
                 ipv4_byte

ipv4_generic4bytes :: Parser IPv4Error String
ipv4_generic4bytes =
  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` parses a short representation of an IPv4 address, such as '127..1'.
ipv4_shortened :: Parser IPv4Error String
ipv4_shortened =
  do chunks_part1 <- many1 ipv4_byte'
     _ <- lookahead (char '.')
     pos <- current_position
     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 IP4IrrelevantShortRepresentation)
     else pure $ A.fold (A.intersperse "." [part1, filling, part2])

ipv4 :: Parser IPv4Error String
ipv4 = ipv4_shortened <|> ipv4_generic4bytes

-- | `ipv4_range` parses an ipv4 range, such as "192.0.2.0/24".
-- | If the parsing succeed, the whole string is returned.
ipv4_range :: Parser IPv4Error String
ipv4_range =
  read_input do _ <- ipv4
                _ <- char '/'
                pos <- current_position
                n <- nat
                if between 0 32 n
                then pure ""
                else Parser \_ -> failureError pos (Just IP4InvalidRange)