network-address 0.1.0 → 0.2.0
raw patch · 3 files changed
+143/−52 lines, 3 files
Files
- Benchmark.hs +16/−0
- Data/Network/Address/IP.hs +125/−50
- network-address.cabal +2/−2
Benchmark.hs view
@@ -14,6 +14,12 @@ ipv6 :: IPv6 ipv6 = toAddress 42540766452641154071740215577757643572 +ipv4subnet :: IPSubnet IPv4+ipv4subnet = IPSubnet ipv4 (toMask (8 :: Int))++ipv6subnet :: IPSubnet IPv6+ipv6subnet = IPSubnet ipv6 (toMask (56 :: Integer))+ main = defaultMain [ bgroup "IPv4" [ bgroup "Parse"@@ -29,6 +35,16 @@ ] , bgroup "PrettyPrint" [ bench "show" $ whnf showAddress ipv6+ ]+ ]+ , bgroup "Subnet"+ [ bgroup "Parse"+ [ bench "readIPv4" $ whnf (readSubnet :: String -> IPSubnet IPv4) "192.168.1.10/8"+ , bench "readIPv6" $ whnf (readSubnet :: String -> IPSubnet IPv6) "2001:0db8:85a3:0:0:8a2e:0370:7334/56"+ ]+ , bgroup "PrettyPrint"+ [ bench "showIPv4" $ whnf showSubnet ipv4subnet+ , bench "showIPv6" $ whnf showSubnet ipv6subnet ] ] ]
Data/Network/Address/IP.hs view
@@ -34,17 +34,22 @@ IPv6(..), IPSubnet(..), Mask,- toMask, fromMask,+ readAddress,+ readSubnet,+ toMask, ) where import Control.Monad (when) import Data.Bits import Data.Char (digitToInt, isDigit)-import Data.List (foldl', intercalate)+import Data.List (foldl', intercalate, findIndex, groupBy)+import Data.Maybe (fromJust) import Data.Word-import Numeric (showHex, readHex)+import Numeric (showHex)+import Text.ParserCombinators.ReadP import Text.Printf (printf)+import Text.Read.Lex (readDecP, readHexP) -- |The byte representation of an IP network mask. type Mask = Integer@@ -66,7 +71,7 @@ -- |Return the byte representation of an IP 'Address'. fromAddress :: a -> Integer -- |Parse a textual representation of an IP 'Address'.- readAddress :: String -> a+ readsAddress :: ReadS a -- |Return a conanical textual representation of an IP 'Address'. showAddress :: a -> String -- |Apply a mask to an 'Address'.@@ -78,7 +83,7 @@ -- IP subnetworks. class (Address a) => Subnet s a | s -> a where -- |Parse a textual representation of a 'Subnet'.- readSubnet :: String -> s+ readsSubnet :: ReadS s -- |Return a conanical textual representation of a 'Subnet'. showSubnet :: s -> String -- |Return the first 'IP' in the 'Subnet'.@@ -89,6 +94,22 @@ member :: a -> s -> Bool member ip s = fromAddress ip .&. netmask s == fromAddress (base s) +-- |@readAddress s@ parses an 'Address'. The 'String' @s@ must be+-- completely consumed.+readAddress :: (Address a) => String -> a+readAddress s = case [x | (x, "") <- readsAddress s] of+ [ip] -> ip+ [] -> error "readAddress: no parse"+ _ -> error "readAddress: ambiguous parse"++-- |@readSubnet s@ parses a 'Subnet'. The 'String' @s@ must be+-- completely consumed.+readSubnet :: (Address a, Subnet s a) => String -> s+readSubnet s = case [x | (x, "") <- readsSubnet s] of+ [ip] -> ip+ [] -> error "readSubnet: no parse"+ _ -> error "readSubnet: ambiguous parse"+ -- -- IPv4 --@@ -96,7 +117,7 @@ instance Address IPv4 where fromAddress (IPv4 x) = toInteger x toAddress = IPv4 . fromInteger- readAddress = readIPv4+ readsAddress = readsIPv4 showAddress = showIPv4 -- |Return a conanical textual representation of an IPv4 IP address,@@ -109,21 +130,28 @@ (r3, d) = shift8 ip shift8 = (`divMod` 256) --- |Parse a textual representation of an 'IPv4' IP address, returning the--- address and the remainded of the 'String'.-readIPv4' :: String -> (IPv4, String)-readIPv4' s = (IPv4 $ sum . zipWith shift ds $ [24, 16, 8, 0], s')- where (a, _:xs1) = span isDigit s- (b, _:xs2) = span isDigit xs1- (c, _:xs3) = span isDigit xs2- (d, s') = span isDigit xs3- ds = map (fromIntegral . digitsToInt) [a, b, c, d] :: [Word32]+-- |Parse an 'IPv4' IP address.+readsIPv4 :: ReadS IPv4+readsIPv4 = readP_to_S readpIPv4 --- |Parse a textual representation of an 'IPv4' IP address,--- e.g. @127.0.0.1@-readIPv4 :: String -> IPv4-readIPv4 = fst . readIPv4'+-- |An IPv4 parser.+readpIPv4 :: ReadP IPv4+readpIPv4 = do+ a <- ipv4Digit+ (b:c:d:_) <- count 3 (char '.' >> ipv4Digit)+ return $ IPv4 (a `shift` 24 + b `shift` 16 + c `shift` 8 + d) +-- |Parse an 8 bit IPv4 digit+ipv4Digit :: ReadP Word32+ipv4Digit = do+ d <- many1 (satisfy isDigit)+ let x = fromIntegral . digitsToInt $ d+ if 0 <= x && x < 256 then return x else pfail++-- |Parse an unsigned integer.+digitsToInt :: String -> Int+digitsToInt = foldl' ((+) . (10 *)) 0 . map digitToInt+ -- -- IPv6 --@@ -131,37 +159,71 @@ instance Address IPv6 where fromAddress = fromIPv6 toAddress = toIPv6- readAddress = readIPv6+ readsAddress = readsIPv6 showAddress = showIPv6 -- |Parse a textual representation of an 'IPv6' IP address, -- e.g. @1080:0:0:0:8:800:200C:417A@-readIPv6 :: String -> IPv6--- TODO: Support collapsed 0's and alternative syntax, as per RFC3513.-readIPv6 s = case ipv6octets s of- Just os -> toIPv6 . octetsToInteger . map (fst . head . readHex) $ os- otherwise -> error "Data.IP: no parse"+readsIPv6 :: ReadS IPv6+readsIPv6 = readP_to_S readpIPv6 +-- |An IPv6 parser.+readpIPv6 :: ReadP IPv6+readpIPv6 = fmap (toAddress . octetsToInteger) $ choice+ [ readHexP >>= \o -> count 7 (char ':' >> readHexP) >>= \os -> return (o:os)+ , do+ head <- many1 (readHexP <<* char ':')+ tail <- many1 (char ':' >> readHexP)+ let body = replicate (8 - (length head + length tail)) 0+ os = head ++ body ++ tail+ case length os of+ 8 -> return os+ _ -> pfail+ , char ':' >> many1 (char ':' >> readHexP) >>= \xs ->+ if length xs <= 8+ then return xs+ else pfail+ , string "::" >> return [0]+ , many1 (readHexP <<* char ':') <<* char ':' >>= \xs ->+ if length xs > 8+ then pfail+ else return (xs ++ replicate (8 - length xs) 0)+ ]++infixl 4 <<*+-- |Monad version of 'Applicative's '<*' operator.+(<<*) :: Monad m => m a -> m b -> m a+a <<* b = a >>= (b >>) . return+ octetsToInteger :: [Word16] -> Integer octetsToInteger = foldl' (\x y -> (x `shift` 16) + fromIntegral y) 0 -- |Return a conanical textual representation of an 'IPv6' IP address, -- e.g. @fedc:ba98:7654:3210:fedc:ba98:7654:3210@ showIPv6 :: IPv6 -> String--- TODO: Collapse the longest group of 0's, as per RFC5952.-showIPv6 = intercalate ":" . map (`showHex` "") . reverse . octets . fromIPv6- where octets x = case x `divMod` (2 ^ 16) of- (0 , o) -> [o]- (x', o) -> o : octets x'+showIPv6 ip = intercalate ":" fields+ where fields = if m == 1+ then map (`showHex` "") octets+ else (init ++ [""] ++ tail)+ init = if i == 0+ then [""]+ else map (`showHex` "") . concat . take i $ grouped+ tail = if i == (length lengths - 1)+ then [""]+ else map (`showHex` "") . concat . drop (i + 1) $ grouped+ i = fromJust $ findIndex (== m) lengths+ m = maximum lengths+ lengths = map length grouped+ grouped = groupBy (\x y -> x == 0 && y == 0) octets+ octets = toIPv6Octets . fromAddress $ ip --- |Split an IPv6 into octets (i.e. by ':').-ipv6octets :: String -> Maybe [String]-ipv6octets s = case span (/= ':') s of- ("", ':':os) -> fmap ((:) "0") (ipv6octets os)- ("", "") -> Just ["0"]- (o, ':':os) -> fmap ((:) o) (ipv6octets os)- (o, "") -> Just [o]- otherwise -> Nothing+-- |Split a number into 'IPv6' octets.+toIPv6Octets :: Integral a => a -> [a]+toIPv6Octets = fill . reverse . go+ where fill os = replicate (8 - length os) 0 ++ os+ go x = case x `divMod` (2 ^ 16) of+ (0, o) -> [o]+ (x', o) -> o : go x' -- |Convert the byte representation to an 'IPv6' address. toIPv6 :: Integer -> IPv6@@ -182,13 +244,13 @@ instance Subnet (IPSubnet IPv4) IPv4 where showSubnet = showIPSubnet- readSubnet = readIPSubnet+ readsSubnet = readsIPv4Subnet base (IPSubnet b _) = b netmask (IPSubnet _ m) = m instance Subnet (IPSubnet IPv6) IPv6 where showSubnet = showIPSubnet- readSubnet = readIPSubnet+ readsSubnet = readsIPv6Subnet base (IPSubnet b _) = b netmask (IPSubnet _ m) = m @@ -201,13 +263,30 @@ showIPSubnet :: (Address a) => IPSubnet a -> String showIPSubnet (IPSubnet ip mask) = showAddress ip ++ "/" ++ show (fromMask mask :: Integer) --- |Parse a textual representation of an IP address and subnet.-readIPSubnet :: (Address a) => String -> IPSubnet a-readIPSubnet s = ipSubnet ip mask- where (x, '/':y) = span (/= '/') s- mask = toMask . digitsToInt $ y- ip = readAddress x+-- |Parse a textual representation of an IPv4 address and subnet.+readsIPv4Subnet :: ReadS (IPSubnet IPv4)+readsIPv4Subnet = readP_to_S readpIPv4Subnet +-- |Return an IPv4 subnet parser.+readpIPv4Subnet :: ReadP (IPSubnet IPv4)+readpIPv4Subnet = do+ ip <- readpIPv4+ _ <- char '/'+ m <- readDecP :: ReadP Word32+ if 0 <= m && m <= 32 then return (ipSubnet ip (toMask m)) else pfail++-- |Parse a textual representation of an IPv6 address and subnet.+readsIPv6Subnet :: ReadS (IPSubnet IPv6)+readsIPv6Subnet = readP_to_S readpIPv6Subnet++-- |Return an IPv6 subnet parser.+readpIPv6Subnet :: ReadP (IPSubnet IPv6)+readpIPv6Subnet = do+ ip <- readpIPv6+ _ <- char '/'+ m <- readDecP :: ReadP Int+ if 0 <= m && m <= 128 then return (ipSubnet ip (toMask m)) else pfail+ -- |Convert a decimal mask to binary (e.g. 8 -> 1111.0000.0000.0000). toMask :: (Integral a, Bits a, Integral b, Bits b) => a -> b toMask size | size > 0 = complement (2^size - 1)@@ -222,8 +301,4 @@ timesDivisible a x = timesDivisible' a x 0 where timesDivisible' a x c | a > 0 = timesDivisible' (a `div` x) x (c + 1) | otherwise = c---- |Parse an integer.-digitsToInt :: String -> Int-digitsToInt = foldl' ((+) . (10 *)) 0 . map digitToInt
network-address.cabal view
@@ -1,5 +1,5 @@ Name: network-address-Version: 0.1.0+Version: 0.2.0 Synopsis: IP data structures and textual representation Description: A library for parsing, representing, computing and transforming network addresses such a IPv4, IPv6@@ -15,7 +15,7 @@ Source-Repository head type: git- location: hit://github.com/sebnow/haskell-network-address.git+ location: git://github.com/sebnow/haskell-network-address.git Flag benchmark Description: Build benchmarking