IPv6Addr 0.1 → 0.2

raw patch · 6 files changed

+488/−390 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• IPv6Addr.cabal +10/−7
• LICENSE +1/−1
• Text/IPv6Addr.hs +33/−382
• Text/IPv6Addr/Internal.hs +311/−0
• Text/IPv6Addr/Manip.hs +103/−0
• Text/IPv6Addr/Types.hs +30/−0

@@ -1,15 +1,15 @@ name:		IPv6Addr-version:	0.1+version:	0.2 license:	BSD3 license-file:	LICENSE-Copyright:      Copyright © 2011 - Michel Boucey+Copyright:      Copyright © 2011-2012 - Michel Boucey 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 the IPv6 address's text representation.-description:	Library to deal with IPv6 addresse's text representation with validation against RFC 4291 and canonization in conformation with RFC 5952.+synopsis:	Library to deal with IPv6 address text representation.+description:	Library to deal with IPv6 address text representation, canonization and manipulations. category:	Network, Text-stability:	stable+stability:	provisional build-type:	Simple cabal-version:	>= 1.6 source-repository head@@ -20,7 +20,10 @@   Build-Depends: base >= 3 && <= 5,                  bytestring >= 0.9,                  network-info >= 0.2,-                 text,-                 random+                 random,+                 text    exposed-modules: Text.IPv6Addr+                   Text.IPv6Addr.Internal+                   Text.IPv6Addr.Manip+                   Text.IPv6Addr.Types

@@ -1,4 +1,4 @@-Copyright (c) 2011 - Michel Boucey+Copyright (c) 2011-2012 - Michel Boucey  All rights reserved. 

@@ -1,32 +1,24 @@+-------------------------------------------------------------------------------- -- |  -- Module      :  Text.IPv6Addr--- Copyright   :  (c) Michel Boucey 2011+-- Copyright   :  (c) Michel Boucey 2011-2012 -- License     :  BSD-style -- Maintainer  :  michel.boucey@gmail.com -- Stability   :  provisional ----- Dealing with IPv6 address's text representation. Main features are validation against RFC 4291 and canonization in conformation with RFC 5952.+-- Dealing with IPv6 address text representation,+-- canonization and manipulations.+--+-------------------------------------------------------------------------------- -module Text.IPv6Addr(-    IPv6Addr,-    IPv6AddrToken(..),-    -- * Validating and canonizing an IPv6 Address-    isIPv6Addr,-    maybeIPv6Addr,-    maybeTokIPv6Addr,-    maybeExpIPv6Addr,-    getIPv6AddrOf,-    -- * Manipulating IPv6 address tokens-    -- ** To IPv6 Address token(s)-    maybeIPv6AddrTokens,-    macAddrToIPv6AddrTokens,-    getTokIPv6AddrOf,-    getTokMacAddrOf,-    sixteenBitsRand,-    ipv4AddrToIPv6AddrTokens,-    -- ** Back to Text-    ipv6TokensToText,-) where+module Text.IPv6Addr+    (+      IPv6Addr+    , maybeIPv6Addr+    , maybePureIPv6Addr+    , maybeFullIPv6Addr+    , getIPv6AddrOf+    ) where  import Control.Monad (replicateM) import Data.Char (intToDigit,isDigit,isHexDigit,toLower)@@ -35,384 +27,43 @@ import Data.Maybe (fromJust,isJust) import qualified Data.Text as T import Data.Text.Read (decimal)-import Network.Info import Numeric (showIntAtBase)-import System.Random (randomRIO) -type IPv6Addr = T.Text--data IPv6AddrToken-    = SixteenBits 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)--data IPv4AddrToken -    = Dot-    | EightBits T.Text deriving (Eq,Show)---- | Some useful tokens-tokdot = T.pack "."-tokcolon = T.pack ":"-tokdcolon = T.pack "::"-tok0 = T.pack "0"-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"--tokenizeBy :: Char -> T.Text -> [T.Text]-tokenizeBy c = T.groupBy ((==) `on` (==c))------- Parsing embedded IPv4 address-----dot :: T.Text -> Maybe IPv4AddrToken-dot s = if s == tokdot then Just Dot else Nothing--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------- Parsing IPv6 Address------- | Returns an IPv4 address as an IPv6 address token.-ipv4Addr :: T.Text -> Maybe IPv6AddrToken-ipv4Addr t =-    do-        let r = map ipv4Token $ tokenizeBy '.' t-        if (Nothing `notElem` r) && (length r == 7)-            then Just (IPv4Addr t) else Nothing--colon :: T.Text -> Maybe IPv6AddrToken-colon t = if t == tokcolon then Just Colon else Nothing--doubleColon :: T.Text -> Maybe IPv6AddrToken-doubleColon t = if t == tokdcolon then Just DoubleColon else Nothing---- | Returns a SixteenBits token.-sixteenBits:: T.Text -> Maybe IPv6AddrToken-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-                    if T.null t'-                        then Just AllZeros-                        -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)-                        else Just $ SixteenBits $ T.toLower t'-                else Nothing-    else Nothing---- | Returns a random 'SixteenBits' token. E.g. sixteenBitsRand \"d\" may produce 'SixteenBits' \"d7b5\".-sixteenBitsRand :: String -> IO IPv6AddrToken-sixteenBitsRand s =-    if all isHexDigit s && l < 4-       then do-           a <- replicateM (4-l) hexRand-           return $ SixteenBits $ T.toLower $ T.pack $ s ++ a-       else return $ SixteenBits tok0--    where--        l = length s--        hexRand = do r <- randomRIO(0,15)-                     return $ intToDigit r+import Text.IPv6Addr.Internal+import Text.IPv6Addr.Types --- | Returns Just an 'IPv6Addr', or Nothing.+-- | Returns Just the text representation of a canonized+-- 'IPv6Addr' in conformation with RFC 5952, or Nothing. ----- > maybeIPv6Addr "D045::00Da:0fA9:0:0:230.34.110.80" == Just "d045:0:da:fa9::e622:6e50"+-- > maybeIPv6Addr "0:0::FFFF:192.0.2.128" == Just "::ffff:192.0.2.128" -- maybeIPv6Addr :: T.Text -> Maybe IPv6Addr-maybeIPv6Addr t = -     case maybeTokIPv6Addr t of-         Just a -> Just $ ipv6TokensToText a-         Nothing -> Nothing---- | Returns Just an expanded IPv6 address, or Nothing.-maybeExpIPv6Addr :: T.Text -> Maybe IPv6Addr-maybeExpIPv6Addr t = -     case maybeTokIPv6Addr t of-         Just a -> Just $ ipv6TokensToText $ fromDoubleColon a-         Nothing -> Nothing---- | 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---- | Returns the corresponding 'Text' of an IPv6 address token.-ipv6TokenToText :: IPv6AddrToken -> T.Text-ipv6TokenToText (SixteenBits s) = s -ipv6TokenToText Colon = tokcolon-ipv6TokenToText DoubleColon = tokdcolon--- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1)-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 tks =-    diffNext tks && (do-        let cdctks = countDoubleColon tks-        let lentks = length tks-        let lasttk = last tks-        let lenconst = (lentks == 15 && cdctks == 0) || (lentks < 15 && cdctks == 1)-        firstValidToken tks &&-            (case countIPv4Addr tks of-                0 -> case lasttk of-                          SixteenBits _ -> lenconst-                          DoubleColon -> lenconst-                          AllZeros -> lenconst-                          otherwise -> False-                1 -> case lasttk of-                          IPv4Addr _ ->-                              (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)-                          otherwise -> False-                otherwise -> False))--            where--                diffNext [_] = True-                diffNext [a,a'] = a /= a'-                diffNext (a:as) = (a /= head as) && diffNext as--                firstValidToken l = -                    case head l of-                        SixteenBits _ -> True-                        DoubleColon -> True-                        AllZeros -> True-                        otherwise -> False--                countDoubleColon l = length $ elemIndices DoubleColon l--countIPv4Addr tks =-     foldr oneMoreIPv4Addr 0 tks-     where oneMoreIPv4Addr t c =-               case t of-                   IPv4Addr _ -> c + 1-                   otherwise -> c---- | Returns Just a list of 'IPv6AddrToken', or Nothing.-maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]-maybeIPv6AddrTokens t = mapM maybeIPv6AddrToken (tokenizeBy ':' t)---- | This is the main function which returns Just the list of a tokenized IPv6 address's--- text representation validated against RFC 4291 and canonized (rewritten) in conformation--- with RFC 5952, or Nothing.-maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]-maybeTokIPv6Addr t =-    case maybeIPv6AddrTokens t of-        Nothing -> Nothing-        Just a ->-            if isIPv6Addr a-                then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) a-            else Nothing--        where--            ipv4AddrReplacement tks =-                if ipv4AddrRewrite tks then init tks ++ ipv4AddrToIPv6AddrTokens (last tks) else tks---- | 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,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+maybeIPv6Addr t = maybeTokIPv6Addr t >>= ipv6TokensToText --- | Rewrites Just an embedded 'IPv4Addr' into the corresponding list of pure IPv6Addr tokens, or returns an empty list.+-- | Returns Just a pure 'IPv6Addr', or Nothing. ----- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"]+-- > maybePureIPv6Addr "::ffff:192.0.2.128" == Just "::ffff:c000:280" ---ipv4AddrToIPv6AddrTokens :: IPv6AddrToken -> [IPv6AddrToken]-ipv4AddrToIPv6AddrTokens t =-    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))]-        otherwise -> []--        where--            toHex a = map (\x -> T.pack $ showIntAtBase 16 intToDigit (read (T.unpack x)::Int) "") $ T.split (=='.') a--            addZero d = if T.length d == 1 then T.pack "0" `T.append` d else d--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 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)--toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]-toDoubleColon 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 (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 =-                        if head h == AllZeros-                        then (True,lh) else (False,lh)--                        where lh = length h--                    groupZerosRuns = group . filter (/= Colon)+maybePureIPv6Addr :: T.Text -> Maybe IPv6Addr+maybePureIPv6Addr t = maybeTokPureIPv6Addr t >>= ipv6TokensToText +-- | Returns Just a pure and expanded 'IPv6Addr', or Nothing. ----- Functions based upon Network.Info to get local MAC and IPv6 adresses.+-- > maybeFullIPv6Addr "::ffff:192.0.2.128" == Just "0000:0000:0000:0000:0000:ffff:c000:0280" --+maybeFullIPv6Addr :: T.Text -> Maybe IPv6Addr+maybeFullIPv6Addr t = do+    a <- maybeTokPureIPv6Addr t+    ipv6TokensToText $ expandTokens $ fromDoubleColon a --- | Given a MAC address, returns the corresponding 'IPv6AddrToken' list, or an empty list.+-- | Returns Just the canonized 'IPv6Addr' of the given network interface,+-- or Nothing. ----- > macAddrToIPv6AddrTokens "fa:1d:58:cc:95:16" == [SixteenBits "fa1d",Colon,SixteenBits "58cc",Colon,SixteenBits "9516"]+-- > getIPv6AddrOf "eth0" ---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]) --networkInterfacesIPv6AddrList :: IO [(String,IPv6)]-networkInterfacesIPv6AddrList = do-    n <- getNetworkInterfaces-    return $ map networkInterfacesIPv6Addr n --    where networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a)--networkInterfacesMacAddrList :: IO [(String,MAC)]-networkInterfacesMacAddrList = do-    n <- getNetworkInterfaces-    return $ map networkInterfacesMac n --    where networkInterfacesMac (NetworkInterface n _ _ m) = (n,m)---- | Given a valid name of a local network interface, e.g. getIPv6AddrOf \"eth0\", return Just the interface's IPv6 address. 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---- | Given a valid name of a local network interface, returns Just the list of tokens of the interface's IPv6 address.-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---- | Given the valid name of a local network interface, returns the corresponding list of 'IPv6AddrToken' of the interface's MAC Address.-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

@@ -0,0 +1,311 @@+--------------------------------------------------------------------------------+-- | +-- Module      :  Text.IPv6Addr+-- Copyright   :  (c) Michel Boucey 2011-2012+-- License     :  BSD-style+-- Maintainer  :  michel.boucey@gmail.com+-- Stability   :  provisional+--+-- Dealing with IPv6 address text representation,+-- canonization and manipulations.+--+--------------------------------------------------------------------------------++module Text.IPv6Addr.Internal+    (+      colon+    , doubleColon+    , sixteenBits+    , ipv4Addr+    , expandTokens+    , maybeIPv6AddrToken+    , maybeIPv6AddrTokens+    , ipv6TokensToText+    , isIPv6Addr+    , maybeTokIPv6Addr+    , maybeTokPureIPv6Addr+    , ipv4AddrToIPv6AddrTokens+    , fromDoubleColon+    , toDoubleColon+    , networkInterfacesIPv6AddrList+    ) where++import Control.Monad (replicateM)+import Data.Char (isDigit,isHexDigit,toLower)+import Data.Function (on)+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 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"++tokenizeBy :: Char -> T.Text -> [T.Text]+tokenizeBy c = T.groupBy ((==) `on` (== c))++--+-- Validation of IPv6 adress tokens+--++dot :: T.Text -> Maybe IPv4AddrToken+dot s = if s == tokdot then Just Dot else Nothing++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 $ tokenizeBy '.' t+    if (Nothing `notElem` r) && (length r == 7)+       then Just (IPv4Addr t) else Nothing++colon :: T.Text -> Maybe IPv6AddrToken+colon t = if t == tokcolon+             then Just Colon+             else Nothing++doubleColon :: T.Text -> Maybe IPv6AddrToken+doubleColon t = if t == tokdcolon+                   then Just DoubleColon+                   else Nothing++sixteenBits:: T.Text -> Maybe IPv6AddrToken+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 if T.null t'+                       then Just AllZeros+                       -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)+                       else Just $ 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+            if ls < 4+               then SixteenBits (T.replicate (4 - ls) tok0 `T.append` s)+               else SixteenBits s+        expTok 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++-- | Returns the corresponding 'Text' of an IPv6 address token.+ipv6TokenToText :: IPv6AddrToken -> T.Text+ipv6TokenToText (SixteenBits s) = s +ipv6TokenToText Colon = tokcolon+ipv6TokenToText DoubleColon = tokdcolon+-- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1)+ipv6TokenToText AllZeros = tok0+ipv6TokenToText (IPv4Addr a) = a++-- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'Text'.+ipv6TokensToText :: [IPv6AddrToken] -> Maybe T.Text+ipv6TokensToText l = Just $ 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 tks =+    diffNext tks && (do+        let cdctks = countDoubleColon tks+        let lentks = length tks+        let lasttk = last tks+        let lenconst = (lentks == 15 && cdctks == 0) || (lentks < 15 && cdctks == 1)+        firstValidToken tks &&+            (case countIPv4Addr tks of+                0 -> case lasttk of+                          SixteenBits _ -> lenconst+                          DoubleColon -> lenconst+                          AllZeros -> lenconst+                          otherwise -> False+                1 -> case lasttk of+                          IPv4Addr _ ->+                              (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)+                          otherwise -> False+                otherwise -> False))+          where diffNext [_] = True+                diffNext [a,a'] = a /= a'+                diffNext (a:as) = (a /= head as) && diffNext as+                firstValidToken l = +                    case head l of+                        SixteenBits _ -> True+                        DoubleColon -> True+                        AllZeros -> True+                        otherwise -> False+                countDoubleColon l = length $ elemIndices DoubleColon l++countIPv4Addr =+     foldr oneMoreIPv4Addr 0+   where oneMoreIPv4Addr t c = case t of+                                   IPv4Addr _ -> c + 1+                                   otherwise -> c++-- | Returns Just a list of 'IPv6AddrToken', or Nothing.+maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]+maybeIPv6AddrTokens t = mapM maybeIPv6AddrToken $ tokenizeBy ':' t++-- | This is the main function which returns Just the list of a tokenized IPv6+-- address's 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 $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks+          then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks+          else 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')++-- | 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,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++-- | Rewrites Just 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+            [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++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 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)++toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]+toDoubleColon 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 (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+        groupZerosRuns = group . filter (/= Colon)++networkInterfacesIPv6AddrList :: IO [(String,IPv6)]+networkInterfacesIPv6AddrList = do+    n <- getNetworkInterfaces+    return $ map networkInterfacesIPv6Addr n+  where networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a)

@@ -0,0 +1,103 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Text.IPv6Addr+-- Copyright   :  (c) Michel Boucey 2011-212+-- License     :  BSD-style+-- Maintainer  :  michel.boucey@gmail.com+-- Stability   :  provisional+--+-- Dealing with IPv6 address's text representation,+-- canonization and manipulations.+--+--------------------------------------------------------------------------------++module Text.IPv6Addr.Manip+    (+      module Text.IPv6Addr.Internal+    , sixteenBitsArbToken+    , macAddrToIPv6AddrTokens+    , getTokIPv6AddrOf+    , getTokMacAddrOf+    ) where++import Control.Monad (replicateM)+import Data.Char (intToDigit,isHexDigit)+import Data.List (intersperse)+import Data.Maybe (catMaybes,fromJust)+import qualified Data.Text as T+import System.Random (randomRIO)++import Network.Info++import Text.IPv6Addr+import Text.IPv6Addr.Internal+import Text.IPv6Addr.Types++-- | Returns an arbitrary 'SixteenBits' token based on a mask \"____\", each+-- underscore being replaced by a random hexadecimal digit.+--+-- > sixteenBitsArbToken "_f__" == Just (SixteenBits "bfd4")+-- +sixteenBitsArbToken :: String -> IO (Maybe IPv6AddrToken)+sixteenBitsArbToken m = do+    cs <- mapM getHex m+    return $ sixteenBits $ T.pack cs+  where getHex c =+            case c of+                '_' -> hexRand+                otherwise -> return c+          where hexRand = do+                    r <- randomRIO(0,15)+                    return $ intToDigit r++ipv6AddrRand :: IO (Maybe IPv6Addr)+ipv6AddrRand = do+    l <- replicateM 8 (sixteenBitsArbToken "____")+    return $ ipv6TokensToText $ intersperse Colon $ catMaybes l++-- | 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 :: 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]) ++--+-- Functions based upon Network.Info to get local MAC and IPv6 adresses.+--++networkInterfacesMacAddrList :: IO [(String,MAC)]+networkInterfacesMacAddrList = do+    n <- getNetworkInterfaces+    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.+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++-- | Given the valid name of a local network interface,+-- returns the corresponding list of 'IPv6AddrToken' of the interface's MAC Address.+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

@@ -0,0 +1,30 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Text.IPv6Addr+-- Copyright   :  (c) Michel Boucey 2011+-- License     :  BSD-style+-- Maintainer  :  michel.boucey@gmail.com+-- Stability   :  provisional+--+-- Dealing with IPv6 address's text representation,+-- canonization and manipulations.+--+--------------------------------------------------------------------------------++module Text.IPv6Addr.Types where++import qualified Data.Text as T++type IPv6Addr = T.Text++data IPv6AddrToken+    = SixteenBits 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)++data IPv4AddrToken+    = Dot+    | EightBits T.Text deriving (Eq,Show)