ip 0.7 → 0.8
raw patch · 16 files changed
+525/−371 lines, 16 files
Files
- ip.cabal +3/−1
- src/Net/IPv4.hs +78/−344
- src/Net/IPv4/ByteString/Char8.hs +4/−1
- src/Net/IPv4/Range.hs +131/−0
- src/Net/IPv4/String.hs +2/−2
- src/Net/IPv4/Text.hs +16/−7
- src/Net/Internal.hs +195/−2
- src/Net/Types.hs +80/−0
- test/ArbitraryInstances.hs +1/−1
- test/Bench.hs +1/−1
- test/Doctests.hs +4/−1
- test/IPv4ByteString1.hs +1/−0
- test/IPv4Text1.hs +1/−2
- test/IPv4Text2.hs +1/−2
- test/Naive.hs +1/−2
- test/Test.hs +6/−5
ip.cabal view
@@ -1,5 +1,5 @@ name: ip-version: 0.7+version: 0.8 synopsis: Library for IP and MAC addresses description: Please see README.md homepage: https://github.com/andrewthad/haskell-ip#readme@@ -19,9 +19,11 @@ Net.Mac.Text Net.Mac.ByteString.Char8 Net.IPv4+ Net.IPv4.Range Net.IPv4.String Net.IPv4.Text Net.IPv4.ByteString.Char8+ Net.Types Net.Internal build-depends: base >= 4.8 && < 5
src/Net/IPv4.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE InstanceSigs #-}@@ -20,67 +18,40 @@ -} module Net.IPv4- ( -- * Types- IPv4(..)- , IPv4Range(..)- -- * Range functions- , mask- , normalize- , member- , lowerInclusive- , upperInclusive- -- * Private Ranges- , private24- , private20- , private16- -- * Conversion Functions- , fromOctets- , fromOctets'+ ( -- * Conversion Functions+ fromOctets , toOctets- -- * Internal Functions- -- $internal- , prAddr- , prRange- , fromDotDecimalText- , fromDotDecimalText'- , rangeFromDotDecimalText'- , dotDecimalRangeParser- , dotDecimalParser- , toDotDecimalText- , toDotDecimalBuilder- , rangeToDotDecimalText- , rangeToDotDecimalBuilder+ -- * Special IP Addresses+ , any+ , loopback+ , broadcast+ -- * Range Predicates+ , private+ , reserved ) 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 ((<>))+import Prelude hiding (any)+import Net.Types (IPv4(..)) import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement) import Data.Word import Data.Int import Data.Hashable import Data.Aeson (FromJSON(..),ToJSON(..)) import GHC.Generics (Generic)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Attoparsec.Text as AT import Net.Internal (attoparsecParseJSON,rightToMaybe) 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 Net.Internal as Internal+import qualified Data.Text.Lazy as LText+import qualified Data.Text.IO as Text 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 --@@ -88,195 +59,8 @@ -- -- >>> 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 #-} !Word8- } deriving (Eq,Ord,Show,Read,Generic)--instance Hashable IPv4Range--instance ToJSON IPv4 where- toJSON addr = Aeson.String (toDotDecimalText addr)--instance FromJSON IPv4 where- parseJSON = attoparsecParseJSON (dotDecimalParser <* AT.endOfInput)--instance ToJSON IPv4Range where- toJSON addrRange = Aeson.String (rangeToDotDecimalText addrRange)--instance FromJSON IPv4Range where- parseJSON (Aeson.String t) =- case rangeFromDotDecimalText' t of- Left err -> fail err- Right res -> return res- parseJSON _ = mzero--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--fromDotDecimalText :: Text -> Maybe IPv4-fromDotDecimalText = rightToMaybe . fromDotDecimalText'--rangeFromDotDecimalText' :: Text -> Either String IPv4Range-rangeFromDotDecimalText' t =- AT.parseOnly (dotDecimalRangeParser <* AT.endOfInput) t--rangeFromDotDecimalText :: Text -> Maybe IPv4Range-rangeFromDotDecimalText = rightToMaybe . rangeFromDotDecimalText'--dotDecimalRangeParser :: AT.Parser IPv4Range-dotDecimalRangeParser = IPv4Range- <$> dotDecimalParser- <* AT.char '/'- <*> (AT.decimal >>= limitSize)- where- limitSize i =- if i > 32- then fail "An IP range length must be between 0 and 32"- else return i---- | This does not do an endOfInput check because it is--- reused in the range parser implementation.-dotDecimalParser :: AT.Parser IPv4-dotDecimalParser = fromOctets'- <$> (AT.decimal >>= limitSize)- <* AT.char '.'- <*> (AT.decimal >>= limitSize)- <* AT.char '.'- <*> (AT.decimal >>= limitSize)- <* AT.char '.'- <*> (AT.decimal >>= limitSize)- where- limitSize i =- if i > 255- 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.@@ -289,20 +73,9 @@ -- IPv4 {getIPv4 = 3232235777} -- fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> IPv4-fromOctets a b c d = fromOctets'+fromOctets a b c d = IPv4 $ Internal.fromOctets' (fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d) --- | This is sort of a misnomer. It takes Word32 to make--- 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- .|. shiftL b 16- .|. shiftL c 8- .|. 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.@@ -314,114 +87,75 @@ , 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-{-# INLINE toDotDecimalText #-}--toDotDecimalBuilder :: IPv4 -> TBuilder.Builder-toDotDecimalBuilder = TBuilder.fromText . toTextPreAllocated-{-# INLINE toDotDecimalBuilder #-}+-- | The IP address representing any host: @0.0.0.0@+any :: IPv4+any = IPv4 0 -rangeToDotDecimalText :: IPv4Range -> Text-rangeToDotDecimalText = LText.toStrict . TBuilder.toLazyText . rangeToDotDecimalBuilder+-- | The loopback IP address: @127.0.0.1@+loopback :: IPv4+loopback = fromOctets 127 0 0 1 -rangeToDotDecimalBuilder :: IPv4Range -> TBuilder.Builder-rangeToDotDecimalBuilder (IPv4Range addr len) =- toDotDecimalBuilder addr- <> TBuilder.singleton '/'- <> decimal len+-- | The broadcast IP address: @127.0.0.1@+broadcast :: IPv4+broadcast = fromOctets 255 255 255 255 --- | I think that this function can be improved. Right now, it--- always allocates enough space for a fifteen-character text--- rendering of an IP address. I think that it should be possible--- to do more of the math upfront and allocate less space.-toTextPreAllocated :: IPv4 -> Text-toTextPreAllocated (IPv4 w) =- let w1 = fromIntegral $ 255 .&. shiftR w 24- w2 = fromIntegral $ 255 .&. shiftR w 16- w3 = fromIntegral $ 255 .&. shiftR w 8- w4 = fromIntegral $ 255 .&. w- dot = 46- (arr,len) = runST $ do- marr <- TArray.new 15- i1 <- putAndCount 0 w1 marr- let n1 = i1- n1' = i1 + 1- TArray.unsafeWrite marr n1 dot- i2 <- putAndCount n1' w2 marr- let n2 = i2 + n1'- n2' = n2 + 1- TArray.unsafeWrite marr n2 dot- i3 <- putAndCount n2' w3 marr- let n3 = i3 + n2'- n3' = n3 + 1- TArray.unsafeWrite marr n3 dot- i4 <- putAndCount n3' w4 marr- theArr <- TArray.unsafeFreeze marr- return (theArr,i4 + n3')- in Text arr 0 len+-- | Checks to see if the 'IPv4' address belongs to a private+-- network. The three private networks that are checked are+-- @10.0.0.0/8@, @172.16.0.0/12@, and @192.168.0.0/16@.+private :: IPv4 -> Bool+private (IPv4 w) =+ Internal.mask8 .&. w == Internal.p24+ || Internal.mask12 .&. w == Internal.p20+ || Internal.mask16 .&. w == Internal.p16 -putAndCount :: Int -> Word8 -> TArray.MArray s -> ST s Int-putAndCount pos w marr- | w < 10 = TArray.unsafeWrite marr pos (i2w w) >> return 1- | w < 100 = write2 pos w >> return 2- | otherwise = write3 pos w >> return 3- where- write2 off i0 = do- let i = fromIntegral i0; j = i + i- TArray.unsafeWrite marr off $ get2 j- TArray.unsafeWrite marr (off + 1) $ get2 (j + 1)- write3 off i0 = do- let i = fromIntegral i0; j = i + i + i- TArray.unsafeWrite marr off $ get3 j- TArray.unsafeWrite marr (off + 1) $ get3 (j + 1)- TArray.unsafeWrite marr (off + 2) $ get3 (j + 2)- get2 = fromIntegral . ByteString.unsafeIndex twoDigits- get3 = fromIntegral . ByteString.unsafeIndex threeDigits+-- | Checks to see if the 'IPv4' address belongs to a reserved+-- network. This includes the three private networks that 'private'+-- checks along with several other ranges that are not used+-- on the public Internet.+reserved :: IPv4 -> Bool+reserved =+ let a = Internal.fromOctets' 0 0 0 0+ b = Internal.fromOctets' 100 64 0 0+ c = Internal.fromOctets' 127 0 0 0+ d = Internal.fromOctets' 169 254 0 0+ e = Internal.fromOctets' 192 0 0 0+ f = Internal.fromOctets' 192 0 2 0+ g = Internal.fromOctets' 192 88 99 0+ h = Internal.fromOctets' 198 18 0 0+ i = Internal.fromOctets' 198 51 100 0+ j = Internal.fromOctets' 203 0 113 0+ k = Internal.fromOctets' 224 0 0 0+ l = Internal.fromOctets' 240 0 0 0+ m = Internal.fromOctets' 255 255 255 255+ in \(IPv4 w) -> Internal.mask8 .&. w == Internal.p24+ || Internal.mask12 .&. w == Internal.p20+ || Internal.mask16 .&. w == Internal.p16+ || Internal.mask8 .&. w == a+ || Internal.mask10 .&. w == b+ || Internal.mask16 .&. w == d+ || Internal.mask24 .&. w == e+ || Internal.mask24 .&. w == g+ || Internal.mask15 .&. w == h+ || Internal.mask24 .&. w == i+ || Internal.mask24 .&. w == j+ || Internal.mask4 .&. w == k+ || Internal.mask4 .&. w == l+ || Internal.mask32 .&. w == m -zero :: Word16-zero = 48-{-# INLINE zero #-}+-- | Checks to see if the 'IPv4' address is publicly routable.+--+-- prop> public x == not (reserved x)+public :: IPv4 -> Bool+public = not . reserved -i2w :: (Integral a) => a -> Word16-i2w v = zero + fromIntegral v-{-# INLINE i2w #-}+-- | $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. -twoDigits :: ByteString-twoDigits = BC8.pack- "0001020304050607080910111213141516171819\- \2021222324252627282930313233343536373839\- \4041424344454647484950515253545556575859\- \6061626364656667686970717273747576777879\- \8081828384858687888990919293949596979899"+-- This only exists for doctests. Do not use it.+-- prAddr :: IPv4 -> IO ()+-- prAddr (IPv4 addr) = Text.putStrLn (Internal.toDotDecimalText addr) -threeDigits :: ByteString-threeDigits =- ByteString.replicate 300 0 <> BC8.pack- "100101102103104105106107108109110111112\- \113114115116117118119120121122123124125\- \126127128129130131132133134135136137138\- \139140141142143144145146147148149150151\- \152153154155156157158159160161162163164\- \165166167168169170171172173174175176177\- \178179180181182183184185186187188189190\- \191192193194195196197198199200201202203\- \204205206207208209210211212213214215216\- \217218219220221222223224225226227228229\- \230231232233234235236237238239240241242\- \243244245246247248249250251252253254255"
src/Net/IPv4/ByteString/Char8.hs view
@@ -6,8 +6,11 @@ , parser ) where +import Net.Types (IPv4(..)) import Net.IPv4 import Control.Monad+import Data.Coerce (coerce)+import qualified Net.Internal as Internal import qualified Net.IPv4.Text as IPv4Text import qualified Data.Attoparsec.ByteString.Char8 as AB import qualified Data.ByteString.Builder as Builder@@ -102,7 +105,7 @@ builder = Builder.byteString . encode parser :: Parser IPv4-parser = fromOctets'+parser = coerce $ Internal.fromOctets' <$> (AB.decimal >>= limitSize) <* AB.char '.' <*> (AB.decimal >>= limitSize)
+ src/Net/IPv4/Range.hs view
@@ -0,0 +1,131 @@+module Net.IPv4.Range+ ( -- * Range functions+ normalize+ , member+ , lowerInclusive+ , upperInclusive+ -- * Private Ranges+ , private24+ , private20+ , private16+ -- * Internal Functions+ -- $internal+ , prRange+ ) where++import Net.Types (IPv4(..),IPv4Range(..))+import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement)+import qualified Net.Internal as Internal+import qualified Net.IPv4 as IPv4+import qualified Data.Text.IO as Text++-- $setup+--+-- These are here to get doctest's property checking to work.+--+-- >>> import qualified Net.IPv4.Text as I+-- >>> import Net.IPv4 (fromOctets)+-- >>> import Test.QuickCheck (Arbitrary(..))+-- >>> instance Arbitrary IPv4 where { arbitrary = fmap IPv4 arbitrary }+-- >>> instance Arbitrary IPv4Range where { arbitrary = IPv4Range <$> arbitrary <*> arbitrary }+--++-- | 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 = Internal.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++-- | The inclusive lower bound of an 'IPv4Range'. This is conventionally+-- understood to be the broadcast address of a subnet. For example:+--+-- >>> I.print $ lowerInclusive $ IPv4Range (fromOctets 10 10 1 160) 25+-- 10.10.1.128+--+-- Note that the lower bound of a normalized 'IPv4Range' is simply the+-- ip address of the range:+--+-- prop> lowerInclusive r == ipv4RangeBase (normalize r)+lowerInclusive :: IPv4Range -> IPv4+lowerInclusive (IPv4Range (IPv4 w) len) =+ IPv4 (w .&. Internal.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 (IPv4 Internal.p24) 8++-- | The RFC1918 20-bit block. Subnet mask: @172.16.0.0/12@+private20 :: IPv4Range+private20 = IPv4Range (IPv4 Internal.p20) 12++-- | The RFC1918 16-bit block. Subnet mask: @192.168.0.0/16@+private16 :: IPv4Range+private16 = IPv4Range (IPv4 Internal.p16) 16++-- | 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 .&. Internal.mask len'+ in IPv4Range (IPv4 w') len'+++-- | This only exists for doctests. Do not use it.+prRange :: IPv4Range -> IO ()+prRange (IPv4Range (IPv4 addr) range) =+ Text.putStrLn (Internal.rangeToDotDecimalText addr range)+
src/Net/IPv4/String.hs view
@@ -2,7 +2,7 @@ -- 'String' representation of an 'IPv4' address. Using this module -- is discouraged unless the end user is working with a library -- that can only use 'String' to deal with textual data (such as--- @pandoc@ or @hxr@).+-- @pandoc@, @hxr@, or @network@). -- module Net.IPv4.String ( encode@@ -10,7 +10,7 @@ , decodeEither ) where -import Net.IPv4+import Net.Types (IPv4(..)) import qualified Data.Text as Text import qualified Net.IPv4.Text as N
src/Net/IPv4/Text.hs view
@@ -4,26 +4,35 @@ , decodeEither , builder , parser+ , print ) where +import Prelude hiding (print)+import Net.Types (IPv4(..)) import Net.IPv4-import Net.Internal (rightToMaybe) import Data.Text (Text)-import qualified Data.Attoparsec.Text as AT+import Data.Coerce (coerce)+import qualified Data.Text.IO as Text+import qualified Data.Attoparsec.Text as AT import qualified Data.Text.Lazy.Builder as TBuilder+import qualified Net.Internal as Internal encode :: IPv4 -> Text-encode = toDotDecimalText+encode = Internal.toDotDecimalText . getIPv4 decodeEither :: Text -> Either String IPv4-decodeEither = fromDotDecimalText'+decodeEither = coerce . Internal.fromDotDecimalText' decode :: Text -> Maybe IPv4-decode = rightToMaybe . decodeEither+decode = Internal.rightToMaybe . decodeEither builder :: IPv4 -> TBuilder.Builder-builder = toDotDecimalBuilder+builder = Internal.toDotDecimalBuilder . getIPv4 parser :: AT.Parser IPv4-parser = dotDecimalParser+parser = coerce Internal.dotDecimalParser++-- | This exists mostly for testing purposes.+print :: IPv4 -> IO ()+print = Text.putStrLn . encode
src/Net/Internal.hs view
@@ -1,7 +1,20 @@ module Net.Internal where -import qualified Data.Attoparsec.Text as AT-import qualified Data.Aeson.Types as Aeson+import Data.Monoid ((<>))+import Data.Word+import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement)+import Control.Monad.ST+import Data.Text.Internal (Text(..))+import Data.ByteString (ByteString)+import Data.Text.Lazy.Builder.Int (decimal)+import qualified Data.Text.Lazy as LText+import qualified Data.Attoparsec.Text as AT+import qualified Data.Aeson.Types as Aeson+import qualified Data.Text.Array as TArray+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 attoparsecParseJSON :: AT.Parser a -> Aeson.Value -> Aeson.Parser a attoparsecParseJSON p v =@@ -14,4 +27,184 @@ rightToMaybe :: Either a b -> Maybe b rightToMaybe = either (const Nothing) Just++toDotDecimalText :: Word32 -> Text+toDotDecimalText = toTextPreAllocated+{-# INLINE toDotDecimalText #-}++toDotDecimalBuilder :: Word32 -> TBuilder.Builder+toDotDecimalBuilder = TBuilder.fromText . toTextPreAllocated+{-# INLINE toDotDecimalBuilder #-}++rangeToDotDecimalText :: Word32 -> Word8 -> Text+rangeToDotDecimalText addr len =+ LText.toStrict (TBuilder.toLazyText (rangeToDotDecimalBuilder addr len))++rangeToDotDecimalBuilder :: Word32 -> Word8 -> TBuilder.Builder+rangeToDotDecimalBuilder addr len =+ toDotDecimalBuilder addr+ <> TBuilder.singleton '/'+ <> decimal len++-- | I think that this function can be improved. Right now, it+-- always allocates enough space for a fifteen-character text+-- rendering of an IP address. I think that it should be possible+-- to do more of the math upfront and allocate less space.+toTextPreAllocated :: Word32 -> Text+toTextPreAllocated w =+ let w1 = fromIntegral $ 255 .&. shiftR w 24+ w2 = fromIntegral $ 255 .&. shiftR w 16+ w3 = fromIntegral $ 255 .&. shiftR w 8+ w4 = fromIntegral $ 255 .&. w+ dot = 46+ (arr,len) = runST $ do+ marr <- TArray.new 15+ i1 <- putAndCount 0 w1 marr+ let n1 = i1+ n1' = i1 + 1+ TArray.unsafeWrite marr n1 dot+ i2 <- putAndCount n1' w2 marr+ let n2 = i2 + n1'+ n2' = n2 + 1+ TArray.unsafeWrite marr n2 dot+ i3 <- putAndCount n2' w3 marr+ let n3 = i3 + n2'+ n3' = n3 + 1+ TArray.unsafeWrite marr n3 dot+ i4 <- putAndCount n3' w4 marr+ theArr <- TArray.unsafeFreeze marr+ return (theArr,i4 + n3')+ in Text arr 0 len++putAndCount :: Int -> Word8 -> TArray.MArray s -> ST s Int+putAndCount pos w marr+ | w < 10 = TArray.unsafeWrite marr pos (i2w w) >> return 1+ | w < 100 = write2 pos w >> return 2+ | otherwise = write3 pos w >> return 3+ where+ write2 off i0 = do+ let i = fromIntegral i0; j = i + i+ TArray.unsafeWrite marr off $ get2 j+ TArray.unsafeWrite marr (off + 1) $ get2 (j + 1)+ write3 off i0 = do+ let i = fromIntegral i0; j = i + i + i+ TArray.unsafeWrite marr off $ get3 j+ TArray.unsafeWrite marr (off + 1) $ get3 (j + 1)+ TArray.unsafeWrite marr (off + 2) $ get3 (j + 2)+ get2 = fromIntegral . ByteString.unsafeIndex twoDigits+ get3 = fromIntegral . ByteString.unsafeIndex threeDigits++zero :: Word16+zero = 48+{-# INLINE zero #-}++i2w :: Integral a => a -> Word16+i2w v = zero + fromIntegral v+{-# INLINE i2w #-}++twoDigits :: ByteString+twoDigits = BC8.pack+ "0001020304050607080910111213141516171819\+ \2021222324252627282930313233343536373839\+ \4041424344454647484950515253545556575859\+ \6061626364656667686970717273747576777879\+ \8081828384858687888990919293949596979899"++threeDigits :: ByteString+threeDigits =+ ByteString.replicate 300 0 <> BC8.pack+ "100101102103104105106107108109110111112\+ \113114115116117118119120121122123124125\+ \126127128129130131132133134135136137138\+ \139140141142143144145146147148149150151\+ \152153154155156157158159160161162163164\+ \165166167168169170171172173174175176177\+ \178179180181182183184185186187188189190\+ \191192193194195196197198199200201202203\+ \204205206207208209210211212213214215216\+ \217218219220221222223224225226227228229\+ \230231232233234235236237238239240241242\+ \243244245246247248249250251252253254255"++fromDotDecimalText' :: Text -> Either String Word32+fromDotDecimalText' t =+ AT.parseOnly (dotDecimalParser <* AT.endOfInput) t++fromDotDecimalText :: Text -> Maybe Word32+fromDotDecimalText = rightToMaybe . fromDotDecimalText'++rangeFromDotDecimalText' :: (Word32 -> Word8 -> a) -> Text -> Either String a+rangeFromDotDecimalText' f t =+ AT.parseOnly (dotDecimalRangeParser f <* AT.endOfInput) t+{-# INLINE rangeFromDotDecimalText' #-}++rangeFromDotDecimalText :: (Word32 -> Word8 -> a) -> Text -> Maybe a+rangeFromDotDecimalText f = rightToMaybe . rangeFromDotDecimalText' f++dotDecimalRangeParser :: (Word32 -> Word8 -> a) -> AT.Parser a+dotDecimalRangeParser f = f+ <$> dotDecimalParser+ <* AT.char '/'+ <*> (AT.decimal >>= limitSize)+ where+ limitSize i =+ if i > 32+ then fail "An IP range length must be between 0 and 32"+ else return i++-- | This does not do an endOfInput check because it is+-- reused in the range parser implementation.+dotDecimalParser :: AT.Parser Word32+dotDecimalParser = fromOctets'+ <$> (AT.decimal >>= limitSize)+ <* AT.char '.'+ <*> (AT.decimal >>= limitSize)+ <* AT.char '.'+ <*> (AT.decimal >>= limitSize)+ <* AT.char '.'+ <*> (AT.decimal >>= limitSize)+ where+ limitSize i =+ if i > 255+ then fail "All octets in an ip address must be between 0 and 255"+ else return i++-- | This is sort of a misnomer. It takes Word32 to make+-- dotDecimalParser probably perform better. This is mostly+-- for internal use.+fromOctets' :: Word32 -> Word32 -> Word32 -> Word32 -> Word32+fromOctets' a b c d =+ ( shiftL a 24+ .|. shiftL b 16+ .|. shiftL c 8+ .|. d+ )++mask :: Word8 -> Word32+mask = complement . shiftR 0xffffffff . fromIntegral++p24 :: Word32+p24 = fromOctets' 10 0 0 0++p20 :: Word32+p20 = fromOctets' 172 16 0 0++p16 :: Word32+p16 = fromOctets' 192 168 0 0++mask8,mask4,mask12,mask20,mask28,mask16,mask10,mask24,mask32,mask15 :: Word32+mask4 = 0xF0000000+mask8 = 0xFF000000+mask10 = 0xFFC00000+mask12 = 0xFFF00000+mask15 = 0xFFFE0000+mask16 = 0xFFFF0000+mask20 = 0xFFFFF000+mask24 = 0xFFFFFF00+mask28 = 0xFFFFFFF0+mask32 = 0xFFFFFFFF++-- r1,r2,r3,r4,r5,r6 :: Word32+-- r1 = fromOctets' 0 0 0 0+
+ src/Net/Types.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Net.Types+ ( IPv4(..)+ , IPv4Range(..)+ ) where++import qualified Net.Internal as Internal+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Attoparsec.Text as AT+import Data.Coerce (coerce)+import Control.Monad+import Data.Word+import Data.Int+import Data.Hashable+import Data.Aeson (FromJSON(..),ToJSON(..))+import GHC.Generics (Generic)++-- | 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 #-} !Word8+ } deriving (Eq,Ord,Show,Read,Generic)++instance Hashable IPv4Range++instance ToJSON IPv4 where+ toJSON (IPv4 addr) = Aeson.String (Internal.toDotDecimalText addr)++instance FromJSON IPv4 where+ parseJSON = Internal.attoparsecParseJSON+ (coerce (Internal.dotDecimalParser <* AT.endOfInput))++instance ToJSON IPv4Range where+ toJSON (IPv4Range (IPv4 addr) range) = Aeson.String (Internal.rangeToDotDecimalText addr range)++instance FromJSON IPv4Range where+ parseJSON (Aeson.String t) =+ case Internal.rangeFromDotDecimalText' mkIPv4Range t of+ Left err -> fail err+ Right res -> return res+ parseJSON _ = mzero++mkIPv4Range :: Word32 -> Word8 -> IPv4Range+mkIPv4Range w len = IPv4Range (IPv4 w) len+{-# INLINE mkIPv4Range #-}++-- 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)+
test/ArbitraryInstances.hs view
@@ -5,7 +5,7 @@ -- Orphan instances that are needed to make QuickCheck work. -import Net.IPv4 (IPv4(..),IPv4Range(..))+import Net.Types (IPv4(..),IPv4Range(..)) import Net.Mac (Mac(..)) import Test.QuickCheck (Arbitrary(..))
test/Bench.hs view
@@ -1,7 +1,7 @@ module Main (main) where import Criterion.Main-import Net.IPv4 (IPv4(..))+import Net.Types (IPv4(..)) import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder.Int (decimal)
test/Doctests.hs view
@@ -1,4 +1,7 @@ import Test.DocTest main :: IO ()-main = doctest ["src/Net/IPv4.hs"]+main = doctest+ [ "src/Net/IPv4.hs"+ , "src/Net/IPv4/Range.hs"+ ]
test/IPv4ByteString1.hs view
@@ -1,5 +1,6 @@ module IPv4ByteString1 where +import Net.Types (IPv4(..)) import Net.IPv4 import Data.ByteString.Internal as I
test/IPv4Text1.hs view
@@ -1,11 +1,10 @@ module IPv4Text1 where -import Net.IPv4 (IPv4(..))+import Net.Types (IPv4(..)) import Data.Text (Text) import qualified Net.IPv4 as IPv4 import qualified Data.Text as Text import Text.Read (readMaybe)-import Net.IPv4 (IPv4(..)) import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder.Int (decimal)
test/IPv4Text2.hs view
@@ -1,11 +1,10 @@ module IPv4Text2 where -import Net.IPv4 (IPv4(..))+import Net.Types (IPv4(..)) import Data.Text (Text) import qualified Net.IPv4 as IPv4 import qualified Data.Text as Text import Text.Read (readMaybe)-import Net.IPv4 (IPv4(..)) import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder.Int (decimal)
test/Naive.hs view
@@ -1,11 +1,10 @@ module Naive where -import Net.IPv4 (IPv4(..))+import Net.Types (IPv4(..)) import Data.Text (Text) import qualified Net.IPv4 as IPv4 import qualified Data.Text as Text import Text.Read (readMaybe)-import Net.IPv4 (IPv4(..)) import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement) import Data.Monoid ((<>)) import Data.Text.Lazy.Builder.Int (decimal)
test/Test.hs view
@@ -6,9 +6,10 @@ import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Net.IPv4 (IPv4(..),IPv4Range(..))+import Net.Types (IPv4(..),IPv4Range(..)) import Net.Mac (Mac(..)) import qualified Net.IPv4 as IPv4+import qualified Net.IPv4.Range as IPv4Range import qualified Net.IPv4.Text as IPv4_Text import qualified Net.IPv4.ByteString.Char8 as IPv4_ByteString import qualified Net.Mac as Mac@@ -53,7 +54,7 @@ ] , testGroup "IP Range Operations" [ testProperty "Idempotence of normalizing IPv4 range"- $ propIdempotence IPv4.normalize+ $ propIdempotence IPv4Range.normalize , testProperty "Normalize does not affect membership" propNormalizeMember , testProperty "Membership agrees with bounds" propMemberUpperLower , testProperty "Range contains self" propRangeSelf@@ -70,12 +71,12 @@ 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+propNormalizeMember i r = IPv4Range.member i r == IPv4Range.member i (IPv4Range.normalize r) propMemberUpperLower :: IPv4 -> IPv4Range -> Bool propMemberUpperLower i r =- (i >= IPv4.lowerInclusive r && i <= IPv4.upperInclusive r) == IPv4.member r i+ (i >= IPv4Range.lowerInclusive r && i <= IPv4Range.upperInclusive r) == IPv4Range.member i r propRangeSelf :: IPv4Range -> Bool-propRangeSelf r = IPv4.member r (IPv4.ipv4RangeBase r) == True+propRangeSelf r = IPv4Range.member (ipv4RangeBase r) r == True