{-# 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.Snapshot (CLISnapshotQuery)
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 :: IO ()
main = do
  CLIConfig Any Any Any
cli_conf <- ParserInfo (CLIConfig Any Any Any) -> IO (CLIConfig Any Any Any)
forall a. ParserInfo a -> IO a
Opt.execParser ParserInfo (CLIConfig Any Any Any)
forall n na fla. ParserInfo (CLIConfig n na fla)
optionParserInfo
  let sconf :: SpiderConfig Any Any Any
sconf = CLIConfig Any Any Any -> SpiderConfig Any Any Any
forall n na fla. CLIConfig n na fla -> SpiderConfig n na fla
cliSpiderConfig CLIConfig Any Any Any
cli_conf
      cmd :: Cmd
cmd = CLIConfig Any Any Any -> Cmd
forall n na fla. CLIConfig n na fla -> Cmd
cliCmd CLIConfig Any Any Any
cli_conf
  case Cmd
cmd of
    Cmd
CmdClear -> SpiderConfig Any Any Any -> IO ()
forall n na fla. Config n na fla -> IO ()
doClear SpiderConfig Any Any Any
sconf
    CmdInput InputParams
inp -> IO
  ([FoundNode FindingID DIONode DIOLink],
   [FoundNode FindingID DAONode DAOLink])
-> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO
   ([FoundNode FindingID DIONode DIOLink],
    [FoundNode FindingID DAONode DAOLink])
 -> IO ())
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
-> IO ()
forall a b. (a -> b) -> a -> b
$ SpiderConfig Any Any Any
-> InputParams
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
forall n1 na1 fla1.
Config n1 na1 fla1
-> InputParams
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
doInput SpiderConfig Any Any Any
sconf InputParams
inp
    CmdSnapshot CLISnapshotQuery IPv6ID
q -> SpiderConfig Any Any Any -> CLISnapshotQuery IPv6ID -> IO ()
forall n1 na1 fla1.
SpiderConfig n1 na1 fla1 -> CLISnapshotQuery IPv6ID -> IO ()
doSnapshot SpiderConfig Any Any Any
sconf CLISnapshotQuery IPv6ID
q
    CmdCIS InputParams
inp CLISnapshotQuery IPv6ID
q -> SpiderConfig Any Any Any
-> InputParams -> CLISnapshotQuery IPv6ID -> IO ()
forall n1 na1 fla1.
Config n1 na1 fla1
-> InputParams -> CLISnapshotQuery IPv6ID -> IO ()
doCIS SpiderConfig Any Any Any
sconf InputParams
inp CLISnapshotQuery IPv6ID
q
  where
    doClear :: Config n na fla -> IO ()
doClear Config n na fla
sconf = do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"---- Clear graph database"
      Config n na fla -> (Spider n na fla -> IO ()) -> IO ()
forall n na fla a.
Config n na fla -> (Spider n na fla -> IO a) -> IO a
withSpider Config n na fla
sconf ((Spider n na fla -> IO ()) -> IO ())
-> (Spider n na fla -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Spider n na fla -> IO ()
forall n na fla. Spider n na fla -> IO ()
clearAll

    doInput :: Config n1 na1 fla1
-> InputParams
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
doInput Config n1 na1 fla1
sconf (InputParams [String]
filenames FoundNodeFilter
fnfilter Maybe Year
myear) = do
      -- filenames is a list of syslog filenames

      Year
year <- Maybe Year -> IO Year
getYear Maybe Year
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.
      ([FoundNode FindingID DIONode DIOLink]
dio_nodes, [FoundNode FindingID DAONode DAOLink]
dao_nodes) <- FoundNodeFilter
-> ([FoundNode FindingID DIONode DIOLink],
    [FoundNode FindingID DAONode DAOLink])
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
forall na1 la1 na2 la2.
FoundNodeFilter
-> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
-> IO
     ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
applyFoundNodeFilter FoundNodeFilter
fnfilter
                                (([FoundNode FindingID DIONode DIOLink],
  [FoundNode FindingID DAONode DAOLink])
 -> IO
      ([FoundNode FindingID DIONode DIOLink],
       [FoundNode FindingID DAONode DAOLink]))
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (([([FoundNode FindingID DIONode DIOLink],
   [FoundNode FindingID DAONode DAOLink])]
 -> ([FoundNode FindingID DIONode DIOLink],
     [FoundNode FindingID DAONode DAOLink]))
-> IO
     [([FoundNode FindingID DIONode DIOLink],
       [FoundNode FindingID DAONode DAOLink])]
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [([FoundNode FindingID DIONode DIOLink],
  [FoundNode FindingID DAONode DAOLink])]
-> ([FoundNode FindingID DIONode DIOLink],
    [FoundNode FindingID DAONode DAOLink])
forall a b. [([a], [b])] -> ([a], [b])
concatPairs (IO
   [([FoundNode FindingID DIONode DIOLink],
     [FoundNode FindingID DAONode DAOLink])]
 -> IO
      ([FoundNode FindingID DIONode DIOLink],
       [FoundNode FindingID DAONode DAOLink]))
-> IO
     [([FoundNode FindingID DIONode DIOLink],
       [FoundNode FindingID DAONode DAOLink])]
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
forall a b. (a -> b) -> a -> b
$ (String
 -> IO
      ([FoundNode FindingID DIONode DIOLink],
       [FoundNode FindingID DAONode DAOLink]))
-> [String]
-> IO
     [([FoundNode FindingID DIONode DIOLink],
       [FoundNode FindingID DAONode DAOLink])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Year
-> String
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
loadFile Year
year) [String]
filenames)
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Load done")
      
      -- Input DIO and DAO FoundNodes. Note that we have to cast
      -- SpiderConfig's type to match DIO and DAO FoundNode.
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Put " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID DIONode DIOLink] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FoundNode FindingID DIONode DIOLink]
dio_nodes) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" local findings about DIO")
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config n1 na1 fla1 -> Bool
forall n na fla. Config n na fla -> Bool
isVerboseDebug Config n1 na1 fla1
sconf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID DIONode DIOLink]
-> (FoundNode FindingID DIONode DIOLink -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FoundNode FindingID DIONode DIOLink]
dio_nodes FoundNode FindingID DIONode DIOLink -> IO ()
printDIONode
      SpiderConfig FindingID DIONode DIOLink
-> [FoundNode FindingID DIONode DIOLink] -> IO ()
forall fla na.
(LinkAttributes fla, NodeAttributes na) =>
SpiderConfig FindingID na fla
-> [FoundNode FindingID na fla] -> IO ()
putNodes (Config n1 na1 fla1 -> SpiderConfig FindingID DIONode DIOLink
forall n1 na1 fla1 n2 na2 fla2.
SpiderConfig n1 na1 fla1 -> SpiderConfig n2 na2 fla2
castSpiderConfig Config n1 na1 fla1
sconf) [FoundNode FindingID DIONode DIOLink]
dio_nodes
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Put " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID DAONode DAOLink] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FoundNode FindingID DAONode DAOLink]
dao_nodes) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" local findings about DAO")
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config n1 na1 fla1 -> Bool
forall n na fla. Config n na fla -> Bool
isVerboseDebug Config n1 na1 fla1
sconf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID DAONode DAOLink]
-> (FoundNode FindingID DAONode DAOLink -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FoundNode FindingID DAONode DAOLink]
dao_nodes FoundNode FindingID DAONode DAOLink -> IO ()
printDAONode
      SpiderConfig FindingID DAONode DAOLink
-> [FoundNode FindingID DAONode DAOLink] -> IO ()
forall fla na.
(LinkAttributes fla, NodeAttributes na) =>
SpiderConfig FindingID na fla
-> [FoundNode FindingID na fla] -> IO ()
putNodes (Config n1 na1 fla1 -> SpiderConfig FindingID DAONode DAOLink
forall n1 na1 fla1 n2 na2 fla2.
SpiderConfig n1 na1 fla1 -> SpiderConfig n2 na2 fla2
castSpiderConfig Config n1 na1 fla1
sconf) [FoundNode FindingID DAONode DAOLink]
dao_nodes
      ([FoundNode FindingID DIONode DIOLink],
 [FoundNode FindingID DAONode DAOLink])
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
forall (m :: * -> *) a. Monad m => a -> m a
return ([FoundNode FindingID DIONode DIOLink]
dio_nodes, [FoundNode FindingID DAONode DAOLink]
dao_nodes)

    makeQuery :: CLISnapshotQuery IPv6ID -> IO (Query IPv6ID () () ())
makeQuery CLISnapshotQuery IPv6ID
cli_query = do
      let base_q :: Query IPv6ID () () ()
          base_q :: Query IPv6ID () () ()
base_q = [IPv6ID] -> Query IPv6ID () () ()
forall n na fla. (Eq n, Show n) => [n] -> Query n na fla fla
defQuery []
      Either String (Query IPv6ID () () ()) -> IO (Query IPv6ID () () ())
forall a. Either String a -> IO a
returnWithHelp (Either String (Query IPv6ID () () ())
 -> IO (Query IPv6ID () () ()))
-> Either String (Query IPv6ID () () ())
-> IO (Query IPv6ID () () ())
forall a b. (a -> b) -> a -> b
$ Query IPv6ID () () ()
-> CLISnapshotQuery IPv6ID -> Either String (Query IPv6ID () () ())
forall n na fla sla.
Query n na fla sla
-> CLISnapshotQuery n -> Either String (Query n na fla sla)
CLIS.makeSnapshotQuery Query IPv6ID () () ()
base_q CLISnapshotQuery IPv6ID
cli_query

    doSnapshot :: SpiderConfig n1 na1 fla1 -> CLISnapshotQuery IPv6ID -> IO ()
doSnapshot SpiderConfig n1 na1 fla1
sconf CLISnapshotQuery IPv6ID
cli_query = SpiderConfig n1 na1 fla1 -> Query IPv6ID () () () -> IO ()
forall n1 na1 fla1 na fla sla.
SpiderConfig n1 na1 fla1 -> Query IPv6ID na fla sla -> IO ()
doSnapshot' SpiderConfig n1 na1 fla1
sconf (Query IPv6ID () () () -> IO ())
-> IO (Query IPv6ID () () ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CLISnapshotQuery IPv6ID -> IO (Query IPv6ID () () ())
makeQuery CLISnapshotQuery IPv6ID
cli_query
    doSnapshot' :: SpiderConfig n1 na1 fla1 -> Query IPv6ID na fla sla -> IO ()
doSnapshot' SpiderConfig n1 na1 fla1
sconf Query IPv6ID na fla sla
query = do
      let start_node_num :: Int
start_node_num = [IPv6ID] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([IPv6ID] -> Int) -> [IPv6ID] -> Int
forall a b. (a -> b) -> a -> b
$ Query IPv6ID na fla sla -> [IPv6ID]
forall n na fla sla. Query n na fla sla -> [n]
startsFrom Query IPv6ID na fla sla
query
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Query starts from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
start_node_num) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" nodes")
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
start_node_num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
forall a. String -> IO a
die (String
"Specify the starting nodes with -s option.")
      [IPv6ID] -> (IPv6ID -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Query IPv6ID na fla sla -> [IPv6ID]
forall n na fla sla. Query n na fla sla -> [n]
startsFrom Query IPv6ID na fla sla
query) ((IPv6ID -> IO ()) -> IO ()) -> (IPv6ID -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IPv6ID
nid -> do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (IPv6ID -> String
forall a. Show a => a -> String
show IPv6ID
nid)
      -- Get DIO and DAO snapshot graphs with the Query.
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Get DIO SnapshotGraph")
      SnapshotGraph FindingID DIONode MergedDIOLink
dio_graph <- SpiderConfig FindingID DIONode DIOLink
-> (Spider FindingID DIONode DIOLink
    -> IO (SnapshotGraph FindingID DIONode MergedDIOLink))
-> IO (SnapshotGraph FindingID DIONode MergedDIOLink)
forall n na fla a.
Config n na fla -> (Spider n na fla -> IO a) -> IO a
withSpider (SpiderConfig n1 na1 fla1 -> SpiderConfig FindingID DIONode DIOLink
forall n1 na1 fla1 n2 na2 fla2.
SpiderConfig n1 na1 fla1 -> SpiderConfig n2 na2 fla2
castSpiderConfig SpiderConfig n1 na1 fla1
sconf) ((Spider FindingID DIONode DIOLink
  -> IO (SnapshotGraph FindingID DIONode MergedDIOLink))
 -> IO (SnapshotGraph FindingID DIONode MergedDIOLink))
-> (Spider FindingID DIONode DIOLink
    -> IO (SnapshotGraph FindingID DIONode MergedDIOLink))
-> IO (SnapshotGraph FindingID DIONode MergedDIOLink)
forall a b. (a -> b) -> a -> b
$ \Spider FindingID DIONode DIOLink
sp -> do
        Spider FindingID DIONode DIOLink
-> Query FindingID DIONode DIOLink MergedDIOLink
-> IO (SnapshotGraph FindingID DIONode MergedDIOLink)
forall n fla na sla.
(FromGraphSON n, ToJSON n, Ord n, Hashable n, Show n,
 LinkAttributes fla, NodeAttributes na) =>
Spider n na fla
-> Query n na fla sla -> IO (SnapshotGraph n na sla)
getSnapshot Spider FindingID DIONode DIOLink
sp (Query FindingID DIONode DIOLink MergedDIOLink
 -> IO (SnapshotGraph FindingID DIONode MergedDIOLink))
-> Query FindingID DIONode DIOLink MergedDIOLink
-> IO (SnapshotGraph FindingID DIONode MergedDIOLink)
forall a b. (a -> b) -> a -> b
$ Query IPv6ID na fla sla
-> FindingType
-> Query FindingID DIONode DIOLink MergedDIOLink
-> Query FindingID DIONode DIOLink MergedDIOLink
forall na1 fla1 sla1 na2 fla2 sla2.
Query IPv6ID na1 fla1 sla1
-> FindingType
-> Query FindingID na2 fla2 sla2
-> Query FindingID na2 fla2 sla2
rebaseQuery Query IPv6ID na fla sla
query FindingType
FindingDIO ([FindingID] -> Query FindingID DIONode DIOLink MergedDIOLink
DIO.dioDefQuery [])
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Get DAO SnapshotGraph")
      SnapshotGraph FindingID DAONode DAOLink
dao_graph <- SpiderConfig FindingID DAONode DAOLink
-> (Spider FindingID DAONode DAOLink
    -> IO (SnapshotGraph FindingID DAONode DAOLink))
-> IO (SnapshotGraph FindingID DAONode DAOLink)
forall n na fla a.
Config n na fla -> (Spider n na fla -> IO a) -> IO a
withSpider (SpiderConfig n1 na1 fla1 -> SpiderConfig FindingID DAONode DAOLink
forall n1 na1 fla1 n2 na2 fla2.
SpiderConfig n1 na1 fla1 -> SpiderConfig n2 na2 fla2
castSpiderConfig SpiderConfig n1 na1 fla1
sconf) ((Spider FindingID DAONode DAOLink
  -> IO (SnapshotGraph FindingID DAONode DAOLink))
 -> IO (SnapshotGraph FindingID DAONode DAOLink))
-> (Spider FindingID DAONode DAOLink
    -> IO (SnapshotGraph FindingID DAONode DAOLink))
-> IO (SnapshotGraph FindingID DAONode DAOLink)
forall a b. (a -> b) -> a -> b
$ \Spider FindingID DAONode DAOLink
sp -> do
        Spider FindingID DAONode DAOLink
-> Query FindingID DAONode DAOLink DAOLink
-> IO (SnapshotGraph FindingID DAONode DAOLink)
forall n fla na sla.
(FromGraphSON n, ToJSON n, Ord n, Hashable n, Show n,
 LinkAttributes fla, NodeAttributes na) =>
Spider n na fla
-> Query n na fla sla -> IO (SnapshotGraph n na sla)
getSnapshot Spider FindingID DAONode DAOLink
sp (Query FindingID DAONode DAOLink DAOLink
 -> IO (SnapshotGraph FindingID DAONode DAOLink))
-> Query FindingID DAONode DAOLink DAOLink
-> IO (SnapshotGraph FindingID DAONode DAOLink)
forall a b. (a -> b) -> a -> b
$ Query IPv6ID na fla sla
-> FindingType
-> Query FindingID DAONode DAOLink DAOLink
-> Query FindingID DAONode DAOLink DAOLink
forall na1 fla1 sla1 na2 fla2 sla2.
Query IPv6ID na1 fla1 sla1
-> FindingType
-> Query FindingID na2 fla2 sla2
-> Query FindingID na2 fla2 sla2
rebaseQuery Query IPv6ID na fla sla
query FindingType
FindingDAO ([FindingID] -> Query FindingID DAONode DAOLink DAOLink
DAO.daoDefQuery [])
      
      -- Merge DIO and DAO SnapshotGraphs into one.
      let com_graph :: SnapshotGraphCombined
com_graph = SnapshotGraph FindingID DIONode MergedDIOLink
-> SnapshotGraph FindingID DAONode DAOLink -> SnapshotGraphCombined
RPL.combineGraphs SnapshotGraph FindingID DIONode MergedDIOLink
dio_graph SnapshotGraph FindingID DAONode DAOLink
dao_graph
      -- Write the merged SnapshotGraph in GraphML to stdout.
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Format DIO+DAO SnapshotGraph into GraphML")
      Text -> IO ()
TLIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ SnapshotGraphCombined -> Text
forall n na la.
(ToNodeID n, ToAttributes na, ToAttributes la) =>
SnapshotGraph n na la -> Text
writeGraphML SnapshotGraphCombined
com_graph

    doCIS :: Config n1 na1 fla1
-> InputParams -> CLISnapshotQuery IPv6ID -> IO ()
doCIS Config n1 na1 fla1
sconf InputParams
input_params CLISnapshotQuery IPv6ID
cli_query = do
      Query IPv6ID () () ()
query_base <- CLISnapshotQuery IPv6ID -> IO (Query IPv6ID () () ())
makeQuery CLISnapshotQuery IPv6ID
cli_query
      Config n1 na1 fla1 -> IO ()
forall n na fla. Config n na fla -> IO ()
doClear Config n1 na1 fla1
sconf
      ([FoundNode FindingID DIONode DIOLink]
dio_nodes, [FoundNode FindingID DAONode DAOLink]
dao_nodes) <- Config n1 na1 fla1
-> InputParams
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
forall n1 na1 fla1.
Config n1 na1 fla1
-> InputParams
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
doInput Config n1 na1 fla1
sconf InputParams
input_params
      -- Make a query from the FoundNodes just loaded.
      let starts :: [IPv6ID]
starts = ((FoundNode FindingID DAONode DAOLink -> IPv6ID)
-> [FoundNode FindingID DAONode DAOLink] -> [IPv6ID]
forall a b. (a -> b) -> [a] -> [b]
map (FindingID -> IPv6ID
ipv6Only (FindingID -> IPv6ID)
-> (FoundNode FindingID DAONode DAOLink -> FindingID)
-> FoundNode FindingID DAONode DAOLink
-> IPv6ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundNode FindingID DAONode DAOLink -> FindingID
forall n na la. FoundNode n na la -> n
subjectNode) ([FoundNode FindingID DAONode DAOLink] -> [IPv6ID])
-> [FoundNode FindingID DAONode DAOLink] -> [IPv6ID]
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID DAONode DAOLink]
-> [FoundNode FindingID DAONode DAOLink]
sortDAONodes [FoundNode FindingID DAONode DAOLink]
dao_nodes)
                   [IPv6ID] -> [IPv6ID] -> [IPv6ID]
forall a. [a] -> [a] -> [a]
++
                   ((FoundNode FindingID DIONode DIOLink -> IPv6ID)
-> [FoundNode FindingID DIONode DIOLink] -> [IPv6ID]
forall a b. (a -> b) -> [a] -> [b]
map (FindingID -> IPv6ID
ipv6Only (FindingID -> IPv6ID)
-> (FoundNode FindingID DIONode DIOLink -> FindingID)
-> FoundNode FindingID DIONode DIOLink
-> IPv6ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundNode FindingID DIONode DIOLink -> FindingID
forall n na la. FoundNode n na la -> n
subjectNode) [FoundNode FindingID DIONode DIOLink]
dio_nodes)
          q :: Query IPv6ID () () ()
q = Query IPv6ID () () ()
query_base { startsFrom :: [IPv6ID]
startsFrom = [IPv6ID]
starts }
      Config n1 na1 fla1 -> Query IPv6ID () () () -> IO ()
forall n1 na1 fla1 na fla sla.
SpiderConfig n1 na1 fla1 -> Query IPv6ID na fla sla -> IO ()
doSnapshot' Config n1 na1 fla1
sconf Query IPv6ID () () ()
q
    isVerboseDebug :: Config n na fla -> Bool
isVerboseDebug Config n na fla
sconf = Config n na fla -> LogLevel
forall n na fla. Config n na fla -> LogLevel
logThreshold Config n na fla
sconf LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= LogLevel
LevelDebug


---- CLI parsers.

-- | Filter function of 'FoundNode', agnostic of node and link
-- attributes.
data FoundNodeFilter =
  FoundNodeFilter
  { FoundNodeFilter
-> forall na la.
   [FoundNode FindingID na la] -> [FoundNode FindingID na la]
fnfRun :: forall na la . [FoundNode FindingID na la] -> [FoundNode FindingID na la],
    FoundNodeFilter -> String
fnfSymbol :: String,
    FoundNodeFilter -> Text
fnfDesc :: Text
  }

applyFoundNodeFilter :: FoundNodeFilter
                     -> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
                     -> IO ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
applyFoundNodeFilter :: FoundNodeFilter
-> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
-> IO
     ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
applyFoundNodeFilter FoundNodeFilter
fnf ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
input = do
  Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Apply filter '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FoundNodeFilter -> String
fnfSymbol FoundNodeFilter
fnf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' to local findings.")
  ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
-> IO
     ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
forall (m :: * -> *) a. Monad m => a -> m a
return (([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
 -> IO
      ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2]))
-> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
-> IO
     ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
forall a b. (a -> b) -> a -> b
$ (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])
forall na1 la1 na2 la2.
(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 (FoundNodeFilter
-> forall na la.
   [FoundNode FindingID na la] -> [FoundNode FindingID na la]
fnfRun FoundNodeFilter
fnf) ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2])
input

-- | Top-level configuration obtained from command-line arguments.
data CLIConfig n na fla =
  CLIConfig
  { CLIConfig n na fla -> SpiderConfig n na fla
cliSpiderConfig :: SpiderConfig n na fla,
    CLIConfig n na fla -> Cmd
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 (CLISnapshotQuery IPv6ID) -- ^ Get a snapshot graph.
         | CmdCIS InputParams (CLISnapshotQuery IPv6ID) -- ^ Clear + Input + Snapshot

returnWithHelp :: Either String a -> IO a
returnWithHelp :: Either String a -> IO a
returnWithHelp (Right a
a) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
returnWithHelp (Left String
e) = do
  Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e)
  IO (CLIConfig Any Any Any) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (CLIConfig Any Any Any) -> IO ())
-> IO (CLIConfig Any Any Any) -> IO ()
forall a b. (a -> b) -> a -> b
$ ParserResult (CLIConfig Any Any Any) -> IO (CLIConfig Any Any Any)
forall a. ParserResult a -> IO a
Opt.handleParseResult (ParserResult (CLIConfig Any Any Any)
 -> IO (CLIConfig Any Any Any))
-> ParserResult (CLIConfig Any Any Any)
-> IO (CLIConfig Any Any Any)
forall a b. (a -> b) -> a -> b
$ ParserPrefs
-> ParserInfo (CLIConfig Any Any Any)
-> [String]
-> ParserResult (CLIConfig Any Any Any)
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
Opt.execParserPure ParserPrefs
Opt.defaultPrefs ParserInfo (CLIConfig Any Any Any)
forall n na fla. ParserInfo (CLIConfig n na fla)
optionParserInfo [String
"--help"]
  String -> IO a
forall a. HasCallStack => String -> a
error String
"This should not happen."

optionParserInfo :: Opt.ParserInfo (CLIConfig n na fla)
optionParserInfo :: ParserInfo (CLIConfig n na fla)
optionParserInfo =
  Parser (CLIConfig n na fla)
-> InfoMod (CLIConfig n na fla) -> ParserInfo (CLIConfig n na fla)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Parser (CLIConfig n na fla -> CLIConfig n na fla)
forall a. Parser (a -> a)
Opt.helper Parser (CLIConfig n na fla -> CLIConfig n na fla)
-> Parser (CLIConfig n na fla) -> Parser (CLIConfig n na fla)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (CLIConfig n na fla)
forall n na fla. Parser (CLIConfig n na fla)
optionParser) (InfoMod (CLIConfig n na fla) -> ParserInfo (CLIConfig n na fla))
-> InfoMod (CLIConfig n na fla) -> ParserInfo (CLIConfig n na fla)
forall a b. (a -> b) -> a -> b
$ [InfoMod (CLIConfig n na fla)] -> InfoMod (CLIConfig n na fla)
forall a. Monoid a => [a] -> a
mconcat ([InfoMod (CLIConfig n na fla)] -> InfoMod (CLIConfig n na fla))
-> [InfoMod (CLIConfig n na fla)] -> InfoMod (CLIConfig n na fla)
forall a b. (a -> b) -> a -> b
$
  [ String -> InfoMod (CLIConfig n na fla)
forall a. String -> InfoMod a
Opt.progDesc String
"net-spider front-end for RPL data model."
  ]

optionParser :: Opt.Parser (CLIConfig n na fla)
optionParser :: Parser (CLIConfig n na fla)
optionParser = SpiderConfig n na fla -> Cmd -> CLIConfig n na fla
forall n na fla. SpiderConfig n na fla -> Cmd -> CLIConfig n na fla
CLIConfig (SpiderConfig n na fla -> Cmd -> CLIConfig n na fla)
-> Parser (SpiderConfig n na fla)
-> Parser (Cmd -> CLIConfig n na fla)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SpiderConfig n na fla)
forall n na fla. Parser (SpiderConfig n na fla)
parserSpiderConfig Parser (Cmd -> CLIConfig n na fla)
-> Parser Cmd -> Parser (CLIConfig n na fla)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Cmd
parserCommands
  where
    parserCommands :: Parser Cmd
parserCommands = Mod CommandFields Cmd -> Parser Cmd
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields Cmd -> Parser Cmd)
-> Mod CommandFields Cmd -> Parser Cmd
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields Cmd] -> Mod CommandFields Cmd
forall a. Monoid a => [a] -> a
mconcat [Mod CommandFields Cmd]
commands
    commands :: [Mod CommandFields Cmd]
commands = [ String -> ParserInfo Cmd -> Mod CommandFields Cmd
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"clear" (ParserInfo Cmd -> Mod CommandFields Cmd)
-> ParserInfo Cmd -> Mod CommandFields Cmd
forall a b. (a -> b) -> a -> b
$
                 Parser Cmd -> InfoMod Cmd -> ParserInfo Cmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Cmd -> Parser Cmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
CmdClear) (String -> InfoMod Cmd
forall a. String -> InfoMod a
Opt.progDesc String
"Clear the entire database."),
                 String -> ParserInfo Cmd -> Mod CommandFields Cmd
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"input" (ParserInfo Cmd -> Mod CommandFields Cmd)
-> ParserInfo Cmd -> Mod CommandFields Cmd
forall a b. (a -> b) -> a -> b
$
                 Parser Cmd -> InfoMod Cmd -> ParserInfo Cmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (InputParams -> Cmd
CmdInput (InputParams -> Cmd) -> Parser InputParams -> Parser Cmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InputParams
parserInputParams)
                 (String -> InfoMod Cmd
forall a. String -> InfoMod a
Opt.progDesc String
"Input local findings into the database."),
                 String -> ParserInfo Cmd -> Mod CommandFields Cmd
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"snapshot" (ParserInfo Cmd -> Mod CommandFields Cmd)
-> ParserInfo Cmd -> Mod CommandFields Cmd
forall a b. (a -> b) -> a -> b
$
                 Parser Cmd -> InfoMod Cmd -> ParserInfo Cmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Bool -> Parser Cmd
parserSnapshot Bool
True) (String -> InfoMod Cmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get a snapshot graph from the database."),
                 String -> ParserInfo Cmd -> Mod CommandFields Cmd
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"cis" (ParserInfo Cmd -> Mod CommandFields Cmd)
-> ParserInfo Cmd -> Mod CommandFields Cmd
forall a b. (a -> b) -> a -> b
$
                 Parser Cmd -> InfoMod Cmd -> ParserInfo Cmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (InputParams -> CLISnapshotQuery IPv6ID -> Cmd
CmdCIS (InputParams -> CLISnapshotQuery IPv6ID -> Cmd)
-> Parser InputParams -> Parser (CLISnapshotQuery IPv6ID -> Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InputParams
parserInputParams Parser (CLISnapshotQuery IPv6ID -> Cmd)
-> Parser (CLISnapshotQuery IPv6ID) -> Parser Cmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser (CLISnapshotQuery IPv6ID)
parserSnapshotQuery Bool
False)
                 (String -> InfoMod Cmd
forall a. String -> InfoMod a
Opt.progDesc String
"Clear + Input + Snapshot at once. `startsFrom` of the query is set by local findings loaded from the files.")
               ]
    parserInputParams :: Parser InputParams
parserInputParams = [String] -> FoundNodeFilter -> Maybe Year -> InputParams
InputParams ([String] -> FoundNodeFilter -> Maybe Year -> InputParams)
-> Parser [String]
-> Parser (FoundNodeFilter -> Maybe Year -> InputParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [String]
parserInputFiles Parser (FoundNodeFilter -> Maybe Year -> InputParams)
-> Parser FoundNodeFilter -> Parser (Maybe Year -> InputParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FoundNodeFilter
parserFilter Parser (Maybe Year -> InputParams)
-> Parser (Maybe Year) -> Parser InputParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Year)
parserYear
    parserInputFiles :: Parser [String]
parserInputFiles = Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser String -> Parser [String])
-> Parser String -> Parser [String]
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument (Mod ArgumentFields String -> Parser String)
-> Mod ArgumentFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields String] -> Mod ArgumentFields String
forall a. Monoid a => [a] -> a
mconcat
                       [ String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE",
                         String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Input file. You can specify multiple times. If '-' is specified, it reads STDIN."
                       ]
    ipv6Reader :: ReadM IPv6ID
ipv6Reader = (ReadM IPv6ID
-> (IPv6ID -> ReadM IPv6ID) -> Maybe IPv6ID -> ReadM IPv6ID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReadM IPv6ID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid IPv6") IPv6ID -> ReadM IPv6ID
forall (m :: * -> *) a. Monad m => a -> m a
return  (Maybe IPv6ID -> ReadM IPv6ID)
-> (String -> Maybe IPv6ID) -> String -> ReadM IPv6ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe IPv6ID
ipv6FromText (Text -> Maybe IPv6ID)
-> (String -> Text) -> String -> Maybe IPv6ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (String -> ReadM IPv6ID) -> ReadM String -> ReadM IPv6ID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReadM String
forall s. IsString s => ReadM s
Opt.str
    parserSnapshot :: Bool -> Parser Cmd
parserSnapshot Bool
parse_arg = (CLISnapshotQuery IPv6ID -> Cmd)
-> Parser (CLISnapshotQuery IPv6ID) -> Parser Cmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CLISnapshotQuery IPv6ID -> Cmd
CmdSnapshot (Parser (CLISnapshotQuery IPv6ID) -> Parser Cmd)
-> Parser (CLISnapshotQuery IPv6ID) -> Parser Cmd
forall a b. (a -> b) -> a -> b
$ Bool -> Parser (CLISnapshotQuery IPv6ID)
parserSnapshotQuery Bool
parse_arg
    parserSnapshotQuery :: Bool -> Parser (CLISnapshotQuery IPv6ID)
parserSnapshotQuery Bool
parse_arg =
      SnapshotConfig IPv6ID -> Parser (CLISnapshotQuery IPv6ID)
forall n. SnapshotConfig n -> Parser (CLISnapshotQuery n)
CLIS.parserSnapshotQuery (SnapshotConfig IPv6ID -> Parser (CLISnapshotQuery IPv6ID))
-> SnapshotConfig IPv6ID -> Parser (CLISnapshotQuery IPv6ID)
forall a b. (a -> b) -> a -> b
$
      SnapshotConfig :: forall n. ReadM n -> Bool -> SnapshotConfig n
CLIS.SnapshotConfig
      { nodeIDReader :: ReadM IPv6ID
CLIS.nodeIDReader = ReadM IPv6ID
ipv6Reader,
        startsFromAsArguments :: Bool
CLIS.startsFromAsArguments = Bool
parse_arg
      }
    parserFilter :: Parser FoundNodeFilter
parserFilter = ReadM FoundNodeFilter
-> Mod OptionFields FoundNodeFilter -> Parser FoundNodeFilter
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM FoundNodeFilter
readerFilter (Mod OptionFields FoundNodeFilter -> Parser FoundNodeFilter)
-> Mod OptionFields FoundNodeFilter -> Parser FoundNodeFilter
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FoundNodeFilter]
-> Mod OptionFields FoundNodeFilter
forall a. Monoid a => [a] -> a
mconcat
                   [ String -> Mod OptionFields FoundNodeFilter
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILTER",
                     String -> Mod OptionFields FoundNodeFilter
forall (f :: * -> *) a. String -> Mod f a
Opt.help ( String
"Filter for local findings. Out of the local findings loaded from the input files, "
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"only those that pass the filter are input to the database. "
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Possible values are: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filterDescs
                              ),
                     Char -> Mod OptionFields FoundNodeFilter
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'F',
                     String -> Mod OptionFields FoundNodeFilter
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"filter",
                     FoundNodeFilter -> Mod OptionFields FoundNodeFilter
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value ([FoundNodeFilter]
allFilters [FoundNodeFilter] -> Int -> FoundNodeFilter
forall a. [a] -> Int -> a
!! Int
0)
                   ]
    filterDescs :: String
filterDescs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (FoundNodeFilter -> String) -> [FoundNodeFilter] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FoundNodeFilter -> String
descFor [FoundNodeFilter]
allFilters
    descFor :: FoundNodeFilter -> String
descFor FoundNodeFilter
fnf = String
"'" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FoundNodeFilter -> String
fnfSymbol FoundNodeFilter
fnf String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"': " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ FoundNodeFilter -> Text
fnfDesc FoundNodeFilter
fnf)
    readerFilter :: ReadM FoundNodeFilter
readerFilter = String -> ReadM FoundNodeFilter
forall (m :: * -> *). MonadFail m => String -> m FoundNodeFilter
selectFoundNodeFilter (String -> ReadM FoundNodeFilter)
-> ReadM String -> ReadM FoundNodeFilter
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReadM String
forall s. IsString s => ReadM s
Opt.str
    selectFoundNodeFilter :: String -> m FoundNodeFilter
selectFoundNodeFilter String
symbol =
      case (FoundNodeFilter -> Bool) -> [FoundNodeFilter] -> [FoundNodeFilter]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FoundNodeFilter
fnf -> FoundNodeFilter -> String
fnfSymbol FoundNodeFilter
fnf String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
symbol) [FoundNodeFilter]
allFilters of
        [] -> String -> m FoundNodeFilter
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown filter: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
symbol)
        (FoundNodeFilter
x : [FoundNodeFilter]
_) -> FoundNodeFilter -> m FoundNodeFilter
forall (m :: * -> *) a. Monad m => a -> m a
return FoundNodeFilter
x
    allFilters :: [FoundNodeFilter]
allFilters =
      [ FoundNodeFilter :: (forall na la.
 [FoundNode FindingID na la] -> [FoundNode FindingID na la])
-> String -> Text -> FoundNodeFilter
FoundNodeFilter
        { fnfRun :: forall na la.
[FoundNode FindingID na la] -> [FoundNode FindingID na la]
fnfRun = forall a. a -> a
forall na la.
[FoundNode FindingID na la] -> [FoundNode FindingID na la]
id,
          fnfSymbol :: String
fnfSymbol = String
"none",
          fnfDesc :: Text
fnfDesc = Text
"Not filter anything. This is the default."
        },
        FoundNodeFilter :: (forall na la.
 [FoundNode FindingID na la] -> [FoundNode FindingID na la])
-> String -> Text -> FoundNodeFilter
FoundNodeFilter
        { fnfRun :: forall na la.
[FoundNode FindingID na la] -> [FoundNode FindingID na la]
fnfRun = forall na la.
[FoundNode FindingID na la] -> [FoundNode FindingID na la]
getLatestForEachNode,
          fnfSymbol :: String
fnfSymbol = String
"latest",
          fnfDesc :: Text
fnfDesc = Text
"Input only the latest local finding for each node."
        }
      ]
    parserYear :: Parser (Maybe Year)
parserYear = Parser Year -> Parser (Maybe Year)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Year -> Parser (Maybe Year))
-> Parser Year -> Parser (Maybe Year)
forall a b. (a -> b) -> a -> b
$ ReadM Year -> Mod OptionFields Year -> Parser Year
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Year
forall a. Read a => ReadM a
Opt.auto (Mod OptionFields Year -> Parser Year)
-> Mod OptionFields Year -> Parser Year
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Year] -> Mod OptionFields Year
forall a. Monoid a => [a] -> a
mconcat
                 [ String -> Mod OptionFields Year
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"year",
                   String -> Mod OptionFields Year
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"YEAR",
                   String -> Mod OptionFields Year
forall (f :: * -> *) a. String -> Mod f a
Opt.help ( String
"If specified, the year of timestamps in local findings is set to YEAR. "
                              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"If not specified, the year of the local system time is used. "
                              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"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 :: SpiderConfig n1 na1 fla1 -> SpiderConfig n2 na2 fla2
castSpiderConfig SpiderConfig n1 na1 fla1
sc = SpiderConfig n1 na1 fla1
sc { nodeIdKey :: Key VNode n2
nodeIdKey = Text -> Key VNode n2
forall a b. Text -> Key a b
Key (Text -> Key VNode n2) -> Text -> Key VNode n2
forall a b. (a -> b) -> a -> b
$ Key VNode n1 -> Text
forall a b. Key a b -> Text
unKey (Key VNode n1 -> Text) -> Key VNode n1 -> Text
forall a b. (a -> b) -> a -> b
$ SpiderConfig n1 na1 fla1 -> Key VNode n1
forall n na fla. Config n na fla -> Key VNode n
nodeIdKey SpiderConfig n1 na1 fla1
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 :: Query IPv6ID na1 fla1 sla1
-> FindingType
-> Query FindingID na2 fla2 sla2
-> Query FindingID na2 fla2 sla2
rebaseQuery Query IPv6ID na1 fla1 sla1
orig FindingType
ftype Query FindingID na2 fla2 sla2
base = Query FindingID na2 fla2 sla2
base { startsFrom :: [FindingID]
startsFrom = (IPv6ID -> FindingID) -> [IPv6ID] -> [FindingID]
forall a b. (a -> b) -> [a] -> [b]
map IPv6ID -> FindingID
liftToFindingID ([IPv6ID] -> [FindingID]) -> [IPv6ID] -> [FindingID]
forall a b. (a -> b) -> a -> b
$ Query IPv6ID na1 fla1 sla1 -> [IPv6ID]
forall n na fla sla. Query n na fla sla -> [n]
startsFrom Query IPv6ID na1 fla1 sla1
orig,
                                     timeInterval :: Interval Timestamp
timeInterval = Query IPv6ID na1 fla1 sla1 -> Interval Timestamp
forall n na fla sla. Query n na fla sla -> Interval Timestamp
timeInterval Query IPv6ID na1 fla1 sla1
orig
                                   }
  where
    liftToFindingID :: IPv6ID -> FindingID
liftToFindingID (IPv6ID IPv6
ip) = FindingType -> IPv6 -> FindingID
FindingID FindingType
ftype IPv6
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 :: Maybe Year -> IO Year
getYear (Just Year
y) = Year -> IO Year
forall (m :: * -> *) a. Monad m => a -> m a
return Year
y
getYear Maybe Year
Nothing = do
  ZonedTime
zt <- IO ZonedTime
getZonedTime
  let (Year
y, Int
_, Int
_) = Day -> (Year, Int, Int)
toGregorian (Day -> (Year, Int, Int)) -> Day -> (Year, Int, Int)
forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay (LocalTime -> Day) -> LocalTime -> Day
forall a b. (a -> b) -> a -> b
$ ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
zt
  Year -> IO Year
forall (m :: * -> *) a. Monad m => a -> m a
return Year
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
-> String
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
loadFile Year
year String
file = do
  ([FoundNode FindingID DIONode DIOLink]
dio_nodes, [FoundNode FindingID DAONode DAOLink]
dao_nodes) <- IO
  ([FoundNode FindingID DIONode DIOLink],
   [FoundNode FindingID DAONode DAOLink])
loadNodes
  Handle -> String -> IO ()
hPutStrLn Handle
stderr ((Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID DIONode DIOLink] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FoundNode FindingID DIONode DIOLink]
dio_nodes) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" DIO local findings loaded")
  Handle -> String -> IO ()
hPutStrLn Handle
stderr ((Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID DAONode DAOLink] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FoundNode FindingID DAONode DAOLink]
dao_nodes) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" DAO local findings loaded")
  ([FoundNode FindingID DIONode DIOLink],
 [FoundNode FindingID DAONode DAOLink])
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
forall (m :: * -> *) a. Monad m => a -> m a
return ([FoundNode FindingID DIONode DIOLink]
dio_nodes, [FoundNode FindingID DAONode DAOLink]
dao_nodes)
  where
    phead :: Parser Timestamp
phead = Year -> Maybe TimeZone -> Parser Timestamp
pSyslogHead Year
year Maybe TimeZone
forall a. Maybe a
Nothing
    loadNodes :: IO
  ([FoundNode FindingID DIONode DIOLink],
   [FoundNode FindingID DAONode DAOLink])
loadNodes = do
      if String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-"
        then do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Loading from stdin")
        Parser Timestamp
-> Handle
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
parseFileHandle Parser Timestamp
phead Handle
stdin
        else do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Loading " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
file)
        Parser Timestamp
-> String
-> IO
     ([FoundNode FindingID DIONode DIOLink],
      [FoundNode FindingID DAONode DAOLink])
parseFile Parser Timestamp
phead String
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 :: SpiderConfig FindingID na fla
-> [FoundNode FindingID na fla] -> IO ()
putNodes SpiderConfig FindingID na fla
sconf [FoundNode FindingID na fla]
input_nodes = do
  SpiderConfig FindingID na fla
-> (Spider FindingID na fla -> IO ()) -> IO ()
forall n na fla a.
Config n na fla -> (Spider n na fla -> IO a) -> IO a
withSpider SpiderConfig FindingID na fla
sconf ((Spider FindingID na fla -> IO ()) -> IO ())
-> (Spider FindingID na fla -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Spider FindingID na fla
sp -> do
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"---- Add " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID na fla] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([FoundNode FindingID na fla] -> Int)
-> [FoundNode FindingID na fla] -> Int
forall a b. (a -> b) -> a -> b
$ [FoundNode FindingID na fla]
input_nodes) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" local findings")
    [(FoundNode FindingID na fla, Year)]
-> ((FoundNode FindingID na fla, Year) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FoundNode FindingID na fla]
-> [Year] -> [(FoundNode FindingID na fla, Year)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FoundNode FindingID na fla]
input_nodes ([Year
0 ..] :: [Integer])) (((FoundNode FindingID na fla, Year) -> IO ()) -> IO ())
-> ((FoundNode FindingID na fla, Year) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FoundNode FindingID na fla
input_node, Year
index) -> do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Year
index Year -> Year -> Year
forall a. Integral a => a -> a -> a
`mod` Year
100) Year -> Year -> Bool
forall a. Eq a => a -> a -> Bool
== Year
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Add local finding [" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Year -> String
forall a. Show a => a -> String
show Year
index String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]")
      Spider FindingID na fla -> FoundNode FindingID na fla -> IO ()
forall n fla na.
(ToJSON n, LinkAttributes fla, NodeAttributes na) =>
Spider n na fla -> FoundNode n na fla -> IO ()
addFoundNode Spider FindingID na fla
sp FoundNode FindingID na fla
input_node
    Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Add done"

---- Print FoundNodes for debug

printDIONode :: FoundNodeDIO -> IO ()
printDIONode :: FoundNode FindingID DIONode DIOLink -> IO ()
printDIONode FoundNode FindingID DIONode DIOLink
fn = do
  Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text
"---- DIO finding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FindingID -> Text
idToText (FindingID -> Text) -> FindingID -> Text
forall a b. (a -> b) -> a -> b
$ FoundNode FindingID DIONode DIOLink -> FindingID
forall n na la. FoundNode n na la -> n
subjectNode FoundNode FindingID DIONode DIOLink
fn) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", rank " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rank_text)
  [FoundLink FindingID DIOLink]
-> (FoundLink FindingID DIOLink -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FoundLink FindingID DIOLink]
plinks ((FoundLink FindingID DIOLink -> IO ()) -> IO ())
-> (FoundLink FindingID DIOLink -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FoundLink FindingID DIOLink
l -> do
    Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text
"  -> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FindingID -> Text
idToText (FindingID -> Text) -> FindingID -> Text
forall a b. (a -> b) -> a -> b
$ FoundLink FindingID DIOLink -> FindingID
forall n la. FoundLink n la -> n
targetNode FoundLink FindingID DIOLink
l))
  where
    plinks :: [FoundLink FindingID DIOLink]
plinks = (FoundLink FindingID DIOLink -> Bool)
-> [FoundLink FindingID DIOLink] -> [FoundLink FindingID DIOLink]
forall a. (a -> Bool) -> [a] -> [a]
filter FoundLink FindingID DIOLink -> Bool
forall n. FoundLink n DIOLink -> Bool
isPreferredParentLink ([FoundLink FindingID DIOLink] -> [FoundLink FindingID DIOLink])
-> [FoundLink FindingID DIOLink] -> [FoundLink FindingID DIOLink]
forall a b. (a -> b) -> a -> b
$ FoundNode FindingID DIONode DIOLink
-> [FoundLink FindingID DIOLink]
forall n na la. FoundNode n na la -> [FoundLink n la]
neighborLinks FoundNode FindingID DIONode DIOLink
fn
    rank_text :: Text
rank_text = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Rank -> String
forall a. Show a => a -> String
show (Rank -> String) -> Rank -> String
forall a b. (a -> b) -> a -> b
$ DIONode -> Rank
DIO.rank (DIONode -> Rank) -> DIONode -> Rank
forall a b. (a -> b) -> a -> b
$ FoundNode FindingID DIONode DIOLink -> DIONode
forall n na la. FoundNode n na la -> na
nodeAttributes FoundNode FindingID DIONode DIOLink
fn
    isPreferredParentLink :: FoundLink n DIOLink -> Bool
isPreferredParentLink FoundLink n DIOLink
l =
      (DIOLink -> NeighborType
DIO.neighborType (DIOLink -> NeighborType) -> DIOLink -> NeighborType
forall a b. (a -> b) -> a -> b
$ FoundLink n DIOLink -> DIOLink
forall n la. FoundLink n la -> la
linkAttributes FoundLink n DIOLink
l) NeighborType -> NeighborType -> Bool
forall a. Eq a => a -> a -> Bool
== NeighborType
DIO.PreferredParent

printDAONode :: FoundNodeDAO -> IO ()
printDAONode :: FoundNode FindingID DAONode DAOLink -> IO ()
printDAONode FoundNode FindingID DAONode DAOLink
fn = do
  Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text
"---- DAO finding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FindingID -> Text
idToText (FindingID -> Text) -> FindingID -> Text
forall a b. (a -> b) -> a -> b
$ FoundNode FindingID DAONode DAOLink -> FindingID
forall n na la. FoundNode n na la -> n
subjectNode FoundNode FindingID DAONode DAOLink
fn) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
route_num_text)
  [FoundLink FindingID DAOLink]
-> (FoundLink FindingID DAOLink -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (FoundNode FindingID DAONode DAOLink
-> [FoundLink FindingID DAOLink]
forall n na la. FoundNode n na la -> [FoundLink n la]
neighborLinks FoundNode FindingID DAONode DAOLink
fn) ((FoundLink FindingID DAOLink -> IO ()) -> IO ())
-> (FoundLink FindingID DAOLink -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FoundLink FindingID DAOLink
l -> do
    Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text
"  -> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FindingID -> Text
idToText (FindingID -> Text) -> FindingID -> Text
forall a b. (a -> b) -> a -> b
$ FoundLink FindingID DAOLink -> FindingID
forall n la. FoundLink n la -> n
targetNode FoundLink FindingID DAOLink
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", lifetime " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FoundLink FindingID DAOLink -> Text
forall n. FoundLink n DAOLink -> Text
lt_text FoundLink FindingID DAOLink
l)
  where
    lt_text :: FoundLink n DAOLink -> Text
lt_text FoundLink n DAOLink
l = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Rank -> String
forall a. Show a => a -> String
show (Rank -> String) -> Rank -> String
forall a b. (a -> b) -> a -> b
$ DAOLink -> Rank
DAO.pathLifetimeSec (DAOLink -> Rank) -> DAOLink -> Rank
forall a b. (a -> b) -> a -> b
$ FoundLink n DAOLink -> DAOLink
forall n la. FoundLink n la -> la
linkAttributes FoundLink n DAOLink
l
    route_num_text :: Text
route_num_text =
      case DAONode -> Maybe Rank
DAO.daoRouteNum (DAONode -> Maybe Rank) -> DAONode -> Maybe Rank
forall a b. (a -> b) -> a -> b
$ FoundNode FindingID DAONode DAOLink -> DAONode
forall n na la. FoundNode n na la -> na
nodeAttributes FoundNode FindingID DAONode DAOLink
fn of
        Maybe Rank
Nothing -> Text
""
        Just Rank
n -> Text
", route_num " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Rank -> String
forall a. Show a => a -> String
show Rank
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 :: (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 forall na la.
[FoundNode FindingID na la] -> [FoundNode FindingID na la]
f ([FoundNode FindingID na1 la1]
ns1, [FoundNode FindingID na2 la2]
ns2) = ([FoundNode FindingID na1 la1] -> [FoundNode FindingID na1 la1]
forall na la.
[FoundNode FindingID na la] -> [FoundNode FindingID na la]
f [FoundNode FindingID na1 la1]
ns1, [FoundNode FindingID na2 la2] -> [FoundNode FindingID na2 la2]
forall na la.
[FoundNode FindingID na la] -> [FoundNode FindingID na la]
f [FoundNode FindingID na2 la2]
ns2)

concatPairs :: [([a], [b])] -> ([a], [b])
concatPairs :: [([a], [b])] -> ([a], [b])
concatPairs [] = ([],[])
concatPairs (([a]
as, [b]
bs) : [([a], [b])]
rest) = ([a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rest_as, [b]
bs [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b]
rest_bs)
  where
    ([a]
rest_as, [b]
rest_bs) = [([a], [b])] -> ([a], [b])
forall a b. [([a], [b])] -> ([a], [b])
concatPairs [([a], [b])]
rest


---- Filter for FoundNode.

type NodeMap n = HashMap FindingID [n]

collectNodes :: [FoundNode FindingID na la] -> NodeMap (FoundNode FindingID na la)
collectNodes :: [FoundNode FindingID na la] -> NodeMap (FoundNode FindingID na la)
collectNodes = (FoundNode FindingID na la
 -> NodeMap (FoundNode FindingID na la)
 -> NodeMap (FoundNode FindingID na la))
-> NodeMap (FoundNode FindingID na la)
-> [FoundNode FindingID na la]
-> NodeMap (FoundNode FindingID na la)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FoundNode FindingID na la
-> NodeMap (FoundNode FindingID na la)
-> NodeMap (FoundNode FindingID na la)
forall k na la.
(Eq k, Hashable k) =>
FoundNode k na la
-> HashMap k [FoundNode k na la] -> HashMap k [FoundNode k na la]
addNode NodeMap (FoundNode FindingID na la)
forall k v. HashMap k v
HM.empty
  where
    addNode :: FoundNode k na la
-> HashMap k [FoundNode k na la] -> HashMap k [FoundNode k na la]
addNode FoundNode k na la
n HashMap k [FoundNode k na la]
acc = ([FoundNode k na la] -> [FoundNode k na la] -> [FoundNode k na la])
-> k
-> [FoundNode k na la]
-> HashMap k [FoundNode k na la]
-> HashMap k [FoundNode k na la]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith [FoundNode k na la] -> [FoundNode k na la] -> [FoundNode k na la]
forall a. [a] -> [a] -> [a]
f (FoundNode k na la -> k
forall n na la. FoundNode n na la -> n
subjectNode FoundNode k na la
n) [FoundNode k na la
n] HashMap k [FoundNode k na la]
acc
      where
        f :: [a] -> [a] -> [a]
f [a]
new [a]
old = [a]
new [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
old

getLatestNodes :: NodeMap (FoundNode n na la) -> [FoundNode n na la]
getLatestNodes :: NodeMap (FoundNode n na la) -> [FoundNode n na la]
getLatestNodes NodeMap (FoundNode n na la)
nm = [[FoundNode n na la]] -> [FoundNode n na la]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FoundNode n na la]] -> [FoundNode n na la])
-> [[FoundNode n na la]] -> [FoundNode n na la]
forall a b. (a -> b) -> a -> b
$ NodeMap (FoundNode n na la) -> [[FoundNode n na la]]
forall k v. HashMap k v -> [v]
HM.elems (NodeMap (FoundNode n na la) -> [[FoundNode n na la]])
-> NodeMap (FoundNode n na la) -> [[FoundNode n na la]]
forall a b. (a -> b) -> a -> b
$ ([FoundNode n na la] -> [FoundNode n na la])
-> NodeMap (FoundNode n na la) -> NodeMap (FoundNode n na la)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FoundNode n na la] -> [FoundNode n na la]
forall n na la. [FoundNode n na la] -> [FoundNode n na la]
filterLatest NodeMap (FoundNode n na la)
nm
  where
    filterLatest :: [FoundNode n na la] -> [FoundNode n na la]
filterLatest [FoundNode n na la]
fns = [FoundNode n na la] -> [FoundNode n na la]
forall a. [a] -> [a]
getHead ([FoundNode n na la] -> [FoundNode n na la])
-> [FoundNode n na la] -> [FoundNode n na la]
forall a b. (a -> b) -> a -> b
$ [FoundNode n na la] -> [FoundNode n na la]
forall a. [a] -> [a]
reverse ([FoundNode n na la] -> [FoundNode n na la])
-> [FoundNode n na la] -> [FoundNode n na la]
forall a b. (a -> b) -> a -> b
$ (FoundNode n na la -> Timestamp)
-> [FoundNode n na la] -> [FoundNode n na la]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn FoundNode n na la -> Timestamp
forall n na la. FoundNode n na la -> Timestamp
foundAt [FoundNode n na la]
fns
    getHead :: [a] -> [a]
getHead [] = []
    getHead (a
a : [a]
_) = [a
a]

getLatestForEachNode :: [FoundNode FindingID na la] -> [FoundNode FindingID na la]
getLatestForEachNode :: [FoundNode FindingID na la] -> [FoundNode FindingID na la]
getLatestForEachNode = NodeMap (FoundNode FindingID na la) -> [FoundNode FindingID na la]
forall n na la. NodeMap (FoundNode n na la) -> [FoundNode n na la]
getLatestNodes (NodeMap (FoundNode FindingID na la)
 -> [FoundNode FindingID na la])
-> ([FoundNode FindingID na la]
    -> NodeMap (FoundNode FindingID na la))
-> [FoundNode FindingID na la]
-> [FoundNode FindingID na la]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FoundNode FindingID na la] -> NodeMap (FoundNode FindingID na la)
forall na la.
[FoundNode FindingID na la] -> NodeMap (FoundNode FindingID na la)
collectNodes


---- FoundNode utility

sortDAONodes :: [FoundNodeDAO] -> [FoundNodeDAO]
sortDAONodes :: [FoundNode FindingID DAONode DAOLink]
-> [FoundNode FindingID DAONode DAOLink]
sortDAONodes = [FoundNode FindingID DAONode DAOLink]
-> [FoundNode FindingID DAONode DAOLink]
forall a. [a] -> [a]
reverse ([FoundNode FindingID DAONode DAOLink]
 -> [FoundNode FindingID DAONode DAOLink])
-> ([FoundNode FindingID DAONode DAOLink]
    -> [FoundNode FindingID DAONode DAOLink])
-> [FoundNode FindingID DAONode DAOLink]
-> [FoundNode FindingID DAONode DAOLink]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundNode FindingID DAONode DAOLink -> Maybe Rank)
-> [FoundNode FindingID DAONode DAOLink]
-> [FoundNode FindingID DAONode DAOLink]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (DAONode -> Maybe Rank
DAO.daoRouteNum (DAONode -> Maybe Rank)
-> (FoundNode FindingID DAONode DAOLink -> DAONode)
-> FoundNode FindingID DAONode DAOLink
-> Maybe Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundNode FindingID DAONode DAOLink -> DAONode
forall n na la. FoundNode n na la -> na
nodeAttributes)