IPv6Addr 0.6.1.0 → 0.6.2.0
raw patch · 6 files changed
+264/−235 lines, 6 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Text.IPv6Addr: IPv6Addr :: Text -> IPv6Addr
+ Text.IPv6Addr: IPv6Addr :: !Text -> IPv6Addr
- Text.IPv6Addr.Types: IPv4Addr :: Text -> IPv6AddrToken
+ Text.IPv6Addr.Types: IPv4Addr :: !Text -> IPv6AddrToken
- Text.IPv6Addr.Types: IPv6Addr :: Text -> IPv6Addr
+ Text.IPv6Addr.Types: IPv6Addr :: !Text -> IPv6Addr
- Text.IPv6Addr.Types: SixteenBit :: Text -> IPv6AddrToken
+ Text.IPv6Addr.Types: SixteenBit :: !Text -> IPv6AddrToken
Files
- IPv6Addr.cabal +24/−18
- README.md +3/−1
- Text/IPv6Addr.hs +70/−62
- Text/IPv6Addr/Internal.hs +146/−138
- Text/IPv6Addr/Manip.hs +13/−8
- Text/IPv6Addr/Types.hs +8/−8
IPv6Addr.cabal view
@@ -1,13 +1,13 @@ name: IPv6Addr-version: 0.6.1.0+version: 0.6.2.0 synopsis: Library to deal with IPv6 address text representations. description: Library to deal with IPv6 address text representations, canonization and manipulations. homepage: https://github.com/MichelBoucey/IPv6Addr license: BSD3 license-file: LICENSE author: Michel Boucey-maintainer: michel.boucey@gmail.com-copyright: Copyright (c) 2011-2015 - Michel Boucey+maintainer: michel.boucey@cybervisible.fr+copyright: (c) 2011-2016 - Michel Boucey category: Network build-type: Simple extra-source-files: README.md@@ -18,21 +18,27 @@ Location: https://github.com/MichelBoucey/IPv6Addr.git library- exposed-modules: Text.IPv6Addr, Text.IPv6Addr.Types, Text.IPv6Addr.Manip, Text.IPv6Addr.Internal- other-extensions: OverloadedStrings- build-depends: base >=4.6 && <5, text >=1.1, iproute >=1.3, network >=2.5, random >=1.0, attoparsec >=0.12, network-info >=0.2- default-language: Haskell2010- GHC-Options: -Wall+ exposed-modules: Text.IPv6Addr, Text.IPv6Addr.Types, Text.IPv6Addr.Manip, Text.IPv6Addr.Internal+ other-extensions: OverloadedStrings+ build-depends: base >=4.6 && <5+ , text >=1.1+ , iproute >=1.3+ , network >=2.5+ , random >=1.0+ , attoparsec >=0.12+ , network-info >=0.2+ default-language: Haskell2010+ GHC-Options: -Wall Test-Suite tests- Type: exitcode-stdio-1.0- default-language: Haskell2010- HS-Source-Dirs: tests- Main-Is: Main.hs- Build-Depends: base,- HUnit,- IPv6Addr,- test-framework,- test-framework-hunit,- text+ Type: exitcode-stdio-1.0+ default-language: Haskell2010+ HS-Source-Dirs: tests+ Main-Is: Main.hs+ Build-Depends: base,+ HUnit,+ IPv6Addr,+ test-framework,+ test-framework-hunit,+ text
README.md view
@@ -1,1 +1,3 @@-IPv6Addr is a Haskell library to deal with IPv6 address text representations, canonization and manipulations.+# IPv6Addr [](https://travis-ci.org/MichelBoucey/IPv6Addr)++A library to deal with IPv6 address text representations, canonization and manipulations.
Text/IPv6Addr.hs view
@@ -8,22 +8,26 @@ , maybePureIPv6Addr , maybeFullIPv6Addr , sameIPv6Addr+ -- * Conversions , fromIPv6Addr , toIPv6 , toHostName- -- * Utils , toIP6ARPA , toUNC++ -- * Utils , getIPv6AddrOf , randIPv6Addr , randIPv6AddrWithPrefix+ ) where import Data.IP (IPv6) import Data.Maybe (fromJust, isNothing) import Data.Monoid ((<>)) import qualified Data.Text as T+import Control.Monad (guard) import Network (HostName) import System.Random (randomRIO) @@ -32,7 +36,8 @@ import Text.IPv6Addr.Types instance Eq IPv6Addr where- (==) (IPv6Addr a) (IPv6Addr b) = show (maybePureIPv6Addr a) == show (maybePureIPv6Addr b)+ (==) (IPv6Addr a) (IPv6Addr b) =+ show (maybePureIPv6Addr a) == show (maybePureIPv6Addr b) -- | Returns 'Just' the text representation of a canonized -- 'IPv6Addr' in conformation with RFC 5952, or 'Nothing'.@@ -54,16 +59,19 @@ -- > maybeFullIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "0000:0000:0000:0000:0000:ffff:c000:0280") -- maybeFullIPv6Addr :: T.Text -> Maybe IPv6Addr-maybeFullIPv6Addr t = maybeTokPureIPv6Addr t >>= (ipv6TokensToIPv6Addr . expandTokens . fromDoubleColon)+maybeFullIPv6Addr t =+ maybeTokPureIPv6Addr t >>=+ (ipv6TokensToIPv6Addr . expandTokens . fromDoubleColon) -- | Returns 'True' if arguments are two textual representations of a same IPv6 address. sameIPv6Addr :: T.Text -> T.Text -> Bool sameIPv6Addr a b =- case maybePureIPv6Addr a of+ case maybePureIPv6Addr a of+ Nothing -> False+ Just a' ->+ case maybePureIPv6Addr b of Nothing -> False- Just a' -> case maybePureIPv6Addr b of- Nothing -> False- Just b' -> a' == b'+ Just b' -> a' == b' -- | Returns the reverse lookup domain name corresponding of the given IPv6 address (RFC 3596 Section 2.5). --@@ -71,7 +79,7 @@ -- toIP6ARPA :: IPv6Addr -> T.Text toIP6ARPA a =- T.reverse (T.concatMap trans $ fromIPv6Addr $ fromJust $ maybeFullIPv6Addr $ fromIPv6Addr a) <> "IP6.ARPA."+ T.reverse (T.concatMap trans $ fromIPv6Addr $ fromJust $ maybeFullIPv6Addr $ fromIPv6Addr a) <> "IP6.ARPA." where trans ':' = T.empty trans c = "." <> T.pack [c]@@ -82,7 +90,7 @@ -- toUNC :: IPv6Addr -> T.Text toUNC a =- (T.concatMap trans $ fromIPv6Addr $ fromJust $ maybePureIPv6Addr $ fromIPv6Addr a) <> ".ipv6-literal.net"+ (T.concatMap trans $ fromIPv6Addr $ fromJust $ maybePureIPv6Addr $ fromIPv6Addr a) <> ".ipv6-literal.net" where trans ':' = "-" trans c = T.pack [c]@@ -101,8 +109,9 @@ -- > getIPv6AddrOf "eth0" -- getIPv6AddrOf :: String -> IO (Maybe IPv6Addr)-getIPv6AddrOf s = maybe Nothing (maybeIPv6Addr . T.pack . show) <$>- (lookup s <$> networkInterfacesIPv6AddrList)+getIPv6AddrOf s =+ maybe Nothing (maybeIPv6Addr . T.pack . show) <$>+ (lookup s <$> networkInterfacesIPv6AddrList) -- | Returns a random 'IPv6Addr'. randIPv6Addr :: IO IPv6Addr@@ -114,56 +123,55 @@ -- randIPv6AddrWithPrefix :: Maybe T.Text -> IO (Maybe IPv6Addr) randIPv6AddrWithPrefix p =- if isNothing p- then do- r <- randomRIO (1,8)- tks <- case r of- 8 -> randPartialIPv6Addr 8- _ -> do- r' <- randomRIO (1,8-r)- case r + r' of- 7 -> concat <$>- sequence [ randPartialIPv6Addr r- , pure [Colon,AllZeros,Colon]- , randPartialIPv6Addr r'- ]- 8 -> randPartialIPv6Addr 8- _ -> concat <$>- sequence [ randPartialIPv6Addr r- , pure [DoubleColon]- , randPartialIPv6Addr r'- ]- return $ ipv6TokensToIPv6Addr tks- else case maybeIPv6AddrTokens (fromJust p) of- Just tks -> do- ntks <- do let ctks = countChunks tks- case (snd ctks :: Int) of- 0 -> return $ 8 - fst ctks- 1 -> return $ 6 - fst ctks- _ -> return 0- if ntks > 0- then do- rtks <- randPartialIPv6Addr ntks- let tks' = addColon tks ++ rtks- return $ if isIPv6Addr tks'- then ipv6TokensToIPv6Addr $- (toDoubleColon . fromDoubleColon) tks'- else Nothing- else return Nothing- Nothing -> return Nothing+ if isNothing p+ then do+ r <- randomRIO (1,8)+ tks <-+ case r of+ 8 -> randPartialIPv6Addr 8+ _ -> do+ r' <- randomRIO (1,8-r)+ case r + r' of+ 7 -> concat <$>+ sequence [ randPartialIPv6Addr r+ , pure [Colon,AllZeros,Colon]+ , randPartialIPv6Addr r'+ ]+ 8 -> randPartialIPv6Addr 8+ _ -> concat <$>+ sequence [ randPartialIPv6Addr r+ , pure [DoubleColon]+ , randPartialIPv6Addr r'+ ]+ return $ ipv6TokensToIPv6Addr tks+ else+ case maybeIPv6AddrTokens (fromJust p) of+ Just tks -> do+ ntks <- do let ctks = countChunks tks+ case (snd ctks :: Int) of+ 0 -> return $ 8 - fst ctks+ 1 -> return $ 6 - fst ctks+ _ -> return 0+ guard (ntks > 0)+ rtks <- randPartialIPv6Addr ntks+ let tks' = addColon tks ++ rtks+ guard (isIPv6Addr tks')+ return $ ipv6TokensToIPv6Addr $+ (toDoubleColon . fromDoubleColon) tks'+ Nothing -> return Nothing where- countChunks =- foldr count (0,0)- where- count c (a,b) =- case c of- SixteenBit _ -> (a+1,b)- AllZeros -> (a+1,b)- DoubleColon -> (a,b+1)- _ -> (a,b)- addColon ts =- case last ts of- SixteenBit _ -> ts ++ [Colon]- AllZeros -> ts ++ [Colon]- _ -> ts+ countChunks =+ foldr count (0,0)+ where+ count c (a,b) =+ case c of+ SixteenBit _ -> (a+1,b)+ AllZeros -> (a+1,b)+ DoubleColon -> (a,b+1)+ _ -> (a,b)+ addColon ts =+ case last ts of+ SixteenBit _ -> ts ++ [Colon]+ AllZeros -> ts ++ [Colon]+ _ -> ts
Text/IPv6Addr/Internal.hs view
@@ -17,6 +17,7 @@ ) where import Control.Applicative ((<|>))+import Control.Monad (guard) import Data.Attoparsec.Text import Data.Char (isDigit) import Data.List (elemIndex, elemIndices, group,@@ -52,89 +53,95 @@ isIPv6Addr [DoubleColon] = True isIPv6Addr [DoubleColon,SixteenBit "1"] = True isIPv6Addr tks =- diffNext tks && (do- let cdctks = countDoubleColon tks- lentks = length tks- lasttk = last tks- lenconst = (lentks == 15 && cdctks == 0) || (lentks < 15 && cdctks == 1)- firstValidToken tks &&- (case countIPv4Addr tks :: Int of- 0 -> case lasttk of- SixteenBit _ -> lenconst- DoubleColon -> lenconst- AllZeros -> lenconst- _ -> False- 1 -> case lasttk of- IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)- _ -> False- _ -> False))- 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- SixteenBit _ -> True- DoubleColon -> True- AllZeros -> True- _ -> False- countDoubleColon l = length $ elemIndices DoubleColon l+ diffNext tks && (do+ let cdctks = countDoubleColon tks+ lentks = length tks+ lasttk = last tks+ lenconst = (lentks == 15 && cdctks == 0) || (lentks < 15 && cdctks == 1)+ firstValidToken tks &&+ (case countIPv4Addr tks :: Int of+ 0 -> case lasttk of+ SixteenBit _ -> lenconst+ DoubleColon -> lenconst+ AllZeros -> lenconst+ _ -> False+ 1 -> case lasttk of+ IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)+ _ -> False+ _ -> False))+ 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+ SixteenBit _ -> True+ DoubleColon -> True+ AllZeros -> True+ _ -> False+ countDoubleColon l = length $ elemIndices DoubleColon l countIPv4Addr :: [IPv6AddrToken] -> Int countIPv4Addr =- foldr oneMoreIPv4Addr 0+ foldr oneMoreIPv4Addr 0 where oneMoreIPv4Addr t c = case t of- IPv4Addr _ -> c + 1- _ -> c+ IPv4Addr _ -> c + 1+ _ -> 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 =- case maybeIPv6AddrTokens t of- Just ltks -> if isIPv6Addr ltks- then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks- else Nothing- Nothing -> Nothing+ case maybeIPv6AddrTokens t of+ Just ltks -> do+ guard (isIPv6Addr ltks)+ Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks+ Nothing -> Nothing where ipv4AddrReplacement ltks =- if ipv4AddrRewrite ltks- then init ltks ++ ipv4AddrToIPv6AddrTokens (last ltks)- else 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+ ltks <- maybeIPv6AddrTokens t+ guard (isIPv6Addr ltks)+ return $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks where- ipv4AddrReplacement ltks' = init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks')+ ipv4AddrReplacement ltks' =+ init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks') -- | Tokenize a 'T.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- Partial _ -> Nothing+ case readText s of+ Done r l -> if r==T.empty then Just l else Nothing+ Fail {} -> Nothing+ Partial _ -> Nothing where- readText _s = feed (parse (many1 $ ipv4Addr <|> sixteenBit <|> doubleColon <|> colon) _s) T.empty+ 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@@ -153,17 +160,17 @@ -- ipv4AddrRewrite :: [IPv6AddrToken] -> Bool ipv4AddrRewrite tks =- case last tks of- IPv4Addr _ -> do- let itks = init tks- not (itks == [DoubleColon]- || itks == [DoubleColon,SixteenBit tokffff,Colon]- || itks == [DoubleColon,SixteenBit tokffff,Colon,AllZeros,Colon]- || itks == [SixteenBit "64",Colon,SixteenBit "ff9b",DoubleColon]- || [SixteenBit "200",Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks- || [AllZeros,Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks- || [DoubleColon,SixteenBit tok5efe,Colon] `isSuffixOf` itks)- _ -> False+ case last tks of+ IPv4Addr _ -> do+ let itks = init tks+ not (itks == [DoubleColon]+ || itks == [DoubleColon,SixteenBit tokffff,Colon]+ || itks == [DoubleColon,SixteenBit tokffff,Colon,AllZeros,Colon]+ || itks == [SixteenBit "64",Colon,SixteenBit "ff9b",DoubleColon]+ || [SixteenBit "200",Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks+ || [AllZeros,Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks+ || [DoubleColon,SixteenBit tok5efe,Colon] `isSuffixOf` itks)+ _ -> False where tokffff = "ffff" tok5efe = "5efe"@@ -174,63 +181,68 @@ -- ipv4AddrToIPv6AddrTokens :: IPv6AddrToken -> [IPv6AddrToken] ipv4AddrToIPv6AddrTokens t =- case t of- IPv4Addr a -> do- let m = toHex a- [ SixteenBit ((!!) m 0 <> addZero ((!!) m 1))- , Colon- , SixteenBit ((!!) m 2 <> 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 "0" <> d else d+ case t of+ IPv4Addr a -> do+ let m = toHex a+ [ SixteenBit ((!!) m 0 <> addZero ((!!) m 1))+ , Colon+ , SixteenBit ((!!) m 2 <> 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 "0" <> d else d expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]-expandTokens = map expandToken- where expandToken (SixteenBit s) = SixteenBit $ T.justifyRight 4 '0' s- expandToken AllZeros = SixteenBit "0000"- expandToken t = t+expandTokens =+ map expandToken+ where+ expandToken (SixteenBit s) = SixteenBit $ T.justifyRight 4 '0' s+ expandToken AllZeros = SixteenBit "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- fsts = fst s- snds = if not (null (snd s)) then tail(snd s) else []- fste = if null fsts then [] else fsts ++ [Colon]- snde = if null snds then [] else Colon : snds- fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde+ if DoubleColon `notElem` tks+ then tks+ else do+ let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks+ fsts = fst s+ snds = if not (null (snd s)) then tail(snd s) else []+ fste = if null fsts then [] else fsts ++ [Colon]+ 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+ 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 =- zerosToDoubleColon tks (zerosRunToReplace $ zerosRunsList tks)+ zerosToDoubleColon tks (zerosRunToReplace $ zerosRunsList tks) where- zerosToDoubleColon :: [IPv6AddrToken] -> (Int,Int) -> [IPv6AddrToken] -- No all zeros token, so no double colon replacement... zerosToDoubleColon ls (_,0) = ls -- "The symbol '::' MUST NOT be used to shorten just one 16-bit 0 field" (RFC 5952 4.2.2) zerosToDoubleColon ls (_,1) = ls zerosToDoubleColon ls (i,l) =- let ls' = filter (/= Colon) ls- in intersperse Colon (Prelude.take i ls') ++ [DoubleColon] ++ intersperse Colon (drop (i+l) ls')+ let ls' = filter (/= Colon) 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)+ let l = longestLengthZerosRun t+ in (firstLongestZerosRunIndex t l,l) where 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+ 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)@@ -240,62 +252,58 @@ networkInterfacesIPv6AddrList :: IO [(String,IPv6)] networkInterfacesIPv6AddrList =- getNetworkInterfaces >>= \n -> return $ map networkInterfacesIPv6Addr n+ fmap networkInterfacesIPv6Addr <$> getNetworkInterfaces where networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a) macAddr :: Parser (Maybe [IPv6AddrToken]) macAddr = do- n1 <- count 2 hexaChar <* ":"- n2 <- count 2 hexaChar <* ":"- n3 <- count 2 hexaChar <* ":"- n4 <- count 2 hexaChar <* ":"- n5 <- count 2 hexaChar <* ":"- n6 <- count 2 hexaChar- return $ maybeIPv6AddrTokens $ T.pack $ concat [n1,n2,n3,n4,n5,n6]+ n1 <- count 2 hexaChar <* ":"+ n2 <- count 2 hexaChar <* ":"+ n3 <- count 2 hexaChar <* ":"+ n4 <- count 2 hexaChar <* ":"+ n5 <- count 2 hexaChar <* ":"+ n6 <- count 2 hexaChar+ return $ maybeIPv6AddrTokens $ T.pack $ concat [n1,n2,n3,n4,n5,n6] sixteenBit :: Parser IPv6AddrToken sixteenBit = do- r <- ipv6AddrFullChunk <|> 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'+ r <- ipv6AddrFullChunk <|> 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 <* "."- if n1 /= T.empty- then do n2 <- manyDigits <* "."- if n2 /= T.empty- then do n3 <- manyDigits <* "."- if n3 /= T.empty- then do n4 <- manyDigits- if n4 /= T.empty- then return $ IPv4Addr $ T.intercalate "." [n1,n2,n3,n4]- else parserFailure- else parserFailure- else parserFailure- else parserFailure+ n1 <- manyDigits <* "."+ guard (n1 /= T.empty)+ n2 <- manyDigits <* "."+ guard (n2 /= T.empty)+ n3 <- manyDigits <* "."+ guard (n3 /= T.empty)+ n4 <- manyDigits+ guard (n4 /= T.empty)+ return $ IPv4Addr $ T.intercalate "." [n1,n2,n3,n4] where- parserFailure = fail "ipv4Addr parsing failure" manyDigits = do ds <- takeWhile1 isDigit case R.decimal ds :: Either String (Integer, T.Text) of- Right (n,_) -> return (if n < 256 then T.pack $ show n else T.empty)- Left _ -> return T.empty+ Right (n,_) -> return $ if n < 256 then T.pack $ show n else T.empty+ Left _ -> return T.empty doubleColon :: Parser IPv6AddrToken doubleColon = do- _ <- string "::"- return DoubleColon+ _ <- string "::"+ return DoubleColon colon :: Parser IPv6AddrToken colon = do- _ <- string ":"- return Colon+ _ <- string ":"+ return Colon ipv6AddrFullChunk :: Parser String ipv6AddrFullChunk = count 4 hexaChar
Text/IPv6Addr/Manip.hs view
@@ -24,7 +24,7 @@ -- randIPv6AddrChunk :: String -> IO IPv6AddrToken randIPv6AddrChunk m =- mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g+ mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g where getHex c | c == '_' = intToDigit <$> randomRIO (0,15)@@ -33,8 +33,8 @@ -- | Generates a random partial 'IPv6Addr' with n 'SixteenBit' randPartialIPv6Addr :: Int -> IO [IPv6AddrToken] randPartialIPv6Addr n- | n > 0 && n < 9 = intersperse Colon <$> replicateM n (randIPv6AddrChunk "____")- | otherwise = return []+ | n > 0 && n < 9 = intersperse Colon <$> replicateM n (randIPv6AddrChunk "____")+ | otherwise = return [] -- | Given a MAC address, returns 'Just' the corresponding 'IPv6AddrToken' list, or 'Nothing'. --@@ -42,9 +42,12 @@ -- 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+ 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.@@ -55,7 +58,8 @@ -- > getTokIPv6AddrOf "eth0" == Just [SixteenBit "fe80",DoubleColon,SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"] -- getTokIPv6AddrOf :: String -> IO (Maybe [IPv6AddrToken])-getTokIPv6AddrOf s = maybe Nothing (maybeTokIPv6Addr. T.pack . show) <$> (lookup s <$> networkInterfacesIPv6AddrList)+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,@@ -65,7 +69,8 @@ -- getTokMacAddrOf :: String -> IO (Maybe [IPv6AddrToken]) getTokMacAddrOf s =- maybe Nothing (macAddrToIPv6AddrTokens . T.pack . show) <$> (lookup s <$> networkInterfacesMacAddrList)+ 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
@@ -2,16 +2,16 @@ import qualified Data.Text as T -data IPv6Addr = IPv6Addr T.Text+data IPv6Addr = IPv6Addr !T.Text instance Show IPv6Addr where- show (IPv6Addr addr) = T.unpack addr+ show (IPv6Addr a) = T.unpack a data IPv6AddrToken- = 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- | IPv4Addr T.Text -- ^ An embedded IPv4 address as representation of the last 32-Bit- deriving (Eq,Show)+ = 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+ | IPv4Addr !T.Text -- ^ An embedded IPv4 address as representation of the last 32-Bit+ deriving (Eq, Show)