diff --git a/app/App/Commands.hs b/app/App/Commands.hs --- a/app/App/Commands.hs +++ b/app/App/Commands.hs @@ -1,5 +1,6 @@ module App.Commands where +import App.Commands.RangeStats import App.Commands.TextToWord import Data.Semigroup ((<>)) import Options.Applicative @@ -11,3 +12,4 @@ commandsGeneral = subparser $ mempty <> commandGroup "Commands:" <> cmdTextToWord + <> cmdRangeStats diff --git a/app/App/Commands/RangeStats.hs b/app/App/Commands/RangeStats.hs new file mode 100644 --- /dev/null +++ b/app/App/Commands/RangeStats.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module App.Commands.RangeStats + ( cmdRangeStats + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Semigroup ((<>)) +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified HaskellWorks.Data.Network.Ip.Ipv4 as IPv4 +import qualified HaskellWorks.Data.Network.Ip.Range as R +import qualified Text.Appar.String as AP + +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +runRangeStats :: Z.RangeStatsOptions -> IO () +runRangeStats opts = + print $ length . R.rangeToList $ opts ^. the @"range" + +optsRangeStats :: Parser Z.RangeStatsOptions +optsRangeStats = Z.RangeStatsOptions + <$> option (maybeReader parseRange) + ( long "range" + <> short 'r' + <> help "IP Range" + <> metavar "RANGE" + ) + +parseRange :: String -> Maybe (R.Range IPv4.IpAddress) +parseRange = AP.parse (R.parseRange IPv4.parseIpAddress) + +cmdRangeStats :: Mod CommandFields (IO ()) +cmdRangeStats = command "range-stats" $ flip info idm $ runRangeStats <$> optsRangeStats diff --git a/app/App/Commands/Types.hs b/app/App/Commands/Types.hs --- a/app/App/Commands/Types.hs +++ b/app/App/Commands/Types.hs @@ -3,11 +3,19 @@ module App.Commands.Types ( TextToWordOptions(..) + , RangeStatsOptions(..) ) where import GHC.Generics +import qualified HaskellWorks.Data.Network.Ip.Ipv4 as IPv4 +import qualified HaskellWorks.Data.Network.Ip.Range as R + data TextToWordOptions = TextToWordOptions { input :: FilePath , output :: FilePath + } deriving (Eq, Show, Generic) + +data RangeStatsOptions = RangeStatsOptions + { range :: R.Range IPv4.IpAddress } deriving (Eq, Show, Generic) diff --git a/gen/HaskellWorks/Data/Network/Gen.hs b/gen/HaskellWorks/Data/Network/Gen.hs new file mode 100644 --- /dev/null +++ b/gen/HaskellWorks/Data/Network/Gen.hs @@ -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)) diff --git a/hw-ip.cabal b/hw-ip.cabal --- a/hw-ip.cabal +++ b/hw-ip.cabal @@ -1,7 +1,7 @@ -cabal-version: 2.2 +cabal-version: 2.4 name: hw-ip -version: 2.3.4.2 +version: 2.4.0.1 license: BSD-3-Clause license-file: LICENSE copyright: 2018-2019 John Ky, David Turnbull, Jian Wan @@ -76,6 +76,7 @@ , semigroups , text other-modules: App.Commands + App.Commands.RangeStats App.Commands.TextToWord App.Commands.Types main-is: Main.hs @@ -83,6 +84,15 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: hw-ip +library hw-ip-gen + import: base, config + , hedgehog + , hw-bits + , text + exposed-modules: HaskellWorks.Data.Network.Gen + hs-source-dirs: gen + build-depends: hw-ip + test-suite hw-ip-test import: base, config , appar @@ -92,8 +102,7 @@ , hw-bits , hw-hspec-hedgehog , text - other-modules: HaskellWorks.Data.Network.Gen - HaskellWorks.Data.Network.IpBlockSpec + other-modules: HaskellWorks.Data.Network.IpBlockSpec HaskellWorks.Data.Network.IpSpec HaskellWorks.Data.Network.Ipv4Spec HaskellWorks.Data.Network.Ipv6Spec @@ -103,5 +112,5 @@ main-is: Spec.hs hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: hw-ip + build-depends: hw-ip, hw-ip-gen build-tool-depends: hspec-discover:hspec-discover diff --git a/src/HaskellWorks/Data/Network/Ip/Ipv4.hs b/src/HaskellWorks/Data/Network/Ip/Ipv4.hs --- a/src/HaskellWorks/Data/Network/Ip/Ipv4.hs +++ b/src/HaskellWorks/Data/Network/Ip/Ipv4.hs @@ -19,6 +19,7 @@ , showsIpAddress , tshowIpAddress , tshowIpBlock + , wordsToIpAddress , ipAddressToWords , firstIpAddress , lastIpAddress @@ -135,6 +136,13 @@ tshowIpBlock :: IpBlock v -> T.Text tshowIpBlock = T.pack . showIpBlock + +wordsToIpAddress :: Word8 -> Word8 -> Word8 -> Word8 -> IpAddress +wordsToIpAddress a b c d = IpAddress $ + ( fromIntegral a .<. 24) .|. + ( fromIntegral b .<. 16) .|. + ( fromIntegral c .<. 8) .|. + fromIntegral d ipAddressToWords :: IpAddress -> (Word8, Word8, Word8, Word8) ipAddressToWords (IpAddress w) = diff --git a/test/HaskellWorks/Data/Network/Gen.hs b/test/HaskellWorks/Data/Network/Gen.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Network/Gen.hs +++ /dev/null @@ -1,31 +0,0 @@ -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)) diff --git a/test/HaskellWorks/Data/Network/Ipv4Spec.hs b/test/HaskellWorks/Data/Network/Ipv4Spec.hs --- a/test/HaskellWorks/Data/Network/Ipv4Spec.hs +++ b/test/HaskellWorks/Data/Network/Ipv4Spec.hs @@ -102,6 +102,13 @@ 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"]) + it "words and ip should round trip" $ requireTest $ do + a <- forAll $ G.word8 R.constantBounded + b <- forAll $ G.word8 R.constantBounded + c <- forAll $ G.word8 R.constantBounded + d <- forAll $ G.word8 R.constantBounded + ipAddressToWords (wordsToIpAddress a b c d) === (a, b, c, d) + 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