{-# 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
{ DAONode -> Maybe Word
daoRouteNum :: Maybe Word
}
deriving (Int -> DAONode -> ShowS
[DAONode] -> ShowS
DAONode -> String
(Int -> DAONode -> ShowS)
-> (DAONode -> String) -> ([DAONode] -> ShowS) -> Show DAONode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DAONode] -> ShowS
$cshowList :: [DAONode] -> ShowS
show :: DAONode -> String
$cshow :: DAONode -> String
showsPrec :: Int -> DAONode -> ShowS
$cshowsPrec :: Int -> DAONode -> ShowS
Show,DAONode -> DAONode -> Bool
(DAONode -> DAONode -> Bool)
-> (DAONode -> DAONode -> Bool) -> Eq DAONode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DAONode -> DAONode -> Bool
$c/= :: DAONode -> DAONode -> Bool
== :: DAONode -> DAONode -> Bool
$c== :: DAONode -> DAONode -> Bool
Eq,Eq DAONode
Eq DAONode
-> (DAONode -> DAONode -> Ordering)
-> (DAONode -> DAONode -> Bool)
-> (DAONode -> DAONode -> Bool)
-> (DAONode -> DAONode -> Bool)
-> (DAONode -> DAONode -> Bool)
-> (DAONode -> DAONode -> DAONode)
-> (DAONode -> DAONode -> DAONode)
-> Ord DAONode
DAONode -> DAONode -> Bool
DAONode -> DAONode -> Ordering
DAONode -> DAONode -> DAONode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DAONode -> DAONode -> DAONode
$cmin :: DAONode -> DAONode -> DAONode
max :: DAONode -> DAONode -> DAONode
$cmax :: DAONode -> DAONode -> DAONode
>= :: DAONode -> DAONode -> Bool
$c>= :: DAONode -> DAONode -> Bool
> :: DAONode -> DAONode -> Bool
$c> :: DAONode -> DAONode -> Bool
<= :: DAONode -> DAONode -> Bool
$c<= :: DAONode -> DAONode -> Bool
< :: DAONode -> DAONode -> Bool
$c< :: DAONode -> DAONode -> Bool
compare :: DAONode -> DAONode -> Ordering
$ccompare :: DAONode -> DAONode -> Ordering
$cp1Ord :: Eq DAONode
Ord,(forall x. DAONode -> Rep DAONode x)
-> (forall x. Rep DAONode x -> DAONode) -> Generic DAONode
forall x. Rep DAONode x -> DAONode
forall x. DAONode -> Rep DAONode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DAONode x -> DAONode
$cfrom :: forall x. DAONode -> Rep DAONode x
Generic)
keyDaoRouteNum :: Key VFoundNode (Maybe Word)
keyDaoRouteNum :: Key VFoundNode (Maybe Word)
keyDaoRouteNum = Key VFoundNode (Maybe Word)
"dao_route_num"
instance NodeAttributes DAONode where
writeNodeAttributes :: DAONode -> Binder (Walk SideEffect VFoundNode VFoundNode)
writeNodeAttributes DAONode
dn = ([KeyValue VFoundNode] -> Walk SideEffect VFoundNode VFoundNode)
-> Binder [KeyValue VFoundNode]
-> Binder (Walk SideEffect VFoundNode VFoundNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [KeyValue VFoundNode] -> Walk SideEffect VFoundNode VFoundNode
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues (Binder [KeyValue VFoundNode]
-> Binder (Walk SideEffect VFoundNode VFoundNode))
-> Binder [KeyValue VFoundNode]
-> Binder (Walk SideEffect VFoundNode VFoundNode)
forall a b. (a -> b) -> a -> b
$ [Binder (KeyValue VFoundNode)] -> Binder [KeyValue VFoundNode]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Key VFoundNode (Maybe Word)
keyDaoRouteNum Key VFoundNode (Maybe Word)
-> Maybe Word -> Binder (KeyValue VFoundNode)
forall b a.
ToJSON b =>
Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
<=?> DAONode -> Maybe Word
daoRouteNum DAONode
dn]
parseNodeAttributes :: PMap Multi GValue -> Parser DAONode
parseNodeAttributes PMap Multi GValue
ps = Maybe Word -> DAONode
DAONode (Maybe Word -> DAONode) -> Parser (Maybe Word) -> Parser DAONode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either PMapLookupException (Maybe Word) -> Parser (Maybe Word)
forall (m :: * -> *) a.
MonadFail m =>
Either PMapLookupException a -> m a
pMapToFail (Either PMapLookupException (Maybe Word) -> Parser (Maybe Word))
-> Either PMapLookupException (Maybe Word) -> Parser (Maybe Word)
forall a b. (a -> b) -> a -> b
$ Key VFoundNode (Maybe Word)
-> PMap Multi GValue -> Either PMapLookupException (Maybe Word)
forall k (c :: * -> *) a.
(PMapKey k, NonEmptyLike c, PMapValue k ~ Maybe a,
FromGraphSON a) =>
k -> PMap c GValue -> Either PMapLookupException (Maybe a)
lookupAs' Key VFoundNode (Maybe Word)
keyDaoRouteNum PMap Multi GValue
ps)
instance GraphML.ToAttributes DAONode where
toAttributes :: DAONode -> [(AttributeKey, AttributeValue)]
toAttributes DAONode
dn =
case DAONode -> Maybe Word
daoRouteNum DAONode
dn of
Maybe Word
Nothing -> []
Just Word
p -> [(Key VFoundNode (Maybe Word) -> AttributeKey
forall k. PMapKey k => k -> AttributeKey
keyText Key VFoundNode (Maybe Word)
keyDaoRouteNum, Int -> AttributeValue
GraphML.AttrInt (Int -> AttributeValue) -> Int -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word
p)]
instance FromJSON DAONode where
parseJSON :: Value -> Parser DAONode
parseJSON = Options -> Value -> Parser DAONode
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
optSnake
instance ToJSON DAONode where
toJSON :: DAONode -> Value
toJSON = Options -> DAONode -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
optSnake
toEncoding :: DAONode -> Encoding
toEncoding = Options -> DAONode -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
optSnake
data DAOLink =
DAOLink
{ DAOLink -> Word
pathLifetimeSec :: Word
}
deriving (Int -> DAOLink -> ShowS
[DAOLink] -> ShowS
DAOLink -> String
(Int -> DAOLink -> ShowS)
-> (DAOLink -> String) -> ([DAOLink] -> ShowS) -> Show DAOLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DAOLink] -> ShowS
$cshowList :: [DAOLink] -> ShowS
show :: DAOLink -> String
$cshow :: DAOLink -> String
showsPrec :: Int -> DAOLink -> ShowS
$cshowsPrec :: Int -> DAOLink -> ShowS
Show,DAOLink -> DAOLink -> Bool
(DAOLink -> DAOLink -> Bool)
-> (DAOLink -> DAOLink -> Bool) -> Eq DAOLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DAOLink -> DAOLink -> Bool
$c/= :: DAOLink -> DAOLink -> Bool
== :: DAOLink -> DAOLink -> Bool
$c== :: DAOLink -> DAOLink -> Bool
Eq,Eq DAOLink
Eq DAOLink
-> (DAOLink -> DAOLink -> Ordering)
-> (DAOLink -> DAOLink -> Bool)
-> (DAOLink -> DAOLink -> Bool)
-> (DAOLink -> DAOLink -> Bool)
-> (DAOLink -> DAOLink -> Bool)
-> (DAOLink -> DAOLink -> DAOLink)
-> (DAOLink -> DAOLink -> DAOLink)
-> Ord DAOLink
DAOLink -> DAOLink -> Bool
DAOLink -> DAOLink -> Ordering
DAOLink -> DAOLink -> DAOLink
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DAOLink -> DAOLink -> DAOLink
$cmin :: DAOLink -> DAOLink -> DAOLink
max :: DAOLink -> DAOLink -> DAOLink
$cmax :: DAOLink -> DAOLink -> DAOLink
>= :: DAOLink -> DAOLink -> Bool
$c>= :: DAOLink -> DAOLink -> Bool
> :: DAOLink -> DAOLink -> Bool
$c> :: DAOLink -> DAOLink -> Bool
<= :: DAOLink -> DAOLink -> Bool
$c<= :: DAOLink -> DAOLink -> Bool
< :: DAOLink -> DAOLink -> Bool
$c< :: DAOLink -> DAOLink -> Bool
compare :: DAOLink -> DAOLink -> Ordering
$ccompare :: DAOLink -> DAOLink -> Ordering
$cp1Ord :: Eq DAOLink
Ord,(forall x. DAOLink -> Rep DAOLink x)
-> (forall x. Rep DAOLink x -> DAOLink) -> Generic DAOLink
forall x. Rep DAOLink x -> DAOLink
forall x. DAOLink -> Rep DAOLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DAOLink x -> DAOLink
$cfrom :: forall x. DAOLink -> Rep DAOLink x
Generic)
keyPathLifetimeSec :: Key EFinds Word
keyPathLifetimeSec :: Key EFinds Word
keyPathLifetimeSec = Key EFinds Word
"path_lifetime_sec"
instance LinkAttributes DAOLink where
writeLinkAttributes :: DAOLink -> Binder (Walk SideEffect EFinds EFinds)
writeLinkAttributes DAOLink
dl = ([KeyValue EFinds] -> Walk SideEffect EFinds EFinds)
-> Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [KeyValue EFinds] -> Walk SideEffect EFinds EFinds
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues (Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds))
-> Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds)
forall a b. (a -> b) -> a -> b
$ [Binder (KeyValue EFinds)] -> Binder [KeyValue EFinds]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Binder (KeyValue EFinds)]
pairs
where
pairs :: [Binder (KeyValue EFinds)]
pairs = [ Key EFinds Word
keyPathLifetimeSec Key EFinds Word -> Word -> Binder (KeyValue EFinds)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> DAOLink -> Word
pathLifetimeSec DAOLink
dl
]
parseLinkAttributes :: PMap Single GValue -> Parser DAOLink
parseLinkAttributes PMap Single GValue
ps = Word -> DAOLink
DAOLink (Word -> DAOLink) -> Parser Word -> Parser DAOLink
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either PMapLookupException Word -> Parser Word
forall (m :: * -> *) a.
MonadFail m =>
Either PMapLookupException a -> m a
pMapToFail (Either PMapLookupException Word -> Parser Word)
-> Either PMapLookupException Word -> Parser Word
forall a b. (a -> b) -> a -> b
$ Key EFinds Word
-> PMap Single GValue -> Either PMapLookupException Word
forall k (c :: * -> *) a.
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a) =>
k -> PMap c GValue -> Either PMapLookupException a
lookupAs Key EFinds Word
keyPathLifetimeSec PMap Single GValue
ps)
instance GraphML.ToAttributes DAOLink where
toAttributes :: DAOLink -> [(AttributeKey, AttributeValue)]
toAttributes DAOLink
dl = [ (Key EFinds Word -> AttributeKey
forall k. PMapKey k => k -> AttributeKey
keyText Key EFinds Word
keyPathLifetimeSec, Int -> AttributeValue
GraphML.AttrInt (Int -> AttributeValue) -> Int -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ DAOLink -> Word
pathLifetimeSec DAOLink
dl) ]
instance FromJSON DAOLink where
parseJSON :: Value -> Parser DAOLink
parseJSON = Options -> Value -> Parser DAOLink
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
optSnake
instance ToJSON DAOLink where
toJSON :: DAOLink -> Value
toJSON = Options -> DAOLink -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
optSnake
toEncoding :: DAOLink -> Encoding
toEncoding = Options -> DAOLink -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
optSnake
daoDefQuery :: [FindingID]
-> Query.Query FindingID DAONode DAOLink DAOLink
daoDefQuery :: [FindingID] -> Query FindingID DAONode DAOLink DAOLink
daoDefQuery [FindingID]
start =
([FindingID] -> Query FindingID DAONode Any Any
forall n na fla. (Eq n, Show n) => [n] -> Query n na fla fla
Query.defQuery [FindingID]
start)
{ startsFrom :: [FindingID]
Query.startsFrom = [FindingID]
start,
unifyLinkSamples :: LinkSampleUnifier FindingID DAONode DAOLink DAOLink
Query.unifyLinkSamples = UnifyStdConfig FindingID DAONode DAOLink DAOLink ()
-> LinkSampleUnifier FindingID DAONode DAOLink DAOLink
forall n lsid na fla sla.
(Eq n, Show n, Ord lsid) =>
UnifyStdConfig n na fla sla lsid -> LinkSampleUnifier n na fla sla
Unify.unifyStd UnifyStdConfig FindingID DAONode DAOLink DAOLink ()
daoUnifierConf
}
daoUnifierConf :: UnifyStdConfig FindingID DAONode DAOLink DAOLink ()
daoUnifierConf :: UnifyStdConfig FindingID DAONode DAOLink DAOLink ()
daoUnifierConf = UnifyStdConfig FindingID Any DAOLink DAOLink ()
forall n na fla. Eq n => UnifyStdConfig n na fla fla ()
Unify.defUnifyStdConfig { negatesLinkSample :: SnapshotNode FindingID DAONode
-> LinkSample FindingID DAOLink -> Bool
Unify.negatesLinkSample = \SnapshotNode FindingID DAONode
_ LinkSample FindingID DAOLink
_ -> Bool
False }