hw-ip 1.0.0.0 → 2.0.0.0

raw patch · 18 files changed

+1010/−306 lines, 18 filesdep +containersdep −attoparsecdep ~apparPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependencies removed: attoparsec

Dependency ranges changed: appar

API changes (from Hackage documentation)

Files

• hw-ip.cabal +34/−8
• src/HaskellWorks/Data/Network/Ip.hs +1/−9
• src/HaskellWorks/Data/Network/Ip/Internal.hs +31/−14
• src/HaskellWorks/Data/Network/Ip/Ip.hs +34/−34
• src/HaskellWorks/Data/Network/Ip/Ipv4.hs +151/−88
• src/HaskellWorks/Data/Network/Ip/Ipv6.hs +112/−57
• src/HaskellWorks/Data/Network/Ip/Range.hs +27/−0
• src/HaskellWorks/Data/Network/Ip/SafeEnum.hs +89/−0
• src/HaskellWorks/Data/Network/Ip/Type.hs +0/−14
• src/HaskellWorks/Data/Network/Ip/Validity.hs +5/−0
• src/HaskellWorks/Data/Network/Ip/Word128.hs +76/−0
• test/HaskellWorks/Data/Network/Gen.hs +31/−0
• test/HaskellWorks/Data/Network/IpBlockSpec.hs +25/−0
• test/HaskellWorks/Data/Network/IpSpec.hs +0/−82
• test/HaskellWorks/Data/Network/Ipv4Spec.hs +210/−0
• test/HaskellWorks/Data/Network/Ipv6Spec.hs +95/−0
• test/HaskellWorks/Data/Network/RangeSpec.hs +41/−0
• test/HaskellWorks/Data/Network/Word128Spec.hs +48/−0

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: hw-ip-version: 1.0.0.0+version: 2.0.0.0 license: BSD3 license-file: LICENSE copyright: 2018 John Ky, David Turnbull, Jian Wan@@ -25,19 +25,30 @@ library     exposed-modules:       HaskellWorks.Data.Network.Ip-      HaskellWorks.Data.Network.Ip.Ip-      HaskellWorks.Data.Network.Ip.Ipv6       HaskellWorks.Data.Network.Ip.Internal+      HaskellWorks.Data.Network.Ip.Ip       HaskellWorks.Data.Network.Ip.Ipv4-      HaskellWorks.Data.Network.Ip.Type+      HaskellWorks.Data.Network.Ip.Ipv6+      HaskellWorks.Data.Network.Ip.Range+      HaskellWorks.Data.Network.Ip.SafeEnum+      HaskellWorks.Data.Network.Ip.Validity+      HaskellWorks.Data.Network.Ip.Word128     hs-source-dirs: src     other-modules:         Paths_hw_ip     default-language: Haskell2010+    ghc-options:+      -Wall+      -Wcompat+      -Wincomplete-record-updates+      -Wincomplete-uni-patterns+      -Wredundant-constraints+      -O2+      -msse4.2     build-depends:         base            >= 4            && < 4.13       , appar           >= 0.1.7        && < 0.2-      , attoparsec      >= 0.13.2.2     && < 0.14+      , containers       , generic-lens    >= 0.5.1.0      && < 1.2       , hw-bits         >= 0.7.0.2      && < 0.8       , iproute         >= 1.7.3        && < 1.8@@ -48,13 +59,28 @@     main-is: Spec.hs     hs-source-dirs: test     other-modules:-        HaskellWorks.Data.Network.IpSpec+        HaskellWorks.Data.Network.Gen+        HaskellWorks.Data.Network.IpBlockSpec+        HaskellWorks.Data.Network.Ipv4Spec+        HaskellWorks.Data.Network.Ipv6Spec+        HaskellWorks.Data.Network.RangeSpec+        HaskellWorks.Data.Network.Word128Spec         Paths_hw_ip     default-language: Haskell2010-    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    ghc-options:+      -Wall+      -Wcompat+      -Wincomplete-record-updates+      -Wincomplete-uni-patterns+      -Wredundant-constraints+      -O2+      -msse4.2+      -threaded+      -rtsopts+      -with-rtsopts=-N     build-depends:         base              >= 4          && < 4.13-      , attoparsec+      , appar       , generic-lens       , hedgehog          >= 0.5.3      && < 0.7       , hspec             >= 2.4.4      && < 2.6

@@ -1,9 +1,1 @@-module HaskellWorks.Data.Network.Ip-  ( module X-  ) where--import HaskellWorks.Data.Network.Ip.Internal as X-import HaskellWorks.Data.Network.Ip.Ip       as X-import HaskellWorks.Data.Network.Ip.Ipv4     as X-import HaskellWorks.Data.Network.Ip.Ipv6     as X-import HaskellWorks.Data.Network.Ip.Type     as X+module HaskellWorks.Data.Network.Ip where

@@ -6,7 +6,7 @@ import Data.Word import HaskellWorks.Data.Bits.BitWise -import qualified Data.Attoparsec.Text as AP+import qualified Text.Appar.String as AP  fourOctetsToWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 fourOctetsToWord32 a b c d =@@ -23,11 +23,11 @@   where paste a b = a * 10 + b  octet :: AP.Parser Word8-octet = (ds 1 2 #<*>#  d 5  ) #<*># ds 0 5-  <|>   (ds 1 2 #<*># ds 0 4) #<*># ds 0 9-  <|>   ( d 1   #<*># ds 0 9) #<*># ds 0 9-  <|>    ds 1 9 #<*># ds 0 9-  <|>    ds 0 9+octet = AP.try ((digits 1 2 #<*>#  digit 5  ) #<*># digits 0 5)+  <|>   AP.try ((digits 1 2 #<*># digits 0 4) #<*># digits 0 9)+  <|>   AP.try (( digit 1   #<*># digits 0 9) #<*># digits 0 9)+  <|>   AP.try ( digits 1 9 #<*># digits 0 9)+  <|>            digits 0 9  whitespace :: AP.Parser () whitespace = void $ many (AP.satisfy isSpace)@@ -40,16 +40,16 @@   <*>  octet  ipv4NetMask :: AP.Parser Word8-ipv4NetMask =  d 3   #<*># ds 0 2-  <|>          d 2   #<*># ds 0 9-  <|>          d 1   #<*># ds 0 9-  <|>         ds 0 9+ipv4NetMask =  AP.try (digit 3   #<*># digits 0 2)+  <|>          AP.try (digit 2   #<*># digits 0 9)+  <|>          AP.try (digit 1   #<*># digits 0 9)+  <|>           digits 0 9 -d :: Int -> AP.Parser Word8-d c      = fromIntegral . (+ (-48)) . ord <$> AP.satisfy (== chr (c + 48))+digit :: Int -> AP.Parser Word8+digit c      = fromIntegral . (+ (-48)) . ord <$> AP.satisfy (== chr (c + 48)) -ds :: Int -> Int -> AP.Parser Word8-ds c1 c2 = fromIntegral . (+ (-48)) . ord <$> AP.satisfy (\c -> c >= chr (c1 + 48) && c <= chr (c2 + 48))+digits :: Int -> Int -> AP.Parser Word8+digits c1 c2 = fromIntegral . (+ (-48)) . ord <$> AP.satisfy (\c -> c >= chr (c1 + 48) && c <= chr (c2 + 48))  ipv4Block :: AP.Parser (Word32, Word8) ipv4Block = do@@ -60,3 +60,20 @@  word32x4ToWords :: (Word32, Word32, Word32, Word32) -> [Word32] word32x4ToWords (a, b, c, d) = [a, b, c, d]++bitPower :: Word8 -> Word64+bitPower m = fromIntegral (32 - m)++blockSize :: Word8 -> Int+blockSize m = 2 ^ bitPower m++bitPower128 :: Word8 -> Integer+bitPower128 m = fromIntegral (128 - m)++blockSize128 :: Word8 -> Integer+blockSize128 m = 2 ^ bitPower128 m++readsPrecOnParser :: AP.Parser a -> Int -> String -> [(a, String)]+readsPrecOnParser p _ s = case AP.runParser (whitespace *> p) s of+    (Just a, r) -> [(a, r)]+    _           -> []

@@ -1,62 +1,62 @@-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DuplicateRecordFields      #-}-{-# LANGUAGE InstanceSigs               #-}-{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE OverloadedStrings     #-}  module HaskellWorks.Data.Network.Ip.Ip   ( IpBlock(..)-  , isValidIpBlock-  , firstAddress-  , lastAddress+  , isCanonical+  , canonicalise+  , firstIpAddress+  , lastIpAddress   ) where -import Control.Applicative import Control.Monad-import Data.Char-import Data.Maybe import Data.Word import GHC.Generics import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Network.Ip.Validity import Text.Read -import qualified Data.Attoparsec.Text                  as AP-import qualified Data.Bits                             as B-import qualified Data.Text                             as T-import qualified HaskellWorks.Data.Network.Ip.Internal as I-import qualified HaskellWorks.Data.Network.Ip.Ipv4     as I4-import qualified HaskellWorks.Data.Network.Ip.Ipv6     as I6-import qualified Text.ParserCombinators.ReadPrec       as RP+import qualified HaskellWorks.Data.Network.Ip.Ipv4 as V4+import qualified HaskellWorks.Data.Network.Ip.Ipv6 as V6 -data IpBlock = IpBlockV4 I4.Ipv4Block | IpBlockV6 I6.Ipv6Block+data IpBlock v = IpBlockV4 (V4.IpBlock v) | IpBlockV6 (V6.IpBlock v)   deriving (Eq, Ord, Generic) -instance Show IpBlock where+instance Show (IpBlock v) where   showsPrec _ (IpBlockV4 a) = shows a   showsPrec _ (IpBlockV6 a) = shows a -instance Read IpBlock where+instance Read (IpBlock Unaligned) where   readsPrec _ s =-    case readMaybe s :: Maybe I4.Ipv4Block of-      Just ipv4 -> [(IpBlockV4 ipv4, "")]+    case readMaybe s :: Maybe (V4.IpBlock Unaligned) of+      Just ip -> [(IpBlockV4 ip, "")]        Nothing ->-        case readMaybe s :: Maybe I6.Ipv6Block of+        case readMaybe s :: Maybe (V6.IpBlock Unaligned) of           Just ipv6 -> [(IpBlockV6 ipv6, "")]           Nothing   -> [] -isValidIpBlock :: IpBlock -> Bool-isValidIpBlock (IpBlockV4 b) = I4.isValidIpv4Block b-isValidIpBlock (IpBlockV6 b) = I6.isValidIpv6Block b+isCanonical :: IpBlock v -> Bool+isCanonical (IpBlockV4 b) = V4.isCanonical b+isCanonical (IpBlockV6 b) = V6.isCanonical b -firstAddress :: IpBlock -> (Word32, Word32, Word32, Word32)-firstAddress (IpBlockV4 i4b)                 = firstAddress (IpBlockV6 (I6.ipv4BlockToMappedIpv6Block i4b))-firstAddress (IpBlockV6 (I6.Ipv6Block ip _)) = I6.words ip+canonicalise :: IpBlock Unaligned -> Maybe (IpBlock Canonical)+canonicalise (IpBlockV4 (V4.IpBlock a m)) = mfilter isCanonical (Just $ IpBlockV4 (V4.IpBlock a m))+canonicalise (IpBlockV6 (V6.IpBlock a m)) = mfilter isCanonical (Just $ IpBlockV6 (V6.IpBlock a m)) -lastAddress :: IpBlock -> (Word32, Word32, Word32, Word32)-lastAddress (IpBlockV4 ib) = (0, 0, 0xFFFF, I4.word (I4.lastIpv4Address ib))-lastAddress (IpBlockV6 (I6.Ipv6Block ip (I6.Ipv6NetMask msk))) =-    let (w1, w2, w3, w4) = I6.words ip-        lt = I6.masksIpv6 $ fromIntegral msk+firstIpAddress :: IpBlock Canonical -> (Word32, Word32, Word32, Word32)+firstIpAddress (IpBlockV4 v4Block)                          = firstIpAddress (IpBlockV6 (V6.fromV4 v4Block))+-- firstIpAddress (IpBlockV6 (V6.IpBlock ip _)) = V6.words ip+firstIpAddress (IpBlockV6 (V6.IpBlock (V6.IpAddress ip) _)) = ip++lastIpAddress :: IpBlock Canonical -> (Word32, Word32, Word32, Word32)+lastIpAddress (IpBlockV4 ib) = (0, 0, 0xFFFF, V4.word (V4.lastIpAddress ib))+lastIpAddress (IpBlockV6 (V6.IpBlock (V6.IpAddress ip) (V6.IpNetMask msk))) =+    let (w1, w2, w3, w4) = ip+        lt = V6.masksIp $ fromIntegral msk         w1' = w1 .|. (lt !! 0)         w2' = w2 .|. (lt !! 1)         w3' = w3 .|. (lt !! 2)

@@ -1,140 +1,203 @@ {-# LANGUAGE BangPatterns               #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE DuplicateRecordFields      #-}+{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs               #-}  module HaskellWorks.Data.Network.Ip.Ipv4-  ( Ipv4Address(..)-  , Ipv4NetMask(..)-  , Ipv4Block(..)-  , isValidIpv4Block+  ( IpAddress(..)+  , IpNetMask(..)+  , IpBlock(..)   , bitPower-  , blockSize   , isCanonical   , splitBlock-  , textToMaybeIpv4Address-  , parseIpv4Address-  , ipv4AddressToString-  , ipv4AddressToText-  , ipv4AddressToWords-  , firstIpv4Address-  , lastIpv4Address+  , parseIpAddress+  , showIpAddress+  , showsIpAddress+  , tshowIpAddress+  , tshowIpBlock+  , ipAddressToWords+  , firstIpAddress+  , lastIpAddress+  , canonicaliseIpBlock+  , collapseIpBlocks+  , splitIpRange+  , rangeToBlocksDL+  , rangeToBlocks+  , blockToRange   ) where -import Control.Applicative-import Control.Monad-import Data.Char-import Data.Maybe+import Data.Bifunctor+import Data.Foldable+import Data.Semigroup                        ((<>)) import Data.Word import GHC.Generics import HaskellWorks.Data.Bits.BitWise-import Text.Read+import HaskellWorks.Data.Network.Ip.Range+import HaskellWorks.Data.Network.Ip.Validity -import qualified Data.Attoparsec.Text                  as AP import qualified Data.Bits                             as B+import qualified Data.Sequence                         as S import qualified Data.Text                             as T import qualified HaskellWorks.Data.Network.Ip.Internal as I-import qualified Text.ParserCombinators.ReadPrec       as RP+import qualified Text.Appar.String                     as AP -newtype Ipv4Address = Ipv4Address+newtype IpAddress = IpAddress   { word :: Word32-  } deriving (Enum, Eq, Ord, Generic)+  } deriving (Enum, Bounded, Eq, Ord, Generic) -instance Show Ipv4Address where-  showsPrec _ (Ipv4Address w) =-    shows ((w .>. 24) .&. 0xff) . ('.':) .-    shows ((w .>. 16) .&. 0xff) . ('.':) .-    shows ((w .>.  8) .&. 0xff) . ('.':) .-    shows ( w         .&. 0xff)+instance Show IpAddress where+  showsPrec _ = showsIpAddress -instance Read Ipv4Address where-  readsPrec :: Int -> String -> [(Ipv4Address, String)]-  readsPrec _ s = case AP.parseWith (return mempty) (I.whitespace *> I.ipv4Address) (T.pack s) of-    Just result -> case result of-      AP.Done i r   -> [(Ipv4Address r, T.unpack i)]-      AP.Partial _  -> []-      AP.Fail a b c -> []-    Nothing -> []+instance Read IpAddress where+  readsPrec :: Int -> String -> [(IpAddress, String)]+  readsPrec = I.readsPrecOnParser (IpAddress <$> I.ipv4Address) -newtype Ipv4NetMask = Ipv4NetMask+newtype IpNetMask = IpNetMask   { word8 :: Word8-  } deriving (Enum, Eq, Ord, Show, Generic)+  } deriving (Enum, Bounded, Eq, Ord, Show, Generic) -data Ipv4Block = Ipv4Block-  { base :: !Ipv4Address-  , mask :: !Ipv4NetMask-  } deriving (Eq, Ord)+-- | An IP block.  The type parameter determines whether or not the value of the type is+-- canonical.+data IpBlock v = IpBlock+  { base :: !IpAddress+  , mask :: !IpNetMask+  } deriving (Eq, Ord, Generic) -instance Show Ipv4Block where-  showsPrec _ (Ipv4Block b (Ipv4NetMask m)) = shows b . ('/':) . shows m+instance Show (IpBlock v) where+  showsPrec _ = showsIpBlock -instance Read Ipv4Block where-  readsPrec :: Int -> String -> [(Ipv4Block, String)]-  readsPrec _ s = case AP.parseWith (return mempty) (I.whitespace *> I.ipv4Block) (T.pack s) of-    Just result -> case result of-      AP.Done i (a, m) ->-        case validIpv4Block $ Ipv4Block (Ipv4Address a) (Ipv4NetMask m) of-          Just b  -> [(b, T.unpack i)]-          Nothing -> []-      AP.Partial _    -> []-      AP.Fail a b c   -> []-    Nothing -> []+instance Read (IpBlock Unaligned) where+  readsPrec = I.readsPrecOnParser parseUnalignedIpBlock --- shift the address left by the amount of mask bits to reveal only host bits--- if any bits left are non-zero, then the mask is not big enough-validIpv4Block :: Ipv4Block -> Maybe Ipv4Block-validIpv4Block b@(Ipv4Block (Ipv4Address word) (Ipv4NetMask mask)) =-  if word `B.shiftL` fromIntegral mask `B.xor` 0 == 0-    then pure b-    else Nothing+instance Read (IpBlock Canonical) where+  readsPrec = I.readsPrecOnParser parseCanonicalIpBlock -isValidIpv4Block :: Ipv4Block -> Bool-isValidIpv4Block = isJust . validIpv4Block+-- | Canonicalise the block by zero-ing out the host bits+canonicaliseIpBlock :: IpBlock v -> IpBlock Canonical+canonicaliseIpBlock (IpBlock (IpAddress w) (IpNetMask m)) = IpBlock (IpAddress newWord) (IpNetMask m)+  where bp = fromIntegral (32 - m)+        newWord = (w .>. bp) .<. bp -firstIpv4Address :: Ipv4Block -> Ipv4Address-firstIpv4Address (Ipv4Block base _) = base+firstIpAddress :: IpBlock v -> IpAddress+firstIpAddress (IpBlock b _) = b -lastIpv4Address :: Ipv4Block -> Ipv4Address-lastIpv4Address b@(Ipv4Block (Ipv4Address base) _) = Ipv4Address (base + fromIntegral (blockSize b) - 1)+lastIpAddress :: IpBlock v -> IpAddress+lastIpAddress (IpBlock (IpAddress b) (IpNetMask m)) = IpAddress (b + fromIntegral (I.blockSize m) - 1) -bitPower :: Ipv4NetMask -> Word64-bitPower (Ipv4NetMask m) = fromIntegral (32 - m)+bitPower :: IpNetMask -> Word64+bitPower (IpNetMask m) = fromIntegral (32 - m) -isCanonical :: Ipv4Block -> Bool-isCanonical (Ipv4Block (Ipv4Address b) m) = ((b .>. bitPower m) .<. bitPower m) == b+-- | A valid block must have all host-bits set to zero after the mask is applied+isCanonical :: IpBlock v -> Bool+isCanonical (IpBlock (IpAddress b) (IpNetMask m)) = ((b .>. I.bitPower m) .<. I.bitPower m) == b -splitBlock :: Ipv4Block -> Maybe (Ipv4Block, Ipv4Block)-splitBlock (Ipv4Block (Ipv4Address b) (Ipv4NetMask m)) =+splitBlock :: IpBlock Canonical -> Maybe (IpBlock Canonical, IpBlock Canonical)+splitBlock (IpBlock (IpAddress b) (IpNetMask m)) =   if m >= 0 && m < 32     then  let !hm       = m + 1-              !halfMask = Ipv4NetMask hm+              !halfMask = IpNetMask hm               !c        = fromIntegral ((0x100000000 :: Word64) .>. fromIntegral (m + 1))           in  Just-              ( Ipv4Block (Ipv4Address  b     ) halfMask-              , Ipv4Block (Ipv4Address (b + c)) halfMask+              ( IpBlock (IpAddress  b     ) halfMask+              , IpBlock (IpAddress (b + c)) halfMask               )     else  Nothing -blockSize :: Ipv4Block -> Int-blockSize (Ipv4Block _ m) = 2 ^ bitPower m+showsIpAddress :: IpAddress -> String -> String+showsIpAddress (IpAddress w) =+  shows ((w .>. 24) .&. 0xff) . ('.':) .+  shows ((w .>. 16) .&. 0xff) . ('.':) .+  shows ((w .>.  8) .&. 0xff) . ('.':) .+  shows ( w         .&. 0xff) -textToMaybeIpv4Address :: T.Text -> Maybe Ipv4Address-textToMaybeIpv4Address t = AP.maybeResult =<< AP.parseWith (return mempty) parseIpv4Address t+showIpAddress :: IpAddress -> String+showIpAddress ipAddress = showsIpAddress ipAddress "" -ipv4AddressToString :: Ipv4Address -> String-ipv4AddressToString = show+tshowIpAddress :: IpAddress -> T.Text+tshowIpAddress = T.pack . showIpAddress -ipv4AddressToText :: Ipv4Address -> T.Text-ipv4AddressToText = T.pack . ipv4AddressToString+showsIpBlock :: IpBlock v -> String -> String+showsIpBlock (IpBlock b (IpNetMask m)) = shows b . ('/':) . shows m -ipv4AddressToWords :: Ipv4Address -> (Word8, Word8, Word8, Word8)-ipv4AddressToWords (Ipv4Address w) =+showIpBlock :: IpBlock v -> String+showIpBlock ipBlock = showsIpBlock ipBlock ""++tshowIpBlock :: IpBlock v -> T.Text+tshowIpBlock = T.pack . showIpBlock++ipAddressToWords :: IpAddress -> (Word8, Word8, Word8, Word8)+ipAddressToWords (IpAddress w) =   ( fromIntegral (w .>. 24) .&. 0xff   , fromIntegral (w .>. 16) .&. 0xff   , fromIntegral (w .>.  8) .&. 0xff   , fromIntegral (w         .&. 0xff)   ) -parseIpv4Address :: AP.Parser Ipv4Address-parseIpv4Address = Ipv4Address <$> I.ipv4Address+parseIpAddress :: AP.Parser IpAddress+parseIpAddress = IpAddress <$> I.ipv4Address++parseUnalignedIpBlock :: AP.Parser (IpBlock Unaligned)+parseUnalignedIpBlock = do+  (a, m) <- I.ipv4Block+  return (IpBlock (IpAddress a) (IpNetMask m))++parseCanonicalIpBlock :: AP.Parser (IpBlock Canonical)+parseCanonicalIpBlock = do+  b <- parseUnalignedIpBlock+  if isCanonical b+    then let IpBlock ip m = b in return (IpBlock ip m)+    else fail $ showIpBlock b <> " is not a canonical block"++splitIpRange :: Range IpAddress -> (IpBlock Canonical, Maybe (Range IpAddress))+splitIpRange (Range (IpAddress a) (IpAddress z)) = (block, remainder)+  where bpOuter   = width - B.countLeadingZeros (z + 1 - a) - 1+        bpInner   = B.countTrailingZeros ((maxBound .<. fromIntegral bpOuter) .|. a)+        block     = IpBlock (IpAddress a) (IpNetMask (fromIntegral (width - bpInner)))+        hostMask  = comp (maxBound .<. fromIntegral bpInner)+        remainder = if a + hostMask >= z+          then Nothing+          else Just (Range (IpAddress (a + hostMask + 1)) (IpAddress z))+        width = B.finiteBitSize a++-- assume distinct & sorted input+collapseIpBlocks :: [IpBlock Canonical] -> [IpBlock Canonical]+collapseIpBlocks tomerge =+  skipOverlapped $ concat $ toList <$> go S.empty tomerge+  where+    go :: S.Seq (IpBlock Canonical) -> [IpBlock Canonical] -> [S.Seq (IpBlock Canonical)]+    go m [] = [m]+    go m (b:bs) =+      case S.viewr m of+        S.EmptyR -> go (m S.|> b) bs+        m' S.:> bp -> do+          let sp@(IpBlock _ (IpNetMask msk)) = superBlock bp+          let sp'@(IpBlock _ (IpNetMask msk')) = superBlock b+          if sp == sp' then go m' (sp : bs)+          else if msk > msk' then+                 m : go (S.empty S.|> b) bs+               else+                 go (m S.|> b) bs+    superBlock (IpBlock (IpAddress w32) (IpNetMask m)) =+      IpBlock (IpAddress (w32 B..&. (0xFFFFFFFF `B.shiftL` fromIntegral (32 - (m - 1))))) (IpNetMask (m - 1))+    skipOverlapped [] = []+    skipOverlapped [b] = [b]+    skipOverlapped (b1:b2:bs) =+      if lastIpAddress b1 >= lastIpAddress b2 then+        skipOverlapped (b1:bs)+      else+        b1 : skipOverlapped (b2:bs)++rangeToBlocksDL :: Range IpAddress -> [IpBlock Canonical] -> [IpBlock Canonical]+rangeToBlocksDL r = do+  let (b, remainder) = splitIpRange r+  case remainder of+    Just rmd -> (b:) . rangeToBlocksDL rmd+    Nothing  -> (b:)++rangeToBlocks :: Range IpAddress -> [IpBlock Canonical]+rangeToBlocks r = rangeToBlocksDL r []++blockToRange :: IpBlock Canonical -> Range IpAddress+blockToRange b = uncurry Range $ bimap firstIpAddress lastIpAddress (b, b)

@@ -1,106 +1,131 @@ {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE DuplicateRecordFields      #-}+{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs               #-} {-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE TypeApplications           #-}  module HaskellWorks.Data.Network.Ip.Ipv6-  ( Ipv6Address(..)-  , Ipv6NetMask(..)-  , Ipv6Block(..)-  , ipv4BlockToMappedIpv6Block-  , parseIpv6Block-  , masksIpv6-  , isValidIpv6Block+  ( IpAddress(..)+  , IpNetMask(..)+  , IpBlock(..)+  , fromV4+  , parseIpBlock+  , masksIp+  , showIpAddress+  , showsIpAddress+  , tshowIpAddress+  , tshowIpBlock+  , firstIpAddress+  , lastIpAddress+  , rangeToBlocks+  , rangeToBlocksDL+  , blockToRange+  , isCanonical+  , splitIpRange   ) where  import Control.Applicative import Control.Monad-import Data.Bits-import Data.Char-import Data.Generics.Product.Any+import Data.Bifunctor import Data.Maybe import Data.Word import GHC.Generics-import Prelude                   hiding (words)+import HaskellWorks.Data.Network.Ip.Range+import HaskellWorks.Data.Network.Ip.SafeEnum+import HaskellWorks.Data.Network.Ip.Validity+import Prelude                               hiding (words) import Text.Read -import qualified Data.Attoparsec.Text                  as AP import qualified Data.Bits                             as B import qualified Data.IP                               as D-import qualified Data.String                           as S import qualified Data.Text                             as T import qualified HaskellWorks.Data.Network.Ip.Internal as I-import qualified HaskellWorks.Data.Network.Ip.Ipv4     as I4-import qualified Text.ParserCombinators.ReadPrec       as RP+import qualified HaskellWorks.Data.Network.Ip.Ipv4     as V4+import qualified HaskellWorks.Data.Network.Ip.Word128  as W -newtype Ipv6Address = Ipv6Address-  { words :: (Word32, Word32, Word32, Word32)-  } deriving (Eq, Ord, Generic)+newtype IpAddress = IpAddress W.Word128 deriving (Eq, Ord, Generic, SafeEnum) -instance Show Ipv6Address where-  showsPrec _ (Ipv6Address w) = shows (D.fromHostAddress6 w)+instance Show IpAddress where+  showsPrec _ (IpAddress w) = shows (D.fromHostAddress6 w) -instance Read Ipv6Address where-  readsPrec :: Int -> String -> [(Ipv6Address, String)]+instance Read IpAddress where+  readsPrec :: Int -> String -> [(IpAddress, String)]   readsPrec _ s =     case readMaybe s :: Maybe D.IPv6 of-      Just ip -> [(Ipv6Address (D.toHostAddress6 ip), "")]+      Just ip -> [(IpAddress (D.toHostAddress6 ip), "")]       Nothing -> [] -newtype Ipv6NetMask = Ipv6NetMask+newtype IpNetMask = IpNetMask   { word :: Word8   } deriving (Enum, Eq, Ord, Show, Generic) -instance Read Ipv6NetMask where+instance Read IpNetMask where   readsPrec _ s =-    case Ipv6NetMask <$> m of+    case IpNetMask <$> m of       Just maskv6 -> [(maskv6, "")]       Nothing     -> []     where       m = mfilter (\a -> a >= 0 && a <= 128) (readMaybe s) -data Ipv6Block = Ipv6Block-  { base :: !Ipv6Address-  , mask :: !Ipv6NetMask+data IpBlock v = IpBlock+  { base :: !IpAddress+  , mask :: !IpNetMask   } deriving (Eq, Ord, Generic) -instance Read Ipv6Block where+instance Read (IpBlock Unaligned) where   readsPrec _ s =     case T.unpack <$> T.split (== '/') (T.pack s) of-      [addr, mask] ->-        case readMaybe addr :: Maybe Ipv6Address of+      [addr, msk] ->+        case readMaybe addr :: Maybe IpAddress of           Just ipv6 ->-            case readMaybe mask of-              Just maskv6 ->-                let i6b = Ipv6Block ipv6 maskv6 in-                  [(i6b, "") | isValidIpv6Block i6b]+            case readMaybe msk of+              Just mskv6 ->+                let i6b = IpBlock ipv6 mskv6 in+                  [(i6b, "") | isCanonical i6b]               Nothing     -> []           Nothing -> []       _ -> [] -instance Show Ipv6Block where-  showsPrec _ (Ipv6Block b (Ipv6NetMask m))  = shows b . ('/':) . shows m+instance Show (IpBlock v) where+  showsPrec _ (IpBlock b (IpNetMask m))  = shows b . ('/':) . shows m -parseIpv6Block :: T.Text -> Either T.Text Ipv6Block-parseIpv6Block t =+parseIpBlock :: T.Text -> Either T.Text (IpBlock Unaligned)+parseIpBlock t =   case T.unpack <$> T.split (== '/') t of-    [addr, mask] ->-      case readMaybe addr :: Maybe Ipv6Address of+    [addr, msk] ->+      case readMaybe addr :: Maybe IpAddress of         Just ipv6 ->-          case readMaybe mask of-            Just maskv6 -> Right $ Ipv6Block ipv6 maskv6-            Nothing     -> Left "cannot read mask"+          case readMaybe msk of+            Just mskv6 -> Right $ IpBlock ipv6 mskv6+            Nothing    -> Left "cannot read mask"         Nothing -> Left "cannot read addr"     _ -> Left "invalid input string" -masksIpv6 :: Word8 -> [Word32]-masksIpv6 m =+showsIpAddress :: IpAddress -> String -> String+showsIpAddress (IpAddress w) = shows (D.fromHostAddress6 w)++showIpAddress :: IpAddress -> String+showIpAddress ipAddress = showsIpAddress ipAddress ""++tshowIpAddress :: IpAddress -> T.Text+tshowIpAddress = T.pack . showIpAddress++showsIpBlock :: IpBlock v -> String -> String+showsIpBlock (IpBlock b (IpNetMask m)) = shows b . ('/':) . shows m++showIpBlock :: IpBlock v -> String+showIpBlock ipBlock = showsIpBlock ipBlock ""++tshowIpBlock :: IpBlock v -> T.Text+tshowIpBlock = T.pack . showIpBlock++masksIp :: Word8 -> [Word32]+masksIp m =   let e = 0xFFFFFFFF :: Word32       -- bits: number of bits which should be 1-      maskValue bits = e `shiftR` (32 - bits) in+      maskValue bits = e `B.shiftR` (32 - bits) in     if m < 32 then       [maskValue (32 - fromIntegral m), e, e, e]     else if m < 64 then@@ -112,13 +137,43 @@     else       [0, 0, 0, 0] -isValidIpv6Block :: Ipv6Block -> Bool-isValidIpv6Block (Ipv6Block b (Ipv6NetMask m)) =-  let lt = masksIpv6 m-      ipv6 = I.word32x4ToWords (words b) in-    ipv6 == zipWith (.&.) ipv6 (zipWith xor ipv6 lt)+isCanonical :: IpBlock v -> Bool+isCanonical (IpBlock (IpAddress w) (IpNetMask m)) =+  let lt = masksIp m+      ipv6 = I.word32x4ToWords w in+    ipv6 == zipWith (B..&.) ipv6 (zipWith B.xor ipv6 lt) -ipv4BlockToMappedIpv6Block :: I4.Ipv4Block -> Ipv6Block-ipv4BlockToMappedIpv6Block (I4.Ipv4Block b m) =+fromV4 :: V4.IpBlock Canonical -> IpBlock v+fromV4 (V4.IpBlock b m) =   -- RFC-4291, "IPv4-Mapped IPv6 Address"-  Ipv6Block (Ipv6Address (0, 0, 0xFFFF, I4.word b)) (Ipv6NetMask (96 + I4.word8 m))+  IpBlock (IpAddress (0, 0, 0xFFFF, V4.word b)) (IpNetMask (96 + V4.word8 m))++firstIpAddress :: IpBlock Canonical -> IpAddress+firstIpAddress (IpBlock b _) = b++lastIpAddress :: IpBlock Canonical -> IpAddress+lastIpAddress (IpBlock (IpAddress b) (IpNetMask m)) = IpAddress (b + fromIntegral (I.blockSize128 m) - 1)++splitIpRange :: Range IpAddress -> (IpBlock Canonical, Maybe (Range IpAddress))+splitIpRange (Range (IpAddress a) (IpAddress z)) = (block, remainder)+  where bpOuter   = width - B.countLeadingZeros (z + 1 - a) - 1+        bpInner   = B.countTrailingZeros ((maxBound `B.shiftL` fromIntegral bpOuter) B..|. a)+        block     = IpBlock (IpAddress a) (IpNetMask (fromIntegral (width - bpInner)))+        hostMask  = B.complement (maxBound `B.shiftL` fromIntegral bpInner)+        remainder = if a + hostMask >= z+          then Nothing+          else Just (Range (IpAddress (a + hostMask + 1)) (IpAddress z))+        width = B.finiteBitSize a++rangeToBlocksDL :: Range IpAddress -> [IpBlock Canonical] -> [IpBlock Canonical]+rangeToBlocksDL r = do+  let (b, remainder) = splitIpRange r+  case remainder of+    Just rmd -> (b:) . rangeToBlocksDL rmd+    Nothing  -> (b:)++rangeToBlocks :: Range IpAddress -> [IpBlock Canonical]+rangeToBlocks r = rangeToBlocksDL r []++blockToRange :: IpBlock Canonical -> Range IpAddress+blockToRange b = uncurry Range $ bimap firstIpAddress lastIpAddress (b, b)

@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE MonoLocalBinds    #-}+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Network.Ip.Range where++import GHC.Generics+import HaskellWorks.Data.Network.Ip.SafeEnum++import qualified Text.Appar.String as AP++data Range a = Range+  { first :: a+  , last  :: a+  } deriving (Eq, Ord, Show, Generic)++parseRange :: AP.Parser a -> AP.Parser (Range a)+parseRange pa = Range <$> pa <* AP.string " - " <*> pa++-- | Merge adjacent ranges if they overlap or are adjacent+mergeRanges :: (SafeEnum a, Ord a) => [Range a] -> [Range a]+mergeRanges (r1@(Range f1 l1):r2@(Range f2 l2):rs)+  | boundedSucc l1 >= f2  = mergeRanges (nr:rs)+  | otherwise = r1 : mergeRanges (r2:rs)+  where nr = Range f1 (max l1 l2)+mergeRanges [r] = [r]+mergeRanges [] = []

@@ -0,0 +1,89 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeSynonymInstances #-}++module HaskellWorks.Data.Network.Ip.SafeEnum+  ( SafeEnum(..)+  , boundedPred+  , boundedSucc+  ) where++import Data.Int+import Data.Maybe+import Data.Word+import HaskellWorks.Data.Network.Ip.Word128++class SafeEnum a where+  safePred :: a -> Maybe a+  safeSucc :: a -> Maybe a++instance SafeEnum Word where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Word8 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Word16 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Word32 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Word64 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Word128 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Int where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Int8 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Int16 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Int32 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Int64 where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Char where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Bool where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum () where+  safePred = defaultSafePred+  safeSucc = defaultSafeSucc++instance SafeEnum Integer where+  safePred = Just . pred+  safeSucc = Just . succ++boundedPred :: SafeEnum a => a -> a+boundedPred a = fromMaybe a (safePred a)++boundedSucc :: SafeEnum a => a -> a+boundedSucc a = fromMaybe a (safeSucc a)++defaultSafePred :: (Bounded a, Enum a, Eq a) => a -> Maybe a+defaultSafePred v = if v /= minBound then Just (pred v) else Nothing++defaultSafeSucc :: (Bounded a, Enum a, Eq a) => a -> Maybe a+defaultSafeSucc v = if v /= maxBound then Just (succ v) else Nothing

@@ -1,14 +0,0 @@-{-# LANGUAGE DuplicateRecordFields      #-}-{-# LANGUAGE InstanceSigs               #-}--module HaskellWorks.Data.Network.Ip.Type-  ( I4.Ipv4Address(..)-  , I4.Ipv4NetMask(..)-  , I4.Ipv4Block(..)-  , I6.Ipv6Address(..)-  , I6.Ipv6NetMask(..)-  , I6.Ipv6Block(..)-  ) where--import qualified HaskellWorks.Data.Network.Ip.Ipv4 as I4-import qualified HaskellWorks.Data.Network.Ip.Ipv6 as I6

@@ -0,0 +1,5 @@+module HaskellWorks.Data.Network.Ip.Validity where++data Canonical = Canonical++data Unaligned = Unaligned

@@ -0,0 +1,76 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE TypeSynonymInstances  #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module HaskellWorks.Data.Network.Ip.Word128 where++import Data.Maybe+import Data.Word+import Prelude    hiding (words)++import qualified Data.Bits as B++type Word128 = (Word32, Word32, Word32, Word32)++instance Enum Word128 where+  fromEnum  = fromIntegral . word128ToInteger+  toEnum i  = integerToWord128 $ fromIntegral i+  succ (0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff) = (0, 0, 0, 0)+  succ (a,          0xffffffff, 0xffffffff, 0xffffffff) = (succ a, 0, 0, 0)+  succ (a,                   b, 0xffffffff, 0xffffffff) = (a, succ b, 0, 0)+  succ (a,                   b,          c, 0xffffffff) = (a, b, succ c, 0)+  succ (a,                   b,          c,          d) = (a, b, c, succ d)+  pred (0, 0, 0, 0) = (0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff)+  pred (a, 0, 0, 0) = (    pred a, 0xffffffff, 0xffffffff, 0xffffffff)+  pred (a, b, 0, 0) = (         a,     pred b, 0xffffffff, 0xffffffff)+  pred (a, b, c, 0) = (         a,          b,     pred c, 0xffffffff)+  pred (a, b, c, d) = (         a,          b,          c,     pred d)++integerToWord128 :: Integer -> Word128+integerToWord128 i = let a  = fromIntegral (i `B.shiftR` 96 B..&. 0xffffffff)+                         b  = fromIntegral (i `B.shiftR` 64 B..&. 0xffffffff)+                         c  = fromIntegral (i `B.shiftR` 32 B..&. 0xffffffff)+                         d  = fromIntegral (i `B.shiftR` 00 B..&. 0xffffffff)+                     in (a, b, c, d)++word128ToInteger :: Word128 -> Integer+word128ToInteger (a, b, c, d) = let a' = fromIntegral a `B.shift` 96+                                    b' = fromIntegral b `B.shift` 64+                                    c' = fromIntegral c `B.shift` 32+                                    d' = fromIntegral d `B.shift` 0+                                in a' B..|. b' B..|. c' B..|. d' :: Integer++instance Num Word128 where+  (+) l r     = integerToWord128 $ (word128ToInteger l) + (word128ToInteger r)+  (-) l r     = integerToWord128 $ (word128ToInteger l) - (word128ToInteger r)+  (*) l r     = integerToWord128 $ (word128ToInteger l) * (word128ToInteger r)+  abs a       = a+  signum (0, 0, 0, 0) = minBound+  signum _            = 1+  fromInteger = integerToWord128++instance B.Bits Word128 where+  (.&.) (a, b, c, d) (e, f, g, h) = (a B..&. e, b B..&. f, c B..&. g, d B..&. h)+  (.|.) (a, b, c, d) (e, f, g, h) = (a B..|. e, b B..|. f, c B..|. g, d B..|. h)+  xor (a, b, c, d) (e, f, g, h)   = (a `B.xor` e, b `B.xor` f, c `B.xor` g, d `B.xor` h)+  complement (a, b, c, d)         = (B.complement a, B.complement b, B.complement c, B.complement d)+  shift w n                       = integerToWord128 $ word128ToInteger w `B.shift` n+  shiftL w n+    | n < 0 = minBound  -- This is the special case to make it behaviour as the same as Word32+    | otherwise = integerToWord128 $ word128ToInteger w `B.shiftL` n+  shiftR w n                      = integerToWord128 $ word128ToInteger w `B.shiftR` n+  rotate w n                      = integerToWord128 $ word128ToInteger w `B.rotate` n+  rotateL w n                     = integerToWord128 $ word128ToInteger w `B.rotateL` n+  rotateR w n                     = integerToWord128 $ word128ToInteger w `B.rotateR` n+  bitSize _                       = 128+  bitSizeMaybe _                  = Just 128+  isSigned _                      = False+  testBit w                       = B.testBit (word128ToInteger w)+  bit n                           = integerToWord128 $ B.bit n+  popCount w                      = B.popCount $ word128ToInteger w++instance B.FiniteBits Word128 where+  finiteBitSize _ = 128

@@ -0,0 +1,31 @@+module HaskellWorks.Data.Network.Gen+  ( canonicalIpv4Block+  , canonicalIpv6Block+  ) where++import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Network.Ip.Validity+import Hedgehog++import qualified Data.Bits                         as B+import qualified HaskellWorks.Data.Network.Ip.Ipv4 as V4+import qualified HaskellWorks.Data.Network.Ip.Ipv6 as V6+import qualified Hedgehog.Gen                      as G+import qualified Hedgehog.Range                    as R++canonicalIpv4Block :: MonadGen m => m (V4.IpBlock Canonical)+canonicalIpv4Block = do+  m <- G.word8   (R.linear 0 32)+  let p = fromIntegral (32 - m)+  w <- G.word32  (R.linear 0 ((0xffffffff .>. p) .<. p))+  return (V4.IpBlock (V4.IpAddress (w .<. p)) (V4.IpNetMask m))++canonicalIpv6Block :: MonadGen m => m (V6.IpBlock Canonical)+canonicalIpv6Block = do+  m <- G.word8   (R.linear 0 128)+  let p = fromIntegral (128 - m)+  w128 <- (,,,) <$> G.word32 (R.linear 0 0xffffffff)+                <*> G.word32 (R.linear 0 0xffffffff)+                <*> G.word32 (R.linear 0 0xffffffff)+                <*> G.word32 (R.linear 0 0xffffffff)+  return (V6.IpBlock (V6.IpAddress (w128 `B.shift` p)) (V6.IpNetMask m))

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}++module HaskellWorks.Data.Network.IpBlockSpec (spec) where++import HaskellWorks.Data.Network.Ip.Validity+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Data.Network.Ip.Ip   as V+import qualified HaskellWorks.Data.Network.Ip.Ipv6 as V6++{-# ANN module ("HLint: ignore Redundant do"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Network.IpSpec" $ do+  describe "IpBlock" $ do+    it "should implement show" $ requireTest $ do+      show (V.IpBlockV6 @Unaligned (V6.IpBlock (V6.IpAddress (3, 3, 3, 0)) (V6.IpNetMask 96))) === "0:3:0:3:0:3::/96"++    it "should implement read" $ requireTest $ do+      read "1:2:3:4::/127"  === V.IpBlockV6 @Unaligned (V6.IpBlock (V6.IpAddress (0x10002    , 0x30004 , 0, 0)) (V6.IpNetMask 127))+      read "1234::/16"      === V.IpBlockV6 @Unaligned (V6.IpBlock (V6.IpAddress (0x12340000 , 0       , 0, 0)) (V6.IpNetMask  16))+      read "12:34::/32"     === V.IpBlockV6 @Unaligned (V6.IpBlock (V6.IpAddress (0x120034   , 0       , 0, 0)) (V6.IpNetMask  32))

@@ -1,82 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module HaskellWorks.Data.Network.IpSpec (spec) where--import HaskellWorks.Data.Network.Ip-import HaskellWorks.Data.Network.Ip.Ipv4-import HaskellWorks.Data.Network.Ip.Internal-import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Test.Hspec--import qualified Data.Attoparsec.Text as AP-import qualified Text.Read as TR-import qualified Data.Text as T-import qualified Hedgehog.Gen as G-import qualified Hedgehog.Range as R--{-# ANN module ("HLint: ignore Redundant do"  :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.HUnit.IpSpec" $ do-  describe "octet" $ do-    it "should go from 0-255" $ require $ property $ do-      b <- forAll $ G.word8 R.constantBounded-      AP.parseOnly octet (T.pack . show $ b) === Right b--  describe "Ipv4Address" $ do-    it "should implement show" $ requireTest $ do-      show (Ipv4Address 0x000000ff) === "0.0.0.255"-      show (Ipv4Address 0x0000ff00) === "0.0.255.0"-      show (Ipv4Address 0x00ff0000) === "0.255.0.0"-      show (Ipv4Address 0xff000000) === "255.0.0.0"--    it "should implement read" $ requireTest $ do-      read "1.2.3.4"      === Ipv4Address 0x01020304-      read "10.20.30.40"  === Ipv4Address 0x0a141e28-      read "1.2.3.12"     === Ipv4Address 0x0102030c-      read "1.2.3.160"    === Ipv4Address 0x010203a0--    it "should be possible to extract the octets" $ requireTest $ do-      ipv4AddressToWords (Ipv4Address 0x01020304) === (1, 2, 3, 4)--  describe "Ipv4Block" $ do-    it "should implement show" $ requireTest $ do-      show (Ipv4Block (Ipv4Address 0x000000ff) (Ipv4NetMask 32)) === "0.0.0.255/32"-      show (Ipv4Block (Ipv4Address 0x0000ff00) (Ipv4NetMask 32)) === "0.0.255.0/32"-      show (Ipv4Block (Ipv4Address 0x00ff0000) (Ipv4NetMask 32)) === "0.255.0.0/32"-      show (Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 32)) === "255.0.0.0/32"-      show (Ipv4Block (Ipv4Address 0x000000ff) (Ipv4NetMask 16)) === "0.0.0.255/16"-      show (Ipv4Block (Ipv4Address 0x0000ff00) (Ipv4NetMask 16)) === "0.0.255.0/16"-      show (Ipv4Block (Ipv4Address 0x00ff0000) (Ipv4NetMask 16)) === "0.255.0.0/16"-      show (Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 16)) === "255.0.0.0/16"-      show (firstIpv4Address $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 8))  === "255.0.0.0"-      show (lastIpv4Address  $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 8))  === "255.255.255.255"-      show (firstIpv4Address $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 16)) === "255.0.0.0"-      show (lastIpv4Address  $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 16)) === "255.0.255.255"-      show (firstIpv4Address $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 24)) === "255.0.0.0"-      show (lastIpv4Address  $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 24)) === "255.0.0.255"-      show (firstIpv4Address $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 32)) === "255.0.0.0"-      show (lastIpv4Address  $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 32)) === "255.0.0.0"-      show (firstIpv4Address $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 21)) === "255.0.0.0"-      show (lastIpv4Address  $ Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 21)) === "255.0.7.255"--    it "should implement read" $ requireTest $ do-      read "1.0.0.0/8"  === Ipv4Block (Ipv4Address 0x01000000) (Ipv4NetMask 8)-      read "1.2.0.0/16" === Ipv4Block (Ipv4Address 0x01020000) (Ipv4NetMask 16)-      read "1.2.3.4/32" === Ipv4Block (Ipv4Address 0x01020304) (Ipv4NetMask 32)--    it "should implement splitBlock" $ requireTest $ do-      splitBlock (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 32)) === Nothing-      splitBlock (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 31)) === Just (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 32), Ipv4Block (Ipv4Address 0x00000001) (Ipv4NetMask 32))-      splitBlock (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 30)) === Just (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 31), Ipv4Block (Ipv4Address 0x00000002) (Ipv4NetMask 31))-      splitBlock (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask  0)) === Just (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask  1), Ipv4Block (Ipv4Address 0x80000000) (Ipv4NetMask  1))--    it "should implement blockSize" $ requireTest $ do-      blockSize (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 32)) === 1-      blockSize (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask  0)) === 0x100000000--    it "should validate masks" $ requireTest $ do-      (TR.readMaybe "1.2.3.4/8"  :: Maybe Ipv4Block) === Nothing-      (TR.readMaybe "1.2.3.4/0"  :: Maybe Ipv4Block) === Nothing-      (TR.readMaybe "1.2.3.4/32" :: Maybe Ipv4Block) === (Just $ Ipv4Block (Ipv4Address 0x01020304) (Ipv4NetMask 32))

@@ -0,0 +1,210 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}++module HaskellWorks.Data.Network.Ipv4Spec (spec) where++import HaskellWorks.Data.Network.Ip.Internal+import HaskellWorks.Data.Network.Ip.Ipv4+import HaskellWorks.Data.Network.Ip.Range+import HaskellWorks.Data.Network.Ip.Validity+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.List                             as DL+import qualified HaskellWorks.Data.Network.Gen         as G+import qualified HaskellWorks.Data.Network.Ip.Internal as I+import qualified HaskellWorks.Data.Network.Ip.Ipv4     as I+import qualified HaskellWorks.Data.Network.Ip.Range    as I+import qualified Hedgehog.Gen                          as G+import qualified Hedgehog.Range                        as R+import qualified Text.Appar.String                     as AP++{-# ANN module ("HLint: ignore Redundant do"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Network.Ipv4Spec" $ do+  describe "octet" $ do+    it "should go from 0-255" $ require $ property $ do+      b <- forAll $ G.word8 R.constantBounded+      AP.runParser octet (show b) === (Just b, "")++  describe "I.IpAddress" $ do+    it "should implement show" $ requireTest $ do+      show (I.IpAddress 0x000000ff) === "0.0.0.255"+      show (I.IpAddress 0x0000ff00) === "0.0.255.0"+      show (I.IpAddress 0x00ff0000) === "0.255.0.0"+      show (I.IpAddress 0xff000000) === "255.0.0.0"++    it "should implement read" $ requireTest $ do+      read "1.2.3.4"      === I.IpAddress 0x01020304+      read "10.20.30.40"  === I.IpAddress 0x0a141e28+      read "1.2.3.12"     === I.IpAddress 0x0102030c+      read "1.2.3.160"    === I.IpAddress 0x010203a0++    it "should be possible to extract the octets" $ requireTest $ do+      I.ipAddressToWords (I.IpAddress 0x01020304) === (1, 2, 3, 4)++  describe "I.IpBlock" $ do+    it "should implement show" $ requireTest $ do+      show (I.IpBlock (I.IpAddress 0x000000ff) (I.IpNetMask 32)) === "0.0.0.255/32"+      show (I.IpBlock (I.IpAddress 0x0000ff00) (I.IpNetMask 32)) === "0.0.255.0/32"+      show (I.IpBlock (I.IpAddress 0x00ff0000) (I.IpNetMask 32)) === "0.255.0.0/32"+      show (I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 32)) === "255.0.0.0/32"+      show (I.IpBlock (I.IpAddress 0x000000ff) (I.IpNetMask 16)) === "0.0.0.255/16"+      show (I.IpBlock (I.IpAddress 0x0000ff00) (I.IpNetMask 16)) === "0.0.255.0/16"+      show (I.IpBlock (I.IpAddress 0x00ff0000) (I.IpNetMask 16)) === "0.255.0.0/16"+      show (I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 16)) === "255.0.0.0/16"+      show (I.firstIpAddress $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 8))  === "255.0.0.0"+      show (I.lastIpAddress  $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 8))  === "255.255.255.255"+      show (I.firstIpAddress $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 16)) === "255.0.0.0"+      show (I.lastIpAddress  $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 16)) === "255.0.255.255"+      show (I.firstIpAddress $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 24)) === "255.0.0.0"+      show (I.lastIpAddress  $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 24)) === "255.0.0.255"+      show (I.firstIpAddress $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 32)) === "255.0.0.0"+      show (I.lastIpAddress  $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 32)) === "255.0.0.0"+      show (I.firstIpAddress $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 21)) === "255.0.0.0"+      show (I.lastIpAddress  $ I.IpBlock (I.IpAddress 0xff000000) (I.IpNetMask 21)) === "255.0.7.255"++    it "should implement read" $ requireTest $ do+      read "1.0.0.0/8"  === I.IpBlock @Unaligned (I.IpAddress 0x01000000) (I.IpNetMask 8)+      read "1.2.0.0/16" === I.IpBlock @Unaligned (I.IpAddress 0x01020000) (I.IpNetMask 16)+      read "1.2.3.4/32" === I.IpBlock @Unaligned (I.IpAddress 0x01020304) (I.IpNetMask 32)++    it "should implement splitBlock" $ requireTest $ do+      I.splitBlock (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask 32)) === Nothing+      I.splitBlock (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask 31)) === Just (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask 32), I.IpBlock (I.IpAddress 0x00000001) (I.IpNetMask 32))+      I.splitBlock (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask 30)) === Just (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask 31), I.IpBlock (I.IpAddress 0x00000002) (I.IpNetMask 31))+      I.splitBlock (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask  0)) === Just (I.IpBlock (I.IpAddress 0x00000000) (I.IpNetMask  1), I.IpBlock (I.IpAddress 0x80000000) (I.IpNetMask  1))++    it "should implement blockSize" $ requireTest $ do+      I.blockSize 32 === 0x000000001+      I.blockSize  0 === 0x100000000++    it "should validate masks" $ requireTest $ do+      (read "1.2.3.4/8"  :: I.IpBlock Unaligned) === I.IpBlock (I.IpAddress 0x01020304) (I.IpNetMask  8)+      (read "1.2.3.4/0"  :: I.IpBlock Unaligned) === I.IpBlock (I.IpAddress 0x01020304) (I.IpNetMask  0)+      (read "1.2.3.4/32" :: I.IpBlock Unaligned) === I.IpBlock (I.IpAddress 0x01020304) (I.IpNetMask 32)++    it "should canonicalise block" $ requireTest $ do+      I.canonicaliseIpBlock (I.IpBlock (I.IpAddress 0x01020304) (I.IpNetMask 32)) === I.IpBlock (I.IpAddress 0x01020304) (I.IpNetMask 32)+      I.canonicaliseIpBlock (I.IpBlock (I.IpAddress 0x01020304) (I.IpNetMask 24)) === I.IpBlock (I.IpAddress 0x01020300) (I.IpNetMask 24)+      I.canonicaliseIpBlock (I.IpBlock (I.IpAddress 0x01020304) (I.IpNetMask 16)) === I.IpBlock (I.IpAddress 0x01020000) (I.IpNetMask 16)+      I.canonicaliseIpBlock (I.IpBlock (I.IpAddress 0x01020304) (I.IpNetMask  8)) === I.IpBlock (I.IpAddress 0x01000000) (I.IpNetMask  8)++    it "should collapse blocks" $ requireTest $ do+      let ipblocks1 = read @(IpBlock Canonical) <$> ["1.2.3.4/32", "4.3.2.1/32"]+      collapseIpBlocks ipblocks1 === ipblocks1+      let ipblocks2 = read @(IpBlock Canonical) <$> ["1.2.3.3/32", "1.2.3.0/32", "1.2.3.1/32", "1.2.3.2/32"]+      collapseIpBlocks (DL.sort ipblocks2) === (read @(IpBlock Canonical) <$> ["1.2.3.0/30"])+      let ipblocks3 = read @(IpBlock Canonical) <$> ["1.2.3.3/32", "1.2.3.0/32", "1.2.3.1/32", "1.2.3.2/32", "5.5.5.5/32"]+      collapseIpBlocks (DL.sort ipblocks3) === (read @(IpBlock Canonical) <$> ["1.2.3.0/30", "5.5.5.5/32"])++  describe "should split ranges" $ do+    it "0.0.0.0 - 0.0.0.0" $ requireTest $ do+      let ip1 = read "0.0.0.0" :: I.IpAddress+      let ip2 = read "0.0.0.0" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 32), Nothing)+    it "0.0.0.1 - 0.0.0.1" $ requireTest $ do+      let ip1 = read "0.0.0.1" :: I.IpAddress+      let ip2 = read "0.0.0.1" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 32), Nothing)+    it "0.0.0.0 - 0.0.0.1" $ requireTest $ do+      let ip1 = read "0.0.0.0" :: I.IpAddress+      let ip2 = read "0.0.0.1" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 31), Nothing)+    it "0.0.0.0 - 0.0.0.2" $ requireTest $ do+      let ip1 = read "0.0.0.0" :: I.IpAddress+      let ip2 = read "0.0.0.2" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 31), Just (Range ip2 ip2))+    it "0.0.0.0 - 0.0.0.3" $ requireTest $ do+      let ip1 = read "0.0.0.0" :: I.IpAddress+      let ip2 = read "0.0.0.3" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 30), Nothing)+    it "0.0.0.0 - 0.0.0.4" $ requireTest $ do+      let ip1 = read "0.0.0.0" :: I.IpAddress+      let ip2 = read "0.0.0.4" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 30), Just (Range ip2 ip2))+    it "0.0.0.0 - 0.0.0.5" $ requireTest $ do+      let ip1 = read "0.0.0.0" :: I.IpAddress+      let ip2 = read "0.0.0.4" :: I.IpAddress+      let ip3 = read "0.0.0.5" :: I.IpAddress+      I.splitIpRange (Range ip1 ip3) === (I.IpBlock ip1 (I.IpNetMask 30), Just (Range ip2 ip3))+    it "0.0.0.0 - 0.0.0.5" $ requireTest $ do+      let ip1 = read "0.0.0.0" :: I.IpAddress+      let ip2 = read "0.0.0.4" :: I.IpAddress+      let ip3 = read "0.0.0.6" :: I.IpAddress+      I.splitIpRange (Range ip1 ip3) === (I.IpBlock ip1 (I.IpNetMask 30), Just (Range ip2 ip3))+    it "0.0.0.0 - 0.0.0.7" $ requireTest $ do+      let ip1 = read "0.0.0.0" :: I.IpAddress+      let ip2 = read "0.0.0.7" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 29), Nothing)+    it "0.0.0.1 - 0.0.0.7" $ requireTest $ do+      let ip1 = read "0.0.0.1" :: I.IpAddress+      let ip2 = read "0.0.0.2" :: I.IpAddress+      let ip3 = read "0.0.0.7" :: I.IpAddress+      I.splitIpRange (Range ip1 ip3) === (I.IpBlock ip1 (I.IpNetMask 32), Just (Range ip2 ip3))+    it "0.0.0.2 - 0.0.0.7" $ requireTest $ do+      let ip1 = read "0.0.0.2" :: I.IpAddress+      let ip2 = read "0.0.0.4" :: I.IpAddress+      let ip3 = read "0.0.0.7" :: I.IpAddress+      I.splitIpRange (Range ip1 ip3) === (I.IpBlock ip1 (I.IpNetMask 31), Just (Range ip2 ip3))+    it "0.0.0.3 - 0.0.0.7" $ requireTest $ do+      let ip1 = read "0.0.0.3" :: I.IpAddress+      let ip2 = read "0.0.0.4" :: I.IpAddress+      let ip3 = read "0.0.0.7" :: I.IpAddress+      I.splitIpRange (Range ip1 ip3) === (I.IpBlock ip1 (I.IpNetMask 32), Just (Range ip2 ip3))+    it "0.0.0.4 - 0.0.0.7" $ requireTest $ do+      let ip1 = read "0.0.0.4" :: I.IpAddress+      let ip2 = read "0.0.0.7" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 30), Nothing)+    it "0.0.0.5 - 0.0.0.7" $ requireTest $ do+      let ip1 = read "0.0.0.5" :: I.IpAddress+      let ip2 = read "0.0.0.6" :: I.IpAddress+      let ip3 = read "0.0.0.7" :: I.IpAddress+      I.splitIpRange (Range ip1 ip3) === (I.IpBlock ip1 (I.IpNetMask 32), Just (Range ip2 ip3))+    it "0.0.0.6 - 0.0.0.7" $ requireTest $ do+      let ip1 = read "0.0.0.6" :: I.IpAddress+      let ip2 = read "0.0.0.7" :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 31), Nothing)+    it "0.0.0.7 - 0.0.0.7" $ requireTest $ do+      let ip1 = read "0.0.0.7" :: I.IpAddress+      I.splitIpRange (Range ip1 ip1) === (I.IpBlock ip1 (I.IpNetMask 32), Nothing)+    it "0.0.0.6 - 0.0.0.6" $ requireTest $ do+      let ip1 = read "0.0.0.6" :: I.IpAddress+      I.splitIpRange (Range ip1 ip1) === (I.IpBlock ip1 (I.IpNetMask 32), Nothing)+    it "255.255.255.255 - 255.255.255.255" $ requireTest $ do+      let ip1 = read "255.255.255.255" :: I.IpAddress+      I.splitIpRange (Range ip1 ip1) === (I.IpBlock ip1 (I.IpNetMask 32), Nothing)+    it "128.0.0.0 - 255.255.255.255" $ requireTest $ do+      let ip1 = read "128.0.0.0"        :: I.IpAddress+      let ip2 = read "255.255.255.255"  :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 1), Nothing)+    it "0.0.0.0 - 255.255.255.255" $ requireTest $ do+      let ip1 = read "0.0.0.0"          :: I.IpAddress+      let ip2 = read "255.255.255.255"  :: I.IpAddress+      I.splitIpRange (Range ip1 ip2) === (I.IpBlock ip1 (I.IpNetMask 0), Nothing)++  describe "should get blocks from ranges" $ do+    it "0.0.0.1 - 0.0.0.2" $ requireTest $ do+      I.rangeToBlocks (I.Range (I.IpAddress 0x000001) (I.IpAddress 0x000002)) === [ I.IpBlock (I.IpAddress 0x000001) (I.IpNetMask 32)+                                                                                  , I.IpBlock (I.IpAddress 0x000002) (I.IpNetMask 32)]+    it "102.36.48.28 - 102.36.48.255" $ requireTest $ do+      I.rangeToBlocks (I.Range (I.IpAddress 0x6624301c) (I.IpAddress 0x662430ff)) === [ I.IpBlock (I.IpAddress 0x6624301c) (I.IpNetMask 30)+                                                                                      , I.IpBlock (I.IpAddress 0x66243020) (I.IpNetMask 27)+                                                                                      , I.IpBlock (I.IpAddress 0x66243040) (I.IpNetMask 26)+                                                                                      , I.IpBlock (I.IpAddress 0x66243080) (I.IpNetMask 25)]++    it "102.36.48.2 - 102.36.48.8" $ requireTest $ do+      I.rangeToBlocks (I.Range (I.IpAddress 0x66243002) (I.IpAddress 0x66243008)) === [ I.IpBlock (I.IpAddress 0x66243002) (I.IpNetMask 31)+                                                                                      , I.IpBlock (I.IpAddress 0x66243004) (I.IpNetMask 30)+                                                                                      , I.IpBlock (I.IpAddress 0x66243008) (I.IpNetMask 32)]++  describe "should get blocks from ranges with difference lists" $ do+    it "0.0.0.1 - 0.0.0.2" $ requireTest $ do+      I.rangeToBlocksDL (I.Range (I.IpAddress 0x000001) (I.IpAddress 0x000002)) [] === [ I.IpBlock (I.IpAddress 0x000001) (I.IpNetMask 32)+                                                                                        , I.IpBlock (I.IpAddress 0x000002) (I.IpNetMask 32)]++  it "block can be converted to range and back" $ require $ property $ do+    b <- forAll G.canonicalIpv4Block+    I.splitIpRange (I.blockToRange b) === (b, Nothing)

@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}++module HaskellWorks.Data.Network.Ipv6Spec (spec) where++import HaskellWorks.Data.Network.Ip.SafeEnum+import HaskellWorks.Data.Network.Ip.Validity+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec+++import qualified Data.Text                          as T+import qualified HaskellWorks.Data.Network.Gen      as G+import qualified HaskellWorks.Data.Network.Ip.Ip    as V+import qualified HaskellWorks.Data.Network.Ip.Ipv4  as V4+import qualified HaskellWorks.Data.Network.Ip.Ipv6  as V6+import qualified HaskellWorks.Data.Network.Ip.Range as R+import qualified HaskellWorks.Data.Network.Ip.Range as IR++import qualified Hedgehog.Gen   as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Redundant do"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Network.Ipv6Spec" $ do+  describe "V6.IpBlock" $ do+    it "should implement show" $ requireTest $ do+      show (V6.IpBlock (V6.IpAddress (3, 3, 3, 0)) (V6.IpNetMask 96)) === "0:3:0:3:0:3::/96"++    it "should implement firstAddress/lastAddress" $ requireTest $ do+      V.firstIpAddress (V.IpBlockV4 (V4.IpBlock (V4.IpAddress   0xff000000) (V4.IpNetMask  8)))  === (0, 0, 0xFFFF, 0xFF000000)+      V.firstIpAddress (V.IpBlockV6 (V6.IpBlock (V6.IpAddress (4, 4, 0, 0)) (V6.IpNetMask 33)))  === (4, 4, 0, 0)+      V.lastIpAddress  (V.IpBlockV4 (V4.IpBlock (V4.IpAddress   0xff000000) (V4.IpNetMask  8)))  === (0 , 0 , 0xFFFF , 0xFFFFFFFF)+      V.lastIpAddress  (V.IpBlockV6 (V6.IpBlock (V6.IpAddress (4, 4, 0, 0)) (V6.IpNetMask 33)))  === (4 , 0x7FFFFFFF , 0xFFFFFFFF , 0xFFFFFFFF)++    it "should implement read" $ requireTest $ do+      read "1:2:3:4::"      === V6.IpAddress (0x10002,0x30004,0,0)+      read "1:2:3:4::/127"  === V6.IpBlock @Unaligned (V6.IpAddress (0x10002   , 0x30004 , 0, 0)) (V6.IpNetMask 127)+      read "1234::/16"      === V6.IpBlock @Unaligned (V6.IpAddress (0x12340000, 0       , 0, 0)) (V6.IpNetMask  16)+      read "12:34::/32"     === V6.IpBlock @Unaligned (V6.IpAddress (0x120034  , 0       , 0, 0)) (V6.IpNetMask  32)++    it "should parse what it has shown" $ require $ property $ do+      a <- forAll $ G.word32 R.constantBounded+      m <- forAll $ G.word8 $ R.linear 0 128+      let addr = V6.IpBlock (V6.IpAddress (a, 0, 0, 0)) (V6.IpNetMask m)+      V6.parseIpBlock (T.pack (show addr)) === Right addr++    it "should support enum" $ require $ property $ do+      boundedPred (V6.IpAddress (32, 32, 32, 32)) === V6.IpAddress (32, 32, 32, 31)+      boundedSucc (V6.IpAddress (32, 32, 32, 32)) === V6.IpAddress (32, 32, 32, 33)+      boundedPred (V6.IpAddress (0, 0, 0, 0xffffffff)) === V6.IpAddress (0, 0, 0, 0xfffffffe)+      boundedSucc (V6.IpAddress (0, 0, 0, 0xffffffff)) === V6.IpAddress (0, 0, 1, 0)+      boundedSucc (V6.IpAddress maxBound ) === V6.IpAddress maxBound+      boundedPred (V6.IpAddress (0, 0, 0, 0)) === V6.IpAddress (0, 0, 0, 0)++    it "should convert ::/128 to ranges" $ requireTest $ do+      V6.blockToRange (V6.IpBlock (V6.IpAddress (0, 0, 0, 0)) (V6.IpNetMask 128)) === R.Range (V6.IpAddress (0, 0, 0, 0)) (V6.IpAddress (0, 0, 0, 0))++    it "should convert 1234::/64 to ranges" $ requireTest $ do+      V6.blockToRange (V6.IpBlock (V6.IpAddress (0x12340000, 0, 0, 0)) (V6.IpNetMask 64)) === R.Range (V6.IpAddress (0x12340000, 0, 0, 0)) (V6.IpAddress (0x12340000, 0, 0xffffffff, 0xffffffff))++    it "block can be converted to range" $ require $ property $ do+      let b = V6.IpBlock (V6.IpAddress (0x12340000, 0, 0, 0)) (V6.IpNetMask 16)+      V6.blockToRange b === IR.Range (read "1234::") (read "1234:ffff:ffff:ffff:ffff:ffff:ffff:ffff")++    it "block can be converted to range and back" $ require $ property $ do+      b <- forAll G.canonicalIpv6Block+      V6.splitIpRange (V6.blockToRange b) === (b, Nothing)++    it "ranges can be split" $ require $ property $ do+      V6.splitIpRange (IR.Range (read "::") (read "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff")) === (V6.IpBlock (V6.IpAddress (0, 0, 0, 0)) (V6.IpNetMask 0), Nothing)+      V6.splitIpRange (IR.Range (read "::") (read "::88")) === (V6.IpBlock (V6.IpAddress (0, 0, 0, 0)) (V6.IpNetMask 121), Just (IR.Range (read "::80") (read "::88")))+      V6.splitIpRange (IR.Range (read "::3") (read "::88")) === (V6.IpBlock (V6.IpAddress (0, 0, 0, 3)) (V6.IpNetMask 128), Just (IR.Range (read "::4") (read "::88")))+      V6.splitIpRange (IR.Range (read "::127") (read "::129")) === (V6.IpBlock (V6.IpAddress (0, 0, 0, 0x127)) (V6.IpNetMask 128), Just (IR.Range (read "::128") (read "::129")))++  describe "should get blocks from ranges" $ do+    it ":: - ::ff" $ requireTest $ do+      V6.rangeToBlocks (R.Range (V6.IpAddress 0) (V6.IpAddress 0xff)) === [ V6.IpBlock (V6.IpAddress 0) (V6.IpNetMask 120)]+    it "::fe - ::18e" $ requireTest $ do+      V6.rangeToBlocks (R.Range (V6.IpAddress 0xfe) (V6.IpAddress 0x18e)) === [ V6.IpBlock (V6.IpAddress 0xfe) (V6.IpNetMask 127)+                                                                              , V6.IpBlock (V6.IpAddress 0x100) (V6.IpNetMask 121)+                                                                              , V6.IpBlock (V6.IpAddress 0x180) (V6.IpNetMask 125)+                                                                              , V6.IpBlock (V6.IpAddress 0x188) (V6.IpNetMask 126)+                                                                              , V6.IpBlock (V6.IpAddress 0x18c) (V6.IpNetMask 127)+                                                                              , V6.IpBlock (V6.IpAddress 0x18e) (V6.IpNetMask 128)+                                                                              ]+    it ":: - ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" $ requireTest $ do+      V6.rangeToBlocks (R.Range (V6.IpAddress 0) (V6.IpAddress maxBound)) === [ V6.IpBlock (V6.IpAddress 0) (V6.IpNetMask 0)]++  describe "should get blocks from ranges with difference lists" $ do+    it "::100 - ::200" $ requireTest $ do+      V6.rangeToBlocksDL (R.Range (V6.IpAddress 0x100) (V6.IpAddress 0x200)) [] === [ V6.IpBlock (V6.IpAddress 0x100) (V6.IpNetMask 120)+                                                                                     , V6.IpBlock (V6.IpAddress 0x200) (V6.IpNetMask 128)]

@@ -0,0 +1,41 @@+{-# LANGUAGE MonoLocalBinds    #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}++module HaskellWorks.Data.Network.RangeSpec (spec) where++import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Data.Network.Ip.Ipv6  as V6+import qualified HaskellWorks.Data.Network.Ip.Range as R+import qualified Text.Appar.String                  as AP++{-# ANN module ("HLint: ignore Redundant do"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Network.RangeSpec" $ do+  describe "Range" $ do+    it "should be mergeable" $ requireTest $ do+      R.mergeRanges [] === ([] :: [R.Range Int])+      R.mergeRanges @Int [R.Range 0 5] === [R.Range 0 5]+      R.mergeRanges @Int [R.Range 3 5, R.Range 6 7] === [R.Range 3 7]+      R.mergeRanges @Int [R.Range 0 5, R.Range 7 7] === [R.Range 0 5, R.Range 7 7]+      R.mergeRanges [R.Range 'a' 'b', R.Range 'c' 'f'] === [R.Range 'a' 'f']+      R.mergeRanges [R.Range 'a' 'a', R.Range 'a' 'f'] === [R.Range 'a' 'f']+      R.mergeRanges [R.Range 'a' 'b', R.Range 'b' 'b'] === [R.Range 'a' 'b']+      R.mergeRanges [R.Range 'a' 'f', R.Range 'c' 'e'] === [R.Range 'a' 'f']+      R.mergeRanges [R.Range 'a' 'f', R.Range 'c' 'e', R.Range 'x' 'z'] === [R.Range 'a' 'f', R.Range 'x' 'z']++      let v6Ranges1 = [ R.Range (V6.IpAddress (0, 0, 0, 0)) (V6.IpAddress (0, 0, 0, 20))+                      , R.Range (V6.IpAddress (0, 0, 0, 21)) (V6.IpAddress (0, 0, 0, 0xffffffff))+                      , R.Range (V6.IpAddress (0, 0, 1, 0)) (V6.IpAddress (0, 0, 1, 200))+                      ]+      let v6Ranges2 = [ R.Range (V6.IpAddress (0, 0, 0, 0)) (V6.IpAddress (0, 0, 1, 200))+                      ]+      R.mergeRanges v6Ranges1 === v6Ranges2++    it "should parse dash-delimited ranges" $ requireTest $ do+      AP.runParser (AP.try (R.parseRange AP.alphaNum)) "a b"   === (Nothing               , "a b")+      AP.runParser (AP.try (R.parseRange AP.alphaNum)) "a - b" === (Just (R.Range 'a' 'b'), ""   )

@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Network.Word128Spec (spec) where++import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Bits                            as B+import qualified HaskellWorks.Data.Network.Ip.Word128 as W++{-# ANN module ("HLint: ignore Redundant do"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Network.Ipv6Spec" $ do+  describe "Word128" $ do+    it "should implement +" $ requireTest $ do+      ((1, 1, 1, 1) :: W.Word128) + ((1, 1, 1, 1) :: W.Word128) === ((2, 2, 2, 2) :: W.Word128)+      ((1, 1, 1, 0xffffffff) :: W.Word128) + ((1, 1, 1, 1) :: W.Word128) === ((2, 2, 3, 0) :: W.Word128)+      (maxBound :: W.Word128) + ((0, 0, 0, 1) :: W.Word128) === ((0, 0, 0, 0) :: W.Word128)++    it "should implement -" $ requireTest $ do+      ((1, 1, 1, 1) :: W.Word128) - ((1, 1, 1, 1) :: W.Word128) === ((0, 0, 0, 0) :: W.Word128)+      ((1, 1, 1, 0xffffffff) :: W.Word128) - ((1, 1, 1, 1) :: W.Word128) === ((0, 0, 0, 0xfffffffe) :: W.Word128)+      ((0, 0, 0, 1) :: W.Word128) - (maxBound :: W.Word128) === ((0, 0, 0, 2) :: W.Word128)++    it "should implement *" $ requireTest $ do+      ((0, 0, 0, 0) :: W.Word128) * ((1, 1, 1, 1) :: W.Word128) === ((0, 0, 0, 0) :: W.Word128)+      ((1, 1, 1, 1) :: W.Word128) * ((1, 1, 1, 1) :: W.Word128) === ((4, 3, 2, 1) :: W.Word128)+      ((1, 1, 1, 0xffffffff) :: W.Word128) * ((0, 0, 0, 1) :: W.Word128) === ((1, 1, 1, 0xffffffff) :: W.Word128)+      ((0, 0, 0, 1) :: W.Word128) * (maxBound :: W.Word128) === (maxBound :: W.Word128)++    it "should implement shift" $ requireTest $ do+      ((1, 1, 1, 1) :: W.Word128) `B.shift` (16 :: Int) === ((0x10000, 0x10000, 0x10000, 0x10000) :: W.Word128)+      ((1, 1, 1, 1) :: W.Word128) `B.shift` (32 :: Int) === ((1, 1, 1, 0) :: W.Word128)+      ((1, 1, 1, 0xffffffff) :: W.Word128) `B.shift` (32 :: Int) === ((1, 1, 0xffffffff, 0) :: W.Word128)+      ((1, 1, 1, 1) :: W.Word128) `B.shiftR` (16 :: Int) === ((0, 0x10000, 0x10000, 0x10000) :: W.Word128)+      ((1, 1, 1, 1) :: W.Word128) `B.shiftR` (32 :: Int) === ((0, 1, 1, 1) :: W.Word128)+      ((1, 1, 0xffffffff, 1) :: W.Word128) `B.shiftR` (32 :: Int) === ((0, 1, 1, 0xffffffff) :: W.Word128)+      (maxBound :: W.Word128) `B.shift` (1 :: Int) === ((0xffffffff, 0xffffffff, 0xffffffff, 0xfffffffe) :: W.Word128)++    it "should implement Bits" $ requireTest $ do+      B.countLeadingZeros ((0, 0, 0, 0) :: W.Word128) === 128+      B.countLeadingZeros ((0, 0, 0, 1) :: W.Word128) === 127+      B.countLeadingZeros ((1, 1, 1, 1) :: W.Word128) === 31+      B.countTrailingZeros ((0, 0, 0, 1) :: W.Word128) === 0+      B.countTrailingZeros ((0, 0, 0, 0) :: W.Word128) === 128+      B.countTrailingZeros ((0, 0, 0x10, 0) :: W.Word128) === 36