Hello community, here is the log from the commit of package ghc-IPv6Addr for openSUSE:Factory checked in at 2017-08-31 20:45:53 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-IPv6Addr (Old) and /work/SRC/openSUSE:Factory/.ghc-IPv6Addr.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-IPv6Addr" Thu Aug 31 20:45:53 2017 rev:4 rq:513190 version:1.0.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-IPv6Addr/ghc-IPv6Addr.changes 2017-03-18 20:50:14.820458524 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-IPv6Addr.new/ghc-IPv6Addr.changes 2017-08-31 20:45:54.372362851 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:08 UTC 2017 - psimons@suse.com + +- Update to version 1.0.1. + +------------------------------------------------------------------- Old: ---- IPv6Addr-0.6.3.tar.gz IPv6Addr.cabal New: ---- IPv6Addr-1.0.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-IPv6Addr.spec ++++++ --- /var/tmp/diff_new_pack.4mtGZY/_old 2017-08-31 20:45:55.588192193 +0200 +++ /var/tmp/diff_new_pack.4mtGZY/_new 2017-08-31 20:45:55.604189948 +0200 @@ -19,15 +19,15 @@ %global pkg_name IPv6Addr %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.6.3 +Version: 1.0.1 Release: 0 Summary: Library to deal with IPv6 address text representations License: BSD-3-Clause Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-aeson-devel BuildRequires: ghc-attoparsec-devel BuildRequires: ghc-iproute-devel BuildRequires: ghc-network-devel @@ -59,7 +59,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ IPv6Addr-0.6.3.tar.gz -> IPv6Addr-1.0.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPv6Addr-0.6.3/IPv6Addr.cabal new/IPv6Addr-1.0.1/IPv6Addr.cabal --- old/IPv6Addr-0.6.3/IPv6Addr.cabal 2016-12-26 16:25:59.000000000 +0100 +++ new/IPv6Addr-1.0.1/IPv6Addr.cabal 2017-04-17 14:42:36.000000000 +0200 @@ -1,5 +1,5 @@ name: IPv6Addr -version: 0.6.3 +version: 1.0.1 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 @@ -7,7 +7,7 @@ license-file: LICENSE author: Michel Boucey maintainer: michel.boucey@cybervisible.fr -copyright: (c) 2011-2016 - Michel Boucey +copyright: (c) 2011-2017 - Michel Boucey category: Network build-type: Simple extra-source-files: README.md @@ -18,14 +18,15 @@ Location: https://github.com/MichelBoucey/IPv6Addr.git library - exposed-modules: Text.IPv6Addr, Text.IPv6Addr.Types, Text.IPv6Addr.Manip, Text.IPv6Addr.Internal + exposed-modules: Text.IPv6Addr other-extensions: OverloadedStrings - build-depends: base >=4.6 && <5 - , text >=1.1 && <1.3 - , iproute >=1.3 && <1.8 - , network >=2.5 && <2.7 - , random >=1.0 && <=1.1 - , attoparsec >=0.12 && <0.14 + build-depends: base >=4.8 && < 5 + , text >=1.1 && < 1.3 + , iproute >=1.3 && < 1.8 + , network >=2.5 && < 2.7 + , random >=1.0 && <= 1.1 + , attoparsec >=0.12 && < 0.14 + , aeson >= 0.8.0.2 && < 1.3 , network-info >=0.2 && <=0.3 default-language: Haskell2010 GHC-Options: -Wall diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPv6Addr-0.6.3/LICENSE new/IPv6Addr-1.0.1/LICENSE --- old/IPv6Addr-0.6.3/LICENSE 2016-04-05 18:28:22.000000000 +0200 +++ new/IPv6Addr-1.0.1/LICENSE 2017-04-02 14:06:49.000000000 +0200 @@ -1,4 +1,4 @@ -Copyright (c) 2011-2016, Michel Boucey +Copyright (c) 2011-2017, Michel Boucey All rights reserved. Redistribution and use in source and binary forms, with or without diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPv6Addr-0.6.3/Text/IPv6Addr/Internal.hs new/IPv6Addr-1.0.1/Text/IPv6Addr/Internal.hs --- old/IPv6Addr-0.6.3/Text/IPv6Addr/Internal.hs 2016-11-17 11:10:08.000000000 +0100 +++ new/IPv6Addr-1.0.1/Text/IPv6Addr/Internal.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,314 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Text.IPv6Addr.Internal - ( expandTokens - , macAddr - , maybeIPv6AddrTokens - , ipv4AddrToIPv6AddrTokens - , ipv6TokensToText - , ipv6TokensToIPv6Addr - , isIPv6Addr - , maybeTokIPv6Addr - , maybeTokPureIPv6Addr - , toDoubleColon - , fromDoubleColon - , fromIPv6Addr - , networkInterfacesIPv6AddrList - ) where - -import Control.Applicative ((<|>)) -import Control.Monad (guard) -import Data.Attoparsec.Text -import Data.Char (isDigit) -import Data.List (elemIndex, elemIndices, group, - intersperse, isSuffixOf) -import Data.Maybe (fromJust) -import Data.Monoid ((<>)) -import qualified Data.Text as T -import qualified Data.Text.Read as R (decimal) -import Network.Info -import Numeric (showHex) - -import Text.IPv6Addr.Types - --- | Returns the 'T.Text' of an IPv6 address. -fromIPv6Addr :: IPv6Addr -> T.Text -fromIPv6Addr (IPv6Addr t) = t - --- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'T.Text'. -ipv6TokensToText :: [IPv6AddrToken] -> T.Text -ipv6TokensToText l = T.concat $ map ipv6TokenToText l - --- | Returns the corresponding 'T.Text' of an IPv6 address token. -ipv6TokenToText :: IPv6AddrToken -> T.Text -ipv6TokenToText (SixteenBit s) = s -ipv6TokenToText Colon = ":" -ipv6TokenToText DoubleColon = "::" -ipv6TokenToText AllZeros = "0" -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1) -ipv6TokenToText (IPv4Addr a) = a - --- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address. -isIPv6Addr :: [IPv6AddrToken] -> Bool -isIPv6Addr [] = False -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 - -countIPv4Addr :: [IPv6AddrToken] -> Int -countIPv4Addr = - foldr oneMoreIPv4Addr 0 - where - oneMoreIPv4Addr t c = - case t of - 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 -> 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 - --- | 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 - guard (isIPv6Addr ltks) - return $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks - where - 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 - 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 --- they deals with IPv4 to IPv6 transition process (RFC 5952 Section 5): --- --- IPv4-compatible IPv6 address like "::1.2.3.4" --- --- IPv4-mapped IPv6 address like "::ffff:1.2.3.4" --- --- IPv4-translated address like "::ffff:0:1.2.3.4" --- --- IPv4-translatable address like "64:ff9b::1.2.3.4" --- --- ISATAP address like "fe80::5efe:1.2.3.4" --- -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 - where - tokffff = "ffff" - tok5efe = "5efe" - --- | Rewrites an embedded 'IPv4Addr' into the corresponding list of pure 'IPv6Addr' tokens. --- --- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"] --- -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 - -expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken] -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 - 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 = - zerosToDoubleColon tks (zerosRunToReplace $ zerosRunsList tks) - where - -- 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') - zerosRunToReplace t = - 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 - where - helper h = (head h == AllZeros, lh) where lh = length h - groupZerosRuns = group . filter (/= Colon) - -ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr -ipv6TokensToIPv6Addr l = Just $ IPv6Addr $ ipv6TokensToText l - -networkInterfacesIPv6AddrList :: IO [(String,IPv6)] -networkInterfacesIPv6AddrList = - 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] - -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' - -ipv4Addr :: Parser IPv6AddrToken -ipv4Addr = do - 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 - 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 - -doubleColon :: Parser IPv6AddrToken -doubleColon = do - _ <- string "::" - return DoubleColon - -colon :: Parser IPv6AddrToken -colon = do - _ <- string ":" - return Colon - -ipv6AddrFullChunk :: Parser String -ipv6AddrFullChunk = count 4 hexaChar - -hexaChar :: Parser Char -hexaChar = satisfy (inClass "0-9a-fA-F") - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPv6Addr-0.6.3/Text/IPv6Addr/Manip.hs new/IPv6Addr-1.0.1/Text/IPv6Addr/Manip.hs --- old/IPv6Addr-0.6.3/Text/IPv6Addr/Manip.hs 2016-11-17 11:05:34.000000000 +0100 +++ new/IPv6Addr-1.0.1/Text/IPv6Addr/Manip.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,80 +0,0 @@ -module Text.IPv6Addr.Manip - ( randIPv6AddrChunk - , randPartialIPv6Addr - , macAddrToIPv6AddrTokens - , getTokIPv6AddrOf - , getTokMacAddrOf - ) where - -import Control.Monad (replicateM) -import Data.Attoparsec.Text as A -import Data.Char (intToDigit) -import Data.List (intersperse) -import qualified Data.Text as T -import Network.Info -import System.Random (randomRIO) - -import Text.IPv6Addr.Internal -import Text.IPv6Addr.Types - --- | Returns 'Just' a random 'SixteenBit' token based on a mask \"____\", each --- underscore being replaced by a random hexadecimal digit. --- --- > randIPv6AddrChunk "_f__" == Just (SixteenBit "bfd4") --- -randIPv6AddrChunk :: String -> IO IPv6AddrToken -randIPv6AddrChunk m = - mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g - where - getHex c - | c == '_' = intToDigit <$> randomRIO (0,15) - | otherwise = return c - --- | 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 [] - --- | Given a MAC address, returns 'Just' the corresponding 'IPv6AddrToken' list, or 'Nothing'. --- --- > macAddrToIPv6AddrTokens "fa:1d:58:cc:95:16" == Just [SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"] --- -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. --- --- | 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 = - 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 = - maybe Nothing (macAddrToIPv6AddrTokens . T.pack . show) <$> - (lookup s <$> networkInterfacesMacAddrList) - where - networkInterfacesMacAddrList = getNetworkInterfaces >>= - \n -> return $ map networkInterfacesMac n - where networkInterfacesMac (NetworkInterface n _ _ m) = (n,m) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPv6Addr-0.6.3/Text/IPv6Addr/Types.hs new/IPv6Addr-1.0.1/Text/IPv6Addr/Types.hs --- old/IPv6Addr-0.6.3/Text/IPv6Addr/Types.hs 2016-11-09 11:31:02.000000000 +0100 +++ new/IPv6Addr-1.0.1/Text/IPv6Addr/Types.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,17 +0,0 @@ -module Text.IPv6Addr.Types where - -import qualified Data.Text as T - -data IPv6Addr = IPv6Addr !T.Text - -instance Show IPv6Addr where - 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) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPv6Addr-0.6.3/Text/IPv6Addr.hs new/IPv6Addr-1.0.1/Text/IPv6Addr.hs --- old/IPv6Addr-0.6.3/Text/IPv6Addr.hs 2016-11-17 10:59:56.000000000 +0100 +++ new/IPv6Addr-1.0.1/Text/IPv6Addr.hs 2017-04-08 15:27:59.000000000 +0200 @@ -1,9 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} module Text.IPv6Addr - ( - IPv6Addr (IPv6Addr) + ( IPv6Addr (IPv6Addr) , maybeIPv6Addr , maybePureIPv6Addr , maybeFullIPv6Addr @@ -16,29 +14,62 @@ , toIP6ARPA , toUNC - -- * Utils + -- * Utilities , 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) - -import Text.IPv6Addr.Internal -import Text.IPv6Addr.Manip (randPartialIPv6Addr) -import Text.IPv6Addr.Types + -- * Manipulations + , randIPv6AddrChunk + , randPartialIPv6Addr + , macAddrToIPv6AddrTokens + , getTokIPv6AddrOf + , getTokMacAddrOf ) where + +import Control.Applicative ((<|>)) +import Control.Monad (replicateM, guard) +import Data.Aeson +import Data.Attoparsec.Text as A +import Data.Char (intToDigit, isDigit) +import Data.IP (IPv6) +import Data.List (elemIndex, elemIndices, group, + intersperse, isSuffixOf) +import Data.Maybe (fromJust, isNothing) +import Data.Monoid ((<>)) +import qualified Data.Text as T +import qualified Data.Text.Read as R (decimal) +import Network (HostName) +import Network.Info +import Numeric (showHex) +import System.Random (randomRIO) + +data IPv6Addr = IPv6Addr !T.Text + +instance Show IPv6Addr where + 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) instance Eq IPv6Addr where (==) (IPv6Addr a) (IPv6Addr b) = show (maybePureIPv6Addr a) == show (maybePureIPv6Addr b) +instance ToJSON IPv6Addr where + toJSON (IPv6Addr a) = String a + +instance FromJSON IPv6Addr where + parseJSON (String s) = + case maybeIPv6Addr s of + Just a -> pure a + Nothing -> fail "Not An IPv6 Address" + parseJSON _ = fail "JSON String Expected" + -- | Returns 'Just' the text representation of a canonized -- 'IPv6Addr' in conformation with RFC 5952, or 'Nothing'. -- @@ -100,7 +131,7 @@ toHostName = show -- | Given an 'IPv6addr', returns the corresponding 'IPv6' address. -toIPv6 :: IPv6Addr -> IPv6 +toIPv6 :: IPv6Addr -> Data.IP.IPv6 toIPv6 a = read $ show a -- | Returns 'Just' the canonized 'IPv6Addr' of the given local network interface, @@ -161,9 +192,9 @@ Nothing -> return Nothing where countChunks = - foldr count (0,0) + foldr go (0,0) where - count c (a,b) = + go c (a,b) = case c of SixteenBit _ -> (a+1,b) AllZeros -> (a+1,b) @@ -175,3 +206,359 @@ AllZeros -> ts ++ [Colon] _ -> ts + +-- ------------------------------------------------------------------------ -- +-- Maniplations -- +-- ------------------------------------------------------------------------ -- + +-- | Returns 'Just' a random 'SixteenBit' token based on a mask \"____\", each +-- underscore being replaced by a random hexadecimal digit. +-- +-- > randIPv6AddrChunk "_f__" == Just (SixteenBit "bfd4") +-- +randIPv6AddrChunk :: String -> IO IPv6AddrToken +randIPv6AddrChunk m = + mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g + where + getHex c + | c == '_' = getDigit + | otherwise = pure c + +-- | Generates a random partial 'IPv6Addr' with n 'SixteenBit'. +randPartialIPv6Addr :: Int -> IO [IPv6AddrToken] +randPartialIPv6Addr n = + if n > 0 && n < 9 + then + intersperse Colon <$> + replicateM n (SixteenBit . T.pack <$> replicateM 4 getDigit) + else pure [] + +-- | Given a MAC address, returns 'Just' the corresponding 'IPv6AddrToken' list, or 'Nothing'. +-- +-- > macAddrToIPv6AddrTokens "fa:1d:58:cc:95:16" == Just [SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"] +-- +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. +-- +-- | 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 = + 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 = + maybe Nothing (macAddrToIPv6AddrTokens . T.pack . show) <$> + (lookup s <$> networkInterfacesMacAddrList) + where + networkInterfacesMacAddrList = getNetworkInterfaces >>= + \n -> return (networkInterfacesMac <$> n) + where networkInterfacesMac (NetworkInterface n _ _ m) = (n,m) + +getDigit :: IO Char +getDigit = intToDigit <$> randomRIO (0,15) + +-- ---------------------------------------------------------------------------- +-- Internals +-- ---------------------------------------------------------------------------- + +-- | Returns the 'T.Text' of an IPv6 address. +fromIPv6Addr :: IPv6Addr -> T.Text +fromIPv6Addr (IPv6Addr t) = t + +-- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'T.Text'. +ipv6TokensToText :: [IPv6AddrToken] -> T.Text +ipv6TokensToText l = T.concat $ map ipv6TokenToText l + +-- | Returns the corresponding 'T.Text' of an IPv6 address token. +ipv6TokenToText :: IPv6AddrToken -> T.Text +ipv6TokenToText (SixteenBit s) = s +ipv6TokenToText Colon = ":" +ipv6TokenToText DoubleColon = "::" +ipv6TokenToText AllZeros = "0" -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1) +ipv6TokenToText (IPv4Addr a) = a + +-- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address. +isIPv6Addr :: [IPv6AddrToken] -> Bool +isIPv6Addr [] = False +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 + +countIPv4Addr :: [IPv6AddrToken] -> Int +countIPv4Addr = + foldr oneMoreIPv4Addr 0 + where + oneMoreIPv4Addr t c = + case t of + 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 -> 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 + +-- | 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 + guard (isIPv6Addr ltks) + return $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks + where + 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 + 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 +-- they deals with IPv4 to IPv6 transition process (RFC 5952 Section 5): +-- +-- IPv4-compatible IPv6 address like "::1.2.3.4" +-- +-- IPv4-mapped IPv6 address like "::ffff:1.2.3.4" +-- +-- IPv4-translated address like "::ffff:0:1.2.3.4" +-- +-- IPv4-translatable address like "64:ff9b::1.2.3.4" +-- +-- ISATAP address like "fe80::5efe:1.2.3.4" +-- +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 + where + tokffff = "ffff" + tok5efe = "5efe" + +-- | Rewrites an embedded 'IPv4Addr' into the corresponding list of pure 'IPv6Addr' tokens. +-- +-- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"] +-- +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 + +expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken] +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 + 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 = + zerosToDoubleColon tks (zerosRunToReplace $ zerosRunsList tks) + where + -- 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') + zerosRunToReplace t = + 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 + where + helper h = (head h == AllZeros, lh) where lh = length h + groupZerosRuns = group . filter (/= Colon) + +ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr +ipv6TokensToIPv6Addr l = Just $ IPv6Addr $ ipv6TokensToText l + +networkInterfacesIPv6AddrList :: IO [(String,Network.Info.IPv6)] +networkInterfacesIPv6AddrList = + 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] + +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' + +ipv4Addr :: Parser IPv6AddrToken +ipv4Addr = do + 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 + 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 + +doubleColon :: Parser IPv6AddrToken +doubleColon = do + _ <- string "::" + return DoubleColon + +colon :: Parser IPv6AddrToken +colon = do + _ <- string ":" + return Colon + +ipv6AddrFullChunk :: Parser String +ipv6AddrFullChunk = count 4 hexaChar + +hexaChar :: Parser Char +hexaChar = satisfy (inClass "0-9a-fA-F") + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IPv6Addr-0.6.3/tests/Main.hs new/IPv6Addr-1.0.1/tests/Main.hs --- old/IPv6Addr-0.6.3/tests/Main.hs 2016-04-05 18:20:50.000000000 +0200 +++ new/IPv6Addr-1.0.1/tests/Main.hs 2017-01-31 11:24:27.000000000 +0100 @@ -25,6 +25,7 @@ , (~?=) (maybeIPv6Addr "::1") (Just (IPv6Addr "::1")) , (~?=) (maybeIPv6Addr "::1:") Nothing , (~?=) (maybeIPv6Addr "0000:0000:0000:0000:0000:0000:0000:0001") (Just (IPv6Addr "::1")) + , (~?=) (maybeIPv6Addr "0:0:0:0:0:0:0:1") (Just (IPv6Addr "::1")) , (~?=) (maybeIPv6Addr "a") Nothing , (~?=) (maybeIPv6Addr "ab") Nothing , (~?=) (maybeIPv6Addr "abc") Nothing