{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module NetSpider.RPL.Combined
(
combineGraphs,
combineNodes,
combineLinks,
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)
data CombinedNode =
CombinedNode
{ attrsDIO :: Maybe DIONode,
attrsDAO :: Maybe DAONode
}
deriving (Show,Eq,Ord,Generic)
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)
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)
instance FromJSON CombinedNode where
parseJSON = Aeson.genericParseJSON optCombinedNode
instance ToJSON CombinedNode where
toJSON = Aeson.genericToJSON optCombinedNode
toEncoding = Aeson.genericToEncoding optCombinedNode
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
instance FromJSON CombinedLink where
parseJSON = Aeson.genericParseJSON optCombinedLink
instance ToJSON CombinedLink where
toJSON = Aeson.genericToJSON optCombinedLink
toEncoding = Aeson.genericToEncoding optCombinedLink
combinedLinkType :: CombinedLink -> FindingType
combinedLinkType (CombinedDIOLink _) = FindingDIO
combinedLinkType (CombinedDAOLink _) = FindingDAO
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 ->
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
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)
type SnapshotGraphCombined = SnapshotGraph IPv6ID CombinedNode CombinedLink
combineGraphs :: SnapshotGraphDIO
-> SnapshotGraphDAO
-> SnapshotGraphCombined
combineGraphs (dio_ns, dio_ls) (dao_ns, dao_ls) =
(combineNodes dio_ns dao_ns, combineLinks dio_ls dao_ls)