ip 0.8.6 → 0.8.7

raw patch · 8 files changed

+326/−11 lines, 8 filesdep ~aesondep ~basedep ~vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, base, vector

API changes (from Hackage documentation)

Files

• ip.cabal +5/−1
• src/Net/IP.hs +19/−0
• src/Net/IPv6.hs +44/−0
• src/Net/IPv6/Text.hs +124/−0
• src/Net/Internal.hs +55/−5
• src/Net/Mac/ByteString/Char8.hs +1/−1
• src/Net/Types.hs +17/−3
• test/Test.hs +61/−1

@@ -1,5 +1,5 @@ name:                ip-version:             0.8.6+version:             0.8.7 synopsis:            Library for IP and MAC addresses homepage:            https://github.com/andrewthad/haskell-ip#readme license:             BSD3@@ -48,6 +48,9 @@     Net.IPv4.String     Net.IPv4.Text     Net.IPv4.ByteString.Char8+    Net.IPv6+    Net.IPv6.Text+    Net.IP     Net.Types     Net.Internal   build-depends:@@ -76,6 +79,7 @@     , bytestring     , HUnit     , test-framework-hunit+    , attoparsec   other-modules:     ArbitraryInstances     Naive

@@ -0,0 +1,19 @@+module Net.IP where++import Net.Types+import Data.Bits++case_ :: (IPv4 -> a) -> (IPv6 -> a) -> IP -> a+case_ f g (IP addr@(IPv6 w1 w2)) = if w1 == 0 && (0xFFFFFFFF00000000 .&. w2 == 0x0000FFFF00000000)+  then f (IPv4 (fromIntegral w2))+  else g addr++-- | If the address is an 'IPv4' address, return the address.+ipv4 :: IP -> Maybe IPv4+ipv4 = case_ Just (const Nothing)++-- | If the address is an 'IPv6' address, and if it is not+--   an IPv4-mapped IPv6 address, return the address.+ipv6 :: IP -> Maybe IPv6+ipv6 = case_ (const Nothing) Just+

@@ -0,0 +1,44 @@+{-# LANGUAGE BangPatterns #-}++module Net.IPv6 where++import qualified Net.Internal as Internal+import Data.Bits+import Data.Word+import Net.Types++fromOctets ::+     Word8 -> Word8 -> Word8 -> Word8+  -> Word8 -> Word8 -> Word8 -> Word8+  -> Word8 -> Word8 -> Word8 -> Word8+  -> Word8 -> Word8 -> Word8 -> Word8+  -> IPv6+fromOctets a b c d e f g h i j k l m n o p =+  let !(w1,w2) = Internal.fromOctetsV6+        (fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d)+        (fromIntegral e) (fromIntegral f) (fromIntegral g) (fromIntegral h)+        (fromIntegral i) (fromIntegral j) (fromIntegral k) (fromIntegral l)+        (fromIntegral m) (fromIntegral n) (fromIntegral o) (fromIntegral p)+   in IPv6 w1 w2++fromWord16s ::+     Word16 -> Word16 -> Word16 -> Word16+  -> Word16 -> Word16 -> Word16 -> Word16+  -> IPv6+fromWord16s a b c d e f g h =+  let !(w1,w2) = Internal.fromWord16sV6+        (fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d)+        (fromIntegral e) (fromIntegral f) (fromIntegral g) (fromIntegral h)+   in IPv6 w1 w2++toWord16s :: IPv6 -> (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16)+toWord16s (IPv6 a b) =+  ( fromIntegral (unsafeShiftR a 48)+  , fromIntegral (unsafeShiftR a 32)+  , fromIntegral (unsafeShiftR a 16)+  , fromIntegral a+  , fromIntegral (unsafeShiftR b 48)+  , fromIntegral (unsafeShiftR b 32)+  , fromIntegral (unsafeShiftR b 16)+  , fromIntegral b+  )

@@ -0,0 +1,124 @@+{-# LANGUAGE BangPatterns #-}++module Net.IPv6.Text+  ( parser+  ) where++import Prelude hiding (print)+import Net.Types (IPv6(..))+import Data.Bits+import Data.Word+import Control.Applicative+import qualified Data.Text as Text+import qualified Data.Attoparsec.Text as Atto+import Debug.Trace++parser :: Atto.Parser IPv6+parser = do+  s <- start+  case toIPv6 (traceShowId s) of+    Nothing -> fail "Wrong number of octets in IPv6 address"+    Just ip -> return ip+  where+  msg = "All chunks in a formatted IPv6 address must be between 0x0000 and 0xFFFF"+  colonMsg = "Cannot use double colon for omitting zeroes more than once in an IPv6 address"+  start = do+    c <- Atto.peekChar'+    if c == ':'+      then go (-1) 0 []+      else Atto.hexadecimal >>= \w -> go (-1) 1 [w]+    -- r <- fmap Just Atto.hexadecimal <|> (Nothing <$ Atto.char ':')+    -- case r of+    --   Just !w -> go (-1) 1 [w]+    --   Nothing -> go 0 0 []+  go !colonIndex !currentIndex !ws = do+    r <- do+      m <- Atto.peekChar+      case m of+        Nothing -> return ResDone+        Just c -> if c == ':'+          then do+            _ <- Atto.anyChar -- should be a colon+            if colonIndex == currentIndex+              then fmap ResWord Atto.hexadecimal <|> pure ResDone+                -- do+                -- md <- Atto.peekChar+                -- case md of+                --   Nothing -> return ResDone+                --   Just d -> fmap ResWord Atto.hexadecimal <|> pure+								-- 		then return ResColon+								-- 		else fmap ResWord Atto.hexadecimal+              else do+                d <- Atto.peekChar'+                if d == ':'+                  then return ResColon+                  else fmap ResWord Atto.hexadecimal+              -- else if colonIndex == currentIndex+              --   then fmap ResWord Atto.hexadecimal <|> (ResDone <$ Atto.anyChar)+              --   else fmap ResWord Atto.hexadecimal+          else return ResDone+    -- fmap ResWord Atto.hexadecimal <|> (ResColon <$ Atto.char ':')+    -- ) <|> pure ResDone+    -- r <- (do _ <- Atto.char ':'+    --          fmap ResWord Atto.hexadecimal <|> (ResColon <$ Atto.char ':')+    --      ) <|> pure ResDone+    case r of+      ResDone -> pure (S colonIndex currentIndex ws)+      ResColon -> if alreadySet colonIndex+        then fail colonMsg+        else go currentIndex currentIndex ws+      ResWord w -> restrictTo16 msg w >> go colonIndex (currentIndex + 1) (w : ws)++toIPv6 :: S -> Maybe IPv6+toIPv6 (S colonIndex total input) = go 0 0 input+  where+  revColonIndex = total - colonIndex+  spacesToSkip = 8 - total+  go :: Int -> Word64 -> [Word64] -> Maybe IPv6+  go !ix !acc ws = if ix > 3+    then fmap (flip IPv6 acc) (go2 ix 0 ws)+    else case ws of+      w : wsNext -> if ix == revColonIndex+        then go (ix + spacesToSkip) acc (w : wsNext)+        else go (ix + 1) (acc .|. unsafeShiftL w (times16 ix)) wsNext+      [] -> if ix == revColonIndex+        then Just $ IPv6 0 acc+        else Nothing -- Not enough word16s in list+  go2 :: Int -> Word64 -> [Word64] -> Maybe Word64+  go2 !ix !acc ws = case ws of+    w : wsNext -> if ix == revColonIndex+      then go2 (ix + spacesToSkip) acc (w : wsNext)+      else go2 (ix + 1) (acc .|. unsafeShiftL w (times16 ix - 64)) wsNext+    [] -> if ix == revColonIndex || ix > 7+      then Just acc+      else Nothing -- Not enough word16s in list++times16 :: Int -> Int+times16 a = unsafeShiftL a 4++alreadySet :: Int -> Bool+alreadySet i = i /= (-1)++restrictTo16 :: String -> Word64 -> Atto.Parser ()+restrictTo16 msg w = if w > 65535+  then fail msg+  else return ()++-- | This is an internal data type used as the result+--   after parsing an ipv6 address. The first field+--   indicates the index at which a double colon occurs.+--   The second is the length of the third.+--   The third is a reversed list of the 16s+--   that comprise the ipv6 address.+data S = S+  { sDoubleColon :: {-# UNPACK #-} !Int+  , sTotal :: {-# UNPACK #-} !Int+  , sRevWords :: ![Word64]+  } deriving (Show,Read)++data Res+  = ResWord {-# UNPACK #-} !Word64+  | ResColon+  | ResDone++

@@ -4,7 +4,7 @@  import Data.Monoid ((<>)) import Data.Word-import Data.Bits ((.&.),(.|.),shiftR,shiftL,shift,complement)+import Data.Bits ((.&.),(.|.),shiftR,shiftL,shift,complement,unsafeShiftR,unsafeShiftL) import Control.Monad.ST import Data.Text.Internal (Text(..)) import Data.ByteString (ByteString)@@ -146,11 +146,11 @@  macToTextPreAllocated :: Word8 -> Bool -> Word16 -> Word32 -> Text macToTextPreAllocated separator' isUpperCase wa wb =-  let w1 = fromIntegral $ 255 .&. shiftR wa 8+  let w1 = fromIntegral $ 255 .&. unsafeShiftR wa 8       w2 = fromIntegral $ 255 .&. wa-      w3 = fromIntegral $ 255 .&. shiftR wb 24-      w4 = fromIntegral $ 255 .&. shiftR wb 16-      w5 = fromIntegral $ 255 .&. shiftR wb 8+      w3 = fromIntegral $ 255 .&. unsafeShiftR wb 24+      w4 = fromIntegral $ 255 .&. unsafeShiftR wb 16+      w5 = fromIntegral $ 255 .&. unsafeShiftR wb 8       w6 = fromIntegral $ 255 .&. wb       hexPairs = if isUpperCase then twoHexDigits else twoHexDigitsLower       separator = fromIntegral separator' :: Word16@@ -226,12 +226,62 @@ -- | This is sort of a misnomer. It takes Word32 to make --   dotDecimalParser probably perform better. This is mostly --   for internal use.+--+--   At some point, it would be worth revisiting the decision+--   to use 'Word32' here. Using 'Word' would probably give+--   better performance on a 64-bit processor. fromOctets' :: Word32 -> Word32 -> Word32 -> Word32 -> Word32 fromOctets' a b c d =     ( shiftL a 24   .|. shiftL b 16   .|. shiftL c 8   .|. d+    )++fromOctetsV6 ::+     Word64 -> Word64 -> Word64 -> Word64+  -> Word64 -> Word64 -> Word64 -> Word64+  -> Word64 -> Word64 -> Word64 -> Word64+  -> Word64 -> Word64 -> Word64 -> Word64+  -> (Word64,Word64)+fromOctetsV6 a b c d e f g h i j k l m n o p =+  ( fromOctetsWord64 a b c d e f g h+  , fromOctetsWord64 i j k l m n o p+  )++fromWord16sV6 ::+     Word64 -> Word64 -> Word64 -> Word64+  -> Word64 -> Word64 -> Word64 -> Word64+  -> (Word64,Word64)+fromWord16sV6 a b c d e f g h =+  ( fromWord16Word64 a b c d+  , fromWord16Word64 e f g h+  )++fromWord16Word64 :: Word64 -> Word64 -> Word64 -> Word64 -> Word64+fromWord16Word64 a b c d = fromIntegral+    ( unsafeShiftL a 48+  .|. unsafeShiftL b 32+  .|. unsafeShiftL c 16+  .|. d+    )++-- | All the words given as argument should be+--   range restricted from 0 to 255. This is not+--   checked.+fromOctetsWord64 ::+     Word64 -> Word64 -> Word64 -> Word64+  -> Word64 -> Word64 -> Word64 -> Word64+  -> Word64+fromOctetsWord64 a b c d e f g h = fromIntegral+    ( shiftL a 56+  .|. shiftL b 48+  .|. shiftL c 40+  .|. shiftL d 32+  .|. shiftL e 24+  .|. shiftL f 16+  .|. shiftL g 8+  .|. h     )  -- | Given the size of the mask, return the

@@ -65,7 +65,7 @@ parseTwoHex = do   a <- ABW.anyWord8 >>= parseWord8Hex   b <- ABW.anyWord8 >>= parseWord8Hex-  return (unsafeShiftL a 1 + b)+  return (unsafeShiftL a 4 + b)  parseWord8Hex :: Word8 -> Parser Word8 parseWord8Hex w

@@ -9,6 +9,8 @@  module Net.Types   ( IPv4(..)+  , IPv6(..)+  , IP(..)   , IPv4Range(..)   , Mac(..)   , MacEncoding(..)@@ -28,7 +30,7 @@ import qualified Data.Vector.Unboxed.Mutable    as MUVector import qualified Data.Vector.Primitive.Mutable  as MPVector import Data.Primitive.Types (Prim)-import Data.Bits (Bits,(.|.),shiftL)+import Data.Bits (Bits,FiniteBits,(.|.),shiftL) import Data.Coerce (coerce) import Control.Monad import Data.Word@@ -37,9 +39,21 @@ import Data.Aeson (FromJSON(..),ToJSON(..)) import GHC.Generics (Generic) --- | A 32-bit Internet Protocol address.+-- | A 32-bit Internet Protocol version 4 address. newtype IPv4 = IPv4 { getIPv4 :: Word32 }-  deriving (Eq,Ord,Show,Read,Enum,Bounded,Hashable,Generic,Prim,Bits)+  deriving (Eq,Ord,Show,Read,Enum,Bounded,Hashable,Generic,Prim,Bits,FiniteBits)++-- | A 128-bit Internet Protocol version 6 address.+data IPv6 = IPv6+  { ipv6A :: {-# UNPACK #-} !Word64+  , ipv6B :: {-# UNPACK #-} !Word64+  } deriving (Eq,Ord,Show,Read)++-- | A 32-bit 'IPv4' address or a 128-bit 'IPv6' address. Internally, this+--   is just represented as an 'IPv6' address. The functions provided+--   in @Net.IP@ help simulate pattern matching on it.+newtype IP = IP { getIP :: IPv6 }+  deriving (Eq,Ord,Show,Read)  -- | The length should be between 0 and 32. These bounds are inclusive. --   This expectation is not in any way enforced by this library because

@@ -7,16 +7,22 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit       (testCase) import Test.HUnit                           (Assertion,(@?=))+import Numeric                              (showHex)+import Data.Word -import Net.Types (IPv4(..),IPv4Range(..),Mac(..))+import Net.Types (IPv4(..),IPv4Range(..),Mac(..),IPv6(..)) import qualified Data.Text as Text import qualified Net.IPv4 as IPv4+import qualified Net.IPv6 as IPv6 import qualified Net.IPv4.Range as IPv4Range import qualified Net.IPv4.Text as IPv4Text+import qualified Net.IPv6.Text as IPv6Text import qualified Net.IPv4.ByteString.Char8 as IPv4ByteString import qualified Net.Mac as Mac import qualified Net.Mac.Text as MacText +import qualified Data.Attoparsec.Text as AT+ import ArbitraryInstances () import qualified Naive import qualified IPv4Text1@@ -59,6 +65,9 @@       [ testProperty "Identical to Naive"           $ propMatching IPv4ByteString.encode Naive.encodeByteString       ]+    , testGroup "IPv6 encode/decode"+      [ testCase "Parser Test Cases" testIPv6Parser+      ]     ]   , testGroup "IP Range Operations"     [ testProperty "Idempotence of normalizing IPv4 range"@@ -92,6 +101,36 @@ testIPv4Decode = IPv4Text.decode (Text.pack "124.222.255.0")              @?= Just (IPv4.fromOctets 124 222 255 0) +testIPv6Parser :: Assertion+testIPv6Parser = do+  -- Basic test+  go 0xABCD 0x1234 0xABCD 0x1234 0xDCBA 0x4321 0xFFFF 0xE0E0+     "ABCD:1234:ABCD:1234:DCBA:4321:FFFF:E0E0"+  -- Tests that leading zeros can be omitted+  go 0x1234 0x5678 0x9ABC 0xDEF0 0x0123 0x4567 0x89AB 0xCDEF+     "1234:5678:9ABC:DEF0:123:4567:89AB:CDEF"+  -- Test that the IPv6 "any" abbreviation works+  go 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000+     "::"+  go 0x1623 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000+     "1623::"+  go 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0xABCD 0x1234+     "::ABCD:1234"+  go 0xAAAA 0x0000 0x0000 0x0000 0x0000 0x0000 0xABCD 0x1234+     "AAAA::ABCD:1234"+  go 0xAAAA 0x0000 0x0000 0x0000 0xBBBB 0x0000 0xABCD 0x1234+     "AAAA::BBBB:0000:ABCD:1234"+  go 0xAAAA 0x0000 0x0000 0x0000 0xBBBB 0x0000 0xABCD 0x1234+     "AAAA:0000:0000:0000:BBBB::ABCD:1234"+  where+  go a b c d e f g h str =+    Right (HexIPv6 (IPv6.fromWord16s a b c d e f g h))+    @?= fmap HexIPv6+      (AT.parseOnly+        (IPv6Text.parser <* AT.endOfInput)+        (Text.pack str)+      )+ textBadIPv4 :: [String] textBadIPv4 =   [ "122.256.0.0"@@ -111,4 +150,25 @@ testMacEncode :: Assertion testMacEncode = MacText.encode (Mac.fromOctets 0xFF 0x00 0xAB 0x12 0x99 0x0F)             @?= Text.pack "ff:00:ab:12:99:0f"++newtype HexIPv6 = HexIPv6 { getHexIPv6 :: IPv6 }+  deriving (Eq)++instance Show HexIPv6 where+  showsPrec _ (HexIPv6 v) =+    let (a,b,c,d,e,f,g,h) = IPv6.toWord16s v+     in showHex a . showChar ':'+        . showHex b . showChar ':'+        . showHex c . showChar ':'+        . showHex d . showChar ':'+        . showHex e . showChar ':'+        . showHex f . showChar ':'+        . showHex g . showChar ':'+        . showHex h++newtype Hex a = Hex { getHex :: a }++-- instance (Integral a, Show a) => Show (Hex a) where+--   show = showHex . getHex+