net-spider-rpl-cli (empty) → 0.1.1.0
raw patch · 9 files changed
+621/−0 lines, 9 filesdep +basedep +greskelldep +hspecsetup-changed
Dependencies added: base, greskell, hspec, ip, monad-logger, net-spider, net-spider-cli, net-spider-rpl, net-spider-rpl-cli, optparse-applicative, text, time, unordered-containers
Files
- ChangeLog.md +16/−0
- LICENSE +30/−0
- README.md +90/−0
- Setup.hs +2/−0
- app/Main.hs +3/−0
- net-spider-rpl-cli.cabal +71/−0
- src/NetSpider/RPL/CLI.hs +371/−0
- test/NetSpider/RPL/CLISpec.hs +37/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,16 @@+# Revision history for net-spider-rpl-cli++## 0.1.1.0 -- 2019-09-23++* First release.+* Improve README.+* Add `--filter` option to `input` command.+* Add `--year` option to `input` command.+* Improve debug messages.+* Now `--starts-from` option is mandatory for `snapshot` command.+* Now at least one input file is mandatory for `input` command.+++## 0.1.0.0 -- 2019-09-16++* Preliminary version. Not released to hackage. Just to test Docker Hub.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Toshio Ito++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Toshio Ito nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,90 @@+# net-spider-rpl-cli++An executable of [net-spider](https://hackage.haskell.org/package/net-spider) specialized for analyzing [RPL](https://tools.ietf.org/html/rfc6550) networks.++## Synopsis++Here is an example of using the Docker images of this package. You have to install [docker](https://docs.docker.com/install/) and [docker-compose](https://docs.docker.com/compose/) first.++1. Start the graph database backend (i.e. Gremlin Server).++ $ docker-compose up -d++2. Clear the entire database.++ $ ./run-net-spider.sh clear++3. Input logs about RPL networks.++ $ ./run-net-spider.sh input < syslog++4. Get a snapshot graph of the RPL network in GraphML format.++ $ ./run-net-spider.sh snapshot --time-to '2019-09-20T10:43:08' --starts-from 'fd00::212:eeaa:0077:2f9c' > snapshot.graphml+++## Description++net-spider-rpl-cli is a tool to analyze evolution of an RPL network. It collects "local findings" about the network topology from RPL nodes, and stores those data into a graph database. Then you can query the database to get a "snapshot graph", a network topology at the specified time.++For general description about net-spider and its terminology, see [net-spider README](https://github.com/debug-ito/net-spider).++For details on command-line options, run the tool with `--help` option.++## Build and install++net-spider-rpl-cli is a regular Haskell package with an executable. You can install it from [hackage repository](https://hackage.haskell.org/package/net-spider-rpl-cli).++Or, you can just use [the pre-built Docker image](#Docker-image).++## Graph database++net-spider-rpl-cli stores time-varying topology of an RPL network into a graph dabase via the [Gremlin Server](http://tinkerpop.apache.org/). You have to set up the server, and pass the server's hostname and port to `--host` and `--port` options, respectively.++## Commands++net-spider-rpl-cli has the folowing sub-commands.++### clear command++`clear` command clears the entire database. Use with care.++### input command++`input` command reads log files, extracts information about the RPL network topology with timestamps and stores them into the database.++Currently, the format of the log files must be **logs of rpl-lite module of [Contiki-NG](https://github.com/contiki-ng/contiki-ng) operating system, prefixed with the standard syslog header.** See [this test file](https://github.com/debug-ito/net-spider/blob/master/net-spider-rpl/test/data/syslog_root.log) for an example.++There are two kinds of RPL network topology: the DIO (upward) graph and the DAO (downward) graph. `input` command extracts and stores both kinds of information.++### snapshot command++`snapshot` command queries the database to make a "snapshot graph", an RPL network topology observed at the specified time. You can specify a time range with `--time-from` and `--time-to` options, and then it makes a snapshot graph using only those input information observed during the time range.++To run this command, you have to specify `--starts-from` option at least one time. This is the IPv6 address of the node from which it searches for a snapshot graph. Usually this should be the address of the DODAG root.++It prints the obtained snapshot graph to STDOUT in [GraphML](http://graphml.graphdrawing.org/) format. The graph includes both DIO and DAO graphs, but you can distinguish them by `link_type` attribute of edges.++### cis command++`cis` command is a short for "clear + input + snapshot". It clears the database, inputs the specified log files and returns a snapshot graph.++With this command, you don't have to specify `--starts-from` option (it's ignored.) Instead, all IPv6 addresses observed in the input log files are searched.+++## Docker image++We provide pre-built Docker images of net-spider-rpl-cli and the graph database.++- The Docker image of the graph database is specified in `docker-compose.yml` in this directory.++ - You can start it with `docker-compose up` command.+ - The "db" directory stores persistent graph data.++- The Docker image of net-spider-rpl-cli is available at Docker Hub as [debugito/net-spider-rpl-cli](https://hub.docker.com/r/debugito/net-spider-rpl-cli).+- To run the net-spider-rpl-cli image with the graph database image, use "run-net-spider.sh" script in this directory.+++## Author++Toshio Ito <debug.ito@gmail.com>
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,3 @@+module Main (main) where++import NetSpider.RPL.CLI (main)
+ net-spider-rpl-cli.cabal view
@@ -0,0 +1,71 @@+name: net-spider-rpl-cli+version: 0.1.1.0+author: Toshio Ito <debug.ito@gmail.com>+maintainer: Toshio Ito <debug.ito@gmail.com>+license: BSD3+license-file: LICENSE+synopsis: CLI executable of NetSpider.RPL.+description: CLI executable of "NetSpider.RPL". It's also an example of "NetSpider.CLI" module.+ .+ __This package is an experimental release. CLI interface and functionality may change drastically in future.__+ .+ For detail, see README.md+stability: alpha+category: Database+cabal-version: >= 1.10+build-type: Simple+extra-source-files: README.md, ChangeLog.md+homepage: https://github.com/debug-ito/net-spider+bug-reports: https://github.com/debug-ito/net-spider/issues++library+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall -fno-warn-unused-imports+ default-extensions: StrictData+ other-extensions: OverloadedStrings, RankNTypes+ exposed-modules: NetSpider.RPL.CLI+ -- other-modules: + build-depends: base >=4.11.1.0 && <4.13,+ net-spider >=0.3.2.0 && <0.4,+ net-spider-rpl >=0.2.2.0 && <0.3,+ net-spider-cli >=0.1.0.1 && <0.2,+ text >=1.2.2.2 && <1.3,+ unordered-containers >=0.2.8 && <0.3,+ greskell >=0.2.3 && <0.3,+ optparse-applicative >=0.14.3.0 && <0.16,+ monad-logger >=0.3.28.1 && <0.4,+ time >=1.8.0.2 && <1.10++flag static+ description: Static link+ default: False++executable net-spider-rpl-cli+ default-language: Haskell2010+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -Wall -fno-warn-unused-imports+ -- other-modules: + -- default-extensions: + -- other-extensions: + build-depends: base, net-spider-rpl-cli+ if flag(static)+ ld-options: -static++test-suite spec+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"+ main-is: Spec.hs+ -- default-extensions: + -- other-extensions: + other-modules: NetSpider.RPL.CLISpec+ build-depends: base, net-spider-rpl-cli, net-spider, net-spider-rpl, optparse-applicative, + hspec >=2.5.5,+ ip >=1.3.0 && <1.5++source-repository head+ type: git+ location: https://github.com/debug-ito/net-spider.git
+ src/NetSpider/RPL/CLI.hs view
@@ -0,0 +1,371 @@+{-# LANGUAGE OverloadedStrings, RankNTypes #-}+-- |+-- Module: NetSpider.RPL.CLI+-- Description: CLI executable of NetSpider.RPL+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+-- +module NetSpider.RPL.CLI+ ( main,+ -- * Symbols only for testing+ optionParser,+ CLIConfig(..),+ Cmd(..),+ InputParams(..)+ ) where++import qualified Data.Text.Lazy.IO as TLIO+import qualified Data.Text.IO as TIO+import Control.Applicative (many, some, (<$>), (<*>), optional)+import Control.Exception (bracket)+import Control.Monad (forM_, when, void)+import Control.Monad.Logger (LogLevel(LevelDebug))+import Data.Greskell (Key(..))+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.List (sortOn, reverse, intercalate)+import Data.Monoid ((<>), mconcat)+import Data.Text (Text, pack, unpack)+import Data.Time (getZonedTime, ZonedTime(zonedTimeToLocalTime), LocalTime(localDay), toGregorian)+import NetSpider.GraphML.Writer (writeGraphML)+import qualified NetSpider.CLI.Snapshot as CLIS+import NetSpider.CLI.Spider (SpiderConfig, parserSpiderConfig)+import NetSpider.Input+ ( defConfig, logThreshold,+ addFoundNode, clearAll,+ FoundNode(subjectNode, foundAt, neighborLinks, nodeAttributes),+ FoundLink(targetNode, linkAttributes),+ LinkAttributes, NodeAttributes,+ Spider, withSpider, nodeIdKey+ )+import NetSpider.Output+ ( getSnapshot,+ defQuery, unifyLinkSamples, unifyStd,+ Query(startsFrom, timeInterval),+ SnapshotNode, SnapshotLink, secUpTo,+ SnapshotGraph+ )+import NetSpider.RPL.FindingID+ ( FindingID(..), idToText, FindingType(..),+ IPv6ID(..), ipv6FromText, ipv6Only+ )+import NetSpider.RPL.DIO+ ( FoundNodeDIO, DIONode, MergedDIOLink+ )+import qualified NetSpider.RPL.DIO as DIO+import NetSpider.RPL.DAO (FoundNodeDAO)+import qualified NetSpider.RPL.DAO as DAO+import qualified NetSpider.RPL.Combined as RPL+import NetSpider.RPL.ContikiNG (parseFile, parseFileHandle, pSyslogHead)+import qualified Options.Applicative as Opt+import System.Environment (getArgs)+import System.Exit (die)+import System.IO (hPutStrLn, stderr, stdin)++main :: IO ()+main = do+ cli_conf <- Opt.execParser $ Opt.info (Opt.helper <*> optionParser) $ mconcat $+ [ Opt.progDesc "net-spider front-end for RPL data model."+ ]+ let sconf = cliSpiderConfig cli_conf+ cmd = cliCmd cli_conf+ case cmd of+ CmdClear -> doClear sconf+ CmdInput inp -> void $ doInput sconf inp+ CmdSnapshot q -> doSnapshot sconf q+ CmdCIS inp q -> doCIS sconf inp q+ where+ doClear sconf = do+ hPutStrLn stderr "---- Clear graph database"+ withSpider sconf $ clearAll++ doInput sconf (InputParams filenames fnfilter myear) = do+ -- filenames is a list of syslog filenames++ year <- getYear myear+ + -- Read DIO and DAO FoundNodes. It might take a long time to+ -- insert a lot of FoundNodes, so this executable inserts only+ -- the latest FoundNode per node into the net-spider database.+ (dio_nodes, dao_nodes) <- applyFoundNodeFilter fnfilter+ =<< (fmap concatPairs $ mapM (loadFile year) filenames)+ hPutStrLn stderr ("---- Load done")+ + -- Input DIO and DAO FoundNodes. Note that we have to cast+ -- SpiderConfig's type to match DIO and DAO FoundNode.+ hPutStrLn stderr ("---- Put " <> (show $ length dio_nodes) <> " local findings about DIO")+ when (isVerboseDebug sconf) $ forM_ dio_nodes printDIONode+ putNodes (castSpiderConfig sconf) dio_nodes+ hPutStrLn stderr ("---- Put " <> (show $ length dao_nodes) <> " local findings about DAO")+ when (isVerboseDebug sconf) $ forM_ dao_nodes printDAONode+ putNodes (castSpiderConfig sconf) dao_nodes+ return (dio_nodes, dao_nodes)++ doSnapshot sconf query = do+ let start_node_num = length $ startsFrom query+ hPutStrLn stderr ("---- Query starts from " ++ (show start_node_num) ++ " nodes")+ when (start_node_num == 0) $ do+ die ("Specify the starting nodes with -s option.")+ forM_ (startsFrom query) $ \nid -> do+ hPutStrLn stderr (show nid)+ -- Get DIO and DAO snapshot graphs with the Query.+ hPutStrLn stderr ("---- Get DIO SnapshotGraph")+ dio_graph <- withSpider (castSpiderConfig sconf) $ \sp -> do+ getSnapshot sp $ rebaseQuery query FindingDIO (DIO.dioDefQuery [])+ hPutStrLn stderr ("---- Get DAO SnapshotGraph")+ dao_graph <- withSpider (castSpiderConfig sconf) $ \sp -> do+ getSnapshot sp $ rebaseQuery query FindingDAO (DAO.daoDefQuery [])+ + -- Merge DIO and DAO SnapshotGraphs into one.+ let com_graph = RPL.combineGraphs dio_graph dao_graph+ -- Write the merged SnapshotGraph in GraphML to stdout.+ hPutStrLn stderr ("---- Format DIO+DAO SnapshotGraph into GraphML")+ TLIO.putStr $ writeGraphML com_graph++ doCIS sconf input_params query_base = do+ doClear sconf+ (dio_nodes, dao_nodes) <- doInput sconf input_params+ -- Make a query from the FoundNodes just loaded.+ let starts = (map (ipv6Only . subjectNode) $ sortDAONodes dao_nodes)+ +++ (map (ipv6Only . subjectNode) dio_nodes)+ q = query_base { startsFrom = starts }+ doSnapshot sconf q+ isVerboseDebug sconf = logThreshold sconf <= LevelDebug+++---- CLI parsers.++-- | Filter function of 'FoundNode', agnostic of node and link+-- attributes.+data FoundNodeFilter =+ FoundNodeFilter+ { fnfRun :: forall na la . [FoundNode FindingID na la] -> [FoundNode FindingID na la],+ fnfSymbol :: String,+ fnfDesc :: Text+ }++applyFoundNodeFilter :: FoundNodeFilter+ -> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])+ -> IO ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])+applyFoundNodeFilter fnf input = do+ hPutStrLn stderr ("---- Apply filter '" ++ fnfSymbol fnf ++ "' to local findings.")+ return $ filterPairs (fnfRun fnf) input++-- | Top-level configuration obtained from command-line arguments.+data CLIConfig n na fla =+ CLIConfig+ { cliSpiderConfig :: SpiderConfig n na fla,+ cliCmd :: Cmd+ }++-- | Parameters for input command. Filenames to input, filter for+-- FoundNodes, and the year that the parser use to parse the input+-- files.+data InputParams = InputParams [FilePath] FoundNodeFilter (Maybe Year)++-- | CLI subcommands and their arguments.+data Cmd = CmdClear -- ^ Clear the entire database.+ | CmdInput InputParams -- ^ Input FoundNodes to the database+ | CmdSnapshot (Query IPv6ID () () ()) -- ^ Get a snapshot graph.+ | CmdCIS InputParams (Query IPv6ID () () ()) -- ^ Clear + Input + Snapshot++optionParser :: Opt.Parser (CLIConfig n na fla)+optionParser = CLIConfig <$> parserSpiderConfig <*> parserCommands+ where+ parserCommands = Opt.hsubparser $ mconcat commands+ commands = [ Opt.command "clear" $+ Opt.info (pure CmdClear) (Opt.progDesc "Clear the entire database."),+ Opt.command "input" $+ Opt.info (CmdInput <$> parserInputParams)+ (Opt.progDesc "Input local findings into the database."),+ Opt.command "snapshot" $+ Opt.info (parserSnapshot True) (Opt.progDesc "Get a snapshot graph from the database."),+ Opt.command "cis" $+ Opt.info (CmdCIS <$> parserInputParams <*> parserSnapshotQuery False)+ (Opt.progDesc "Clear + Input + Snapshot at once. `startsFrom` of the query is set by local findings loaded from the files.")+ ]+ parserInputParams = InputParams <$> parserInputFiles <*> parserFilter <*> parserYear+ parserInputFiles = some $ Opt.strArgument $ mconcat+ [ Opt.metavar "FILE",+ Opt.help "Input file. You can specify multiple times. If '-' is specified, it reads STDIN."+ ]+ ipv6Reader = (maybe (fail "Invalid IPv6") return . ipv6FromText . pack) =<< Opt.str+ parserSnapshot parse_arg = fmap CmdSnapshot $ parserSnapshotQuery parse_arg+ parserSnapshotQuery parse_arg =+ CLIS.parserSnapshotQuery $+ CLIS.SnapshotConfig+ { CLIS.nodeIDReader = ipv6Reader,+ CLIS.basisSnapshotQuery = defQuery [],+ CLIS.startsFromAsArguments = parse_arg+ }+ parserFilter = Opt.option readerFilter $ mconcat+ [ Opt.metavar "FILTER",+ Opt.help ( "Filter for local findings. Out of the local findings loaded from the input files, "+ <> "only those that pass the filter are input to the database. "+ <> "Possible values are: " <> filterDescs+ ),+ Opt.short 'F',+ Opt.long "filter",+ Opt.value (allFilters !! 0)+ ]+ filterDescs = intercalate ", " $ map descFor allFilters+ descFor fnf = "'" <> fnfSymbol fnf <> "': " <> (unpack $ fnfDesc fnf)+ readerFilter = selectFoundNodeFilter =<< Opt.str+ selectFoundNodeFilter symbol =+ case filter (\fnf -> fnfSymbol fnf == symbol) allFilters of+ [] -> fail ("Unknown filter: " <> symbol)+ (x : _) -> return x+ allFilters =+ [ FoundNodeFilter+ { fnfRun = id,+ fnfSymbol = "none",+ fnfDesc = "Not filter anything. This is the default."+ },+ FoundNodeFilter+ { fnfRun = getLatestForEachNode,+ fnfSymbol = "latest",+ fnfDesc = "Input only the latest local finding for each node."+ }+ ]+ parserYear = optional $ Opt.option Opt.auto $ mconcat+ [ Opt.long "year",+ Opt.metavar "YEAR",+ Opt.help ( "If specified, the year of timestamps in local findings is set to YEAR. "+ <> "If not specified, the year of the local system time is used. "+ <> "This is because the input file format does not contain the year in timestamp."+ )+ ]++---- Type adaptation of Config and Query++-- | Cast type variables of 'SpiderConfig'. The type variables are+-- basically phantom types for now.+castSpiderConfig :: SpiderConfig n1 na1 fla1 -> SpiderConfig n2 na2 fla2+castSpiderConfig sc = sc { nodeIdKey = Key $ unKey $ nodeIdKey sc }++-- | Convert the base of the original query.+rebaseQuery :: Query IPv6ID na1 fla1 sla1 -- ^ original query+ -> FindingType -- ^ new finding type+ -> Query FindingID na2 fla2 sla2 -- ^ new query base+ -> Query FindingID na2 fla2 sla2+rebaseQuery orig ftype base = base { startsFrom = map liftToFindingID $ startsFrom orig,+ timeInterval = timeInterval orig+ }+ where+ liftToFindingID (IPv6ID ip) = FindingID ftype ip++---- I/O of FoundNodes++type Year = Integer++-- | If input is 'Just', it returns that year. If 'Nothing', it gets+-- the local year from the system and returns it.+getYear :: Maybe Year -> IO Year+getYear (Just y) = return y+getYear Nothing = do+ zt <- getZonedTime+ let (y, _, _) = toGregorian $ localDay $ zonedTimeToLocalTime zt+ return y++-- | Read a Contiki-NG log file, parse it with+-- 'NetSpider.RPL.ContikiNG.parseFile' to get 'FoundNodeDIO' and+-- 'FoundNodeDAO'.+loadFile :: Year+ -> FilePath+ -> IO ([FoundNodeDIO], [FoundNodeDAO])+loadFile year file = do+ (dio_nodes, dao_nodes) <- loadNodes+ hPutStrLn stderr ((show $ length dio_nodes) <> " DIO local findings loaded")+ hPutStrLn stderr ((show $ length dao_nodes) <> " DAO local findings loaded")+ return (dio_nodes, dao_nodes)+ where+ phead = pSyslogHead year Nothing+ loadNodes = do+ if file == "-"+ then do+ hPutStrLn stderr ("---- Loading from stdin")+ parseFileHandle phead stdin+ else do+ hPutStrLn stderr ("---- Loading " <> file)+ parseFile phead file+++-- | Put (insert) the given 'FoundNode's into the net-spider+-- database+putNodes :: (LinkAttributes fla, NodeAttributes na)+ => SpiderConfig FindingID na fla+ -> [FoundNode FindingID na fla]+ -> IO ()+putNodes sconf input_nodes = do+ withSpider sconf $ \sp -> do+ hPutStrLn stderr ("---- Add " <> (show $ length $ input_nodes) <> " local findings")+ forM_ (zip input_nodes ([0 ..] :: [Integer])) $ \(input_node, index) -> do+ when ((index `mod` 100) == 0) $ hPutStrLn stderr ("Add local finding [" <> show index <> "]")+ addFoundNode sp input_node+ hPutStrLn stderr "Add done"++---- Print FoundNodes for debug++printDIONode :: FoundNodeDIO -> IO ()+printDIONode fn = do+ TIO.hPutStrLn stderr ("---- DIO finding: " <> (idToText $ subjectNode fn) <> ", rank " <> rank_text)+ forM_ plinks $ \l -> do+ TIO.hPutStrLn stderr (" -> " <> (idToText $ targetNode l))+ where+ plinks = filter isPreferredParentLink $ neighborLinks fn+ rank_text = pack $ show $ DIO.rank $ nodeAttributes fn+ isPreferredParentLink l =+ (DIO.neighborType $ linkAttributes l) == DIO.PreferredParent++printDAONode :: FoundNodeDAO -> IO ()+printDAONode fn = do+ TIO.hPutStrLn stderr ("---- DAO finding: " <> (idToText $ subjectNode fn) <> route_num_text)+ forM_ (neighborLinks fn) $ \l -> do+ TIO.hPutStrLn stderr (" -> " <> (idToText $ targetNode l) <> ", lifetime " <> lt_text l)+ where+ lt_text l = pack $ show $ DAO.pathLifetimeSec $ linkAttributes l+ route_num_text =+ case DAO.daoRouteNum $ nodeAttributes fn of+ Nothing -> ""+ Just n -> ", route_num " <> (pack $ show n)++---- General utility functions.++filterPairs :: (forall na la . [FoundNode FindingID na la] -> [FoundNode FindingID na la])+ -> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])+ -> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])+filterPairs f (ns1, ns2) = (f ns1, f ns2)++concatPairs :: [([a], [b])] -> ([a], [b])+concatPairs [] = ([],[])+concatPairs ((as, bs) : rest) = (as ++ rest_as, bs ++ rest_bs)+ where+ (rest_as, rest_bs) = concatPairs rest+++---- Filter for FoundNode.++type NodeMap n = HashMap FindingID [n]++collectNodes :: [FoundNode FindingID na la] -> NodeMap (FoundNode FindingID na la)+collectNodes = foldr addNode HM.empty+ where+ addNode n acc = HM.insertWith f (subjectNode n) [n] acc+ where+ f new old = new ++ old++getLatestNodes :: NodeMap (FoundNode n na la) -> [FoundNode n na la]+getLatestNodes nm = concat $ HM.elems $ fmap filterLatest nm+ where+ filterLatest fns = getHead $ reverse $ sortOn foundAt fns+ getHead [] = []+ getHead (a : _) = [a]++getLatestForEachNode :: [FoundNode FindingID na la] -> [FoundNode FindingID na la]+getLatestForEachNode = getLatestNodes . collectNodes+++---- FoundNode utility++sortDAONodes :: [FoundNodeDAO] -> [FoundNodeDAO]+sortDAONodes = reverse . sortOn (DAO.daoRouteNum . nodeAttributes)
+ test/NetSpider/RPL/CLISpec.hs view
@@ -0,0 +1,37 @@+module NetSpider.RPL.CLISpec (main,spec) where++import Data.Monoid (mempty)+import qualified Options.Applicative as Opt+import Net.IPv6 (ipv6)+import NetSpider.Query (startsFrom)+import NetSpider.RPL.FindingID (IPv6ID(..))+import Test.Hspec++import NetSpider.RPL.CLI (optionParser, Cmd(..), CLIConfig(..))++main :: IO ()+main = hspec spec++runParser :: Opt.Parser a -> [String] -> Either String a+runParser opt args = toEither $ Opt.execParserPure prefs info args+ where+ prefs = Opt.prefs mempty+ info = Opt.info opt mempty+ toEither (Opt.Success a) = Right a+ toEither (Opt.Failure f) = Left $ show f+ toEither (Opt.CompletionInvoked c) = Left $ show c++spec :: Spec+spec = do+ describe "optionParser" $ do+ specify "--starts-from" $ do+ let parse_result = runParser optionParser ["snapshot", "-s", "fd00::212:4b00:13a4:c554"]+ case parse_result of+ Right (CLIConfig _ (CmdSnapshot got_q)) ->+ startsFrom got_q `shouldBe` [IPv6ID $ ipv6 0xfd00 0 0 0 0x0212 0x4b00 0x13a4 0xc554]+ Right _ ->+ expectationFailure ("Unexpected CLIConfig obtained.")+ Left err ->+ expectationFailure (err)+ +
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}