diff --git a/app/App/Commands.hs b/app/App/Commands.hs new file mode 100644 --- /dev/null +++ b/app/App/Commands.hs @@ -0,0 +1,13 @@ +module App.Commands where + +import App.Commands.TextToWord +import Data.Semigroup ((<>)) +import Options.Applicative + +commands :: Parser (IO ()) +commands = commandsGeneral + +commandsGeneral :: Parser (IO ()) +commandsGeneral = subparser $ mempty + <> commandGroup "Commands:" + <> cmdTextToWord diff --git a/app/App/Commands/TextToWord.hs b/app/App/Commands/TextToWord.hs new file mode 100644 --- /dev/null +++ b/app/App/Commands/TextToWord.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module App.Commands.TextToWord + ( cmdTextToWord + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Data.Maybe (catMaybes) +import Data.Semigroup ((<>)) +import Options.Applicative hiding (columns) +import Text.Read + +import qualified App.Commands.Types as Z +import qualified Data.Binary.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.Network.Ip.Ipv4 as IPv4 +import qualified System.IO as IO + +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +runTextToWord :: Z.TextToWordOptions -> IO () +runTextToWord opts = do + contents <- IO.readFile (opts ^. the @"input") + let as = lines contents + let ips = catMaybes (fmap (readMaybe @IPv4.IpAddress) as) + let ws = fmap (^. the @"word") ips + LBS.writeFile (opts ^. the @"output") (B.toLazyByteString (foldMap B.putWord32le ws)) + +optsTextToWord :: Parser Z.TextToWordOptions +optsTextToWord = Z.TextToWordOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input line seprate IP addresses in text" + <> metavar "FILE" + ) + <*> strOption + ( long "output" + <> short 'o' + <> help "Packed IPs as little-endian Word32s" + <> metavar "FILE" + ) + +cmdTextToWord :: Mod CommandFields (IO ()) +cmdTextToWord = command "text-to-word" $ flip info idm $ runTextToWord <$> optsTextToWord diff --git a/app/App/Commands/Types.hs b/app/App/Commands/Types.hs new file mode 100644 --- /dev/null +++ b/app/App/Commands/Types.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module App.Commands.Types + ( TextToWordOptions(..) + ) where + +import GHC.Generics + +data TextToWordOptions = TextToWordOptions + { input :: FilePath + , output :: FilePath + } deriving (Eq, Show, Generic) diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,11 @@ +module Main where + +import App.Commands +import Control.Monad +import Data.Semigroup ((<>)) +import Options.Applicative + +main :: IO () +main = join $ customExecParser + (prefs $ showHelpOnEmpty <> showHelpOnError) + (info (commands <**> helper) idm) diff --git a/hw-ip.cabal b/hw-ip.cabal --- a/hw-ip.cabal +++ b/hw-ip.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hw-ip -version: 2.3.1.0 +version: 2.3.1.1 license: BSD-3-Clause license-file: LICENSE copyright: 2018 John Ky, David Turnbull, Jian Wan @@ -21,7 +21,37 @@ type: git location: https://github.com/haskell-works/hw-ip + +common base { build-depends: base >= 4 && < 5 } + +common appar { build-depends: appar >= 0.1.8 && < 0.2 } +common binary { build-depends: binary >= 0.8 && < 0.9 } +common bytestring { build-depends: bytestring >= 0.10.6 && < 0.11 } +common containers { build-depends: containers >= 0.6.0.1 && < 0.7 } +common generic-lens { build-depends: generic-lens >= 1.1.0.0 && < 1.2 } +common hedgehog { build-depends: hedgehog >= 0.5.3 && < 0.7 } +common hspec { build-depends: hspec >= 2.4.4 && < 2.6 } +common hw-bits { build-depends: hw-bits >= 0.7 && < 0.8 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.2 && < 0.2 } +common iproute { build-depends: iproute >= 1.7.3 && < 1.8 } +common lens { build-depends: lens >= 4 && < 5 } +common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.15 } +common text { build-depends: text >= 1.2.3.1 && < 1.3 } + +common semigroups { if impl(ghc < 8 ) { build-depends: semigroups >= 0.16 && < 0.19 } } + +common config + default-language: Haskell2010 + ghc-options: -Wall + library + import: base, config + , appar + , containers + , generic-lens + , hw-bits + , iproute + , text exposed-modules: HaskellWorks.Data.Network.Ip HaskellWorks.Data.Network.Ip.Internal @@ -43,16 +73,35 @@ -Wredundant-constraints -O2 -msse4.2 - build-depends: - base >= 4 && < 4.13 - , appar >= 0.1.7 && < 0.2 - , containers - , generic-lens >= 0.5.1.0 && < 1.2 - , hw-bits >= 0.7.0.2 && < 0.8 - , iproute >= 1.7.3 && < 1.8 - , text >= 1.2.2.2 && < 1.3 +executable hw-ip + import: base, config + , appar + , binary + , bytestring + , generic-lens + , lens + , optparse-applicative + , semigroups + , text + main-is: Main.hs + hs-source-dirs: app + ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -msse4.2 + build-depends: hw-ip + other-modules: + App.Commands + App.Commands.TextToWord + App.Commands.Types + test-suite hw-ip-test + import: base, config + , appar + , generic-lens + , hedgehog + , hspec + , hw-bits + , hw-hspec-hedgehog + , text type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test @@ -75,13 +124,5 @@ -threaded -rtsopts -with-rtsopts=-N - build-depends: - base >= 4 && < 4.13 - , appar - , generic-lens - , hedgehog >= 0.5.3 && < 0.7 - , hspec >= 2.4.4 && < 2.6 - , hw-bits - , hw-hspec-hedgehog >= 0.1.0.2 && < 0.2 - , hw-ip - , text + build-depends: hw-ip + build-tools: 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 @@ -171,7 +171,7 @@ else Just (Range (IpAddress (a + hostMask + 1)) (IpAddress z)) width = B.finiteBitSize a --- assume distinct & sorted input +-- | Assume distinct & sorted input collapseIpBlocks :: [IpBlock Canonical] -> [IpBlock Canonical] collapseIpBlocks tomerge = skipOverlapped $ concat $ toList <$> go S.empty tomerge