The purpose of this task is to demonstrate parsing of text-format IP addresses, using IPv4 and IPv6.



Taking the following as inputs:



127.0.0.1

The "localhost" IPv4 address


127.0.0.1:80

The "localhost" IPv4 address, with a specified port (80)


::1

The "localhost" IPv6 address


[::1]:80

The "localhost" IPv6 address, with a specified port (80)


2605:2700:0:3::4713:93e3

Rosetta Code's primary server's public IPv6 address


[2605:2700:0:3::4713:93e3]:80

Rosetta Code's primary server's public IPv6 address, with a specified port (80)



Task

Emit each described IP address as a hexadecimal integer representing the address, the address space, and the port number specified, if any.

In languages where variant result types are clumsy, the result should be ipv4 or ipv6 address number, something which says which address space was represented, port number and something that says if the port was specified.



Example

127.0.0.1   has the address number   7F000001   (2130706433 decimal)
in the ipv4 address space.

::ffff:127.0.0.1   represents the same address in the ipv6 address space where it has the
address number   FFFF7F000001   (281472812449793 decimal).

::1   has address number   1   and serves the same purpose in the ipv6 address
space that   127.0.0.1   serves in the ipv4 address space.




import Data.List (isInfixOf)
import Numeric (showHex)
import Data.Char (isDigit)
 
data IPChunk = IPv6Chunk String | IPv4Chunk (String, String) |
    IPv6WithPort [IPChunk] String | IPv6NoPort [IPChunk] |
    IPv4WithPort IPChunk String | IPv4NoPort IPChunk |
    IPInvalid | IPZeroSection | IPUndefinedWithPort String |
    IPUndefinedNoPort
 
instance Show IPChunk where
    show (IPv6Chunk a) = a
    show (IPv4Chunk (a,b)) = a ++ b
    show (IPv6WithPort a p) = "IPv6 " ++ concatMap show a ++ " port " ++ p
    show (IPv6NoPort a) = "IPv6 " ++ concatMap show a ++ " no port"
    show (IPv4WithPort a p) = "IPv4 " ++ show a ++ " port " ++ p
    show (IPv4NoPort a) = "IPv4 " ++ show a
    show IPInvalid = "Invalid IP address"
 
isIPInvalid IPInvalid = True
isIPInvalid _ = False
 
isIPZeroSection IPZeroSection = True
isIPZeroSection _ = False
 
splitOn _ [] = []
splitOn x xs = let (a, b) = break (== x) xs in a : splitOn x (drop 1 b)
 
count x = length . filter (== x)
 
between a b x = x >= a && x <= b
 
none f = all (not . f)
 
parse1 [] = IPInvalid
parse1 "::" = IPUndefinedNoPort
parse1 ('[':':':':':']':':':ps) = if portIsValid ps then IPUndefinedWithPort ps else IPInvalid
parse1 ('[':xs) = if "]:" `isInfixOf` xs
    then let (a, b) = break (== ']') xs in
            if tail b == ":" then IPInvalid else IPv6WithPort (map chunk (splitOn ':' a)) (drop 2 b)
    else IPInvalid
parse1 xs
    | count ':' xs <= 1 && count '.' xs == 3 =
        let (a, b) = break (== ':') xs in case b of
                "" -> IPv4NoPort (chunk a)
                (':':ps) -> IPv4WithPort (chunk a) ps
                _ -> IPInvalid
    | count ':' xs > 1 && count '.' xs <= 3 =
        IPv6NoPort (map chunk (splitOn ':' xs))
 
chunk [] = IPZeroSection
chunk xs
    | '.' `elem` xs = case splitOn '.' xs of
        [a,b,c,d] -> let [e,f,g,h] = map read [a,b,c,d]
                     in if all (between 0 255) [e,f,g,h]
                            then let [i,j,k,l] = map (\n -> fill 2 $ showHex n "") [e,f,g,h]
                                 in IPv4Chunk (i ++ j, k ++ l)
                            else IPInvalid
    | ':' `notElem` xs && between 1 4 (length xs) && all (`elem` "0123456789abcdef") xs = IPv6Chunk (fill 4 xs)
    | otherwise = IPInvalid 
 
fill n xs = replicate (n - length xs) '0' ++ xs
 
parse2 IPInvalid = IPInvalid
parse2 (IPUndefinedWithPort p) = IPv6WithPort (replicate 8 zeroChunk) p
parse2 IPUndefinedNoPort = IPv6NoPort (replicate 8 zeroChunk)
parse2 a = case a of
    IPv6WithPort xs p -> if none isIPInvalid xs && portIsValid p
        then let ys = complete xs
             in  if countChunks ys == 8
                     then IPv6WithPort ys p
                     else IPInvalid
        else IPInvalid
    IPv6NoPort xs -> if none isIPInvalid xs
        then let ys = complete xs
             in  if countChunks ys == 8
                     then IPv6NoPort ys
                     else IPInvalid
        else IPInvalid
    IPv4WithPort (IPv4Chunk a) p -> if portIsValid p
        then IPv4WithPort (IPv4Chunk a) p
        else IPInvalid
    IPv4NoPort (IPv4Chunk a) -> IPv4NoPort (IPv4Chunk a)
    _ -> IPInvalid
 
zeroChunk = IPv6Chunk "0000"
 
portIsValid a = all isDigit a && between 0 65535 (read a)
 
complete xs = case break isIPZeroSection xs of
    (_, [IPZeroSection]) -> []
    (ys, []) -> ys
    ([], (IPZeroSection:IPZeroSection:ys)) -> if any isIPZeroSection ys || countChunks ys > 7
        then []
        else replicate (8 - countChunks ys) zeroChunk ++ ys
    (ys, (IPZeroSection:zs)) -> if any isIPZeroSection zs || countChunks ys + countChunks zs > 7
        then []
        else ys ++ replicate (8 - countChunks ys - countChunks zs) zeroChunk ++ zs
    _ -> []
 
countChunks xs = foldl f 0 xs
    where f n (IPv4Chunk _) = n + 2
          f n (IPv6Chunk _) = n + 1
 
ip = parse2 . parse1
 
main = mapM_ (putStrLn . show . ip)
    ["127.0.0.1",                                  -- loop back
     "127.0.0.1:80",                               -- loop back +port
     "::1",                                        -- loop back
     "[::1]:80",                                   -- loop back +port
     "2605:2700:0:3::4713:93e3",                   -- Rosetta Code
     "[2605:2700:0:3::4713:93e3]:80"]              -- Rosetta Code
 