ip 1.7.4 → 1.7.5
raw patch · 8 files changed
+269/−215 lines, 8 filesdep +word-compatdep −doctestdep ~aesondep ~basedep ~bytesmith
Dependencies added: word-compat
Dependencies removed: doctest
Dependency ranges changed: aeson, base, bytesmith, bytestring, vector, wide-word
Files
- ip.cabal +8/−20
- src/Data/ByteString/Builder/Fixed.hs +16/−11
- src/Data/Word/Synthetic/Word12.hs +4/−2
- src/Net/IPv4.hs +110/−54
- src/Net/IPv6.hs +48/−45
- src/Net/Mac.hs +79/−65
- test/Doctests.hs +0/−14
- test/Test.hs +4/−4
ip.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: ip-version: 1.7.4+version: 1.7.5 synopsis: Library for IP and MAC addresses homepage: https://github.com/andrewthad/haskell-ip#readme license: BSD-3-Clause@@ -46,21 +46,22 @@ Data.Text.Builder.Variable Data.Word.Synthetic.Word12 build-depends:- , aeson >= 1.0 && < 2.1- , attoparsec >= 0.13 && < 0.14+ , aeson >= 1.0 && < 2.2+ , attoparsec >= 0.13 && < 0.15 , base >= 4.9 && < 5 , byteslice >= 0.1.2 && < 0.3- , bytesmith >= 0.3.3 && < 0.4- , bytestring >= 0.10.8 && < 0.11+ , bytesmith >= 0.3.9 && < 0.4+ , bytestring >= 0.10.8 && < 0.12 , deepseq >= 1.4 && < 1.5- , hashable >= 1.2 && < 1.4+ , hashable >= 1.2 && < 1.5 , natural-arithmetic >= 0.1 && <0.2 , primitive >= 0.6.4 && < 0.8 , bytebuild >= 0.3.4 && <0.4 , text >= 1.2 && < 1.3 , text-short >= 0.1.3 && < 0.2 , vector >= 0.11 && < 0.13- , wide-word >= 0.1.0.8 && < 0.2+ , wide-word >= 0.1.1.2 && < 0.2+ , word-compat >= 0.0.4 && <0.1 ghc-options: -Wall -O2 default-language: Haskell2010 @@ -105,19 +106,6 @@ ghc-options: -Wall -O2 default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover >= 2.5.5--test-suite doctest- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Doctests.hs- build-depends:- , QuickCheck- , base- , doctest >= 0.10- , ip- , wide-word- , vector- default-language: Haskell2010 benchmark criterion type: exitcode-stdio-1.0
src/Data/ByteString/Builder/Fixed.hs view
@@ -1,8 +1,9 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -Wall -funbox-strict-fields #-} @@ -34,11 +35,13 @@ 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+import qualified Data.ByteString.Internal as BI import qualified Data.ByteString.Short.Internal as SBS+import qualified Data.Primitive as PM+import qualified Data.Semigroup as Semigroup data Builder a where BuilderStatic :: !ByteString -> Builder a@@ -74,6 +77,10 @@ fromByteString = BuilderStatic {-# INLINE fromByteString #-} +unsafeIndexShortByteString :: ShortByteString -> Int -> Word8+unsafeIndexShortByteString (SBS.SBS x) i = PM.indexByteArray (PM.ByteArray x) i+{-# INLINE unsafeIndexShortByteString #-}+ run :: Builder a -> a -> ByteString run x a = case x of BuilderStatic t -> t@@ -87,9 +94,9 @@ let !wInt = fromIntegral w !ix = wInt + wInt + wInt !arr = if upper then hexValuesWord12Upper else hexValuesWord12Lower- pokeByteOff marr i (SBS.unsafeIndex arr ix)- pokeByteOff marr (i + 1) (SBS.unsafeIndex arr (ix + 1))- pokeByteOff marr (i + 2) (SBS.unsafeIndex arr (ix + 2))+ pokeByteOff marr i (unsafeIndexShortByteString arr ix)+ pokeByteOff marr (i + 1) (unsafeIndexShortByteString arr (ix + 1))+ pokeByteOff marr (i + 2) (unsafeIndexShortByteString arr (ix + 2)) {-# INLINE word12HexFixedGeneral #-} word12HexFixedUpper :: Builder Word12@@ -124,8 +131,8 @@ let !ix = unsafeShiftL (fromIntegral w) 1 !ix2 = ix + 1 !arr = if upper then hexValuesWord8Upper else hexValuesWord8Lower- pokeByteOff marr i (SBS.unsafeIndex arr ix)- pokeByteOff marr (i + 1) (SBS.unsafeIndex arr ix2)+ pokeByteOff marr i (unsafeIndexShortByteString arr ix)+ pokeByteOff marr (i + 1) (unsafeIndexShortByteString arr ix2) {-# INLINE word8HexFixedGeneral #-} hexValuesWord8Upper :: ShortByteString@@ -165,5 +172,3 @@ -- <> contramapBuilder (word8At 8) twoDigitWord8Hex -- <> BuilderStatic ":" -- <> contramapBuilder (word8At 0) twoDigitWord8Hex--
src/Data/Word/Synthetic/Word12.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PatternSynonyms #-} -- |@@ -42,8 +43,9 @@ import GHC.Read import GHC.Real import GHC.Show-import GHC.Word +import qualified GHC.Word.Compat as Compat+ ------------------------------------------------------------------------ -- Word12 is represented in the same way as Word. Operations may assume and@@ -183,7 +185,7 @@ countTrailingZeros (W12# x#) = I# (word2Int# (ctz12# x#)) {-# RULES-"fromIntegral/Word8->Word12" fromIntegral = \(W8# x#) -> W12# x#+"fromIntegral/Word8->Word12" fromIntegral = \x -> case x of { Compat.W8# y -> W12# y } "fromIntegral/Word12->Word12" fromIntegral = id :: Word12 -> Word12 "fromIntegral/Word12->Integer" fromIntegral = toInteger :: Word12 -> Integer "fromIntegral/a->Word12" fromIntegral = \x -> case fromIntegral x of W# x# -> W12# (narrow12Word# x#)
src/Net/IPv4.hs view
@@ -48,6 +48,9 @@ , parserUtf8Bytes , byteArrayBuilderUtf8 , boundedBuilderUtf8+ -- ** Non-textual Bytes+ , boundedBuilderOctetsBE+ , boundedBuilderOctetsLE -- ** String -- $string , encodeString@@ -116,11 +119,11 @@ import Foreign.Storable (Storable, poke) import GHC.Exts (Word#) import GHC.Generics (Generic)-import GHC.Word (Word32(W32#)) import Prelude hiding (any, print, print) import Text.ParserCombinators.ReadPrec (prec,step) import Text.Printf (printf) import Text.Read (Read(..),Lexeme(Ident),lexP,parens)+ import qualified Arithmetic.Nat as Nat import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson@@ -153,6 +156,7 @@ import qualified Data.Vector.Primitive as PVector import qualified Data.Vector.Unboxed as UVector import qualified Data.Vector.Unboxed.Mutable as MUVector+import qualified GHC.Word.Compat as Compat #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as AesonKey@@ -164,10 +168,16 @@ -- -- >>> :set -XOverloadedStrings -- >>> import Test.QuickCheck (Arbitrary(..))+-- >>> import Net.IPv4 (getIPv4) -- >>> import qualified Prelude as P -- >>> import qualified Data.Text.IO as T+-- >>> import qualified Data.Bytes.Text.Ascii as Ascii+-- >>> import qualified Data.Attoparsec.Text as AT+-- >>> import qualified Data.ByteString.Builder as Builder+-- >>> import qualified Data.Bytes.Builder as UB+-- >>> import qualified Data.Attoparsec.ByteString.Char8 as AB -- >>> instance Arbitrary IPv4 where { arbitrary = fmap IPv4 arbitrary }--- >>> instance Arbitrary IPv4Range where { arbitrary = IPv4Range <$> arbitrary <*> arbitrary }+-- >>> instance Arbitrary IPv4.IPv4Range where { arbitrary = IPv4.IPv4Range <$> arbitrary <*> arbitrary } -- >>> import qualified Data.Bytes.Chunks as Chunks @@ -178,7 +188,7 @@ -- Additionally, it is used for the 'Show' and 'Read' instances -- of 'IPv4' to help keep things readable in GHCi. ----- >>> let addr = ipv4 192 168 1 1+-- >>> let addr = IPv4.ipv4 192 168 1 1 -- >>> addr -- ipv4 192 168 1 1 -- >>> getIPv4 addr@@ -209,28 +219,28 @@ -- | The IP address representing any host. ----- >>> any+-- >>> IPv4.any -- ipv4 0 0 0 0 any :: IPv4 any = IPv4 0 -- | The local loopback IP address. ----- >>> loopback+-- >>> IPv4.loopback -- ipv4 127 0 0 1 loopback :: IPv4 loopback = fromOctets 127 0 0 1 -- | A useful and common alias for 'loopback'. ----- >>> localhost+-- >>> IPv4.localhost -- ipv4 127 0 0 1 localhost :: IPv4 localhost = loopback -- | The broadcast IP address. ----- >>> broadcast+-- >>> IPv4.broadcast -- ipv4 255 255 255 255 broadcast :: IPv4 broadcast = fromOctets 255 255 255 255@@ -312,57 +322,57 @@ -- | Checks to see if the 'IPv4' address is publicly routable. ----- prop> public x == not (reserved x)+-- prop> IPv4.public x == not (IPv4.reserved x) public :: IPv4 -> Bool public = not . reserved -- | Encode an 'IPv4' address to 'Text' using dot-decimal notation: ----- >>> T.putStrLn (encode (ipv4 192 168 2 47))+-- >>> T.putStrLn (IPv4.encode (IPv4.ipv4 192 168 2 47)) -- 192.168.2.47 encode :: IPv4 -> Text encode = toDotDecimalText -- | Decode an 'IPv4' address. ----- >>> decode "192.168.2.47"+-- >>> IPv4.decode "192.168.2.47" -- Just (ipv4 192 168 2 47) ----- >>> decode "10.100.256.256"+-- >>> IPv4.decode "10.100.256.256" -- Nothing decode :: Text -> Maybe IPv4 decode = decodeIPv4TextMaybe -- | Encode an 'IPv4' address to a text 'TBuilder.Builder'. ----- >>> builder (ipv4 192 168 2 47)+-- >>> IPv4.builder (IPv4.ipv4 192 168 2 47) -- "192.168.2.47" builder :: IPv4 -> TBuilder.Builder builder = toDotDecimalBuilder -- | Parse an 'IPv4' address using a 'TextRead.Reader'. ----- >>> reader "192.168.2.47"+-- >>> IPv4.reader "192.168.2.47" -- Right (ipv4 192 168 2 47,"") ----- >>> reader "192.168.2.470"+-- >>> IPv4.reader "192.168.2.470" -- Left "All octets in an IPv4 address must be between 0 and 255" reader :: TextRead.Reader IPv4 reader = decodeIPv4TextReader -- | Parse an 'IPv4' address using a 'AT.Parser'. ----- >>> AT.parseOnly parser "192.168.2.47"+-- >>> AT.parseOnly IPv4.parser "192.168.2.47" -- Right (ipv4 192 168 2 47) ----- >>> AT.parseOnly parser "192.168.2.470"+-- >>> AT.parseOnly IPv4.parser "192.168.2.470" -- Left "Failed reading: All octets in an IPv4 address must be between 0 and 255" parser :: AT.Parser IPv4 parser = dotDecimalParser -- | Encode an 'IPv4' address to a UTF-8 encoded 'ByteString'. ----- >>> encodeUtf8 (ipv4 192 168 2 47)+-- >>> IPv4.encodeUtf8 (IPv4.ipv4 192 168 2 47) -- "192.168.2.47" encodeUtf8 :: IPv4 -> ByteString encodeUtf8 = toBSPreAllocated@@ -408,7 +418,7 @@ -- | Decode a UTF8-encoded 'ByteString' into an 'IPv4'. ----- >>> decodeUtf8 "192.168.2.47"+-- >>> IPv4.decodeUtf8 "192.168.2.47" -- Just (ipv4 192 168 2 47) -- -- Currently not terribly efficient since the implementation@@ -421,7 +431,7 @@ -- | Decode 'ShortText' as an 'IPv4' address. ----- >>> decodeShort "192.168.3.48"+-- >>> IPv4.decodeShort "192.168.3.48" -- Just (ipv4 192 168 3 48) decodeShort :: ShortText -> Maybe IPv4 decodeShort t = decodeUtf8Bytes (Bytes.fromByteArray b)@@ -429,7 +439,7 @@ -- | Encode an 'IPv4' address as 'ShortText'. ----- >>> encodeShort (ipv4 192 168 5 99)+-- >>> IPv4.encodeShort (IPv4.ipv4 192 168 5 99) -- "192.168.5.99" encodeShort :: IPv4 -> ShortText encodeShort !w = id@@ -447,7 +457,7 @@ -- | Decode UTF-8-encoded 'Bytes' into an 'IPv4' address. ----- >>> decodeUtf8Bytes (Bytes.fromAsciiString "127.0.0.1")+-- >>> IPv4.decodeUtf8Bytes (Ascii.fromString "127.0.0.1") -- Just (ipv4 127 0 0 1) decodeUtf8Bytes :: Bytes.Bytes -> Maybe IPv4 decodeUtf8Bytes !b = case Parser.parseBytes (parserUtf8Bytes ()) b of@@ -458,7 +468,7 @@ -- | Parse UTF-8-encoded 'Bytes' as an 'IPv4' address. ----- >>> Parser.parseBytes (parserUtf8Bytes ()) (Bytes.fromAsciiString "10.0.1.254")+-- >>> Parser.parseBytes (IPv4.parserUtf8Bytes ()) (Ascii.fromString "10.0.1.254") -- Success (Slice {offset = 10, length = 0, value = ipv4 10 0 1 254}) parserUtf8Bytes :: e -> Parser.Parser e s IPv4 {-# inline parserUtf8Bytes #-}@@ -480,9 +490,9 @@ -- | Parse UTF-8-encoded 'Bytes' into an 'IPv4Range'. -- This requires the mask to be present. ----- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "192.168.0.0/16")+-- >>> maybe (putStrLn "nope") IPv4.printRange $ Parser.parseBytesMaybe (IPv4.parserRangeUtf8Bytes ()) (Ascii.fromString "192.168.0.0/16") -- 192.168.0.0/16--- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "10.10.10.1")+-- >>> maybe (putStrLn "nope") IPv4.printRange $ Parser.parseBytesMaybe (IPv4.parserRangeUtf8Bytes ()) (Ascii.fromString "10.10.10.1") -- nope -- -- See 'parserRangeUtf8BytesLenient' for a variant that treats@@ -499,9 +509,9 @@ -- | Variant of 'parserRangeUtf8Bytes' that allows the mask -- to be omitted. An omitted mask is treated as a @/32@ mask. ----- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "192.168.0.0/16")+-- >>> maybe (putStrLn "nope") IPv4.printRange $ Parser.parseBytesMaybe (IPv4.parserRangeUtf8BytesLenient ()) (Ascii.fromString "192.168.0.0/16") -- 192.168.0.0/16--- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "10.10.10.1")+-- >>> maybe (putStrLn "nope") IPv4.printRange $ Parser.parseBytesMaybe (IPv4.parserRangeUtf8BytesLenient ()) (Ascii.fromString "10.10.10.1") -- 10.10.10.1/32 parserRangeUtf8BytesLenient :: e -> Parser.Parser e s IPv4Range parserRangeUtf8BytesLenient e = do@@ -516,14 +526,14 @@ -- | Encode an 'IPv4' as a bytestring 'Builder.Builder' ----- >>> Builder.toLazyByteString (builderUtf8 (fromOctets 192 168 2 12))+-- >>> Builder.toLazyByteString (IPv4.builderUtf8 (IPv4.fromOctets 192 168 2 12)) -- "192.168.2.12" builderUtf8 :: IPv4 -> Builder.Builder builderUtf8 = Builder.byteString . encodeUtf8 -- | Encode an 'IPv4' address as a unbounded byte array builder. ----- >>> Chunks.concat (UB.run 1 (byteArrayBuilderUtf8 (fromOctets 192 168 2 13)))+-- >>> Chunks.concat (UB.run 1 (IPv4.byteArrayBuilderUtf8 (IPv4.fromOctets 192 168 2 13))) -- [0x31,0x39,0x32,0x2e,0x31,0x36,0x38,0x2e,0x32,0x2e,0x31,0x33] -- -- Note that period is encoded by UTF-8 as @0x2e@.@@ -532,7 +542,7 @@ -- | Encode an 'IPv4' address as a bounded byte array builder. ----- >>> BB.run Nat.constant (boundedBuilderUtf8 (fromOctets 192 168 2 14))+-- >>> BB.run Nat.constant (IPv4.boundedBuilderUtf8 (IPv4.fromOctets 192 168 2 14)) -- [0x31, 0x39, 0x32, 0x2e, 0x31, 0x36, 0x38, 0x2e, 0x32, 0x2e, 0x31, 0x34] -- -- Note that period is encoded by UTF-8 as @0x2e@.@@ -557,12 +567,56 @@ w3 = fromIntegral (shiftR w 8) :: Word8 w4 = fromIntegral w :: Word8 +-- | Encode 'IPv4' address to a sequence a 4 bytes with the first+-- byte representing corresponding to the most significant byte in+-- the address.+--+-- >>> BB.run Nat.constant (IPv4.boundedBuilderOctetsBE (IPv4.fromOctets 0xc0 0xa8 0x02 0x1f))+-- [0xc0, 0xa8, 0x02, 0x1f]+boundedBuilderOctetsBE :: IPv4 -> BB.Builder 4+{-# inline boundedBuilderOctetsBE #-}+boundedBuilderOctetsBE (IPv4 !w) =+ BB.word8 w1+ `BB.append`+ BB.word8 w2+ `BB.append`+ BB.word8 w3+ `BB.append`+ BB.word8 w4+ where+ w1 = fromIntegral (shiftR w 24) :: Word8+ w2 = fromIntegral (shiftR w 16) :: Word8+ w3 = fromIntegral (shiftR w 8) :: Word8+ w4 = fromIntegral w :: Word8++-- | Encode 'IPv4' address to a sequence a 4 bytes with the first+-- byte representing corresponding to the least significant byte in+-- the address.+--+-- >>> BB.run Nat.constant (IPv4.boundedBuilderOctetsLE (IPv4.fromOctets 0xc0 0xa8 0x02 0x1f))+-- [0x1f, 0x02, 0xa8, 0xc0]+boundedBuilderOctetsLE :: IPv4 -> BB.Builder 4+{-# inline boundedBuilderOctetsLE #-}+boundedBuilderOctetsLE (IPv4 !w) =+ BB.word8 w4+ `BB.append`+ BB.word8 w3+ `BB.append`+ BB.word8 w2+ `BB.append`+ BB.word8 w1+ where+ w1 = fromIntegral (shiftR w 24) :: Word8+ w2 = fromIntegral (shiftR w 16) :: Word8+ w3 = fromIntegral (shiftR w 8) :: Word8+ w4 = fromIntegral w :: Word8+ -- | Parse an 'IPv4' using a 'AB.Parser'. ----- >>> AB.parseOnly parserUtf8 "192.168.2.47"+-- >>> AB.parseOnly IPv4.parserUtf8 "192.168.2.47" -- Right (ipv4 192 168 2 47) ----- >>> AB.parseOnly parserUtf8 "192.168.2.470"+-- >>> AB.parseOnly IPv4.parserUtf8 "192.168.2.470" -- Left "Failed reading: All octets in an ipv4 address must be between 0 and 255" parserUtf8 :: AB.Parser IPv4 parserUtf8 = fromOctets'@@ -606,11 +660,13 @@ -- | Convert an unboxed IPv4 address to a boxed one. box :: IPv4# -> IPv4-box w = IPv4 (W32# w)+{-# inline box #-}+box w = IPv4 (Compat.W32# w) -- | Convert a boxed IPv4 address to an unboxed one. unbox :: IPv4 -> IPv4#-unbox (IPv4 (W32# w)) = w+{-# inline unbox #-}+unbox (IPv4 (Compat.W32# w)) = w -- | A 32-bit Internet Protocol version 4 address. To use this with the -- @network@ library, it is necessary to use @Network.Socket.htonl@ to@@ -955,9 +1011,9 @@ -- handled. This makes the range broader if it cannot be represented in -- CIDR notation. ----- >>> printRange $ fromBounds (fromOctets 192 168 16 0) (fromOctets 192 168 19 255)+-- >>> IPv4.printRange $ IPv4.fromBounds (IPv4.fromOctets 192 168 16 0) (IPv4.fromOctets 192 168 19 255) -- 192.168.16.0/22--- >>> printRange $ fromBounds (fromOctets 10 0 5 7) (fromOctets 10 0 5 14)+-- >>> IPv4.printRange $ IPv4.fromBounds (IPv4.fromOctets 10 0 5 7) (IPv4.fromOctets 10 0 5 14) -- 10.0.5.0/28 fromBounds :: IPv4 -> IPv4 -> IPv4Range fromBounds (IPv4 a) (IPv4 b) =@@ -968,10 +1024,10 @@ -- | 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+-- >>> let ip = IPv4.fromOctets 10 10 1 92+-- >>> IPv4.contains (IPv4.IPv4Range (IPv4.fromOctets 10 0 0 0) 8) ip -- True--- >>> contains (IPv4Range (fromOctets 10 11 0 0) 16) ip+-- >>> IPv4.contains (IPv4.IPv4Range (IPv4.fromOctets 10 11 0 0) 16) ip -- False -- -- Typically, element-testing functions are written to take the element@@ -979,8 +1035,8 @@ -- 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_ (P.print . contains r) (take 5 $ iterate succ $ fromOctets 10 10 10 5)+-- >>> let r = IPv4.IPv4Range (IPv4.fromOctets 10 10 10 6) 31+-- >>> mapM_ (P.print . IPv4.contains r) (take 5 $ iterate succ $ IPv4.fromOctets 10 10 10 5) -- False -- True -- True@@ -1002,27 +1058,27 @@ -- | 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+-- prop> IPv4.member ip r == IPv4.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: ----- >>> T.putStrLn $ encode $ lowerInclusive $ IPv4Range (ipv4 10 10 1 160) 25+-- >>> T.putStrLn $ IPv4.encode $ IPv4.lowerInclusive $ IPv4.IPv4Range (IPv4.ipv4 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)+-- prop> IPv4.lowerInclusive r == IPv4.ipv4RangeBase (IPv4.normalize r) lowerInclusive :: IPv4Range -> IPv4 lowerInclusive (IPv4Range (IPv4 w) len) = IPv4 (w .&. mask len) -- | The inclusive upper bound of an 'IPv4Range'. ----- >>> T.putStrLn $ encode $ upperInclusive $ IPv4Range (ipv4 10 10 1 160) 25+-- >>> T.putStrLn $ IPv4.encode $ IPv4.upperInclusive $ IPv4.IPv4Range (IPv4.ipv4 10 10 1 160) 25 -- 10.10.1.255 upperInclusive :: IPv4Range -> IPv4 upperInclusive (IPv4Range (IPv4 w) len) =@@ -1054,8 +1110,8 @@ -- | Convert an 'IPv4Range' into a list of the 'IPv4' addresses that -- are in it. ----- >>> let r = IPv4Range (fromOctets 192 168 1 8) 30--- >>> mapM_ (T.putStrLn . encode) (toList r)+-- >>> let r = IPv4.IPv4Range (IPv4.fromOctets 192 168 1 8) 30+-- >>> mapM_ (T.putStrLn . IPv4.encode) (IPv4.toList r) -- 192.168.1.8 -- 192.168.1.9 -- 192.168.1.10@@ -1089,9 +1145,9 @@ -- 'IPv4' inside the 'IPv4Range' is changed so that the insignificant -- bits are zeroed out. For example: ----- >>> printRange $ normalize $ IPv4Range (fromOctets 192 168 1 19) 24+-- >>> IPv4.printRange $ IPv4.normalize $ IPv4.IPv4Range (IPv4.fromOctets 192 168 1 19) 24 -- 192.168.1.0/24--- >>> printRange $ normalize $ IPv4Range (fromOctets 192 168 1 163) 28+-- >>> IPv4.printRange $ IPv4.normalize $ IPv4.IPv4Range (IPv4.fromOctets 192 168 1 163) 28 -- 192.168.1.160/28 -- -- The second effect of this is that the mask length is lowered to@@ -1102,7 +1158,7 @@ -- -- Note that 'normalize' is idempotent, that is: ----- prop> normalize r == (normalize . normalize) r+-- prop> IPv4.normalize r == (IPv4.normalize . IPv4.normalize) r normalize :: IPv4Range -> IPv4Range normalize (IPv4Range (IPv4 w) len) = let len' = min len 32@@ -1111,30 +1167,30 @@ -- | Encode an 'IPv4Range' as 'Text'. ----- >>> encodeRange (IPv4Range (ipv4 172 16 0 0) 12)+-- >>> IPv4.encodeRange (IPv4.IPv4Range (IPv4.ipv4 172 16 0 0) 12) -- "172.16.0.0/12" encodeRange :: IPv4Range -> Text encodeRange = rangeToDotDecimalText -- | Decode an 'IPv4Range' from 'Text'. ----- >>> decodeRange "172.16.0.0/12"+-- >>> IPv4.decodeRange "172.16.0.0/12" -- Just (IPv4Range {ipv4RangeBase = ipv4 172 16 0 0, ipv4RangeLength = 12})--- >>> decodeRange "192.168.25.254/16"+-- >>> IPv4.decodeRange "192.168.25.254/16" -- Just (IPv4Range {ipv4RangeBase = ipv4 192 168 0 0, ipv4RangeLength = 16}) decodeRange :: Text -> Maybe IPv4Range decodeRange = rightToMaybe . AT.parseOnly (parserRange <* AT.endOfInput) -- | Encode an 'IPv4Range' to a 'TBuilder.Builder'. ----- >>> builderRange (IPv4Range (ipv4 172 16 0 0) 12)+-- >>> IPv4.builderRange (IPv4.IPv4Range (IPv4.ipv4 172 16 0 0) 12) -- "172.16.0.0/12" builderRange :: IPv4Range -> TBuilder.Builder builderRange = rangeToDotDecimalBuilder -- | Parse an 'IPv4Range' using a 'AT.Parser'. ----- >>> AT.parseOnly parserRange "192.168.25.254/16"+-- >>> AT.parseOnly IPv4.parserRange "192.168.25.254/16" -- Right (IPv4Range {ipv4RangeBase = ipv4 192 168 0 0, ipv4RangeLength = 16}) parserRange :: AT.Parser IPv4Range parserRange = do
src/Net/IPv6.hs view
@@ -86,7 +86,6 @@ import Foreign.Storable (Storable) import GHC.Exts (Int#,Word#,Int(I#)) import GHC.Generics (Generic)-import GHC.Word (Word16(W16#)) import Numeric (showHex) import Text.ParserCombinators.ReadPrec (prec,step) import Text.Read (Read(..),Lexeme(Ident),lexP,parens)@@ -106,6 +105,7 @@ import qualified Data.Text.IO as TIO import qualified Data.Text.Short.Unsafe as TS import qualified Data.Text.Short as TS+import qualified GHC.Word.Compat as Compat import qualified Net.IPv4 as IPv4 -- $setup@@ -114,15 +114,18 @@ -- -- >>> import qualified Prelude as P -- >>> import qualified Data.Text.IO as T+-- >>> import qualified Data.Text as Text+-- >>> import qualified Data.Attoparsec.Text as Atto+-- >>> import qualified Data.Bytes.Text.Ascii as Ascii -- >>> import Test.QuickCheck (Arbitrary(..)) -- >>> instance Arbitrary Word128 where { arbitrary = Word128 <$> arbitrary <*> arbitrary } -- >>> instance Arbitrary IPv6 where { arbitrary = IPv6 <$> arbitrary }--- >>> instance Arbitrary IPv6Range where { arbitrary = IPv6Range <$> arbitrary <*> arbitrary }+-- >>> instance Arbitrary IPv6.IPv6Range where { arbitrary = IPv6.IPv6Range <$> arbitrary <*> arbitrary } -- -- | A 128-bit Internet Protocol version 6 address. newtype IPv6 = IPv6 { getIPv6 :: Word128 }- deriving (Bounded,Enum,Eq,Ord,Storable,Bits,FiniteBits,NFData,Prim,Ix,Data)+ deriving (Bounded,Enum,Eq,Ord,Storable,Bits,FiniteBits,NFData,Prim,Ix,Data,Generic) instance Show IPv6 where showsPrec p addr = showParen (p > 10)@@ -339,21 +342,21 @@ -- | The local loopback IP address. ----- >>> loopback+-- >>> IPv6.loopback -- ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001 loopback :: IPv6 loopback = IPv6 (Word128 0 1) -- | A useful alias for 'loopback'. ----- >>> localhost+-- >>> IPv6.localhost -- ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001 localhost :: IPv6 localhost = loopback -- | The IP address representing any host. ----- >>> any+-- >>> IPv6.any -- ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 any :: IPv6 any = IPv6 zeroWord128@@ -363,11 +366,11 @@ -- Per <https://tools.ietf.org/html/rfc5952#section-5 RFC 5952 Section 5>, -- this uses mixed notation when encoding an IPv4-mapped IPv6 address: ----- >>> T.putStrLn $ encode $ fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234+-- >>> T.putStrLn $ IPv6.encode $ IPv6.fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234 -- dead:beef::1234--- >>> T.putStrLn $ encode $ fromWord16s 0x0 0x0 0x0 0x0 0x0 0xFFFF 0x6437 0xA5B4+-- >>> T.putStrLn $ IPv6.encode $ IPv6.fromWord16s 0x0 0x0 0x0 0x0 0x0 0xFFFF 0x6437 0xA5B4 -- ::ffff:100.55.165.180--- >>> T.putStrLn $ encode $ fromWord16s 0x0 0x0 0x0 0x0 0x0 0x0 0x0 0x0+-- >>> T.putStrLn $ IPv6.encode $ IPv6.fromWord16s 0x0 0x0 0x0 0x0 0x0 0x0 0x0 0x0 -- :: -- -- Per <https://tools.ietf.org/html/rfc5952#section-4.2.2 Section 4.2.2> of the@@ -409,7 +412,7 @@ -- | Decode UTF-8-encoded 'Bytes' into an 'IPv6' address. ----- >>> decodeUtf8Bytes (Bytes.fromAsciiString "::cab:1")+-- >>> decodeUtf8Bytes (Ascii.fromString "::cab:1") -- Just (ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0cab 0x0001) decodeUtf8Bytes :: Bytes.Bytes -> Maybe IPv6 decodeUtf8Bytes !b = case Parser.parseBytes (parserUtf8Bytes ()) b of@@ -421,7 +424,7 @@ -- | Encodes the 'IPv6' address using zero-compression on the -- leftmost longest string of zeroes in the address. ----- >>> BB.run Nat.constant $ boundedBuilderUtf8 $ fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234+-- >>> BB.run Nat.constant $ IPv6.boundedBuilderUtf8 $ IPv6.fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234 -- [0x64, 0x65, 0x61, 0x64, 0x3a, 0x62, 0x65, 0x65, 0x66, 0x3a, 0x3a, 0x31, 0x32, 0x33, 0x34] boundedBuilderUtf8 :: IPv6 -> BB.Builder 39 boundedBuilderUtf8 !ip@(IPv6 (Word128 hi lo))@@ -480,7 +483,7 @@ -- this inlining improves performance of encodeShort by 50%. piece :: Int -> Word16 -> Int -> Int -> BB.Builder 5 {-# inline piece #-}-piece (I# ix) (W16# w) (I# start) (I# end) =+piece (I# ix) (Compat.W16# w) (I# start) (I# end) = piece# ix w start end piece# :: Int# -> Word# -> Int# -> Int# -> BB.Builder 5@@ -495,7 +498,7 @@ ix = I# ix# start = I# start# end = I# end#- w = W16# w#+ w = Compat.W16# w# lastPiece :: Word16 -> Int -> BB.Builder 5 lastPiece !w !end = case end of@@ -542,7 +545,7 @@ -- Per <https://tools.ietf.org/html/rfc5952#section-5 RFC 5952 Section 5>, -- this uses mixed notation when encoding an IPv4-mapped IPv6 address. -- --- >>> encodeShort $ fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0ABC 0x0 0x1234+-- >>> IPv6.encodeShort $ IPv6.fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0ABC 0x0 0x1234 -- "dead:beef::abc:0:1234" encodeShort :: IPv6 -> ShortText encodeShort w = id@@ -567,7 +570,7 @@ -- both uppercase and lowercase characters in the hexadecimal components. -- -- >>> let str = "dead:beef:3240:a426:ba68:1cd0:4263:109b -> alive"--- >>> Parser.parseBytes (parserUtf8Bytes ()) (Bytes.fromAsciiString str)+-- >>> Parser.parseBytes (parserUtf8Bytes ()) (Ascii.fromString str) -- Success (Slice {offset = 39, length = 9, value = ipv6 0xdead 0xbeef 0x3240 0xa426 0xba68 0x1cd0 0x4263 0x109b}) -- -- This does not currently support parsing embedded IPv4 address@@ -704,9 +707,9 @@ -- | Parse UTF-8-encoded 'Bytes' into an 'IPv4Range'. -- This requires the mask to be present. ----- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "1b02:f001:5:200b::/80")+-- >>> maybe (putStrLn "nope") IPv6.printRange $ Parser.parseBytesMaybe (IPv6.parserRangeUtf8Bytes ()) (Ascii.fromString "1b02:f001:5:200b::/80") -- 1b02:f001:5:200b::/80--- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "abcd::")+-- >>> maybe (putStrLn "nope") IPv6.printRange $ Parser.parseBytesMaybe (IPv6.parserRangeUtf8Bytes ()) (Ascii.fromString "abcd::") -- nope -- -- See 'parserRangeUtf8BytesLenient' for a variant that treats@@ -723,9 +726,9 @@ -- | Variant of 'parserRangeUtf8Bytes' that allows the mask -- to be omitted. An omitted mask is treated as a @/128@ mask. ----- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "1b02:f001:5:200b::/80")+-- >>> maybe (putStrLn "nope") IPv6.printRange $ Parser.parseBytesMaybe (IPv6.parserRangeUtf8BytesLenient ()) (Ascii.fromString "1b02:f001:5:200b::/80") -- 1b02:f001:5:200b::/80--- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "abcd::")+-- >>> maybe (putStrLn "nope") IPv6.printRange $ Parser.parseBytesMaybe (IPv6.parserRangeUtf8BytesLenient ()) (Ascii.fromString "abcd::") -- abcd::/128 parserRangeUtf8BytesLenient :: e -> Parser.Parser e s IPv6Range parserRangeUtf8BytesLenient e = do@@ -740,7 +743,7 @@ -- | Parse an 'IPv6' using 'Atto.Parser'. ----- >>> Atto.parseOnly parser (Text.pack "dead:beef:3240:a426:ba68:1cd0:4263:109b")+-- >>> Atto.parseOnly IPv6.parser (Text.pack "dead:beef:3240:a426:ba68:1cd0:4263:109b") -- Right (ipv6 0xdead 0xbeef 0x3240 0xa426 0xba68 0x1cd0 0x4263 0x109b) parser :: Atto.Parser IPv6 parser = makeIP <$> ip@@ -817,11 +820,11 @@ -- 'IPv6' inside the 'IPv6Range' is changed so that the insignificant -- bits are zeroed out. For example: ----- >>> addr1 = ipv6 0x0192 0x0168 0x0001 0x0019 0x0000 0x0000 0x0000 0x0000--- >>> addr2 = ipv6 0x0192 0x0168 0x0001 0x0163 0x0000 0x0000 0x0000 0x0000--- >>> printRange $ normalize $ IPv6Range addr1 24+-- >>> addr1 = IPv6.ipv6 0x0192 0x0168 0x0001 0x0019 0x0000 0x0000 0x0000 0x0000+-- >>> addr2 = IPv6.ipv6 0x0192 0x0168 0x0001 0x0163 0x0000 0x0000 0x0000 0x0000+-- >>> IPv6.printRange $ IPv6.normalize $ IPv6.IPv6Range addr1 24 -- 192:100::/24--- >>> printRange $ normalize $ IPv6Range addr2 28+-- >>> IPv6.printRange $ IPv6.normalize $ IPv6.IPv6Range addr2 28 -- 192:160::/28 -- -- The second effect of this is that the mask length is lowered to be 128@@ -831,7 +834,7 @@ -- -- Note that 'normalize is idempotent, that is: ----- prop> normalize r == (normalize . normalize) r+-- prop> IPv6.normalize r == (IPv6.normalize . IPv6.normalize) r normalize :: IPv6Range -> IPv6Range normalize (IPv6Range ip len) = let len' = min len 128@@ -840,16 +843,16 @@ -- | Encode an 'IPv6Range' as 'Text'. ----- >>> addr = ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B--- >>> T.putStrLn $ encodeRange $ IPv6Range addr 28+-- >>> addr = IPv6.ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B+-- >>> T.putStrLn $ IPv6.encodeRange $ IPv6.IPv6Range addr 28 -- dead:beef:3240:a426:ba68:1cd0:4263:109b/28 encodeRange :: IPv6Range -> Text encodeRange x = encode (ipv6RangeBase x) <> Text.pack "/" <> (Text.pack $ (show . fromEnum) $ ipv6RangeLength x) -- | Decode an 'IPv6Range' from 'Text'. ----- >>> addr = ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B--- >>> fmap encodeRange $ decodeRange (Text.pack "dead:beef:3240:a426:ba68:1cd0:4263:109b/28")+-- >>> addr = IPv6.ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B+-- >>> fmap IPv6.encodeRange $ IPv6.decodeRange (Text.pack "dead:beef:3240:a426:ba68:1cd0:4263:109b/28") -- Just "dead:bee0::/28" decodeRange :: Text -> Maybe IPv6Range decodeRange = rightToMaybe . AT.parseOnly (parserRange <* AT.endOfInput)@@ -869,11 +872,11 @@ -- | Checks to see if an 'IPv6' address belongs in the 'IPv6Range'. ----- >>> let ip = ipv6 0x2001 0x0db8 0x0db8 0x1094 0x2051 0x0000 0x0000 0x0001--- >>> let iprange mask = IPv6Range (ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) mask--- >>> contains (iprange 8) ip+-- >>> let ip = IPv6.ipv6 0x2001 0x0db8 0x0db8 0x1094 0x2051 0x0000 0x0000 0x0001+-- >>> let iprange mask = IPv6.IPv6Range (IPv6.ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) mask+-- >>> IPv6.contains (iprange 8) ip -- True--- >>> contains (iprange 48) ip+-- >>> IPv6.contains (iprange 48) ip -- False -- -- Typically, element-testing functions are written to take the element@@ -881,8 +884,8 @@ -- 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 = IPv6Range (ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) 64--- >>> fmap (contains r) (take 5 $ iterate succ $ ipv6 0x2001 0x0db8 0x0000 0x0000 0xffff 0xffff 0xffff 0xfffe)+-- >>> let r = IPv6.IPv6Range (IPv6.ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) 64+-- >>> fmap (IPv6.contains r) (take 5 $ iterate succ $ IPv6.ipv6 0x2001 0x0db8 0x0000 0x0000 0xffff 0xffff 0xffff 0xfffe) -- [True,True,False,False,False] -- -- The implementation of 'contains' ensures that (with GHC), the bitmask@@ -897,27 +900,27 @@ -- | 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+-- prop> IPv6.member ip r == IPv6.contains r ip member :: IPv6 -> IPv6Range -> Bool member = flip contains -- | The inclusive lower bound of an 'IPv6Range'. This is conventionally -- understood to be the broadcast address of a subnet. For example: ----- >>> T.putStrLn $ encode $ lowerInclusive $ IPv6Range (ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) 25+-- >>> T.putStrLn $ IPv6.encode $ IPv6.lowerInclusive $ IPv6.IPv6Range (IPv6.ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) 25 -- 2001:d80:: -- -- Note that the lower bound of a normalized 'IPv6Range' is simply the -- ip address of the range: ----- prop> lowerInclusive r == ipv6RangeBase (normalize r)+-- prop> IPv6.lowerInclusive r == IPv6.ipv6RangeBase (IPv6.normalize r) lowerInclusive :: IPv6Range -> IPv6 lowerInclusive = ipv6RangeBase . normalize -- | The inclusive upper bound of an 'IPv6Range'. ----- >>> let addr = ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B--- >>> T.putStrLn $ encode $ upperInclusive $ IPv6Range addr 25+-- >>> let addr = IPv6.ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B+-- >>> T.putStrLn $ IPv6.encode $ IPv6.upperInclusive $ IPv6.IPv6Range addr 25 -- dead:beff:ffff:ffff:ffff:ffff:ffff:ffff -- upperInclusive :: IPv6Range -> IPv6@@ -934,8 +937,8 @@ -- | Smart constructor for 'IPv6Range'. Ensures the mask is appropriately -- sized and sets masked bits in the 'IPv6' to zero. ----- >>> let addr = ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B--- >>> printRange $ range addr 25+-- >>> let addr = IPv6.ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B+-- >>> IPv6.printRange $ IPv6.range addr 25 -- dead:be80::/25 range :: IPv6 -> Word8 -> IPv6Range range addr len = normalize (IPv6Range addr len)@@ -946,9 +949,9 @@ -- -- This makes the range broader if it cannot be represented in <https://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing CIDR> notation. ----- >>> addrLower = ipv6 0xDEAD 0xBE80 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000--- >>> addrUpper = ipv6 0xDEAD 0xBEFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF--- >>> printRange $ fromBounds addrLower addrUpper+-- >>> addrLower = IPv6.ipv6 0xDEAD 0xBE80 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000+-- >>> addrUpper = IPv6.ipv6 0xDEAD 0xBEFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF+-- >>> IPv6.printRange $ IPv6.fromBounds addrLower addrUpper -- dead:be80::/25 fromBounds :: IPv6 -> IPv6 -> IPv6Range fromBounds lo hi =
src/Net/Mac.hs view
@@ -48,6 +48,8 @@ , parserUtf8Bytes -- ** Printing , print+ -- * Default Codec+ , defCodec -- * Types , Mac(..) , MacCodec(..)@@ -69,9 +71,6 @@ import Data.Ix (Ix) import Data.Primitive.ByteArray (ByteArray(ByteArray)) import Data.Primitive.Types (Prim(..))-#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup ((<>))-#endif import Data.Text (Text) import Data.Text.Short (ShortText) import Data.Word@@ -79,7 +78,6 @@ import GHC.Enum (predError, succError) import GHC.Exts import GHC.Generics (Generic)-import GHC.Word (Word16(W16#)) import Text.ParserCombinators.ReadPrec (prec,step) import Text.Read (Read(..),Lexeme(Ident),lexP,parens) @@ -102,21 +100,40 @@ import qualified Data.Text.Lazy.Builder as TBuilder import qualified Data.Text.Short.Unsafe as TS import qualified Data.Text as Text ()+import qualified GHC.Prim.Compat as Compat+import qualified GHC.Word.Compat as Compat #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as AK #endif +-- | A 48-bit MAC address. Do not use the data constructor for this+-- type. It is not considered part of the stable API, and it+-- allows you to construct invalid MAC addresses.+newtype Mac = Mac Word64+ deriving (Eq,Ord,Generic,Ix,Data)++instance NFData Mac++ -- $setup -- -- These are here to get doctest's property checking to work -- -- >>> :set -XOverloadedStrings--- >>> import Test.QuickCheck (Arbitrary(..))+-- >>> import Test.QuickCheck (Arbitrary(..),CoArbitrary(..),coarbitraryEnum) -- >>> import qualified Data.Text as Text (pack) -- >>> import qualified Data.Text.IO as T -- >>> import qualified Data.ByteString.Char8 as BC+-- >>> import qualified Data.ByteString as B+-- >>> import qualified Data.Bytes.Text.Ascii as Ascii+-- >>> import qualified Net.Mac as Mac+-- >>> import qualified Arithmetic.Nat as Nat+-- >>> import qualified Data.Attoparsec.Text as AT+-- >>> import qualified Data.Bytes.Builder.Bounded as BBB+-- >>> import Net.Mac (Mac(Mac)) -- >>> instance Arbitrary Mac where { arbitrary = fmap (Mac . (0xFFFFFFFFFFFF .&.)) arbitrary }+-- >>> instance CoArbitrary Mac where { coarbitrary = coarbitraryEnum } -- | Construct a 'Mac' address from a 'Word64'. Only the lower -- 48 bits are used.@@ -132,7 +149,7 @@ -- | Convert a 'Mac' address to the six octets that make it up. -- This function and 'fromOctets' are inverses: ----- prop> m == (let (a,b,c,d,e,f) = toOctets m in fromOctets a b c d e f)+-- prop> m == (let (a,b,c,d,e,f) = Mac.toOctets m in Mac.fromOctets a b c d e f) toOctets :: Mac -> (Word8,Word8,Word8,Word8,Word8,Word8) toOctets (Mac w) = ( fromIntegral $ unsafeShiftR w 40@@ -154,12 +171,14 @@ -- of length 6 successfully decode, and all other 'ByteString's fail -- to decode. ----- >>> decodeOctets (B.pack [0x6B,0x47,0x18,0x90,0x55,0xC3])+-- >>> Mac.decodeOctets (B.pack [0x6B,0x47,0x18,0x90,0x55,0xC3]) -- Just (mac 0x6b47189055c3)--- >>> decodeOctets (B.replicate 6 0x3A)+-- >>> Mac.decodeOctets (B.replicate 6 0x3A) -- Just (mac 0x3a3a3a3a3a3a)--- >>> decodeOctets (B.replicate 7 0x3A)+-- >>> Mac.decodeOctets (B.replicate 7 0x3A) -- Nothing+--+-- Note that the octets are interpreted in a big-endian fashion. decodeOctets :: ByteString -> Maybe Mac decodeOctets bs = if B.length bs == 6 then Just $ fromOctets@@ -179,7 +198,7 @@ -- | Encode a 'Mac' address using the default 'MacCodec' 'defCodec'. ----- >>> T.putStrLn (encode (Mac 0xA47F247AB423))+-- >>> T.putStrLn (Mac.encode (Mac 0xA47F247AB423)) -- a4:7f:24:7a:b4:23 encode :: Mac -> Text encode = encodeWith defCodec@@ -187,10 +206,10 @@ -- | Encode a 'Mac' address using the given 'MacCodec'. -- -- >>> m = Mac 0xA47F247AB423--- >>> T.putStrLn $ encodeWith defCodec m+-- >>> T.putStrLn $ Mac.encodeWith Mac.defCodec m -- a4:7f:24:7a:b4:23 ----- >>> T.putStrLn $ encodeWith (MacCodec (MacGroupingTriples '-') True) m+-- >>> T.putStrLn $ Mac.encodeWith (Mac.MacCodec (Mac.MacGroupingTriples '-') True) m -- A47-F24-7AB-423 encodeWith :: MacCodec -> Mac -> Text encodeWith (MacCodec g u) m = case g of@@ -210,20 +229,20 @@ -- | Decode a 'Mac' address using the default 'MacCodec' 'defCodec'. ----- >>> decode (Text.pack "a4:7f:24:7a:b4:23")+-- >>> Mac.decode (Text.pack "a4:7f:24:7a:b4:23") -- Just (mac 0xa47f247ab423) ----- >>> decode (Text.pack "a47-f24-7ab-423")+-- >>> Mac.decode (Text.pack "a47-f24-7ab-423") -- Nothing decode :: Text -> Maybe Mac decode = decodeWith defCodec -- | Decode a 'Mac' address from 'Text' using the given 'MacCodec'. ----- >>> decodeWith defCodec (Text.pack "a4:7f:24:7a:b4:23")+-- >>> Mac.decodeWith Mac.defCodec (Text.pack "a4:7f:24:7a:b4:23") -- Just (mac 0xa47f247ab423) ----- >>> decodeWith (MacCodec MacGroupingNoSeparator False) (Text.pack "a47f247ab423")+-- >>> Mac.decodeWith (Mac.MacCodec Mac.MacGroupingNoSeparator False) (Text.pack "a47f247ab423") -- Just (mac 0xa47f247ab423) decodeWith :: MacCodec -> Text -> Maybe Mac decodeWith codec t = rightToMaybe (AT.parseOnly (parserWith codec <* AT.endOfInput) t)@@ -234,21 +253,21 @@ -- | Parse a 'Mac' address using a 'AT.Parser'. ----- >>> AT.parseOnly parser (Text.pack "a4:7f:24:7a:b4:23")+-- >>> AT.parseOnly Mac.parser (Text.pack "a4:7f:24:7a:b4:23") -- Right (mac 0xa47f247ab423) ----- >>> AT.parseOnly parser (Text.pack "a47-f24-7ab-423")+-- >>> AT.parseOnly Mac.parser (Text.pack "a47-f24-7ab-423") -- Left "':': Failed reading: satisfy" parser :: AT.Parser Mac parser = parserWith defCodec -- | Parser a 'Mac' address using the given 'MacCodec'. ----- >>> p1 = parserWith defCodec+-- >>> p1 = Mac.parserWith Mac.defCodec -- >>> AT.parseOnly p1 (Text.pack "a4:7f:24:7a:b4:23") -- Right (mac 0xa47f247ab423) ----- >>> p2 = parserWith (MacCodec MacGroupingNoSeparator False)+-- >>> p2 = Mac.parserWith (Mac.MacCodec Mac.MacGroupingNoSeparator False) -- >>> AT.parseOnly p2 (Text.pack "a47f247ab423") -- Right (mac 0xa47f247ab423) parserWith :: MacCodec -> AT.Parser Mac@@ -260,7 +279,7 @@ -- | The default 'MacCodec': all characters are lowercase hex, separated by colons into pairs. ----- >>> T.putStrLn $ encodeWith defCodec (Mac 0xa47f247ab423)+-- >>> T.putStrLn $ Mac.encodeWith Mac.defCodec (Mac 0xa47f247ab423) -- a4:7f:24:7a:b4:23 defCodec :: MacCodec defCodec = MacCodec (MacGroupingPairs ':') False@@ -397,7 +416,7 @@ -- | Encode a 'Mac' address using the default 'MacCodec' 'defCodec'. ----- >>> BC.putStrLn (encodeUtf8 (mac 0x64255A0F2C47))+-- >>> BC.putStrLn (Mac.encodeUtf8 (Mac.mac 0x64255A0F2C47)) -- 64:25:5a:0f:2c:47 encodeUtf8 :: Mac -> ByteString encodeUtf8 = encodeWithUtf8 defCodec@@ -405,21 +424,21 @@ -- | Lenient decoding of MAC address that accepts lowercase, uppercase, -- and any kind of separator. ----- >>> decodeUtf8 "A2:DE:AD:BE:EF:67"+-- >>> Mac.decodeUtf8 "A2:DE:AD:BE:EF:67" -- Just (mac 0xa2deadbeef67)--- >>> decodeUtf8 "13-a2-fe-a4-17-96"+-- >>> Mac.decodeUtf8 "13-a2-fe-a4-17-96" -- Just (mac 0x13a2fea41796)--- >>> decodeUtf8 "0A42.47BA.67C2"+-- >>> Mac.decodeUtf8 "0A42.47BA.67C2" -- Just (mac 0x0a4247ba67c2) decodeUtf8 :: ByteString -> Maybe Mac decodeUtf8 = decodeLenientUtf8 -- | Decode a 'ByteString' as a 'Mac' address using the given 'MacCodec'. ----- >>> decodeWithUtf8 defCodec (BC.pack "64:25:5a:0f:2c:47")+-- >>> Mac.decodeWithUtf8 Mac.defCodec (BC.pack "64:25:5a:0f:2c:47") -- Just (mac 0x64255a0f2c47) ----- >>> decodeWithUtf8 (MacCodec MacGroupingNoSeparator False) (BC.pack "64255a0f2c47")+-- >>> Mac.decodeWithUtf8 (Mac.MacCodec Mac.MacGroupingNoSeparator False) (BC.pack "64255a0f2c47") -- Just (mac 0x64255a0f2c47) decodeWithUtf8 :: MacCodec -> ByteString -> Maybe Mac decodeWithUtf8 codec bs = rightToMaybe (AB.parseOnly (parserWithUtf8 codec <* AB.endOfInput) bs)@@ -436,7 +455,7 @@ -- | Encode a 'Mac' address as colon-separated hexadecimal octets, -- preferring lowercase for alphabetical characters. ----- >>> BBB.run Nat.constant $ boundedBuilderUtf8 $ mac 0xDEADBEEF1609+-- >>> BBB.run Nat.constant $ Mac.boundedBuilderUtf8 $ Mac.mac 0xDEADBEEF1609 -- [0x64, 0x65, 0x3a, 0x61, 0x64, 0x3a, 0x62, 0x65, 0x3a, 0x65, 0x66, 0x3a, 0x31, 0x36, 0x3a, 0x30, 0x39] boundedBuilderUtf8 :: Mac -> BBB.Builder 17 boundedBuilderUtf8 !w =@@ -468,9 +487,9 @@ -- is case insensitive and allows either @:@ or @-@ as the separator. -- It also allows leading zeroes to be missing. ----- >>> decodeUtf8Bytes (Bytes.fromAsciiString "A2:DE:AD:BE:EF:67")+-- >>> Mac.decodeUtf8Bytes (Ascii.fromString "A2:DE:AD:BE:EF:67") -- Just (mac 0xa2deadbeef67)--- >>> decodeUtf8Bytes (Bytes.fromAsciiString "13-a2-FE-A4-17-96")+-- >>> Mac.decodeUtf8Bytes (Ascii.fromString "13-a2-FE-A4-17-96") -- Just (mac 0x13a2fea41796) decodeUtf8Bytes :: Bytes.Bytes -> Maybe Mac decodeUtf8Bytes = Parser.parseBytesMaybe (parserUtf8Bytes ())@@ -479,7 +498,7 @@ -- is case insensitive and allows either @:@ or @-@ as the separator. -- It also allows leading zeroes to be missing. ----- >>> Parser.parseBytes (parserUtf8Bytes ()) (Bytes.fromAsciiString "de:ad:BE:EF:1:23")+-- >>> Parser.parseBytes (Mac.parserUtf8Bytes ()) (Ascii.fromString "de:ad:BE:EF:1:23") -- Success (Slice {offset = 16, length = 0, value = mac 0xdeadbeef0123}) parserUtf8Bytes :: e -> Parser.Parser e s Mac parserUtf8Bytes e = do@@ -626,10 +645,10 @@ -- | Encode a 'Mac' address as a 'ByteString' using the given 'MacCodec'. -- -- >>> m = Mac 0xA47F247AB423--- >>> BC.putStrLn $ encodeWithUtf8 defCodec m+-- >>> BC.putStrLn $ Mac.encodeWithUtf8 Mac.defCodec m -- a4:7f:24:7a:b4:23 ----- >>> BC.putStrLn $ encodeWithUtf8 (MacCodec (MacGroupingTriples '-') True) m+-- >>> BC.putStrLn $ Mac.encodeWithUtf8 (Mac.MacCodec (Mac.MacGroupingTriples '-') True) m -- A47-F24-7AB-423 encodeWithUtf8 :: MacCodec -> Mac -> ByteString encodeWithUtf8 (MacCodec g u) m = case g of@@ -708,14 +727,6 @@ word12AtUtf8 i (Mac w) = fromIntegral (unsafeShiftR w i) {-# INLINE word12AtUtf8 #-} --- | A 48-bit MAC address. Do not use the data constructor for this--- type. It is not considered part of the stable API, and it--- allows you to construct invalid MAC addresses.-newtype Mac = Mac Word64- deriving (Eq,Ord,Generic,Ix,Data)--instance NFData Mac- -- | This only preserves the lower 6 bytes of the 8-byte word that backs a mac address. -- It runs slower than it would if it used a full 8-byte word, but it consumes less -- space. When storing millions of mac addresses, this is a good trade to make. When@@ -726,32 +737,32 @@ sizeOf# _ = 6# alignment# _ = 2# indexByteArray# arr i0 = macFromWord16#- (indexWord16Array# arr i)- (indexWord16Array# arr (i +# 1#))- (indexWord16Array# arr (i +# 2#))+ (Compat.indexWord16Array# arr i)+ (Compat.indexWord16Array# arr (i +# 1#))+ (Compat.indexWord16Array# arr (i +# 2#)) where !i = 3# *# i0- readByteArray# arr i0 s0 = case readWord16Array# arr i s0 of- (# s1, a #) -> case readWord16Array# arr (i +# 1#) s1 of- (# s2, b #) -> case readWord16Array# arr (i +# 2#) s2 of+ readByteArray# arr i0 s0 = case Compat.readWord16Array# arr i s0 of+ (# s1, a #) -> case Compat.readWord16Array# arr (i +# 1#) s1 of+ (# s2, b #) -> case Compat.readWord16Array# arr (i +# 2#) s2 of (# s3, c #) -> (# s3, macFromWord16# a b c #) where !i = 3# *# i0- writeByteArray# arr i0 m s0 = case writeWord16Array# arr i (macToWord16A# m) s0 of- s1 -> case writeWord16Array# arr (i +# 1#) (macToWord16B# m) s1 of- s2 -> writeWord16Array# arr (i +# 2#) (macToWord16C# m) s2+ writeByteArray# arr i0 m s0 = case Compat.writeWord16Array# arr i (macToWord16A# m) s0 of+ s1 -> case Compat.writeWord16Array# arr (i +# 1#) (macToWord16B# m) s1 of+ s2 -> Compat.writeWord16Array# arr (i +# 2#) (macToWord16C# m) s2 where !i = 3# *# i0 indexOffAddr# arr i0 = macFromWord16#- (indexWord16OffAddr# arr i)- (indexWord16OffAddr# arr (i +# 1#))- (indexWord16OffAddr# arr (i +# 2#))+ (Compat.indexWord16OffAddr# arr i)+ (Compat.indexWord16OffAddr# arr (i +# 1#))+ (Compat.indexWord16OffAddr# arr (i +# 2#)) where !i = 3# *# i0- readOffAddr# arr i0 s0 = case readWord16OffAddr# arr i s0 of- (# s1, a #) -> case readWord16OffAddr# arr (i +# 1#) s1 of- (# s2, b #) -> case readWord16OffAddr# arr (i +# 2#) s2 of+ readOffAddr# arr i0 s0 = case Compat.readWord16OffAddr# arr i s0 of+ (# s1, a #) -> case Compat.readWord16OffAddr# arr (i +# 1#) s1 of+ (# s2, b #) -> case Compat.readWord16OffAddr# arr (i +# 2#) s2 of (# s3, c #) -> (# s3, macFromWord16# a b c #) where !i = 3# *# i0- writeOffAddr# arr i0 m s0 = case writeWord16OffAddr# arr i (macToWord16A# m) s0 of- s1 -> case writeWord16OffAddr# arr (i +# 1#) (macToWord16B# m) s1 of- s2 -> writeWord16OffAddr# arr (i +# 2#) (macToWord16C# m) s2+ writeOffAddr# arr i0 m s0 = case Compat.writeWord16OffAddr# arr i (macToWord16A# m) s0 of+ s1 -> case Compat.writeWord16OffAddr# arr (i +# 1#) (macToWord16B# m) s1 of+ s2 -> Compat.writeWord16OffAddr# arr (i +# 2#) (macToWord16C# m) s2 where !i = 3# *# i0 setByteArray# arr# i# len# ident = go 0# where@@ -767,22 +778,25 @@ else s0 macToWord16A# :: Mac -> Word#+{-# inline macToWord16A# #-} macToWord16A# (Mac w) = case word64ToWord16 (unsafeShiftR w 32) of- W16# x -> x+ Compat.W16# x -> x macToWord16B# :: Mac -> Word#+{-# inline macToWord16B# #-} macToWord16B# (Mac w) = case word64ToWord16 (unsafeShiftR w 16) of- W16# x -> x+ Compat.W16# x -> x macToWord16C# :: Mac -> Word#+{-# inline macToWord16C# #-} macToWord16C# (Mac w) = case word64ToWord16 w of- W16# x -> x+ Compat.W16# x -> x macFromWord16# :: Word# -> Word# -> Word# -> Mac macFromWord16# a b c = Mac- $ (unsafeShiftL (word16ToWord64 (W16# a)) 32)- .|. (unsafeShiftL (word16ToWord64 (W16# b)) 16)- .|. (word16ToWord64 (W16# c))+ $ (unsafeShiftL (word16ToWord64 (Compat.W16# a)) 32)+ .|. (unsafeShiftL (word16ToWord64 (Compat.W16# b)) 16)+ .|. (word16ToWord64 (Compat.W16# c)) word16ToWord64 :: Word16 -> Word64 word16ToWord64 = fromIntegral
− test/Doctests.hs
@@ -1,14 +0,0 @@-import Test.DocTest--main :: IO ()-main = doctest- [ "src/Net/IPv4.hs"- , "src/Net/IPv6.hs"- , "src/Net/IP.hs"- , "src/Data/Word/Synthetic/Word12.hs"- , "src/Data/Text/Builder/Common/Internal.hs"- , "src/Data/Text/Builder/Fixed.hs"- , "src/Data/ByteString/Builder/Fixed.hs"- , "src/Net/Mac.hs"- , "-XCPP"- ]
test/Test.hs view
@@ -21,7 +21,7 @@ import Net.Types (IP,IPv4(..),IPv4Range(..),Mac(..),IPv6(..),MacGrouping(..),MacCodec(..),IPv6Range(..)) import Data.WideWord (Word128(..))-import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Text.Ascii as Ascii import qualified Data.Text as Text import qualified Data.Text.Short as TS import qualified Data.ByteString.Char8 as BC8@@ -103,7 +103,7 @@ (Text.pack str) ) , PH.testCase "Bytes Parser Test Cases" $ testIPv6Parser $ \str ->- fmap HexIPv6 (IPv6.decodeUtf8Bytes (Bytes.fromAsciiString str))+ fmap HexIPv6 (IPv6.decodeUtf8Bytes (Ascii.fromString str)) , PH.testCase "Encode test cases" (testIPv6Encode IPv6.encode) , PH.testCase "Encode ShortText" (testIPv6Encode (TS.toText . IPv6.encodeShort)) , PH.testCase "Parser Failure Test Cases"@@ -361,7 +361,7 @@ expectIPv6BytesParserFailure s = Nothing @=?- IPv6.decodeUtf8Bytes (Bytes.fromAsciiString s)+ IPv6.decodeUtf8Bytes (Ascii.fromString s) testIPv6Encode :: (IPv6 -> Text.Text) -> Assertion testIPv6Encode enc = do@@ -521,4 +521,4 @@ arbitraryMacSeparator = elements [':','-','.','_'] byteStringToBytes :: BC8.ByteString -> Bytes-byteStringToBytes = Bytes.fromAsciiString . BC8.unpack+byteStringToBytes = Ascii.fromString . BC8.unpack