ip 1.1.2 → 1.2.0
raw patch · 10 files changed
+306/−36 lines, 10 filesdep +hspecdep +semigroupsdep ~aesondep ~basedep ~quickcheck-classesPVP ok
version bump matches the API change (PVP)
Dependencies added: hspec, semigroups
Dependency ranges changed: aeson, base, quickcheck-classes
API changes (from Hackage documentation)
+ Net.IPv4.Range: instance Data.Bits.Bits Net.IPv4.Range.IPv4Range
+ Net.IPv4.Range: instance Data.Bits.FiniteBits Net.IPv4.Range.IPv4Range
Files
- ip.cabal +19/−3
- src/Data/ByteString/Builder/Fixed.hs +16/−7
- src/Data/Text/Builder/Fixed.hs +20/−11
- src/Data/Text/Builder/Variable.hs +13/−4
- src/Net/IPv4.hs +54/−8
- src/Net/IPv4/Range.hs +44/−2
- test/Net/IPv4/RangeSpec.hs +68/−0
- test/Net/IPv4Spec.hs +68/−0
- test/Spec.hs +1/−0
- test/Test.hs +3/−1
ip.cabal view
@@ -1,5 +1,5 @@ name: ip-version: 1.1.2+version: 1.2.0 synopsis: Library for IP and MAC addresses homepage: https://github.com/andrewthad/haskell-ip#readme license: BSD3@@ -47,7 +47,7 @@ Data.Text.Builder.Common.Internal Data.ByteString.Builder.Fixed build-depends:- base >= 4.8 && < 5+ base >= 4.9 && < 5 , attoparsec >= 0.13 && < 0.14 , aeson >= 0.9 && < 1.3 , hashable >= 1.2 && < 1.3@@ -55,6 +55,7 @@ , bytestring >= 0.10 && < 0.11 , vector >= 0.11 && < 0.13 , primitive >= 0.6 && < 0.7+ , semigroups >= 0.16 && < 0.19 -- if impl(ghcjs) -- build-depends: ghcjs-base >= 0.2 && < 0.3 ghc-options: -Wall -O2@@ -70,7 +71,7 @@ , test-framework , test-framework-quickcheck2 , QuickCheck- , quickcheck-classes >= 0.3 && < 0.4+ , quickcheck-classes >= 0.3 && < 0.5 , text , bytestring , HUnit@@ -81,6 +82,21 @@ IPv4Text1 IPv4Text2 IPv4ByteString1+ ghc-options: -Wall -O2+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends:+ base+ , ip+ , hspec+ , hspec >= 2.4.4 && < 2.5+ other-modules:+ Net.IPv4Spec+ Net.IPv4.RangeSpec ghc-options: -Wall -O2 default-language: Haskell2010
src/Data/ByteString/Builder/Fixed.hs view
@@ -31,6 +31,7 @@ import Data.ByteString.Internal (ByteString(..)) import Foreign import Data.ByteString.Short (ShortByteString)+import qualified Data.Semigroup as Semigroup import qualified Data.ByteString.Internal as BI import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as BC8@@ -40,17 +41,25 @@ BuilderStatic :: !ByteString -> Builder a BuilderFunction :: !ByteString -> !(Int -> Ptr Word8 -> a -> IO ()) -> Builder a +{-# INLINE appendBuilder #-}+appendBuilder :: Builder a -> Builder a -> Builder a+appendBuilder x y = case x of+ BuilderStatic t1@(PS _ _ len1) -> case y of+ BuilderStatic t2 -> BuilderStatic (t1 <> t2)+ BuilderFunction t2 f -> BuilderFunction (t1 <> t2) (\ix marr a -> f (ix + len1) marr a)+ BuilderFunction t1@(PS _ _ len1) f1 -> case y of+ BuilderStatic t2 -> BuilderFunction (t1 <> t2) f1+ BuilderFunction t2 f2 -> BuilderFunction (t1 <> t2) (\ix marr a -> f1 ix marr a >> f2 (ix + len1) marr a)++instance Semigroup.Semigroup (Builder a) where+ {-# INLINE (<>) #-}+ (<>) = appendBuilder+ instance Monoid (Builder a) where {-# INLINE mempty #-} mempty = BuilderStatic ByteString.empty {-# INLINE mappend #-}- mappend x y = case x of- BuilderStatic t1@(PS _ _ len1) -> case y of- BuilderStatic t2 -> BuilderStatic (t1 <> t2)- BuilderFunction t2 f -> BuilderFunction (t1 <> t2) (\ix marr a -> f (ix + len1) marr a)- BuilderFunction t1@(PS _ _ len1) f1 -> case y of- BuilderStatic t2 -> BuilderFunction (t1 <> t2) f1- BuilderFunction t2 f2 -> BuilderFunction (t1 <> t2) (\ix marr a -> f1 ix marr a >> f2 (ix + len1) marr a)+ mappend = (Semigroup.<>) contramapBuilder :: (b -> a) -> Builder a -> Builder b contramapBuilder f x = case x of
src/Data/Text/Builder/Fixed.hs view
@@ -28,6 +28,7 @@ import Data.Char (ord) import Data.Word.Synthetic.Word12 (Word12) import Data.Text (Text)+import qualified Data.Semigroup as Semigroup import qualified Data.Text as Text import qualified Data.Text.Array as A import qualified Data.Text.Internal as TI@@ -37,21 +38,29 @@ BuilderStatic :: Text -> Builder a BuilderFunction :: Text -> (forall s. Int -> A.MArray s -> a -> ST s ()) -> Builder a +{-# INLINE appendBuilder #-}+appendBuilder :: Builder a -> Builder a -> Builder a+appendBuilder x y = case x of+ BuilderStatic t1 -> case y of+ BuilderStatic t2 -> BuilderStatic (t1 <> t2)+ BuilderFunction t2 f ->+ let len1 = I.portableTextLength t1+ in BuilderFunction (t1 <> t2) (\ix marr a -> f (ix + len1) marr a)+ BuilderFunction t1 f1 -> case y of+ BuilderStatic t2 -> BuilderFunction (t1 <> t2) f1+ BuilderFunction t2 f2 ->+ let len1 = I.portableTextLength t1+ in BuilderFunction (t1 <> t2) (\ix marr a -> f1 ix marr a >> f2 (ix + len1) marr a)++instance Semigroup.Semigroup (Builder a) where+ {-# INLINE (<>) #-}+ (<>) = appendBuilder+ instance Monoid (Builder a) where {-# INLINE mempty #-} mempty = BuilderStatic Text.empty {-# INLINE mappend #-}- mappend x y = case x of- BuilderStatic t1 -> case y of- BuilderStatic t2 -> BuilderStatic (t1 <> t2)- BuilderFunction t2 f ->- let len1 = I.portableTextLength t1- in BuilderFunction (t1 <> t2) (\ix marr a -> f (ix + len1) marr a)- BuilderFunction t1 f1 -> case y of- BuilderStatic t2 -> BuilderFunction (t1 <> t2) f1- BuilderFunction t2 f2 ->- let len1 = I.portableTextLength t1- in BuilderFunction (t1 <> t2) (\ix marr a -> f1 ix marr a >> f2 (ix + len1) marr a)+ mappend = (Semigroup.<>) fromText :: Text -> Builder a fromText = BuilderStatic
src/Data/Text/Builder/Variable.hs view
@@ -29,6 +29,7 @@ import Data.Vector (Vector) import Data.Maybe (fromMaybe) import qualified Data.Vector as Vector+import qualified Data.Semigroup as Semigroup import qualified Data.Text.Array as A import qualified Data.Text.Builder.Common.Internal as I import qualified Data.Text.Internal as TI@@ -38,14 +39,22 @@ {-# UNPACK #-} !Int -- the maximum length, not a character count !(forall s. Int -> A.MArray s -> a -> ST s Int) +{-# INLINE appendBuilder #-}+appendBuilder :: Builder a -> Builder a -> Builder a+appendBuilder (Builder len1 f) (Builder len2 g) =+ Builder (len1 + len2) $ \ix1 marr a -> do+ ix2 <- f ix1 marr a+ g ix2 marr a++instance Semigroup.Semigroup (Builder a) where+ {-# INLINE (<>) #-}+ (<>) = appendBuilder+ instance Monoid (Builder a) where {-# INLINE mempty #-} mempty = Builder 0 (\i _ _ -> return i) {-# INLINE mappend #-}- mappend (Builder len1 f) (Builder len2 g) =- Builder (len1 + len2) $ \ix1 marr a -> do- ix2 <- f ix1 marr a- g ix2 marr a+ mappend = (Semigroup.<>) run :: Builder a -> a -> Text run (Builder maxLen f) = \a ->
src/Net/IPv4.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-}@@ -41,7 +42,7 @@ , decode , builder , reader- , parser + , parser -- ** UTF-8 ByteString , encodeUtf8 , decodeUtf8@@ -55,6 +56,8 @@ , print -- * Types , IPv4(..)+ -- * Interoperability+ -- $interoperability ) where import Prelude hiding (any, print)@@ -72,12 +75,12 @@ import Data.Monoid ((<>)) import Data.Text.Encoding (decodeUtf8') import Foreign.Storable (Storable)-import Data.Bits (Bits,FiniteBits) import Data.Primitive.Types (Prim) import Control.Monad.ST (ST,runST) import Text.Printf (printf) import Text.Read (Read(..),Lexeme(Ident),lexP,parens) import Text.ParserCombinators.ReadPrec (prec,step)+import qualified Data.Bits as Bits import qualified Data.Text.Read as TextRead import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Unsafe as ByteString@@ -99,7 +102,7 @@ import qualified Data.Text.Array as TArray import qualified Data.Text.IO as TIO -#if MIN_VERSION_aeson(1,0,0) +#if MIN_VERSION_aeson(1,0,0) import Data.Aeson (ToJSONKey(..),FromJSONKey(..), ToJSONKeyFunction(..),FromJSONKeyFunction(..)) #endif@@ -154,7 +157,7 @@ any :: IPv4 any = IPv4 0 --- | The loopback IP address: @127.0.0.1@+-- | The local loopback IP address: @127.0.0.1@ loopback :: IPv4 loopback = fromOctets 127 0 0 1 @@ -311,7 +314,7 @@ else return i {- $string- + These functions exist for the convenience of those who need a 'String' representation of an 'IPv4' address. Using them is discouraged unless the end user is working with a library@@ -332,7 +335,7 @@ -- convert the underlying 'Word32' from host byte order to network byte -- order. newtype IPv4 = IPv4 { getIPv4 :: Word32 }- deriving (Eq,Ord,Enum,Bounded,Hashable,Generic,Prim,Bits,FiniteBits,Storable)+ deriving (Eq,Ord,Enum,Bounded,Hashable,Generic,Prim,Storable) instance Show IPv4 where showsPrec p addr = showParen (p > 10)@@ -355,7 +358,7 @@ c <- step readPrec d <- step readPrec return (fromOctets a b c d)- + print :: IPv4 -> IO () print = TIO.putStrLn . encode @@ -412,7 +415,7 @@ instance FromJSON IPv4 where parseJSON = Aeson.withText "IPv4" aesonParser -#if MIN_VERSION_aeson(1,0,0) +#if MIN_VERSION_aeson(1,0,0) instance ToJSONKey IPv4 where toJSONKey = ToJSONKeyText encode@@ -427,7 +430,28 @@ Nothing -> fail "Could not parse IPv4 address" Just addr -> return addr +ipv4Bitwise :: (Word32 -> Word32 -> Word32) -> IPv4 -> IPv4 -> IPv4+ipv4Bitwise fun l r = IPv4 $ (getIPv4 l) `fun` (getIPv4 r) +-- | Note: we use network order (big endian) as opposed to host order (little+-- endian) which differs from the underlying IPv4 type representation.+instance Bits.Bits IPv4 where+ (.&.) = ipv4Bitwise (.&.)+ (.|.) = ipv4Bitwise (.|.)+ xor = ipv4Bitwise Bits.xor+ complement = IPv4 . Bits.complement . getIPv4+ shift ip i = IPv4 $ Bits.shift (getIPv4 ip) i+ rotate ip i = IPv4 $ Bits.rotate (getIPv4 ip) i+ bitSize = Bits.finiteBitSize+ bitSizeMaybe = Bits.bitSizeMaybe . getIPv4+ isSigned = Bits.isSigned . getIPv4+ testBit ip i = Bits.testBit (getIPv4 ip) $ Bits.finiteBitSize ip - 1 - i+ bit i = IPv4 $ Bits.bit $ Bits.finiteBitSize any - 1 - i+ popCount = Bits.popCount . getIPv4++instance Bits.FiniteBits IPv4 where+ finiteBitSize = Bits.finiteBitSize . getIPv4+ ------------------------------------ -- Internal functions, not exported ------------------------------------@@ -587,4 +611,26 @@ rightToMaybe :: Either a b -> Maybe b rightToMaybe = either (const Nothing) Just++{- $interoperability++The @<http://hackage.haskell.org/package/network network>@ library is commonly+used to open sockets and communicate over them. In the @Network.Socket@ module,+it provides a type synonym @HostAddress@ that, like 'IPv4', is used+to represent an IPv4 address. However, while 'IPv4' uses a big-endian representation+for ip addresses, @HostAddress@ has platform dependent endianness.+Consequently, it is necessary to convert between the two as follows:++> import Network.Socket (HostAddress,htonl,ntohl)+>+> toHostAddr :: IPv4 -> HostAddress+> toHostAddr (IPv4 w) = htonl w+>+> fromHostAddr :: HostAddress -> IPv4+> fromHostAddr w = IPv4 (ntohl w)++These functions are not included with this library since it would require+picking up a dependency on @network@.++-}
src/Net/IPv4/Range.hs view
@@ -43,6 +43,7 @@ import GHC.Generics (Generic) import Data.Monoid ((<>)) import qualified Net.IPv4 as IPv4+import qualified Data.Bits as Bits import qualified Data.Text.IO as Text import qualified Data.Attoparsec.Text as AT import qualified Data.Text.Lazy.Builder as TBuilder@@ -163,12 +164,12 @@ -- 192.168.1.11 toList :: IPv4Range -> [IPv4]-toList (IPv4Range ip len) = +toList (IPv4Range ip len) = let totalAddrs = countAddrs len in wordSuccessors totalAddrs ip toGenerator :: MonadPlus m => IPv4Range -> m IPv4-toGenerator (IPv4Range ip len) = +toGenerator (IPv4Range ip len) = let totalAddrs = countAddrs len in wordSuccessorsM totalAddrs ip @@ -365,6 +366,47 @@ elemseq _ (IPv4Range a b) = GVector.elemseq (undefined :: UVector.Vector a) a . GVector.elemseq (undefined :: UVector.Vector b) b++rangeBitwise :: (IPv4 -> IPv4 -> IPv4) -> IPv4Range -> IPv4Range -> IPv4Range+rangeBitwise fun l r = range ip len+ where+ -- Normalise first+ l' = normalize l+ r' = normalize r+ ip = (ipv4RangeBase l') `fun` (ipv4RangeBase r')+ len = maximum [ipv4RangeLength l, ipv4RangeLength r]++rangeRebase :: (IPv4 -> IPv4) -> IPv4Range -> IPv4Range+rangeRebase fun r = range (fun $ ipv4RangeBase r) (ipv4RangeLength r)++-- | Notes:+--+-- * bit operations use network order (big endian),+--+-- * do not operate on host bits,+--+-- * return a normalized range dropping host bits,+--+-- * and "promote operands" by extending the length to the larger of two+-- ranges.+--+instance Bits.Bits IPv4Range where+ (.&.) = rangeBitwise (.&.)+ (.|.) = rangeBitwise (.|.)+ xor = rangeBitwise Bits.xor+ complement = rangeRebase Bits.complement+ shift r i = rangeRebase (flip Bits.shift i) r+ rotate r i = rangeRebase (flip Bits.rotate i) r+ bitSize = Bits.finiteBitSize+ bitSizeMaybe = Just . Bits.finiteBitSize+ isSigned = Bits.isSigned . ipv4RangeBase+ testBit ip i = Bits.testBit (ipv4RangeBase ip) i+ bit i = IPv4Range (Bits.bit i) $ fromIntegral $ i + 1+ popCount = Bits.popCount . ipv4RangeBase . normalize++-- | Note: the size is determined by the range length+instance Bits.FiniteBits IPv4Range where+ finiteBitSize = fromIntegral . ipv4RangeLength ----------------- -- Internal Stuff
+ test/Net/IPv4/RangeSpec.hs view
@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+module Net.IPv4.RangeSpec (spec) where+import Prelude hiding (any)+import Data.Bits+import Net.IPv4+import Net.IPv4.Range+import Test.Hspec++spec :: Spec+spec = parallel $ do+ describe "Bits" $ do+ context "underlying IPv4 imlementation used correctly" $ do+ let host = range (ipv4 255 255 0 0) 32+ broadH = range broadcast 32+ negBroadH = range (ipv4 0 0 255 255) 32+ it ".&." $ do+ host .&. broadH `shouldBe` host+ it ".|." $ do+ host .|. broadH `shouldBe` broadH+ it "xor" $ do+ host `xor` broadH `shouldBe` negBroadH+ it "complement" $ do+ complement host `shouldBe` negBroadH+ it "shift" $ do+ shift host 8 `shouldBe` range (ipv4 255 0 0 0) 32+ it "rotate" $ do+ rotate host 8 `shouldBe` range (ipv4 255 0 0 255) 32+ it "isSigned" $ do+ isSigned host `shouldBe` False+ context "size operations use length correctly" $ do+ it "bitSize" $ do+ bitSize (range any 8) `shouldBe` 8+ bitSize (range any 15) `shouldBe` 15+ bitSize (range any 32) `shouldBe` 32+ it "bitSizeMaybe" $ do+ bitSizeMaybe (range broadcast 0) `shouldBe` Just 0+ bitSizeMaybe (range broadcast 24) `shouldBe` Just 24+ bitSizeMaybe (range broadcast 31) `shouldBe` Just 31+ it "testBit" $ do+ let prefix = range loopback 8+ testBit prefix <$> [0..31] `shouldBe`+ -- Note: final bit is False not True+ [ False, True, True, True, True, True, True, True+ , False, False, False, False, False, False, False, False+ , False, False, False, False, False, False, False, False+ , False, False, False, False, False, False, False, False]+ it "bit" $ do+ bit 0 `shouldBe` range (ipv4 128 0 0 0) 1+ bit 1 `shouldBe` range (ipv4 64 0 0 0) 2+ bit 31 `shouldBe` range (ipv4 0 0 0 1) 32+ it "popCount" $ do+ popCount (range any 0) `shouldBe` 0+ popCount (range broadcast 0) `shouldBe` 0+ popCount (range loopback 8) `shouldBe` 7+ popCount (range loopback 32) `shouldBe` 8+ context "operates on network bits only" $ do+ it "bitwise: same length" $ do+ (IPv4Range broadcast 16) .&. (IPv4Range broadcast 16)+ `shouldBe` (IPv4Range (ipv4 255 255 0 0) 16)+ it "bitwise: differing lengths ignoring host bits" $ do+ (IPv4Range broadcast 8) .&. (IPv4Range broadcast 16)+ `shouldBe` (IPv4Range (ipv4 255 0 0 0) 16)+ it "rebase: ignores host bits" $ do+ complement (IPv4Range loopback 16)+ `shouldBe` (IPv4Range (ipv4 128 255 0 0) 16)+ describe "FiniteBits" $ do+ it "finiteBitSize" $ do+ finiteBitSize . (range loopback) <$> [0..31] `shouldBe` [0..31]
+ test/Net/IPv4Spec.hs view
@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+module Net.IPv4Spec (spec) where+import Prelude hiding (any)+import Data.Bits+import Net.IPv4+import Test.Hspec++spec :: Spec+spec = do+ describe "Bits" $ do+ it ".&." $ do+ any .&. any `shouldBe` any+ any .&. loopback `shouldBe` any+ loopback .&. broadcast `shouldBe` loopback+ broadcast .&. broadcast `shouldBe` broadcast+ it ".|." $ do+ any .|. any `shouldBe` any+ any .|. loopback `shouldBe` loopback+ loopback .|. broadcast `shouldBe` broadcast+ broadcast .|. broadcast `shouldBe` broadcast+ it "xor" $ do+ any `xor` any `shouldBe` any+ any `xor` loopback `shouldBe` loopback+ loopback `xor` broadcast `shouldBe` complement loopback+ broadcast `xor` broadcast `shouldBe` any+ it "complement" $ do+ complement any `shouldBe` broadcast+ complement loopback `shouldBe` ipv4 128 255 255 254+ complement broadcast `shouldBe` any+ it "shift" $ do+ shift any 0 `shouldBe` any+ shift broadcast 0 `shouldBe` broadcast+ shift broadcast 8 `shouldBe` ipv4 255 255 255 0+ shift broadcast (-8) `shouldBe` ipv4 0 255 255 255+ shift broadcast 32 `shouldBe` any+ shift broadcast 40 `shouldBe` any+ it "rotate" $ do+ rotate loopback 0 `shouldBe` loopback+ rotate loopback 0 `shouldBe` loopback+ rotate loopback 8 `shouldBe` ipv4 0 0 1 127+ rotate loopback (-8) `shouldBe` ipv4 1 127 0 0+ rotate loopback 32 `shouldBe` loopback+ it "bitSize" $ do+ bitSize any `shouldBe` 32+ it "bitSizeMaybe" $ do+ bitSizeMaybe any `shouldBe` Just 32+ it "isSigned" $ do+ isSigned any `shouldBe` False+ isSigned broadcast `shouldBe` False+ it "testBit" $ do+ testBit loopback <$> [0..31] `shouldBe`+ [ False, True, True, True, True, True, True, True+ , False, False, False, False, False, False, False, False+ , False, False, False, False, False, False, False, False+ , False, False, False, False, False, False, False, True]+ it "bit" $ do+ bit 0 `shouldBe` ipv4 128 0 0 0+ bit 1 `shouldBe` ipv4 64 0 0 0+ bit 31 `shouldBe` ipv4 0 0 0 1+ it "popCount" $ do+ popCount any `shouldBe` 0+ popCount loopback `shouldBe` 8+ popCount broadcast `shouldBe` 32+ describe "FiniteBits" $ do+ it "finiteBitSize" $ do+ finiteBitSize any `shouldBe` 32+ finiteBitSize loopback `shouldBe` 32+ finiteBitSize broadcast `shouldBe` 32
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
test/Test.hs view
@@ -14,7 +14,7 @@ import Numeric (showHex) import Test.QuickCheck.Property (failed,succeeded,Result(..)) import Data.Bifunctor-import Test.QuickCheck.Classes (Laws(..),jsonLaws,showReadLaws)+import Test.QuickCheck.Classes (Laws(..),jsonLaws,showReadLaws,bitsLaws) import qualified Test.Framework.Providers.HUnit as PH import Net.Types (IP,IPv4(..),IPv4Range(..),Mac(..),IPv6(..),MacGrouping(..),MacCodec(..))@@ -99,10 +99,12 @@ [ testGroup "IPv4" [ lawsToTest (jsonLaws (Proxy :: Proxy IPv4)) , lawsToTest (showReadLaws (Proxy :: Proxy IPv4))+ -- , lawsToTest (bitsLaws (Proxy :: Proxy IPv4)) ] , testGroup "IPv4Range" [ lawsToTest (jsonLaws (Proxy :: Proxy IPv4Range)) , lawsToTest (showReadLaws (Proxy :: Proxy IPv4Range))+ -- , lawsToTest (bitsLaws (Proxy :: Proxy IPv4Range)) ] , testGroup "IPv6" [ lawsToTest (jsonLaws (Proxy :: Proxy IPv6))