Merge PR #65

kazu-yamamoto · Oct 24, 2024 · 26ad2b2 · 26ad2b2
2 parents a65609d + 754c8ab
commit 26ad2b2
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 21 deletions.
diff --git 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
@@ -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
@@ -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