diff --git a/hw-ip.cabal b/hw-ip.cabal --- a/hw-ip.cabal +++ b/hw-ip.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: hw-ip -version: 2.0.0.0 +version: 2.0.1.0 license: BSD3 license-file: LICENSE copyright: 2018 John Ky, David Turnbull, Jian Wan diff --git a/src/HaskellWorks/Data/Network/Ip/Ip.hs b/src/HaskellWorks/Data/Network/Ip/Ip.hs --- a/src/HaskellWorks/Data/Network/Ip/Ip.hs +++ b/src/HaskellWorks/Data/Network/Ip/Ip.hs @@ -49,7 +49,6 @@ firstIpAddress :: IpBlock Canonical -> (Word32, Word32, Word32, Word32) firstIpAddress (IpBlockV4 v4Block) = firstIpAddress (IpBlockV6 (V6.fromV4 v4Block)) --- firstIpAddress (IpBlockV6 (V6.IpBlock ip _)) = V6.words ip firstIpAddress (IpBlockV6 (V6.IpBlock (V6.IpAddress ip) _)) = ip lastIpAddress :: IpBlock Canonical -> (Word32, Word32, Word32, Word32) diff --git a/src/HaskellWorks/Data/Network/Ip/Ipv4.hs b/src/HaskellWorks/Data/Network/Ip/Ipv4.hs --- a/src/HaskellWorks/Data/Network/Ip/Ipv4.hs +++ b/src/HaskellWorks/Data/Network/Ip/Ipv4.hs @@ -13,6 +13,7 @@ , isCanonical , splitBlock , parseIpAddress + , parseIpAddressAsBlock , showIpAddress , showsIpAddress , tshowIpAddress @@ -28,6 +29,7 @@ , blockToRange ) where +import Control.Applicative ((<|>)) import Data.Bifunctor import Data.Foldable import Data.Semigroup ((<>)) @@ -35,6 +37,7 @@ import GHC.Generics import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Network.Ip.Range +import HaskellWorks.Data.Network.Ip.SafeEnum import HaskellWorks.Data.Network.Ip.Validity import qualified Data.Bits as B @@ -45,7 +48,7 @@ newtype IpAddress = IpAddress { word :: Word32 - } deriving (Enum, Bounded, Eq, Ord, Generic) + } deriving (Enum, Bounded, Eq, Ord, Generic, SafeEnum) instance Show IpAddress where showsPrec _ = showsIpAddress @@ -69,10 +72,10 @@ showsPrec _ = showsIpBlock instance Read (IpBlock Unaligned) where - readsPrec = I.readsPrecOnParser parseUnalignedIpBlock + readsPrec = I.readsPrecOnParser (AP.try parseUnalignedIpBlock <|> parseIpAddressAsBlock) instance Read (IpBlock Canonical) where - readsPrec = I.readsPrecOnParser parseCanonicalIpBlock + readsPrec = I.readsPrecOnParser (AP.try parseCanonicalIpBlock <|> parseIpAddressAsBlock) -- | Canonicalise the block by zero-ing out the host bits canonicaliseIpBlock :: IpBlock v -> IpBlock Canonical @@ -137,6 +140,9 @@ parseIpAddress :: AP.Parser IpAddress parseIpAddress = IpAddress <$> I.ipv4Address + +parseIpAddressAsBlock :: AP.Parser (IpBlock v) +parseIpAddressAsBlock = (\addr -> IpBlock addr (IpNetMask 32)) <$> parseIpAddress parseUnalignedIpBlock :: AP.Parser (IpBlock Unaligned) parseUnalignedIpBlock = do diff --git a/src/HaskellWorks/Data/Network/Ip/Ipv6.hs b/src/HaskellWorks/Data/Network/Ip/Ipv6.hs --- a/src/HaskellWorks/Data/Network/Ip/Ipv6.hs +++ b/src/HaskellWorks/Data/Network/Ip/Ipv6.hs @@ -45,7 +45,7 @@ import qualified HaskellWorks.Data.Network.Ip.Ipv4 as V4 import qualified HaskellWorks.Data.Network.Ip.Word128 as W -newtype IpAddress = IpAddress W.Word128 deriving (Eq, Ord, Generic, SafeEnum) +newtype IpAddress = IpAddress W.Word128 deriving (Enum, Eq, Ord, Generic, SafeEnum) instance Show IpAddress where showsPrec _ (IpAddress w) = shows (D.fromHostAddress6 w) @@ -86,6 +86,10 @@ [(i6b, "") | isCanonical i6b] Nothing -> [] Nothing -> [] + [addr] -> + case readMaybe addr :: Maybe IpAddress of + Just ipv6 -> let i6b = IpBlock ipv6 (IpNetMask 128) in [(i6b, "") | isCanonical i6b] + Nothing -> [] _ -> [] instance Show (IpBlock v) where diff --git a/test/HaskellWorks/Data/Network/Ipv4Spec.hs b/test/HaskellWorks/Data/Network/Ipv4Spec.hs --- a/test/HaskellWorks/Data/Network/Ipv4Spec.hs +++ b/test/HaskellWorks/Data/Network/Ipv4Spec.hs @@ -71,6 +71,9 @@ read "1.2.0.0/16" === I.IpBlock @Unaligned (I.IpAddress 0x01020000) (I.IpNetMask 16) read "1.2.3.4/32" === I.IpBlock @Unaligned (I.IpAddress 0x01020304) (I.IpNetMask 32) + it "should read blocks without masks as /32" $ requireTest $ do + read "1.0.0.0" === I.IpBlock @Unaligned (I.IpAddress 0x01000000) (I.IpNetMask 32) + it "should implement splitBlock" $ requireTest $ do I.splitBlock (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask 32)) === Nothing I.splitBlock (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask 31)) === Just (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask 32), I.IpBlock (I.IpAddress 0x00000001) (I.IpNetMask 32)) diff --git a/test/HaskellWorks/Data/Network/Ipv6Spec.hs b/test/HaskellWorks/Data/Network/Ipv6Spec.hs --- a/test/HaskellWorks/Data/Network/Ipv6Spec.hs +++ b/test/HaskellWorks/Data/Network/Ipv6Spec.hs @@ -41,6 +41,9 @@ read "1234::/16" === V6.IpBlock @Unaligned (V6.IpAddress (0x12340000, 0 , 0, 0)) (V6.IpNetMask 16) read "12:34::/32" === V6.IpBlock @Unaligned (V6.IpAddress (0x120034 , 0 , 0, 0)) (V6.IpNetMask 32) + it "should read block without mask as /128" $ requireTest $ do + read "1:2:3:4::" === V6.IpBlock @Unaligned (V6.IpAddress (0x10002 , 0x30004 , 0, 0)) (V6.IpNetMask 128) + it "should parse what it has shown" $ require $ property $ do a <- forAll $ G.word32 R.constantBounded m <- forAll $ G.word8 $ R.linear 0 128 diff --git a/test/HaskellWorks/Data/Network/RangeSpec.hs b/test/HaskellWorks/Data/Network/RangeSpec.hs --- a/test/HaskellWorks/Data/Network/RangeSpec.hs +++ b/test/HaskellWorks/Data/Network/RangeSpec.hs @@ -8,6 +8,7 @@ import Hedgehog import Test.Hspec +import qualified HaskellWorks.Data.Network.Ip.Ipv4 as V4 import qualified HaskellWorks.Data.Network.Ip.Ipv6 as V6 import qualified HaskellWorks.Data.Network.Ip.Range as R import qualified Text.Appar.String as AP @@ -39,3 +40,9 @@ it "should parse dash-delimited ranges" $ requireTest $ do AP.runParser (AP.try (R.parseRange AP.alphaNum)) "a b" === (Nothing , "a b") AP.runParser (AP.try (R.parseRange AP.alphaNum)) "a - b" === (Just (R.Range 'a' 'b'), "" ) + + it "should parse ip address ranges" $ requireTest $ do + let r1 = [ R.Range (V4.IpAddress 0x00000000) (V4.IpAddress 0x0001ffff) + , R.Range (V4.IpAddress 0x0000ffff) (V4.IpAddress 0x00ffffff)] + let r2 = [ R.Range (V4.IpAddress 0x00000000) (V4.IpAddress 0x00ffffff)] + R.mergeRanges r1 === r2