IPv6Addr 0.3.0.1 → 0.4
raw patch · 6 files changed
+375/−282 lines, 6 filesdep +HUnitdep +IPv6Addrdep +attoparsecdep ~base
Dependencies added: HUnit, IPv6Addr, attoparsec, test-framework, test-framework-hunit
Dependency ranges changed: base
Files
- IPv6Addr.cabal +29/−17
- Text/IPv6Addr.hs +18/−28
- Text/IPv6Addr/Internal.hs +189/−180
- Text/IPv6Addr/Manip.hs +36/−53
- Text/IPv6Addr/Types.hs +1/−4
- tests/Main.hs +102/−0
IPv6Addr.cabal view
@@ -1,29 +1,41 @@-name: IPv6Addr-version: 0.3.0.1-license: BSD3-license-file: LICENSE+Name: IPv6Addr+Version: 0.4+License: BSD3+License-File: LICENSE Copyright: Copyright © 2011-2013 - Michel Boucey-author: Michel Boucey <michel.boucey@gmail.com>-maintainer: Michel Boucey <michel.boucey@gmail.com>+Author: Michel Boucey <michel.boucey@gmail.com>+Maintainer: Michel Boucey <michel.boucey@gmail.com> Bug-Reports: mailto:michel.boucey@gmail.com-synopsis: Library to deal with IPv6 address text representations.-description: Library to deal with IPv6 address text representations, canonization and manipulations.-category: Network, Text-stability: provisional-build-type: Simple-cabal-version: >= 1.6-source-repository head- type: git- location: https://github.com/MichelBoucey/IPv6Addr+Synopsis: Library to deal with IPv6 address text representations.+Description: Library to deal with IPv6 address text representations, canonization and manipulations.+Category: Network, Text+Build-Type: Simple+Cabal-Version: >= 1.8 +Source-Repository head+ Type: git+ Location: https://github.com/MichelBoucey/IPv6Addr+ Library- Build-Depends: base >= 3 && <= 5,+ Build-Depends: attoparsec,+ base >= 3 && <= 5, bytestring >= 0.9, network-info >= 0.2, random, text - exposed-modules: Text.IPv6Addr+ Exposed-Modules: Text.IPv6Addr Text.IPv6Addr.Internal Text.IPv6Addr.Manip Text.IPv6Addr.Types++Test-Suite tests+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: tests+ Main-Is: Main.hs + Build-Depends: base,+ HUnit,+ IPv6Addr,+ test-framework,+ test-framework-hunit,+ text
Text/IPv6Addr.hs view
@@ -1,11 +1,9 @@ -- ----------------------------------------------------------------------------- --- | -- Module : Text.IPv6Addr -- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-style -- Maintainer : michel.boucey@gmail.com--- Stability : provisional -- -- Dealing with IPv6 address text representations, canonization and manipulations. --@@ -14,7 +12,7 @@ module Text.IPv6Addr (- IPv6Addr+ IPv6Addr (IPv6Addr) , maybeIPv6Addr , maybePureIPv6Addr , maybeFullIPv6Addr@@ -23,17 +21,12 @@ , randIPv6Addr ) where -import Control.Monad (replicateM)-import Data.Char (intToDigit,isDigit,isHexDigit,toLower)-import Data.Function (on)-import Data.List (group,isSuffixOf,elemIndex,elemIndices,intersperse)-import Data.Maybe (catMaybes,fromJust,isJust)+import Control.Applicative ((<$>))+import Data.Maybe (fromJust) import qualified Data.Text as T-import Data.Text.Read (decimal)-import Numeric (showIntAtBase) import Text.IPv6Addr.Internal-import Text.IPv6Addr.Manip (sixteenBitsArbToken,partialRandAddr)+import Text.IPv6Addr.Manip (sixteenBitArbToken,partialRandAddr) import Text.IPv6Addr.Types -- | Returns 'Just' the text representation of a canonized@@ -57,24 +50,24 @@ -- maybeFullIPv6Addr :: T.Text -> Maybe IPv6Addr maybeFullIPv6Addr t =- maybeTokPureIPv6Addr t >>= \m -> ipv6TokensToIPv6Addr $ expandTokens $ fromDoubleColon m+ maybeTokPureIPv6Addr t >>= (ipv6TokensToIPv6Addr . expandTokens . fromDoubleColon) -- | Returns 'Just' the reverse lookup domain name corresponding of the given IPv6 address -- (RFC 3596 Section 2.5), or 'Nothing'. ----- > ip6arpa "4321:0:1:2:3:4:567:89ab" == Just "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa."+-- > ip6arpa (IPv6Addr "4321:0:1:2:3:4:567:89ab") == Just "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa." ---ip6arpa :: T.Text -> Maybe T.Text+ip6arpa :: IPv6Addr -> T.Text ip6arpa t =- case maybeFullIPv6Addr t of- Just (IPv6Addr a) -> Just $ revaddr a T.empty- Nothing -> Nothing + rev (fromIPv6Addr $ fromJust $ maybeFullIPv6Addr $ fromIPv6Addr t) T.empty where- revaddr i o =- if i == T.empty then o `T.append` T.pack "ip6.arpa."- else do let c = T.last i- revaddr (T.init i)- (if c /= ':' then o `T.append` T.pack [c] `T.append` T.pack "." else o)+ rev i o = if i == T.empty+ then o `T.append` T.pack "ip6.arpa."+ else do let c = T.last i+ rev (T.init i)+ (if c /= ':'+ then o `T.append` T.pack [c] `T.append` T.pack "."+ else o) -- | Returns 'Just' the canonized 'IPv6Addr' of the given network interface, -- or 'Nothing'.@@ -82,12 +75,9 @@ -- > getIPv6AddrOf "eth0" -- getIPv6AddrOf :: String -> IO (Maybe IPv6Addr)-getIPv6AddrOf s = do- l <- networkInterfacesIPv6AddrList- case lookup s l of- Just a -> return $ maybeIPv6Addr $ T.pack $ show a- Nothing -> return Nothing+getIPv6AddrOf s =+ maybe Nothing (maybeIPv6Addr . T.pack . show) <$> (lookup s <$> networkInterfacesIPv6AddrList) -- | Returns a random 'IPv6Addr' randIPv6Addr :: IO IPv6Addr-randIPv6Addr = partialRandAddr 8 >>= \p -> return $ IPv6Addr $ ipv6TokensToText p+randIPv6Addr = IPv6Addr . ipv6TokensToText <$> partialRandAddr 8
Text/IPv6Addr/Internal.hs view
@@ -5,7 +5,6 @@ -- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com--- Stability : provisional -- -- Dealing with IPv6 address text representations, canonization and manipulations. --@@ -13,12 +12,8 @@ -- ----------------------------------------------------------------------------- module Text.IPv6Addr.Internal- ( colon- , doubleColon- , sixteenBits- , ipv4Addr- , expandTokens- , maybeIPv6AddrToken+ ( expandTokens+ , macAddr , maybeIPv6AddrTokens , ipv4AddrToIPv6AddrTokens , ipv6TokensToText@@ -27,127 +22,48 @@ , maybeTokIPv6Addr , maybeTokPureIPv6Addr , fromDoubleColon+ , fromIPv6Addr , toDoubleColon , networkInterfacesIPv6AddrList ) where import Control.Monad (replicateM)+import Data.Attoparsec.Text as A import Data.Char (isDigit,isHexDigit,toLower)-import Data.Function (on)+import Control.Applicative ((<|>)) import Data.List (group,isSuffixOf,elemIndex,elemIndices,intersperse) import Numeric (showHex) import qualified Data.Text as T-import Data.Text.Read (decimal)-import Data.Maybe (fromJust,isJust)+import qualified Data.Text.Read as R (decimal)+import Data.Maybe (fromJust) import Network.Info import Text.IPv6Addr.Types -tokdot = T.pack "."-tokcolon = T.pack ":"-tokdcolon = T.pack "::" tok0 = T.pack "0"-tok4x0 = T.pack "0000"-tok1 = T.pack "1"-tokffff = T.pack "ffff"-tok64 = T.pack "64"-tokff9b = T.pack "ff9b"-tokfe80 = T.pack "fe80"-tok5efe = T.pack "5efe"-tok200 = T.pack "200" -tokenizedBy :: Char -> T.Text -> [T.Text]-tokenizedBy c = T.groupBy ((==) `on` (== c))------- Validation of IPv6 address tokens-----dot :: T.Text -> Maybe IPv4AddrToken-dot t- | t == tokdot = Just Dot- | otherwise = Nothing--colon :: T.Text -> Maybe IPv6AddrToken-colon t- | t == tokcolon = Just Colon- | otherwise = Nothing--doubleColon :: T.Text -> Maybe IPv6AddrToken-doubleColon t- | t == tokdcolon = Just DoubleColon- | otherwise = Nothing--sixteenBits:: T.Text -> Maybe IPv6AddrToken-eightBitsToken :: T.Text -> Maybe IPv4AddrToken-eightBitsToken t =- case decimal t of- Right p -> do let i = fst p- if i >= 0 && i <= 255 && snd p == T.empty- then Just (EightBits t) else Nothing- Left _ -> Nothing--ipv4Token :: T.Text -> Maybe IPv4AddrToken-ipv4Token t- | isJust(dot t) = Just Dot- | isJust(eightBitsToken t) = Just (EightBits t)- | otherwise = Nothing--ipv4Addr :: T.Text -> Maybe IPv6AddrToken-ipv4Addr t = do- let r = map ipv4Token $ tokenizedBy '.' t- if (Nothing `notElem` r) && (length r == 7)- then Just (IPv4Addr t) else Nothing--sixteenBits t =- if T.length t < 5- then do- -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1)- let t'= T.dropWhile (=='0') t- if T.length t' < 5 && T.all isHexDigit t'- then- -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)- Just (if T.null t' then AllZeros else SixteenBits $ T.toLower t')- else Nothing- else Nothing--expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]-expandTokens =- map expTok- where expTok AllZeros = SixteenBits tok4x0- expTok (SixteenBits s) = do- let ls = T.length s- SixteenBits (if ls < 4 then T.replicate (4 - ls) tok0 `T.append` s else s)- expTok t = t+-- | Returns the 'Text' of an IPv6 address.+fromIPv6Addr :: IPv6Addr -> T.Text+fromIPv6Addr (IPv6Addr t) = t --- | Returns 'Just' one of the valid 'IPv6AddrToken', or 'Nothing'.-maybeIPv6AddrToken :: T.Text -> Maybe IPv6AddrToken-maybeIPv6AddrToken t- | isJust t' = t'- | isJust(colon t) = Just Colon- | isJust(doubleColon t) = Just DoubleColon- | isJust(ipv4Addr t) = Just (IPv4Addr t)- | otherwise = Nothing- where t' = sixteenBits t+-- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'Text'.+ipv6TokensToText :: [IPv6AddrToken] -> T.Text+ipv6TokensToText l = T.concat $ map ipv6TokenToText l -- | Returns the corresponding 'Text' of an IPv6 address token. ipv6TokenToText :: IPv6AddrToken -> T.Text-ipv6TokenToText (SixteenBits s) = s -ipv6TokenToText Colon = tokcolon-ipv6TokenToText DoubleColon = tokdcolon+ipv6TokenToText (SixteenBit s) = s +ipv6TokenToText Colon = T.pack ":"+ipv6TokenToText DoubleColon = T.pack "::" -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1)-ipv6TokenToText AllZeros = tok0+ipv6TokenToText AllZeros = tok0 -- ipv6TokenToText (IPv4Addr a) = a --- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'Text'.-ipv6TokensToText :: [IPv6AddrToken] -> T.Text-ipv6TokensToText l = T.concat $ map ipv6TokenToText l- -- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address. isIPv6Addr :: [IPv6AddrToken] -> Bool isIPv6Addr [] = False isIPv6Addr [DoubleColon] = True-isIPv6Addr [DoubleColon,SixteenBits tok1] = True+isIPv6Addr [DoubleColon,SixteenBit tok1] = True isIPv6Addr tks = diffNext tks && (do let cdctks = countDoubleColon tks@@ -157,61 +73,79 @@ firstValidToken tks && (case countIPv4Addr tks of 0 -> case lasttk of- SixteenBits _ -> lenconst- DoubleColon -> lenconst- AllZeros -> lenconst- otherwise -> False+ SixteenBit _ -> lenconst+ DoubleColon -> lenconst+ AllZeros -> lenconst+ _ -> False 1 -> case lasttk of- IPv4Addr _ ->- (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)- otherwise -> False+ IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)+ _ -> False otherwise -> False))- where diffNext [_] = True- diffNext [a,a'] = a /= a'- diffNext (a:as) = (a /= head as) && diffNext as+ where diffNext [] = False+ diffNext [_] = True+ diffNext (t:ts) = do+ let h = head ts+ case t of+ SixteenBit _ -> case h of+ SixteenBit _ -> False+ AllZeros -> False+ _ -> diffNext ts+ AllZeros -> case h of+ SixteenBit _ -> False+ AllZeros -> False+ _ -> diffNext ts+ _ -> diffNext ts firstValidToken l = case head l of- SixteenBits _ -> True- DoubleColon -> True- AllZeros -> True- otherwise -> False+ SixteenBit _ -> True+ DoubleColon -> True+ AllZeros -> True+ _ -> False countDoubleColon l = length $ elemIndices DoubleColon l--countIPv4Addr =- foldr oneMoreIPv4Addr 0- where oneMoreIPv4Addr t c = case t of- IPv4Addr _ -> c + 1- otherwise -> c+ tok1 = T.pack "1" --- | Returns 'Just' a list of 'IPv6AddrToken', or 'Nothing'.-maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]-maybeIPv6AddrTokens t = mapM maybeIPv6AddrToken $ tokenizedBy ':' t+countIPv4Addr = foldr oneMoreIPv4Addr 0+ where+ oneMoreIPv4Addr t c = case t of+ IPv4Addr _ -> c + 1+ otherwise -> c -- | This is the main function which returns 'Just' the list of a tokenized IPv6 -- address text representation validated against RFC 4291 and canonized -- in conformation with RFC 5952, or 'Nothing'. maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken] maybeTokIPv6Addr t = - do ltks <- maybeIPv6AddrTokens t- if isIPv6Addr ltks- then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks- else Nothing- where ipv4AddrReplacement ltks' =- if ipv4AddrRewrite ltks'- then init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks')- else ltks'+ case maybeIPv6AddrTokens t of+ Just ltks -> if isIPv6Addr ltks+ then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks+ else Nothing+ Nothing -> Nothing+ where+ ipv4AddrReplacement ltks =+ if ipv4AddrRewrite ltks+ then init ltks ++ ipv4AddrToIPv6AddrTokens (last ltks)+ else ltks -- | Returns 'Just' the list of tokenized pure IPv6 address, always rewriting an -- embedded IPv4 address if present. maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]-maybeTokPureIPv6Addr t =- do ltks <- maybeIPv6AddrTokens t- if isIPv6Addr ltks- then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks- else Nothing- where ipv4AddrReplacement ltks' =- init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks')+maybeTokPureIPv6Addr t = do+ ltks <- maybeIPv6AddrTokens t+ if isIPv6Addr ltks+ then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks+ else Nothing+ where+ ipv4AddrReplacement ltks' = init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks') +-- | Tokenize a 'Text' into 'Just' a list of 'IPv6AddrToken', or 'Nothing'.+maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]+maybeIPv6AddrTokens s = + case readText s of+ Done r l -> if r==T.empty then Just l else Nothing+ Fail {} -> Nothing+ where+ readText s = feed (parse (many1 $ ipv4Addr <|> sixteenBit <|> doubleColon <|> colon) s) T.empty+ -- | An embedded IPv4 address have to be rewritten to output a pure IPv6 Address -- text representation in hexadecimal digits. But some well-known prefixed IPv6 -- addresses have to keep visible in their text representation the fact that@@ -233,13 +167,16 @@ IPv4Addr _ -> do let itks = init tks not (itks == [DoubleColon]- || itks == [DoubleColon,SixteenBits tokffff,Colon]- || itks == [DoubleColon,SixteenBits tokffff,Colon,AllZeros,Colon]- || itks == [SixteenBits tok64,Colon,SixteenBits tokff9b,DoubleColon]- || [SixteenBits tok200,Colon,SixteenBits tok5efe,Colon] `isSuffixOf` itks- || [AllZeros,Colon,SixteenBits tok5efe,Colon] `isSuffixOf` itks- || [DoubleColon,SixteenBits tok5efe,Colon] `isSuffixOf` itks)- otherwise -> False+ || itks == [DoubleColon,SixteenBit tokffff,Colon]+ || itks == [DoubleColon,SixteenBit tokffff,Colon,AllZeros,Colon]+ || itks == [SixteenBit (T.pack "64"),Colon,SixteenBit (T.pack "ff9b"),DoubleColon]+ || [SixteenBit (T.pack "200"),Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks+ || [AllZeros,Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks+ || [DoubleColon,SixteenBit tok5efe,Colon] `isSuffixOf` itks)+ _ -> False+ where+ tokffff = T.pack "ffff"+ tok5efe = T.pack "5efe" -- | Rewrites 'Just' an embedded 'IPv4Addr' into the corresponding list of pure -- 'IPv6Addr' tokens.@@ -251,29 +188,36 @@ case t of IPv4Addr a -> do let m = toHex a- [fromJust $ sixteenBits ((!!) m 0 `T.append` addZero ((!!) m 1))- ,Colon- ,fromJust $ sixteenBits ((!!) m 2 `T.append` addZero ((!!) m 3))]- _ -> [t]- where toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a- addZero d = if T.length d == 1 then tok0 `T.append` d else d+ [ SixteenBit ((!!) m 0 `T.append` addZero ((!!) m 1))+ , Colon+ , SixteenBit ((!!) m 2 `T.append` addZero ((!!) m 3))]+ _ -> [t]+ where+ toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a+ addZero d = if T.length d == 1 then tok0 `T.append` d else d +expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]+expandTokens = map expandToken+ where expandToken (SixteenBit s) = SixteenBit $ T.justifyRight 4 '0' s+ expandToken AllZeros = SixteenBit $ T.pack "0000"+ expandToken t = t+ fromDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken] fromDoubleColon tks = - if DoubleColon `notElem` tks then tks- else do- let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks- let fsts = fst s- let snds = if not (null (snd s)) then tail(snd s) else []- -- let snds = if length(snd s) >= 1 then tail(snd s) else []- let fste = if null fsts then [] else fsts ++ [Colon]- let snde = if null snds then [] else Colon : snds- fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde- where quantityOfAllZerosTokenToReplace x =- ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x- where- ntks tks = if countIPv4Addr tks == 1 then 7 else 8- allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros)+ if DoubleColon `notElem` tks+ then tks+ else do let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks+ let fsts = fst s+ let snds = if not (null (snd s)) then tail(snd s) else []+ let fste = if null fsts then [] else fsts ++ [Colon]+ let snde = if null snds then [] else Colon : snds+ fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde+ where+ allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros)+ quantityOfAllZerosTokenToReplace x =+ ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x+ where+ ntks tks = if countIPv4Addr tks == 1 then 7 else 8 toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken] toDoubleColon tks =@@ -286,22 +230,20 @@ zerosToDoubleColon ls (_,1) = ls zerosToDoubleColon ls (i,l) = let ls' = filter (/= Colon) ls- in intersperse Colon (take i ls') ++ [DoubleColon] ++ intersperse Colon (drop (i+l) ls')+ in intersperse Colon (Prelude.take i ls') ++ [DoubleColon] ++ intersperse Colon (drop (i+l) ls') zerosRunToReplace t = let l = longestLengthZerosRun t in (firstLongestZerosRunIndex t l,l)- where firstLongestZerosRunIndex x y = sum . snd . unzip $ takeWhile (/=(True,y)) x- longestLengthZerosRun x =- maximum $ map longest x- where longest t = case t of- (True,i) -> i- otherwise -> 0- zerosRunsList x =- map helper $ groupZerosRuns x where- helper h =- (head h == AllZeros, lh)- where lh = length h+ firstLongestZerosRunIndex x y = sum . snd . unzip $ Prelude.takeWhile (/=(True,y)) x+ longestLengthZerosRun x =+ maximum $ map longest x+ where longest t = case t of+ (True,i) -> i+ _ -> 0+ zerosRunsList x = map helper $ groupZerosRuns x+ where+ helper h = (head h == AllZeros, lh) where lh = length h groupZerosRuns = group . filter (/= Colon) ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr@@ -310,4 +252,71 @@ networkInterfacesIPv6AddrList :: IO [(String,IPv6)] networkInterfacesIPv6AddrList = getNetworkInterfaces >>= \n -> return $ map networkInterfacesIPv6Addr n- where networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a)+ where+ networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a)++fullSixteenBit :: T.Text -> Maybe IPv6AddrToken+fullSixteenBit t =+ case parse fourHexaChars t of+ Done a b -> if a==T.empty then Just $ SixteenBit $ T.pack b else Nothing+ _ -> Nothing++macAddr :: Parser (Maybe [IPv6AddrToken])+macAddr = do+ n1 <- count 2 hexaChar <*. T.pack ":"+ n2 <- count 2 hexaChar <*. T.pack ":"+ n3 <- count 2 hexaChar <*. T.pack ":"+ n4 <- count 2 hexaChar <*. T.pack ":"+ n5 <- count 2 hexaChar <*. T.pack ":"+ n6 <- count 2 hexaChar+ return $ maybeIPv6AddrTokens $ T.concat $ map T.pack [n1,n2,n3,n4,n5,n6]++sixteenBit :: Parser IPv6AddrToken+sixteenBit = do+ r <- fourHexaChars <|> count 3 hexaChar <|> count 2 hexaChar <|> count 1 hexaChar+ -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1)+ let r' = T.dropWhile (=='0') $ T.pack r+ return $ if T.null r'+ then AllZeros+ -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)+ else SixteenBit $ T.toLower r'++ipv4Addr :: Parser IPv6AddrToken+ipv4Addr = do+ n1 <- manyDigits <*. dot+ if n1 /= T.empty+ then do n2 <- manyDigits <*. dot+ if n2 /= T.empty+ then do n3 <- manyDigits <*. dot+ if n3 /= T.empty+ then do n4 <- manyDigits+ if n4 /= T.empty+ then return $ IPv4Addr $ T.intercalate dot [n1,n2,n3,n4]+ else parserFailure + else parserFailure + else parserFailure + else parserFailure + where+ parserFailure = fail "ipv4Addr parsing failure"+ dot = T.pack "."+ manyDigits = do+ ds <- takeWhile1 isDigit+ case R.decimal ds of+ Right (n,_) -> return (if n < 256 then T.pack $ show n else T.empty)+ Left _ -> return T.empty++doubleColon :: Parser IPv6AddrToken+doubleColon = do+ string $ T.pack "::"+ return DoubleColon++colon :: Parser IPv6AddrToken+colon = do+ string $ T.pack ":"+ return Colon++fourHexaChars :: Parser String+fourHexaChars = count 4 hexaChar++hexaChar :: Parser Char+hexaChar = satisfy (inClass "0-9a-fA-F")
Text/IPv6Addr/Manip.hs view
@@ -5,7 +5,6 @@ -- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com--- Stability : provisional -- -- Dealing with IPv6 address text representations, canonization and manipulations. --@@ -13,91 +12,75 @@ -- ----------------------------------------------------------------------------- module Text.IPv6Addr.Manip- (- module Text.IPv6Addr.Internal- , sixteenBitsArbToken+ ( sixteenBitArbToken , partialRandAddr , macAddrToIPv6AddrTokens , getTokIPv6AddrOf , getTokMacAddrOf ) where +import Control.Applicative ((<$>)) import Control.Monad (replicateM)+import Data.Attoparsec.Text as A import Data.Char (intToDigit,isHexDigit) import Data.List (intersperse)-import Data.Maybe (catMaybes,fromJust)+import Data.Maybe (fromJust) import qualified Data.Text as T-import System.Random (randomRIO)- import Network.Info+import System.Random (randomRIO) import Text.IPv6Addr.Internal import Text.IPv6Addr.Types --- | Returns 'Just' an arbitrary 'SixteenBits' token based on a mask \"____\", each+-- | Returns 'Just' an arbitrary 'SixteenBit' token based on a mask \"____\", each -- underscore being replaced by a random hexadecimal digit. ----- > sixteenBitsArbToken "_f__" == Just (SixteenBits "bfd4")+-- > sixteenBitArbToken "_f__" == Just (SixteenBit "bfd4") -- -sixteenBitsArbToken :: String -> IO (Maybe IPv6AddrToken)-sixteenBitsArbToken m =- mapM getHex m >>= \cs -> return $ sixteenBits $ T.pack cs- where getHex c =- case c of- '_' -> hexRand- otherwise -> return c- where hexRand = randomRIO(0,15) >>= \r -> return $ intToDigit r+sixteenBitArbToken :: String -> IO IPv6AddrToken+sixteenBitArbToken m =+ mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g+ where+ getHex c+ | c == '_' = randomRIO(0,15) >>= \r -> return $ intToDigit r+ | otherwise = return c --- | Generates a partial 'IPv6Addr' with n 'SixteenBits'+-- | Generates a partial 'IPv6Addr' with n 'SixteenBit' partialRandAddr :: Int -> IO [IPv6AddrToken]-partialRandAddr n =- if n < 9 then do l <- replicateM n $ sixteenBitsArbToken "____"- return $ intersperse Colon $ catMaybes l- else return []+partialRandAddr n+ | n > 0 && n < 9 = intersperse Colon <$> replicateM n (sixteenBitArbToken "____")+ | otherwise = return [] -- | Given a MAC address, returns the corresponding 'IPv6AddrToken' list, or an empty list. ----- > macAddrToIPv6AddrTokens "fa:1d:58:cc:95:16" == [SixteenBits "fa1d",Colon,SixteenBits "58cc",Colon,SixteenBits "9516"]+-- > macAddrToIPv6AddrTokens "fa:1d:58:cc:95:16" == [SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"] ---macAddrToIPv6AddrTokens :: T.Text -> [IPv6AddrToken]-macAddrToIPv6AddrTokens mac =- if T.length mac == 17- then do- let p = snd $ trans (T.split (==':') mac,[])- if length p == 3- then intersperse Colon $ map (fromJust . maybeIPv6AddrToken) p- else []- else []- where- trans ([],l) = ([],l)- trans (l1,l2) = do- let s = splitAt 2 l1- trans (snd s,l2 ++ [T.concat $ fst s]) +macAddrToIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]+macAddrToIPv6AddrTokens t =+ case parse macAddr t of+ Done a b -> if a==T.empty then intersperse Colon <$> b else Nothing+ _ -> Nothing -- -- Functions based upon Network.Info to get local MAC and IPv6 addresses. ----networkInterfacesMacAddrList :: IO [(String,MAC)]-networkInterfacesMacAddrList =- getNetworkInterfaces >>= \n -> return $ map networkInterfacesMac n - where networkInterfacesMac (NetworkInterface n _ _ m) = (n,m)- -- | Given a valid name of a local network interface, returns 'Just' the list of -- tokens of the interface's IPv6 address, or 'Nothing'.+--+-- > getTokIPv6AddrOf "eth0" == Just [SixteenBit "fe80",DoubleColon,SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"]+-- getTokIPv6AddrOf :: String -> IO (Maybe [IPv6AddrToken])-getTokIPv6AddrOf s = do- l <- networkInterfacesIPv6AddrList- case lookup s l of- Just a -> return $ maybeTokIPv6Addr $ T.pack $ show a- Nothing -> return Nothing+getTokIPv6AddrOf s = maybe Nothing (maybeTokIPv6Addr. T.pack . show) <$> (lookup s <$> networkInterfacesIPv6AddrList) -- | Given a valid name of a local network interface, -- returns 'Just' the corresponding list of 'IPv6AddrToken' of the interface's MAC Address, -- or 'Nothing'.+--+-- > getTokMacAddrOf "eth0" == Just [SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"]+-- getTokMacAddrOf :: String -> IO (Maybe [IPv6AddrToken])-getTokMacAddrOf s = do- l <- networkInterfacesMacAddrList- case lookup s l of- Just a -> return $ Just $ macAddrToIPv6AddrTokens $ T.pack $ show a- Nothing -> return Nothing+getTokMacAddrOf s =+ maybe Nothing (macAddrToIPv6AddrTokens . T.pack . show) <$> (lookup s <$> networkInterfacesMacAddrList)+ where+ networkInterfacesMacAddrList = getNetworkInterfaces >>= \n -> return $ map networkInterfacesMac n + where networkInterfacesMac (NetworkInterface n _ _ m) = (n,m)
Text/IPv6Addr/Types.hs view
@@ -5,7 +5,6 @@ -- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com--- Stability : provisional -- -- Dealing with IPv6 address text representations, canonization and manipulations. --@@ -16,12 +15,10 @@ import qualified Data.Text as T -data IPv4AddrToken = Dot | EightBits T.Text deriving (Eq,Show)- data IPv6Addr = IPv6Addr T.Text deriving (Eq,Show) data IPv6AddrToken- = SixteenBits T.Text -- ^ A four hexadecimal digits group representing a 16-Bit chunk+ = SixteenBit T.Text -- ^ A four hexadecimal digits group representing a 16-Bit chunk | AllZeros -- ^ An all zeros 16-Bit chunk | Colon -- ^ A separator between 16-Bit chunks | DoubleColon -- ^ A double-colon stands for a unique compression of many consecutive 16-Bit chunks
+ tests/Main.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where+ +import Data.Maybe+import Data.Text+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++import Text.IPv6Addr++main = defaultMain $ hUnitTestToTests tests++tests = TestList+ [ (~?=) (maybeIPv6Addr ":") Nothing+ , (~?=) (maybeIPv6Addr "::") (Just (IPv6Addr "::"))+ , (~?=) (maybeIPv6Addr ":::") Nothing+ , (~?=) (maybeIPv6Addr "::::") Nothing+ , (~?=) (maybeIPv6Addr "::df0::") Nothing+ , (~?=) (maybeIPv6Addr "0:0:0:0:0:0:0") Nothing+ , (~?=) (maybeIPv6Addr "0:0:0:0:0:0:0:0") (Just (IPv6Addr "::"))+ , (~?=) (maybeIPv6Addr "0:0:0:0:0:0:0:0:0") Nothing+ , (~?=) (maybeIPv6Addr "1") Nothing+ , (~?=) (maybeIPv6Addr "::1") (Just (IPv6Addr "::1"))+ , (~?=) (maybeIPv6Addr "::1:") Nothing+ , (~?=) (maybeIPv6Addr "0000:0000:0000:0000:0000:0000:0000:0001") (Just (IPv6Addr "::1"))+ , (~?=) (maybeIPv6Addr "a") Nothing+ , (~?=) (maybeIPv6Addr "ab") Nothing+ , (~?=) (maybeIPv6Addr "abc") Nothing+ , (~?=) (maybeIPv6Addr "abcd") Nothing+ , (~?=) (maybeIPv6Addr "abcd:") Nothing+ , (~?=) (maybeIPv6Addr "abcd::") (Just (IPv6Addr "abcd::"))+ , (~?=) (maybeIPv6Addr "abcd:::") Nothing+ , (~?=) (maybeIPv6Addr "abcde::") Nothing+ , (~?=) (maybeIPv6Addr "a::") (Just (IPv6Addr "a::"))+ , (~?=) (maybeIPv6Addr "0a::") (Just (IPv6Addr "a::"))+ , (~?=) (maybeIPv6Addr "00a::") (Just (IPv6Addr "a::"))+ , (~?=) (maybeIPv6Addr "000a::") (Just (IPv6Addr "a::"))+ , (~?=) (maybeIPv6Addr "0000a::") Nothing+ , (~?=) (maybeIPv6Addr "adb6") Nothing+ , (~?=) (maybeIPv6Addr "adb6ce67") Nothing+ , (~?=) (maybeIPv6Addr "adb6:ce67") Nothing+ , (~?=) (maybeIPv6Addr "adb6::ce67") (Just (IPv6Addr "adb6::ce67"))+ , (~?=) (maybeIPv6Addr "::1.2.3.4") (Just (IPv6Addr "::1.2.3.4"))+ , (~?=) (maybeIPv6Addr "::ffff:1.2.3.4") (Just (IPv6Addr "::ffff:1.2.3.4"))+ , (~?=) (maybeIPv6Addr "::ffff:0:1.2.3.4") (Just (IPv6Addr "::ffff:0:1.2.3.4"))+ , (~?=) (maybeIPv6Addr "64:ff9b::1.2.3.4") (Just (IPv6Addr "64:ff9b::1.2.3.4"))+ , (~?=) (maybeIPv6Addr "fe80::5efe:1.2.3.4") (Just (IPv6Addr "fe80::5efe:1.2.3.4"))+ , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:1257:0000:211E:729C") (Just (IPv6Addr "fe80:cd00:0:cde:1257:0:211e:729c"))+ , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:1257:0000:211E:729X") Nothing+ , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:1257:0000:211E:729CX") Nothing+ , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:0000:211E:729C") Nothing+ , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:FFFF:1257:0000:211E:729C") Nothing+ , (~?=) (maybeIPv6Addr "1111:2222:3333:4444:5555:6666:7777:8888") (Just (IPv6Addr "1111:2222:3333:4444:5555:6666:7777:8888"))+ , (~?=) (maybeIPv6Addr ":1111:2222:3333:4444:5555:6666:7777:8888") Nothing+ , (~?=) (maybeIPv6Addr "1111:2222:3333:4444:5555:6666:7777:8888:") Nothing+ , (~?=) (maybeIPv6Addr "1111::3333:4444:5555:6666::8888") Nothing+ , (~?=) (maybeIPv6Addr "AAAA:BBBB:CCCC:DDDD:EEEE:FFFF:0000:0000") (Just (IPv6Addr "aaaa:bbbb:cccc:dddd:eeee:ffff::"))+ , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:0001") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1"))+ , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:001") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1"))+ , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:01") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1"))+ , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1"))+ , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd::1") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:0:1"))+ , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:0:1") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:0:1"))+ , (~?=) (maybeIPv6Addr "2001:db8:0:0:1:0:0:1") (Just (IPv6Addr "2001:db8::1:0:0:1"))+ , (~?=) (maybeIPv6Addr "2001:db8:0:1:0:0:0:1") (Just (IPv6Addr "2001:db8:0:1::1"))+ , (~?=) (maybeIPv6Addr "2001:DB8:0:0:0::1") (Just (IPv6Addr "2001:db8::1"))+ , (~?=) (maybeIPv6Addr "2001:0DB8:0:0::1") (Just (IPv6Addr "2001:db8::1"))+ , (~?=) (maybeIPv6Addr "2001:0dB8:0::1") (Just (IPv6Addr "2001:db8::1"))+ , (~?=) (maybeIPv6Addr "2001:db8::1") (Just (IPv6Addr "2001:db8::1"))+ , (~?=) (maybeIPv6Addr "2001:db8:0:1::1") (Just (IPv6Addr "2001:db8:0:1::1"))+ , (~?=) (maybeIPv6Addr "2001:0db8:0:1:0:0:0:1") (Just (IPv6Addr "2001:db8:0:1::1"))+ , (~?=) (maybeIPv6Addr "2001:DB8::1:1:1:1:1") (Just (IPv6Addr "2001:db8:0:1:1:1:1:1"))+ , (~?=) (maybeIPv6Addr "2001:DB8::1:1:0:1:1") (Just (IPv6Addr "2001:db8:0:1:1:0:1:1"))+ , (~?=) (maybeIPv6Addr "fe80") Nothing+ , (~?=) (maybeIPv6Addr "fe80::") (Just (IPv6Addr "fe80::"))+ , (~?=) (maybeIPv6Addr "0:0:0:0:0:ffff:192.0.2.1") (Just (IPv6Addr "::ffff:192.0.2.1"))+ , (~?=) (maybeIPv6Addr "::192.0.2.1") (Just (IPv6Addr "::192.0.2.1"))+ , (~?=) (maybeIPv6Addr "192.0.2.1::") Nothing+ , (~?=) (maybeIPv6Addr "::ffff:192.0.2.1") (Just (IPv6Addr "::ffff:192.0.2.1"))+ , (~?=) (maybeIPv6Addr "fe80:0:0:0:0:0:0:0") (Just (IPv6Addr "fe80::"))+ , (~?=) (maybeIPv6Addr "fe80:0000:0000:0000:0000:0000:0000:0000") (Just (IPv6Addr "fe80::"))+ , (~?=) (maybeIPv6Addr "2001:db8:Bad:0:0::0:1") (Just (IPv6Addr "2001:db8:bad::1"))+ , (~?=) (maybeIPv6Addr "2001:0:0:1:b:0:0:A") (Just (IPv6Addr "2001::1:b:0:0:a"))+ , (~?=) (maybeIPv6Addr "2001:0:0:1:000B:0:0:0") (Just (IPv6Addr "2001:0:0:1:b::"))+ , (~?=) (maybeIPv6Addr "2001:0DB8:85A3:0000:0000:8A2E:0370:7334") (Just (IPv6Addr "2001:db8:85a3::8a2e:370:7334"))+ , (~?=) (maybePureIPv6Addr "0:0:0:0:0:ffff:192.0.2.1") (Just (IPv6Addr "::ffff:c000:201"))+ , (~?=) (maybePureIPv6Addr "::ffff:192.0.2.1") (Just (IPv6Addr "::ffff:c000:201"))+ , (~?=) (maybeFullIPv6Addr "::") (Just (IPv6Addr "0000:0000:0000:0000:0000:0000:0000:0000"))+ , (~?=) (maybeFullIPv6Addr "0:0:0:0:0:0:0:0") (Just (IPv6Addr "0000:0000:0000:0000:0000:0000:0000:0000"))+ , (~?=) (maybeFullIPv6Addr "::1") (Just (IPv6Addr "0000:0000:0000:0000:0000:0000:0000:0001"))+ , (~?=) (maybeFullIPv6Addr "2001:db8::1") (Just (IPv6Addr "2001:0db8:0000:0000:0000:0000:0000:0001"))+ , (~?=) (maybeFullIPv6Addr "a:bb:ccc:dddd:1cDc::1") (Just (IPv6Addr "000a:00bb:0ccc:dddd:1cdc:0000:0000:0001"))+ , (~?=) (maybeFullIPv6Addr "FE80::0202:B3FF:FE1E:8329") (Just (IPv6Addr "fe80:0000:0000:0000:0202:b3ff:fe1e:8329"))+ , (~?=) (maybeFullIPv6Addr "aDb6::CE67") (Just (IPv6Addr "adb6:0000:0000:0000:0000:0000:0000:ce67"))+ , (~?=) (ip6arpa (IPv6Addr "::1")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa."+ , (~?=) (ip6arpa (IPv6Addr "2b02:0b08:0:7::0001")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.7.0.0.0.0.0.0.0.8.0.b.0.2.0.b.2.ip6.arpa."+ , (~?=) (ip6arpa (IPv6Addr "2b02:b08:0:7::1")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.7.0.0.0.0.0.0.0.8.0.b.0.2.0.b.2.ip6.arpa."+ , (~?=) (ip6arpa (IPv6Addr "fdda:5cc1:23:4::1f")) "f.1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.4.0.0.0.3.2.0.0.1.c.c.5.a.d.d.f.ip6.arpa."+ , (~?=) (ip6arpa (IPv6Addr "4321:0:1:2:3:4:567:89ab")) "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa."+ ]