{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} -- | -- Module: NetSpider.RPL.Combined -- Description: Snapshot graph combining DIO and DAO graphs -- Maintainer: Toshio Ito -- -- This module defines functions and data models that combine DIO -- (defined in "NetSpider.RPL.DIO") and DAO (defined in -- "NetSpider.RPL.DAO") graphs. module NetSpider.RPL.Combined ( -- * Functions combineGraphs, combineNodes, combineLinks, -- * Types SnapshotGraphCombined, CombinedNode(..), CombinedLink(..), combinedLinkType ) where import Data.Aeson (FromJSON(..), ToJSON(..)) import qualified Data.Aeson as Aeson import Data.Bifunctor (bimap, second) import Data.List (sortOn, reverse) import Data.Semigroup (Semigroup(..)) import Data.Maybe (isJust) import Data.Monoid (Monoid(..), First(..)) import GHC.Exts (groupWith) import GHC.Generics (Generic) import qualified NetSpider.GraphML.Writer as GraphML import NetSpider.Snapshot ( SnapshotNode, SnapshotLink, SnapshotGraph, nodeId, nodeAttributes, nodeTimestamp ) import NetSpider.RPL.FindingID (FindingID(..), FindingType(..), IPv6ID, ipv6Only) import NetSpider.RPL.DIO (DIONode, MergedDIOLink, SnapshotGraphDIO) import NetSpider.RPL.DAO (DAONode, DAOLink, SnapshotGraphDAO) import NetSpider.RPL.JSONUtil (optCombinedNode, optCombinedLink) -- | Node attributes combining 'DIONode' and 'DAONode'. data CombinedNode = CombinedNode { attrsDIO :: Maybe DIONode, attrsDAO :: Maybe DAONode } deriving (Show,Eq,Ord,Generic) -- | Based on instance of 'First'. instance Semigroup CombinedNode where a <> b = CombinedNode dio dao where dio = getFirst $ (First $ attrsDIO a) <> (First $ attrsDIO b) dao = getFirst $ (First $ attrsDAO a) <> (First $ attrsDAO b) -- | Based on instance of 'First'. instance Monoid CombinedNode where mappend a b = a <> b mempty = CombinedNode Nothing Nothing instance GraphML.ToAttributes CombinedNode where toAttributes cn = (GraphML.toAttributes $ attrsDIO cn) ++ (GraphML.toAttributes $ attrsDAO cn) -- | @since 0.4.1.0 instance FromJSON CombinedNode where parseJSON = Aeson.genericParseJSON optCombinedNode -- | @since 0.4.1.0 instance ToJSON CombinedNode where toJSON = Aeson.genericToJSON optCombinedNode toEncoding = Aeson.genericToEncoding optCombinedNode -- | Link attribute combining 'MergedDIOLink' and 'DAOLink'. data CombinedLink = CombinedDIOLink MergedDIOLink | CombinedDAOLink DAOLink deriving (Show,Eq,Ord,Generic) instance GraphML.ToAttributes CombinedLink where toAttributes (CombinedDIOLink ll) = ("link_type", GraphML.AttrString "dio") : GraphML.toAttributes ll toAttributes (CombinedDAOLink ll) = ("link_type", GraphML.AttrString "dao") : GraphML.toAttributes ll -- | @since 0.4.1.0 instance FromJSON CombinedLink where parseJSON = Aeson.genericParseJSON optCombinedLink -- | @since 0.4.1.0 instance ToJSON CombinedLink where toJSON = Aeson.genericToJSON optCombinedLink toEncoding = Aeson.genericToEncoding optCombinedLink combinedLinkType :: CombinedLink -> FindingType combinedLinkType (CombinedDIOLink _) = FindingDIO combinedLinkType (CombinedDAOLink _) = FindingDAO -- | Combine DIO and DAO 'SnapshotNode's. Attributes from 'DIONode' -- and 'DAONode' for the same 'IPv6ID' are combined into one -- 'CombinedNode'. Timestamp of a combined 'SnapshotNode' is the -- latest timestamp of input nodes for that 'IPv6ID'. combineNodes :: [SnapshotNode FindingID DIONode] -> [SnapshotNode FindingID DAONode] -> [SnapshotNode IPv6ID CombinedNode] combineNodes dio_ns dao_ns = concatNodes $ map fromDIO dio_ns ++ map fromDAO dao_ns where fromDIO = bimap ipv6Only (\ln -> CombinedNode (Just ln) Nothing) fromDAO = bimap ipv6Only (\sn -> CombinedNode Nothing (Just sn)) concatNodes nodes = map (merge . sortByTimestamp) $ groupWith nodeId nodes where sortByTimestamp = reverse . sortOn nodeTimestamp merge [] = error "Empty group should not happen." merge group_nodes@(head_node : _) = case mmerged_attr of Nothing -> -- No node has NodeAttribute. There is no need to merge. head_node Just merged_attr -> case filter hasNodeAttr group_nodes of [] -> error "At least one node must have NodeAttributes" (representative_node : _) -> second (const merged_attr) representative_node where mmerged_attr = mconcat $ map nodeAttributes group_nodes hasNodeAttr n = isJust $ nodeAttributes n -- | Convert DIO and DAO links into combined links. Despite its name, -- this function does not combine input links. It just make one -- combined link from each of the input links. combineLinks :: [SnapshotLink FindingID MergedDIOLink] -> [SnapshotLink FindingID DAOLink] -> [SnapshotLink IPv6ID CombinedLink] combineLinks dio_ls dao_ls = map fromDIO dio_ls ++ map fromDAO dao_ls where fromDIO = bimap ipv6Only (\ll -> CombinedDIOLink ll) fromDAO = bimap ipv6Only (\sl -> CombinedDAOLink sl) -- | 'SnapshotGraph' combining DIO and DAO networks. type SnapshotGraphCombined = SnapshotGraph IPv6ID CombinedNode CombinedLink -- | Combine DIO and DAO graphs into the combined graph, using -- 'combineNodes' and 'combineLinks'. combineGraphs :: SnapshotGraphDIO -> SnapshotGraphDAO -> SnapshotGraphCombined combineGraphs (dio_ns, dio_ls) (dao_ns, dao_ls) = (combineNodes dio_ns dao_ns, combineLinks dio_ls dao_ls)