IPv6Addr 0.7.0 → 1.0.0

raw patch · 5 files changed

+395/−438 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• IPv6Addr.cabal +1/−4
• Text/IPv6Addr.hs +394/−18
• Text/IPv6Addr/Internal.hs +0/−314
• Text/IPv6Addr/Manip.hs +0/−85
• Text/IPv6Addr/Types.hs +0/−17

@@ -1,5 +1,5 @@ name:                IPv6Addr-version:             0.7.0+version:             1.0.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@@ -19,9 +19,6 @@  library   exposed-modules:  Text.IPv6Addr-                  , Text.IPv6Addr.Manip-                  , Text.IPv6Addr.Types-  other-modules:    Text.IPv6Addr.Internal   other-extensions: OverloadedStrings   build-depends:    base >=4.8 && < 5                   , text >=1.1 && < 1.3

@@ -1,9 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}  module Text.IPv6Addr-    (-      IPv6Addr (IPv6Addr)+    ( IPv6Addr (IPv6Addr)     , maybeIPv6Addr     , maybePureIPv6Addr     , maybeFullIPv6Addr@@ -16,26 +14,48 @@     , toIP6ARPA     , toUNC -    -- * Utils+    -- * Utilities     , getIPv6AddrOf     , randIPv6Addr     , randIPv6AddrWithPrefix -    ) where+    -- * Manipulations+    , randIPv6AddrChunk+    , randPartialIPv6Addr+    , macAddrToIPv6AddrTokens+    , getTokIPv6AddrOf+    , getTokMacAddrOf ) where +import           Control.Applicative  ((<|>))+import           Control.Monad        (replicateM, guard) import           Data.Aeson-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           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) -import           Text.IPv6Addr.Internal-import           Text.IPv6Addr.Manip    (randPartialIPv6Addr)-import           Text.IPv6Addr.Types+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)@@ -111,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,@@ -172,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)@@ -185,4 +205,360 @@       SixteenBit _ -> ts ++ [Colon]       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") 

@@ -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")-

@@ -1,85 +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 == '_'  = 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)-

@@ -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)-