diff --git a/Data/IP/Addr.hs b/Data/IP/Addr.hs index a5da4a1..832f180 100644 --- a/Data/IP/Addr.hs +++ b/Data/IP/Addr.hs @@ -554,37 +554,43 @@ format bs1 bs2 = do return $ bs1 ++ spring ++ bs2 ip6 :: Parser IPv6 -ip6 = skipSpaces >> toIPv6 <$> ip6' - -ip6' :: Parser [Int] -ip6' = ip4Embedded - <|> do colon2 - bs <- option [] hexcolon - format [] bs - <|> try (do rs <- hexcolon - check rs - return rs) - <|> do bs1 <- hexcolon2 - bs2 <- option [] hexcolon - format bs1 bs2 +ip6 = ip6' True + +ip6' :: Bool -> Parser IPv6 +ip6' checkTermination = skipSpaces >> toIPv6 <$> ip6arr where - hexcolon = hex `sepBy1` char ':' - hexcolon2 = manyTill (hex <* char ':') (char ':') - check bs = when (length bs /= 8) (fail "IPv6 address4") + ip6arr = ip4Embedded' checkTermination + <|> do colon2 + bs <- option [] hexcolon + format [] bs + <|> try (do rs <- hexcolon + check rs + return rs) + <|> do bs1 <- hexcolon2 + bs2 <- option [] hexcolon + format bs1 bs2 + where + hexcolon = hex `sepBy1` char ':' + hexcolon2 = manyTill (hex <* char ':') (char ':') + check bs = when (length bs /= 8) (fail "IPv6 address4") ip4Embedded :: Parser [Int] -ip4Embedded = try (do colon2 +ip4Embedded = ip4Embedded' True + +ip4Embedded' :: Bool -> Parser [Int] +ip4Embedded' checkTermination = + try (do colon2 bs <- beforeEmbedded - embedded <- ip4' True + embedded <- ip4' checkTermination format [] (bs ++ ip4ToIp6 embedded)) -- matches 2001:db8::192.0.2.1 <|> try (do bs1 <- manyTill (try $ hex <* char ':') (char ':') bs2 <- option [] beforeEmbedded - embedded <- ip4' True + embedded <- ip4' checkTermination format bs1 (bs2 ++ ip4ToIp6 embedded)) -- matches 2001:db8:11e:c00:aa:bb:192.0.2.1 <|> try (do bs <- beforeEmbedded - embedded <- ip4' True + embedded <- ip4' checkTermination let rs = bs ++ ip4ToIp6 embedded check rs return rs) diff --git a/Data/IP/Range.hs b/Data/IP/Range.hs index ec6de39..c34e06e 100644 --- a/Data/IP/Range.hs +++ b/Data/IP/Range.hs @@ -130,7 +130,7 @@ IP4 a `maskedIPv4` IP4 m = IP4 (a .&. m) ip6range :: Parser (AddrRange IPv6) ip6range = do - ip <- ip6 + ip <- ip6' False len <- maskLen 128 let msk = maskIPv6 len adr = ip `maskedIPv6` msk diff --git a/test/IPSpec.hs b/test/IPSpec.hs index cf97d0e..0cc7615 100644 --- a/test/IPSpec.hs +++ b/test/IPSpec.hs @@ -8,6 +8,7 @@ module IPSpec where import Control.Applicative #endif import Data.IP +import Data.Maybe (isJust) import Safe (readMay) import Test.Hspec import Test.Hspec.QuickCheck (prop) @@ -71,6 +72,8 @@ spec = do (readMay " ::1" :: Maybe IPv4) `shouldBe` readMay "::1" it "does not read overflow mask lengths" $ do (readMay "192.168.0.1/18446744073709551648" :: Maybe (AddrRange IPv4)) `shouldBe` Nothing + it "can read embedded v4 in v6 range" $ do + (readMay "::ffff:192.0.2.0/120" :: Maybe (AddrRange IPv6)) `shouldSatisfy` isJust to_str_ipv4 :: AddrRange IPv4 -> Bool to_str_ipv4 a = readMay (show a) == Just a