113 lines
4.2 KiB
Haskell
113 lines
4.2 KiB
Haskell
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
|