diff --git a/IPv6Addr.cabal b/IPv6Addr.cabal --- a/IPv6Addr.cabal +++ b/IPv6Addr.cabal @@ -1,5 +1,5 @@ name: IPv6Addr -version: 1.1.0 +version: 1.1.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 @@ -23,7 +23,7 @@ build-depends: base >=4.8 && < 5 , text >=1.1 && < 1.3 , iproute >=1.3 && < 1.8 - , network >=2.5 && < 2.8 + , network >=2.5 && < 2.9 , random >=1.0 && <= 1.1 , attoparsec >=0.12 && < 0.14 , aeson >= 0.8.0.2 && < 1.5 diff --git a/Text/IPv6Addr.hs b/Text/IPv6Addr.hs --- a/Text/IPv6Addr.hs +++ b/Text/IPv6Addr.hs @@ -31,12 +31,12 @@ import Control.Applicative ((<|>)) import Control.Monad (replicateM, guard) import Data.Aeson -import Data.Attoparsec.Text as A +import Data.Attoparsec.Text import Data.Char (intToDigit, isDigit) import Data.IP (IPv6) import Data.List (elemIndex, elemIndices, group, intersperse, isSuffixOf) -import Data.Maybe (fromJust, isNothing) +import Data.Maybe (fromJust, isJust, isNothing) import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Text.Read as R (decimal) @@ -129,7 +129,7 @@ -- toUNC :: IPv6Addr -> T.Text toUNC a = - (T.concatMap trans $ fromIPv6Addr $ fromJust $ maybePureIPv6Addr $ fromIPv6Addr a) <> ".ipv6-literal.net" + T.concatMap trans (fromIPv6Addr $ fromJust $ maybePureIPv6Addr $ fromIPv6Addr a) <> ".ipv6-literal.net" where trans ':' = "-" trans c = T.pack [c] @@ -138,9 +138,9 @@ toHostName :: IPv6Addr -> HostName toHostName = show --- | Given an 'IPv6addr', returns the corresponding 'IPv6' address. +-- | Given an 'IPv6Addr', returns the corresponding 'Data.IP.IPv6' address. toIPv6 :: IPv6Addr -> Data.IP.IPv6 -toIPv6 a = read $ show a +toIPv6 a = read (show a) -- | Returns 'Just' the canonized 'IPv6Addr' of the given local network interface, -- or 'Nothing'. @@ -183,36 +183,38 @@ , randPartialIPv6Addr r' ] return (ipv6TokensToIPv6Addr tks) - else - case maybeIPv6AddrTokens (fromJust p) of - Just tks -> do - ntks <- do let ctks = countChunks tks - case (snd ctks :: Int) of - 0 -> return (8 - fst ctks) - 1 -> return (6 - fst ctks) - _ -> return 0 - guard (ntks > 0) - rtks <- randPartialIPv6Addr ntks - let tks' = addColon tks ++ rtks - guard (isIPv6Addr tks') - return $ ipv6TokensToIPv6Addr $ - (toDoubleColon . fromDoubleColon) tks' - Nothing -> return Nothing + else do + let mtks = maybeIPv6AddrTokens (fromJust p) + guard (isJust mtks) + let tks = fromJust mtks + ntks <- do + let ctks = countChunks tks + return $ + case (snd ctks :: Int) of + 0 -> 8 - fst ctks + 1 -> 6 - fst ctks + _ -> 0 + guard (ntks > 0) + rtks <- randPartialIPv6Addr ntks + let tks' = addColon tks ++ rtks + guard (isIPv6Addr tks') + return $ ipv6TokensToIPv6Addr $ + (toDoubleColon . fromDoubleColon) tks' where - countChunks = - foldr go (0,0) - where - go c (a,b) = - case c of - SixteenBit _ -> (a+1,b) - AllZeros -> (a+1,b) - DoubleColon -> (a,b+1) - _ -> (a,b) - addColon ts = - case last ts of - SixteenBit _ -> ts ++ [Colon] - AllZeros -> ts ++ [Colon] - _ -> ts + countChunks = + foldr go (0,0) + where + go c (a,b) = + case c of + SixteenBit _ -> (a+1,b) + AllZeros -> (a+1,b) + DoubleColon -> (a,b+1) + _ -> (a,b) + addColon ts = + case last ts of + SixteenBit _ -> ts ++ [Colon] + AllZeros -> ts ++ [Colon] + _ -> ts -- ------------------------------------------------------------------------ -- @@ -226,7 +228,7 @@ -- randIPv6AddrChunk :: String -> IO IPv6AddrToken randIPv6AddrChunk m = - mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g + mapM getHex m >>= \g -> return (SixteenBit $ T.dropWhile (=='0') $ T.pack g) where getHex c | c == '_' = getDigit @@ -248,8 +250,8 @@ macAddrToIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken] macAddrToIPv6AddrTokens t = case parse macAddr t of - Done a b -> guard (a == T.empty) >> intersperse Colon <$> b - _ -> Nothing + Done "" b -> intersperse Colon <$> b + _ -> Nothing -- -- Functions based upon Network.Info to get local MAC and IPv6 addresses. @@ -282,9 +284,9 @@ getDigit :: IO Char getDigit = intToDigit <$> randomRIO (0,15) --- ---------------------------------------------------------------------------- --- Internals --- ---------------------------------------------------------------------------- +-- ------------------------------------------------------------------------- -- +-- Internals -- +-- ------------------------------------------------------------------------- -- -- | Returns the 'T.Text' of an IPv6 address. fromIPv6Addr :: IPv6Addr -> T.Text @@ -292,7 +294,7 @@ -- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'T.Text'. ipv6TokensToText :: [IPv6AddrToken] -> T.Text -ipv6TokensToText l = T.concat $ map ipv6TokenToText l +ipv6TokensToText l = T.concat (ipv6TokenToText <$> l) -- | Returns the corresponding 'T.Text' of an IPv6 address token. ipv6TokenToText :: IPv6AddrToken -> T.Text @@ -352,7 +354,7 @@ DoubleColon -> True AllZeros -> True _ -> False - countDoubleColon l = length $ elemIndices DoubleColon l + countDoubleColon l = length (elemIndices DoubleColon l) countIPv4Addr :: [IPv6AddrToken] -> Int countIPv4Addr = @@ -367,12 +369,10 @@ -- 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) - return (ipv4AddrReplacement . toDoubleColon . fromDoubleColon $ ltks) - Nothing -> Nothing +maybeTokIPv6Addr t = do + ltks <- maybeIPv6AddrTokens t + guard (isIPv6Addr ltks) + return (ipv4AddrReplacement . toDoubleColon . fromDoubleColon $ ltks) where ipv4AddrReplacement ltks = if ipv4AddrRewrite ltks @@ -394,9 +394,8 @@ maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken] maybeIPv6AddrTokens s = case readText s of - Done r l -> guard (r == T.empty) >> Just l - Fail {} -> Nothing - Partial _ -> Nothing + Done "" l -> Just l + _ -> Nothing where readText _s = feed @@ -449,7 +448,7 @@ , SixteenBit ((!!) m 2 <> addZero ((!!) m 3)) ] _ -> [t] where - toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a + toHex a = (\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] @@ -495,14 +494,14 @@ where firstLongestZerosRunIndex x y = sum . snd . unzip $ Prelude.takeWhile (/=(True,y)) x longestLengthZerosRun x = - maximum $ map longest x + maximum (longest <$> x) where longest _t = case _t of (True,i) -> i _ -> 0 zerosRunsList x = - map helper $ groupZerosRuns x + helper <$> groupZerosRuns x where helper h = (head h == AllZeros, lh) where lh = length h groupZerosRuns = group . filter (/= Colon) @@ -530,12 +529,12 @@ 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 + 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' + else SixteenBit (T.toLower r') ipv4Addr :: Parser IPv6AddrToken ipv4Addr = do @@ -549,11 +548,14 @@ 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 + manyDigits = takeWhile1 isDigit >>= \ds -> + return $ + case R.decimal ds :: Either String (Integer, T.Text) of + Right (n,_) -> + if n < 256 + then T.pack (show n) + else T.empty + Left _ -> T.empty doubleColon :: Parser IPv6AddrToken doubleColon = do