{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module NetSpider.RPL.DAO
(
FoundNodeDAO,
SnapshotGraphDAO,
DAONode(..),
DAOLink(..),
daoDefQuery,
daoUnifierConf
) where
import Data.Greskell
( gIdentity
)
import Control.Applicative ((<$>), (<*>))
import Data.Aeson (ToJSON(..), FromJSON(..))
import qualified Data.Aeson as Aeson
import Data.Greskell
( lookupAs', Key, pMapToFail, lookupAs, keyText
)
import Data.Greskell.Extra (writeKeyValues, (<=:>), (<=?>))
import Data.Maybe (listToMaybe)
import GHC.Generics (Generic)
import NetSpider.Found (FoundNode)
import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..), VFoundNode, EFinds)
import qualified NetSpider.GraphML.Writer as GraphML
import qualified NetSpider.Query as Query
import NetSpider.Snapshot (SnapshotGraph)
import NetSpider.Unify (UnifyStdConfig, lsLinkAttributes, latestLinkSample)
import qualified NetSpider.Unify as Unify
import NetSpider.RPL.FindingID (FindingID)
import NetSpider.RPL.JSONUtil (optSnake)
type FoundNodeDAO = FoundNode FindingID DAONode DAOLink
type SnapshotGraphDAO = SnapshotGraph FindingID DAONode DAOLink
data DAONode =
DAONode
{ daoRouteNum :: Maybe Word
}
deriving (Show,Eq,Ord,Generic)
keyDaoRouteNum :: Key VFoundNode (Maybe Word)
keyDaoRouteNum = "dao_route_num"
instance NodeAttributes DAONode where
writeNodeAttributes dn = fmap writeKeyValues $ sequence [keyDaoRouteNum <=?> daoRouteNum dn]
parseNodeAttributes ps = DAONode <$> (pMapToFail $ lookupAs' keyDaoRouteNum ps)
instance GraphML.ToAttributes DAONode where
toAttributes dn =
case daoRouteNum dn of
Nothing -> []
Just p -> [(keyText keyDaoRouteNum, GraphML.AttrInt $ fromIntegral $ p)]
instance FromJSON DAONode where
parseJSON = Aeson.genericParseJSON optSnake
instance ToJSON DAONode where
toJSON = Aeson.genericToJSON optSnake
toEncoding = Aeson.genericToEncoding optSnake
data DAOLink =
DAOLink
{ pathLifetimeSec :: Word
}
deriving (Show,Eq,Ord,Generic)
keyPathLifetimeSec :: Key EFinds Word
keyPathLifetimeSec = "path_lifetime_sec"
instance LinkAttributes DAOLink where
writeLinkAttributes dl = fmap writeKeyValues $ sequence pairs
where
pairs = [ keyPathLifetimeSec <=:> pathLifetimeSec dl
]
parseLinkAttributes ps = DAOLink <$> (pMapToFail $ lookupAs keyPathLifetimeSec ps)
instance GraphML.ToAttributes DAOLink where
toAttributes dl = [ (keyText keyPathLifetimeSec, GraphML.AttrInt $ fromIntegral $ pathLifetimeSec dl) ]
instance FromJSON DAOLink where
parseJSON = Aeson.genericParseJSON optSnake
instance ToJSON DAOLink where
toJSON = Aeson.genericToJSON optSnake
toEncoding = Aeson.genericToEncoding optSnake
daoDefQuery :: [FindingID]
-> Query.Query FindingID DAONode DAOLink DAOLink
daoDefQuery start =
(Query.defQuery start)
{ Query.startsFrom = start,
Query.unifyLinkSamples = Unify.unifyStd daoUnifierConf
}
daoUnifierConf :: UnifyStdConfig FindingID DAONode DAOLink DAOLink ()
daoUnifierConf = Unify.defUnifyStdConfig { Unify.negatesLinkSample = \_ _ -> False }