net-spider-rpl-cli 0.1.2.2 → 0.1.3.0

raw patch · 4 files changed

+470/−6 lines, 4 filesdep +bytestringdep +fast-loggerdep +fgldep ~monad-loggerdep ~net-spiderdep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, fast-logger, fgl, hashable, transformers

Dependency ranges changed: monad-logger, net-spider, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• net-spider-rpl-cli.cabal +14/−6
• src/NetSpider/RPL/CLI/Analyze.hs +152/−0
• test/NetSpider/RPL/CLI/AnalyzeSpec.hs +300/−0

@@ -1,5 +1,9 @@ # Revision history for net-spider-rpl-cli +## 0.1.3.0  -- 2020-04-18++* Add Analyze module.+ ## 0.1.2.2  -- 2019-12-29  * Confirm `ip-1.7.0`.

@@ -1,5 +1,5 @@ name:                   net-spider-rpl-cli-version:                0.1.2.2+version:                0.1.3.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -24,10 +24,11 @@   ghc-options:          -Wall -fno-warn-unused-imports   default-extensions:   StrictData   other-extensions:     OverloadedStrings, RankNTypes-  exposed-modules:      NetSpider.RPL.CLI+  exposed-modules:      NetSpider.RPL.CLI,+                        NetSpider.RPL.CLI.Analyze   -- other-modules:           build-depends:        base >=4.11.1.0 && <4.13,-                        net-spider >=0.4.0.0 && <0.5,+                        net-spider >=0.4.3.0 && <0.5,                         net-spider-rpl >=0.4.0.0 && <0.5,                         net-spider-cli >=0.2.0.0 && <0.3,                         text >=1.2.2.2 && <1.3,@@ -35,7 +36,9 @@                         greskell >=1.0.0.0 && <1.1,                         optparse-applicative >=0.14.3.0 && <0.16,                         monad-logger >=0.3.28.1 && <0.4,-                        time >=1.8.0.2 && <1.10+                        time >=1.8.0.2 && <1.10,+                        fgl >=5.6.0.0 && <5.8,+                        transformers >=0.5.5.0 && <0.6  flag static   description: Static link@@ -61,10 +64,15 @@   main-is:              Spec.hs   -- default-extensions:      -- other-extensions:     -  other-modules:        NetSpider.RPL.CLISpec+  other-modules:        NetSpider.RPL.CLISpec,+                        NetSpider.RPL.CLI.AnalyzeSpec   build-depends:        base, net-spider-rpl-cli, net-spider, net-spider-rpl, optparse-applicative, net-spider-cli,+                        text, monad-logger,                         hspec >=2.5.5,-                        ip >=1.3.0 && <1.8+                        ip >=1.3.0 && <1.8,+                        hashable >=1.2.6.1 && <1.4,+                        bytestring >=0.10.8.2 && <0.11,+                        fast-logger >=2.4.11 && <3.1  source-repository head   type:                 git

@@ -0,0 +1,152 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module: NetSpider.RPL.CLI.Analyze+-- Description: Analyze graph attributes+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- @since 0.1.3.0+module NetSpider.RPL.CLI.Analyze+  ( DODAGAttributes(..),+    analyzeDIO,+    analyzeDAO+  ) where++import Control.Applicative (empty)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Maybe (MaybeT(..))+import Data.Graph.Inductive (LNode, LEdge, Gr)+import qualified Data.Graph.Inductive as FGL+import Data.List (sortOn, reverse)+import Data.Maybe (listToMaybe)+import Data.Monoid ((<>))+import Data.Text (Text)+import NetSpider.Log (WriterLoggingM, logErrorW, spack, logDebugW)+import NetSpider.SeqID+  (SeqIDMaker, newSeqIDMaker, convertGraph, originalIDFor)+import NetSpider.Snapshot+  ( SnapshotNode, SnapshotLink, SnapshotGraph,+    nodeId, nodeAttributes, sourceNode, destinationNode, linkAttributes,+    graphTimestamp+  )+import NetSpider.Timestamp (Timestamp, showTimestamp)+import NetSpider.RPL.DIO (SnapshotGraphDIO)+import NetSpider.RPL.DAO (SnapshotGraphDAO)+import NetSpider.RPL.FindingID+  ( IPv6ID, FindingID, FindingType(..), ipv6Only, ipv6ToText)+++-- | Attributes of a DODAG.+data DODAGAttributes =+  DODAGAttributes+  { node_num :: Int,+    edge_num :: Int,+    depth :: Int,+    root :: IPv6ID,+    time :: Timestamp+  }+  deriving (Show,Eq,Ord)++-- | Get analysis on a DIO graph.+analyzeDIO :: SnapshotGraphDIO -> WriterLoggingM (Maybe DODAGAttributes)+analyzeDIO = analyzeGeneric RootDest FindingDIO++-- | Get analysis on a DAO graph.+analyzeDAO :: SnapshotGraphDAO -> WriterLoggingM (Maybe DODAGAttributes)+analyzeDAO = analyzeGeneric RootSource FindingDAO++analyzeGeneric :: RootType -> FindingType -> SnapshotGraph FindingID na la -> WriterLoggingM (Maybe DODAGAttributes)+analyzeGeneric rtype ftype graph = runMaybeT $ go+  where+    maybeLog m err_log =+      case m of+        Nothing -> do+          lift $ logErrorW err_log+          empty+        Just v -> return v+    eitherLog e =+      case e of+        Left err_log -> maybeLog Nothing err_log+        Right v -> return v+    (seqid, gr) = toGr graph+    ft_str =+      case ftype of+        FindingDIO -> "DIO"+        FindingDAO -> "DAO"+    logRootIP root_ip = do+      lift $ logDebugW ("Root of the " <> ft_str <> " graph: " <> ipv6ToText root_ip)+    logTS ts = do+      lift $ logDebugW ("Timestamp of the " <> ft_str <> " graph: " <> showTimestamp ts)+    go = do+      root_node <- fmap fst $ eitherLog $ getRoot rtype gr+      root_ip <- fmap ipv6Only $ maybeLog+                 (originalIDFor seqid root_node)+                 ("Cannot find the FindingID for root node " <> (spack root_node) <> ".")+      logRootIP root_ip+      graph_ts <- maybeLog (graphTimestamp graph) ("The graph has no timestamp.")+      logTS graph_ts+      return DODAGAttributes { node_num = nodeNum gr,+                               edge_num = edgeNum gr,+                               depth = getDepth root_node rtype gr,+                               root = root_ip,+                               time = graph_ts+                             }++toLNode :: SnapshotNode Int na -> LNode (Maybe na)+toLNode n = (nodeId n, nodeAttributes n)++toLEdge :: SnapshotLink Int la -> LEdge la+toLEdge l = (sourceNode l, destinationNode l, linkAttributes l)++toGr :: SnapshotGraph FindingID na la -> (SeqIDMaker FindingID FGL.Node, Gr (Maybe na) la)+toGr graph = (got_maker, FGL.mkGraph lnodes ledges)+  where+    (got_maker, (new_nodes, new_links)) = convertGraph (newSeqIDMaker 0) graph+    lnodes = map toLNode new_nodes+    ledges = map toLEdge new_links++nodeNum :: Gr na la -> Int+nodeNum = FGL.order++edgeNum :: Gr na la -> Int+edgeNum = FGL.size++data RootType = RootSource -- ^ Node with no incoming edges.+              | RootDest -- ^ Node with no outgoing edges.++getRoot :: RootType -> Gr na la -> Either Text (LNode na)+getRoot rt gr = toEither+                $ reverse+                $ sortOn childNum+                $ filter (\n -> parentNum n == 0)+                $ FGL.labNodes gr+  where+    (parentNum, childNum) =+      case rt of+        RootSource -> ((FGL.indeg gr  . fst), (FGL.outdeg gr . fst))+        RootDest   -> ((FGL.outdeg gr . fst), (FGL.indeg gr  . fst))+    toEither [] = Left ("The graph has no node that has no parent.")+    toEither [n] = Right n+    toEither (rnode : others) =+      if childNum rnode > 0 && (all (\n -> childNum n == 0) others)+      then Right rnode+      else if childNum rnode == 0+           then Left ("The graph contains orphan nodes only.")+           else Left ("The graph contains multiple root candidates.")++getDepth :: FGL.Node -- ^ the root node+         -> RootType -- ^ type of the root+         -> Gr na la+         -> Int+getDepth root_node rtype gr = maximum' $ map toPathLen $ FGL.spTree root_node $ convertGr gr+  where+    convertGr = FGL.gmap setEdgeDir . FGL.emap setEdgeLabel+      where+        setEdgeLabel _ = (1 :: Int)+        setEdgeDir orig@(inedges, n, nlabel, outedges) =+          case rtype of+            RootSource -> orig+            RootDest -> (outedges, n, nlabel, inedges)+    toPathLen (FGL.LP nodes) = length nodes - 1+    maximum' [] = 0+    maximum' l = maximum l+

@@ -0,0 +1,300 @@+{-# LANGUAGE OverloadedStrings #-}+module NetSpider.RPL.CLI.AnalyzeSpec (main,spec) where++import Control.Monad.Logger (LogLevel(..))+import System.Log.FastLogger (fromLogStr)+import qualified Data.ByteString as BS+import Data.Foldable (foldl')+import Data.Hashable (Hashable)+import Data.Int (Int64)+import Data.Maybe (fromJust)+import Data.Text (Text, unpack)+import Data.Text.Encoding (encodeUtf8)+import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(..))+import NetSpider.Log (runWriterLoggingM, LogLine)+import NetSpider.Query (foundNodePolicy, unifyLinkSamples, Query)+import NetSpider.RPL.FindingID (FindingID, idFromText, ipv6FromText, IPv6ID)+import NetSpider.RPL.DAO+  ( DAONode(..), DAOLink(..), daoDefQuery, FoundNodeDAO,+    SnapshotGraphDAO+  )+import NetSpider.RPL.DIO+  ( DIONode(..), DIOLink(..), MergedDIOLink(..), NeighborType(..),+    FoundNodeDIO, SnapshotGraphDIO, dioDefQuery+  )+import NetSpider.Snapshot (SnapshotGraph)+import NetSpider.Timestamp (fromEpochMillisecond)+import NetSpider.Weaver (Weaver, newWeaver, getSnapshot, addFoundNode)+import Test.Hspec++import NetSpider.RPL.CLI.Analyze+  ( analyzeDAO, analyzeDIO,+    DODAGAttributes(DODAGAttributes)+  )+import qualified NetSpider.RPL.CLI.Analyze as A++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  spec_DIO+  spec_DAO++makeSnapshotFromQuery :: (Ord n, Hashable n, Show n) => Query n na fla sla -> [FoundNode n na fla] -> SnapshotGraph n na sla+makeSnapshotFromQuery query fns = getS $ foldl' (\w fn -> addFoundNode fn w) newW fns+  where+    newW = newWeaver $ foundNodePolicy $ query+    getS = getSnapshot $ unifyLinkSamples $ query++makeSnapshotDAO :: [FoundNodeDAO] -> SnapshotGraphDAO+makeSnapshotDAO = makeSnapshotFromQuery $ daoDefQuery []++makeSnapshotDIO :: [FoundNodeDIO] -> SnapshotGraphDIO+makeSnapshotDIO = makeSnapshotFromQuery $ dioDefQuery []++idFromText' :: Text -> FindingID+idFromText' = fromJust . idFromText++ipFromText' :: Text -> IPv6ID+ipFromText' = fromJust . ipv6FromText++defPathLifeTime :: Word+defPathLifeTime = 3600++daoNode :: Int64 -- ^ timestamp+        -> Maybe Word -- ^ route num+        -> Text -- ^ subject+        -> [Text] -- ^ targets+        -> FoundNodeDAO+daoNode ts mroutes sub targets =+  FoundNode+  { subjectNode = idFromText' sub,+    foundAt = fromEpochMillisecond ts,+    nodeAttributes = DAONode $ mroutes,+    neighborLinks = map toFL targets+  }+  where+    toFL t = FoundLink+             { targetNode = idFromText' t,+               linkState = LinkToTarget,+               linkAttributes = DAOLink $ defPathLifeTime+             }++dioNode :: Int64+        -> Text -- ^ subject+        -> [Text] -- ^ targets+        -> FoundNodeDIO+dioNode ts sub targets =+  FoundNode+  { subjectNode = idFromText' sub,+    foundAt = fromEpochMillisecond ts,+    nodeAttributes = DIONode defRank defDioInterval,+    neighborLinks = map toFL targets+  }+  where+    defRank = 256+    defDioInterval = 10+    toFL t =+      FoundLink+      { targetNode = idFromText' t,+        linkState = LinkToTarget,+        linkAttributes = DIOLink PreferredParent defNRank Nothing+      }+    defNRank = 512++expectNoErrorLog :: [LogLine] -> IO ()+expectNoErrorLog got_logs =+  if (length $ filter matchLog got_logs) == 0+  then return ()+  else expectationFailure ("Expected no error/warn log, but found. " <> show got_logs)+  where+    matchLog (_, _, LevelError, _) = True+    matchLog (_, _, LevelWarn, _) = True+    matchLog (_, _, _, _) = False++expectErrorLog :: [LogLine] -> Text -> IO ()+expectErrorLog got_logs exp_err_msg =+  if (length $ filter matchLog got_logs) == 0+  then expectationFailure ("Expected an error log matching " <> unpack exp_err_msg <> ", but not found.")+  else return ()+  where+    matchLog (_, _, LevelError, logstr) = matchLogMsg logstr+    matchLog (_, _, _, _) = False+    matchLogMsg logstr = encodeUtf8 exp_err_msg `BS.isInfixOf` fromLogStr logstr++spec_DIO :: Spec+spec_DIO = describe "analyzeDIO" $ do+  specify "root only" $ do+    let fns = [ dioNode 100 "dio://[fd00::1]" []+              ]+        (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns+    got `shouldBe`+      ( Just $ DODAGAttributes+        { A.node_num = 1,+          A.edge_num = 0,+          A.depth = 0,+          A.root = ipFromText' "fd00::1",+          A.time = fromEpochMillisecond 100+        }+      )+    expectNoErrorLog logs+  specify "depth 1" $ do+    let fns = [ dioNode 100 "dio://[fd00::1]" [],+                dioNode 120 "dio://[fd00::2]" ["dio://[fd00::1]"],+                dioNode 140 "dio://[fd00::3]" ["dio://[fd00::1]"],+                dioNode 110 "dio://[fd00::4]" ["dio://[fd00::1]"]+              ]+        (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns+    got `shouldBe`+      ( Just $ DODAGAttributes+        { A.node_num = 4,+          A.edge_num = 3,+          A.depth = 1,+          A.root = ipFromText' "fd00::1",+          A.time = fromEpochMillisecond 140+        }+      )+    expectNoErrorLog logs+  specify "depth 4" $ do+    let fns = [ dioNode 150 "dio://[fd00::1]" [],+                dioNode 110 "dio://[fd00::4]" ["dio://[fd00::3]"],+                dioNode 120 "dio://[fd00::2]" ["dio://[fd00::1]"],+                dioNode 200 "dio://[fd00::3]" ["dio://[fd00::2]"],+                dioNode 170 "dio://[fd00::5]" ["dio://[fd00::4]"],+                dioNode 189 "dio://[fd00::6]" ["dio://[fd00::2]"]+              ]+        (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns+    got `shouldBe`+      ( Just $ DODAGAttributes+        { A.node_num = 6,+          A.edge_num = 5,+          A.depth = 4,+          A.root = ipFromText' "fd00::1",+          A.time = fromEpochMillisecond 200+        }+      )+    expectNoErrorLog logs+  specify "multiple orphan nodes with one root" $ do+    let fns = [ dioNode 110 "dio://[fd00::1]" [],+                dioNode 120 "dio://[fd00::2]" [],+                dioNode 130 "dio://[fd00::3]" [],+                dioNode 100 "dio://[fd00::4]" ["dio://[fd00::2]"]+              ]+        (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns+    got `shouldBe`+      ( Just $ DODAGAttributes+        { A.node_num = 4,+          A.edge_num = 1,+          A.depth = 1,+          A.root = ipFromText' "fd00::2",+          A.time = fromEpochMillisecond 130+        }+      )+    expectNoErrorLog logs+  specify "multiple roots" $ do+    let fns = [ dioNode 100 "dio://[fd00::1]" [],+                dioNode 200 "dio://[fd00::2]" ["dio://[fd00::1]"],+                dioNode 150 "dio://[fd00::3]" [],+                dioNode 130 "dio://[fd00::4]" ["dio://[fd00::3]"]+              ]+        (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns+    got `shouldBe` Nothing+    expectErrorLog logs "multiple root"+  specify "all orphan nodes" $ do+    let fns = [ dioNode 120 "dio://[fd00::1]" [],+                dioNode 170 "dio://[fd00::2]" [],+                dioNode 110 "dio://[fd00::5]" [],+                dioNode 100 "dio://[fd00::3]" [],+                dioNode 180 "dio://[fd00::4]" []+              ]+        (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns+    got `shouldBe` Nothing+    expectErrorLog logs "orphan nodes only"+++spec_DAO :: Spec+spec_DAO = describe "analyzeDAO" $ do+  specify "root only" $ do+    let fns = [ daoNode 100 (Just 0) "dao://[fd00::1]" []+              ]+        (got, logs) = runWriterLoggingM $ analyzeDAO $ makeSnapshotDAO fns+    got `shouldBe`+      ( Just $ DODAGAttributes+        { A.node_num = 1,+          A.edge_num = 0,+          A.depth = 0,+          A.root = ipFromText' "fd00::1",+          A.time = fromEpochMillisecond 100+        }+      )+    expectNoErrorLog logs+  specify "depth 1" $ do+    let fns = [ daoNode 100 (Just 3) "dao://[fd00::1]"+                [ "dao://[fd00::2]",+                  "dao://[fd00::3]",+                  "dao://[fd00::4]"+                ],+                daoNode 100 Nothing "dao://[fd00::2]" [],+                daoNode 100 Nothing "dao://[fd00::3]" [],+                daoNode 100 Nothing "dao://[fd00::4]" []+              ]+        (got, logs) = runWriterLoggingM $ analyzeDAO $ makeSnapshotDAO fns+    got `shouldBe`+      ( Just $ DODAGAttributes+        { A.node_num = 4,+          A.edge_num = 3,+          A.depth = 1,+          A.root = ipFromText' "fd00::1",+          A.time = fromEpochMillisecond 100+        }+      )+    expectNoErrorLog logs+  specify "depth 4" $ do+    let fns = [ daoNode 100 Nothing  "dao://[fd00::3]" ["dao://[fd00::4]"],+                daoNode 100 (Just 4) "dao://[fd00::1]" ["dao://[fd00::2]"],+                daoNode 100 Nothing  "dao://[fd00::5]" [],+                daoNode 100 Nothing  "dao://[fd00::2]" ["dao://[fd00::3]"],+                daoNode 100 Nothing  "dao://[fd00::4]" ["dao://[fd00::5]"]+              ]+        (got, logs) = runWriterLoggingM $ analyzeDAO $ makeSnapshotDAO fns+    got `shouldBe`+      ( Just $ DODAGAttributes+        { A.node_num = 5,+          A.edge_num = 4,+          A.depth = 4,+          A.root = ipFromText' "fd00::1",+          A.time = fromEpochMillisecond 100+        }+      )+    expectNoErrorLog logs+  specify "multiple timestamps" $ do+    let fns = [ daoNode 100 (Just 4) "dao://[fd00::1]" ["dao://[fd00::2]", "dao://[fd00::3]"],+                daoNode 100 Nothing  "dao://[fd00::2]" ["dao://[fd00::4]", "dao://[fd00::5]"],+                daoNode 100 Nothing  "dao://[fd00::3]" [],+                daoNode 100 Nothing  "dao://[fd00::4]" [],+                daoNode 100 Nothing  "dao://[fd00::5]" [],++                daoNode 200 Nothing  "dao://[fd00::3]" ["dao://[fd00::6]"],+                daoNode 200 Nothing  "dao://[fd00::6]" []+                +                -- daoNode 200 (Just 4) "dao://[fd00::1]" ["dao://[fd00::2]", "dao://[fd00::3]", "dao://[fd00::4]"],+                -- daoNode 200 Nothing  "dao://[fd00::2]" ["dao://[fd00::5]"],+                -- daoNode 200 Nothing  "dao://[fd00::4]" [],+                -- daoNode 200 Nothing  "dao://[fd00::5]" [],+              ]+        (got, logs) = runWriterLoggingM $ analyzeDAO $ makeSnapshotDAO fns+    got `shouldBe`+      ( Just $ DODAGAttributes+        { A.node_num = 6,+          A.edge_num = 5,+          A.depth = 2,+          A.root = ipFromText' "fd00::1",+          A.time = fromEpochMillisecond 200+        }+      )+    expectNoErrorLog logs++      +  +