ip 0.6.2 → 0.7

raw patch · 5 files changed

+271/−40 lines, 5 filesdep +doctestdep +primitivedep +vectordep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: doctest, primitive, vector

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ip.cabal +16/−2
• src/Net/IPv4.hs +183/−7
• test/ArbitraryInstances.hs +23/−0
• test/Doctests.hs +4/−0
• test/Test.hs +45/−31

@@ -1,5 +1,5 @@ name:                ip-version:             0.6.2+version:             0.7 synopsis:            Library for IP and MAC addresses description:         Please see README.md homepage:            https://github.com/andrewthad/haskell-ip#readme@@ -30,10 +30,12 @@     , hashable    >= 1.2  && < 1.3     , text        >= 1.2  && < 1.3     , bytestring  >= 0.10 && < 0.11+    , vector      >= 0.11 && < 0.12+    , primitive   ghc-options:         -Wall   default-language:    Haskell2010 -test-suite ip-test+test-suite test   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Test.hs@@ -46,11 +48,23 @@     , text     , bytestring   other-modules:+    ArbitraryInstances     Naive     IPv4Text1     IPv4Text2     IPv4ByteString1   ghc-options:         -Wall -O2+  default-language:    Haskell2010++test-suite doctest+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Doctests.hs+  build-depends:+      base+    , ip+    , doctest >= 0.10+    , QuickCheck   default-language:    Haskell2010  benchmark criterion

@@ -1,5 +1,9 @@- {-# LANGUAGE DeriveGeneric #-}- {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}  {-| An IPv4 data type @@ -19,11 +23,24 @@   ( -- * Types     IPv4(..)   , IPv4Range(..)+    -- * Range functions+  , mask+  , normalize+  , member+  , lowerInclusive+  , upperInclusive+    -- * Private Ranges+  , private24+  , private20+  , private16     -- * Conversion Functions   , fromOctets   , fromOctets'   , toOctets-    -- * Encoding and Decoding Functions+    -- * Internal Functions+    -- $internal+  , prAddr+  , prRange   , fromDotDecimalText   , fromDotDecimalText'   , rangeFromDotDecimalText'@@ -36,6 +53,7 @@   ) where  import qualified Data.Text.Lazy         as LText+import qualified Data.Text.IO           as Text import qualified Data.Text.Lazy.Builder as TBuilder import Data.Text.Lazy.Builder.Int (decimal) import Data.Monoid ((<>))@@ -52,19 +70,38 @@ import Control.Monad import Data.Text.Internal (Text(..)) import Control.Monad.ST+import Data.Coerce (coerce)+import Unsafe.Coerce (unsafeCoerce) import Data.ByteString (ByteString)+import Data.Vector.Generic.Mutable      (MVector(..))+import Control.Monad.Primitive          (PrimMonad,PrimState)+import qualified Data.Vector.Unboxed    as UVector import qualified Data.ByteString.Char8  as BC8 import qualified Data.ByteString        as ByteString import qualified Data.ByteString.Unsafe as ByteString import qualified Data.Text.Lazy.Builder as TBuilder import qualified Data.Text.Array        as TArray +-- $setup+--+-- These are here to get doctest's property checking to work+--+-- >>> import Test.QuickCheck (Arbitrary(..))+-- >>> instance Arbitrary IPv4 where { arbitrary = fmap IPv4 arbitrary }+-- >>> instance Arbitrary IPv4Range where { arbitrary = IPv4Range <$> arbitrary <*> arbitrary }+--++-- | A 32-bit Internet Protocol address. newtype IPv4 = IPv4 { getIPv4 :: Word32 }   deriving (Eq,Ord,Show,Read,Enum,Bounded,Hashable,Generic) +-- | The length should be between 0 and 32. These bounds are inclusive.+--   This expectation is not in any way enforced by this library because+--   it does not cause errors. A mask length greater than 32 will be+--   treated as if it were 32. data IPv4Range = IPv4Range   { ipv4RangeBase   :: {-# UNPACK #-} !IPv4-  , ipv4RangeLength :: {-# UNPACK #-} !Int8+  , ipv4RangeLength :: {-# UNPACK #-} !Word8   } deriving (Eq,Ord,Show,Read,Generic)  instance Hashable IPv4Range@@ -85,9 +122,119 @@       Right res -> return res   parseJSON _ = mzero --- mask :: Int -> IPv4--- mask w = IPv4 $ complement $ 0xffffffff `shiftR` w+newtype instance UVector.MVector s IPv4 = MV_IPv4 (UVector.MVector s Word32) +instance MVector UVector.MVector IPv4 where+  basicLength = coerce (basicLength :: UVector.MVector s Word32 -> Int)+  basicUnsafeSlice = coerce (basicUnsafeSlice :: Int -> Int -> UVector.MVector s Word32 -> UVector.MVector s Word32)+  basicInitialize :: forall m. PrimMonad m => UVector.MVector (PrimState m) IPv4 -> m ()+  basicInitialize = coerce (basicInitialize :: PrimMonad m => UVector.MVector (PrimState m) Word32 -> m ())+  basicUnsafeReplicate :: forall m. PrimMonad m => Int -> IPv4 -> m (UVector.MVector (PrimState m) IPv4)+  basicUnsafeReplicate i (IPv4 w) = fmap coerce (basicUnsafeReplicate i w :: m (UVector.MVector (PrimState m) Word32))+  basicUnsafeRead :: forall m. PrimMonad m => UVector.MVector (PrimState m) IPv4 -> Int -> m IPv4+  basicUnsafeRead v i = fmap coerce (basicUnsafeRead (coerce v :: UVector.MVector (PrimState m) Word32) i :: m Word32)+  basicUnsafeWrite :: forall m. PrimMonad m => UVector.MVector (PrimState m) IPv4 -> Int -> IPv4 -> m ()+  basicUnsafeWrite = coerce (basicUnsafeWrite :: UVector.MVector (PrimState m) Word32 -> Int -> Word32 -> m ())+  basicClear :: forall m. PrimMonad m => UVector.MVector (PrimState m) IPv4 -> m ()+  basicClear = coerce (basicClear :: UVector.MVector (PrimState m) Word32 -> m ())+  basicSet :: forall m. PrimMonad m => UVector.MVector (PrimState m) IPv4 -> IPv4 -> m ()+  basicSet = coerce (basicSet :: UVector.MVector (PrimState m) Word32 -> Word32 -> m ())+  basicUnsafeCopy :: forall m. PrimMonad m => UVector.MVector (PrimState m) IPv4 -> UVector.MVector (PrimState m) IPv4 -> m ()+  basicUnsafeCopy = coerce (basicUnsafeCopy :: UVector.MVector (PrimState m) Word32 -> UVector.MVector (PrimState m) Word32 -> m ())+  basicUnsafeMove :: forall m. PrimMonad m => UVector.MVector (PrimState m) IPv4 -> UVector.MVector (PrimState m) IPv4 -> m ()+  basicUnsafeMove = coerce (basicUnsafeMove :: UVector.MVector (PrimState m) Word32 -> UVector.MVector (PrimState m) Word32 -> m ())+  basicUnsafeGrow :: forall m. PrimMonad m => UVector.MVector (PrimState m) IPv4 -> Int -> m (UVector.MVector (PrimState m) IPv4)+  basicUnsafeGrow (MV_IPv4 v) i = fmap coerce (basicUnsafeGrow v i)++mask :: Word8 -> Word32+mask = complement . shiftR 0xffffffff . fromIntegral++-- normalizeInternal :: Word8 -> Word32 -> Word32+-- normalizeInternal len w = w .&. mask len++-- | Normalize an 'IPv4Range'. The first result of this is that the+-- 'IPv4' inside the 'IPv4Range' is changed so that the insignificant+-- bits are zeroed out. For example:+--+-- >>> prRange $ normalize $ IPv4Range (fromOctets 192 168 1 19) 24+-- 192.168.1.0/24+-- >>> prRange $ normalize $ IPv4Range (fromOctets 192 168 1 163) 28+-- 192.168.1.160/28+--+-- The second effect of this is that the mask length is lowered to+-- be 32 or smaller. Working with 'IPv4Range's that have not been+-- normalized does not cause any issues for this library, although+-- other applications may reject such ranges (especially those with+-- a mask length above 32).+--+-- Note that 'normalize' is idempotent, that is:+--+-- prop> normalize r == (normalize . normalize) r+normalize :: IPv4Range -> IPv4Range+normalize (IPv4Range (IPv4 w) len) =+  let len' = min len 32+      w' = w .&. mask len'+   in IPv4Range (IPv4 w') len'++-- | Checks to see if an 'IPv4' address belongs in the 'IPv4Range'.+--+-- >>> let ip = fromOctets 10 10 1 92+-- >>> contains (IPv4Range (fromOctets 10 0 0 0) 8) ip+-- True+-- >>> contains (IPv4Range (fromOctets 10 11 0 0) 16) ip+-- False+--+-- Typically, element-testing functions are written to take the element+-- as the first argument and the set as the second argument. This is intentionally+-- written the other way for better performance when iterating over a collection.+-- For example, you might test elements in a list for membership like this:+--+-- >>> let r = IPv4Range (fromOctets 10 10 10 6) 31+-- >>> mapM_ (print . contains r) (take 5 $ iterate succ $ fromOctets 10 10 10 5)+-- False+-- True+-- True+-- False+-- False+--+-- The implementation of 'contains' ensures that (with GHC), the bitmask+-- creation and range normalization only occur once in the above example.+-- They are reused as the list is iterated.+contains :: IPv4Range -> IPv4 -> Bool+contains (IPv4Range (IPv4 wsubnet) len) =+  let theMask = mask len+      wsubnetNormalized = wsubnet .&. theMask+   in \(IPv4 w) -> (w .&. theMask) == wsubnetNormalized++-- | This is provided to mirror the interface provided by @Data.Set@. It+-- behaves just like 'contains' but with flipped arguments.+--+-- prop> member ip r == contains r ip+member :: IPv4 -> IPv4Range -> Bool+member = flip contains++lowerInclusive :: IPv4Range -> IPv4+lowerInclusive (IPv4Range (IPv4 w) len) =+  IPv4 (w .&. mask len)++upperInclusive :: IPv4Range -> IPv4+upperInclusive (IPv4Range (IPv4 w) len) =+  let theInvertedMask = shiftR 0xffffffff (fromIntegral len)+      theMask = complement theInvertedMask+   in IPv4 ((w .&. theMask) .|. theInvertedMask)++-- | The RFC1918 24-bit block. Subnet mask: @10.0.0.0/8@+private24 :: IPv4Range+private24 = IPv4Range (fromOctets 10 0 0 0) 8++-- | The RFC1918 20-bit block. Subnet mask: @172.16.0.0/12@+private20 :: IPv4Range+private20  = IPv4Range (fromOctets 172 16 0 0) 12++-- | The RFC1918 16-bit block. Subnet mask: @192.168.0.0/16@+private16 :: IPv4Range+private16 = IPv4Range (fromOctets 192 168 0 0) 16+ fromDotDecimalText' :: Text -> Either String IPv4 fromDotDecimalText' t =   AT.parseOnly (dotDecimalParser <* AT.endOfInput) t@@ -130,12 +277,24 @@       then fail "All octets in an ip address must be between 0 and 255"       else return i +-- | Create an 'IPv4' address from four octets. The first argument+--   is the most significant octet. The last argument is the least+--   significant.+--+--   Since the 'Show' and 'Read' instances for 'IPv4' are not generally+--   usefully, this function is the recommened way to create 'IPv4' addresses.+--   For example:+--+--   >>> fromOctets 192 168 1 1+--   IPv4 {getIPv4 = 3232235777}+-- fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> IPv4 fromOctets a b c d = fromOctets'   (fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d)  -- | This is sort of a misnomer. It takes Word32 to make---   dotDecimalParser probably perform better.+--   dotDecimalParser probably perform better. This is mostly+--   for internal use. fromOctets' :: Word32 -> Word32 -> Word32 -> Word32 -> IPv4 fromOctets' a b c d = IPv4     ( shiftL a 24@@ -144,6 +303,9 @@   .|. d     ) +-- | Convert an 'IPv4' address into a quadruple of octets. The first+--   element in the quadruple is the most significant octet. The last+--   element is the least significant octet. toOctets :: IPv4 -> (Word8,Word8,Word8,Word8) toOctets (IPv4 w) =   ( fromIntegral (shiftR w 24)@@ -151,6 +313,20 @@   , fromIntegral (shiftR w 8)   , fromIntegral w   )++-- | $internal+-- Everything below here is not part of the stable API. Many of these+-- functions must live here because they are needed for the 'ToJSON' and+-- 'FromJSON' instances. Hopefully, at some point, these can be removed+-- from this module.++-- | This only exists for doctests. Do not use it.+prAddr :: IPv4 -> IO ()+prAddr = Text.putStrLn . toDotDecimalText++-- | This only exists for doctests. Do not use it.+prRange :: IPv4Range -> IO ()+prRange = Text.putStrLn . rangeToDotDecimalText  toDotDecimalText :: IPv4 -> Text toDotDecimalText = toTextPreAllocated

@@ -0,0 +1,23 @@+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module ArbitraryInstances where++-- Orphan instances that are needed to make QuickCheck work.++import Net.IPv4 (IPv4(..),IPv4Range(..))+import Net.Mac (Mac(..))+import Test.QuickCheck (Arbitrary(..))++deriving instance Arbitrary IPv4++-- This instance can generate masks that exceed the recommended+-- length of 32.+instance Arbitrary IPv4Range where+  arbitrary = fmap fromTuple arbitrary+    where fromTuple (a,b) = IPv4Range a b++instance Arbitrary Mac where+  arbitrary = fmap fromTuple arbitrary+    where fromTuple (a,b) = Mac a b+

@@ -0,0 +1,4 @@+import Test.DocTest++main :: IO ()+main = doctest ["src/Net/IPv4.hs"]

@@ -1,6 +1,3 @@- {-# LANGUAGE StandaloneDeriving         #-}- {-# LANGUAGE GeneralizedNewtypeDeriving #-}- module Main (main) where  import Naive@@ -17,6 +14,7 @@ import qualified Net.Mac as Mac import qualified Net.Mac.Text as Mac_Text +import ArbitraryInstances () import qualified Naive import qualified IPv4Text1 import qualified IPv4Text2@@ -27,41 +25,57 @@  tests :: [Test] tests =-  [ testGroup "Naive IPv4 encode/decode"-    [ testProperty "Isomorphism"-        $ propEncodeDecodeIso Naive.encodeText Naive.decodeText-    ]-  , testGroup "Text Builder IPv4 Text encode/decode"-    [ testProperty "Identical to Naive"-        $ propMatching IPv4Text2.encode Naive.encodeText-    ]-  , testGroup "Raw byte array IPv4 Text encode/decode"-    [ testProperty "Identical to Naive"-        $ propMatching IPv4Text1.encode Naive.encodeText-    ]-  , testGroup "Raw byte array (without lookup table) IPv4 ByteString encode/decode"-    [ testProperty "Identical to Naive"-        $ propMatching IPv4ByteString1.encode Naive.encodeByteString-    ]-  , testGroup "Raw byte array (with lookup table) IPv4 ByteString encode/decode"-    [ testProperty "Identical to Naive"-        $ propMatching IPv4_ByteString.encode Naive.encodeByteString+  [ testGroup "Encoding and Decoding"+    [ testGroup "Naive IPv4 encode/decode"+      [ testProperty "Isomorphism"+          $ propEncodeDecodeIso Naive.encodeText Naive.decodeText+      ]+    , testGroup "Text Builder IPv4 Text encode/decode"+      [ testProperty "Identical to Naive"+          $ propMatching IPv4Text2.encode Naive.encodeText+      ]+    , testGroup "Raw byte array IPv4 Text encode/decode"+      [ testProperty "Identical to Naive"+          $ propMatching IPv4Text1.encode Naive.encodeText+      ]+    , testGroup "Raw byte array (without lookup table) IPv4 ByteString encode/decode"+      [ testProperty "Identical to Naive"+          $ propMatching IPv4ByteString1.encode Naive.encodeByteString+      ]+    , testGroup "Raw byte array (with lookup table) IPv4 ByteString encode/decode"+      [ testProperty "Identical to Naive"+          $ propMatching IPv4_ByteString.encode Naive.encodeByteString+      ]+    , testGroup "Raw byte array MAC Text encode/decode"+      [ testProperty "Isomorphism"+          $ propEncodeDecodeIso Mac_Text.encode Mac_Text.decode+      ]     ]-  , testGroup "Raw byte array MAC Text encode/decode"-    [ testProperty "Isomorphism"-        $ propEncodeDecodeIso Mac_Text.encode Mac_Text.decode+  , testGroup "IP Range Operations"+    [ testProperty "Idempotence of normalizing IPv4 range"+        $ propIdempotence IPv4.normalize+    , testProperty "Normalize does not affect membership" propNormalizeMember+    , testProperty "Membership agrees with bounds" propMemberUpperLower+    , testProperty "Range contains self" propRangeSelf     ]   ] -deriving instance Arbitrary IPv4--instance Arbitrary Mac where-  arbitrary = fmap fromTuple arbitrary-    where fromTuple (a,b) = Mac a b- propEncodeDecodeIso :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool propEncodeDecodeIso f g a = g (f a) == Just a  propMatching :: Eq b => (a -> b) -> (a -> b) -> a -> Bool propMatching f g a = f a == g a++propIdempotence :: Eq a => (a -> a) -> a -> Bool+propIdempotence f a = f a == f (f a)++propNormalizeMember :: IPv4 -> IPv4Range -> Bool+propNormalizeMember i r = IPv4.member r i == IPv4.member (IPv4.normalize r) i++propMemberUpperLower :: IPv4 -> IPv4Range -> Bool+propMemberUpperLower i r =+  (i >= IPv4.lowerInclusive r && i <= IPv4.upperInclusive r) == IPv4.member r i++propRangeSelf :: IPv4Range -> Bool+propRangeSelf r = IPv4.member r (IPv4.ipv4RangeBase r) == True