net-spider-rpl 0.3.1.0 → 0.4.0.0
raw patch · 5 files changed
+261/−42 lines, 5 filesdep +hspec-need-envdep ~basedep ~greskelldep ~hspecPVP ok
version bump matches the API change (PVP)
Dependencies added: hspec-need-env
Dependency ranges changed: base, greskell, hspec, net-spider, text
API changes (from Hackage documentation)
+ NetSpider.RPL.DIO: instance Data.Aeson.Types.ToJSON.ToJSON NetSpider.RPL.DIO.NeighborType
+ NetSpider.RPL.DIO: instance Data.Greskell.GraphSON.FromGraphSON NetSpider.RPL.DIO.NeighborType
Files
- ChangeLog.md +10/−0
- net-spider-rpl.cabal +24/−3
- src/NetSpider/RPL/DAO.hs +17/−16
- src/NetSpider/RPL/DIO.hs +48/−23
- test/ServerTest.hs +162/−0
ChangeLog.md view
@@ -1,5 +1,15 @@ # Revision history for net-spider-rpl +## 0.4.0.0 -- 2019-12-28++* [BREAKING CHANGE] Changes instances of `LinkAttributes` and+ `NodeAttributes` because their signature are changed in+ `net-spider-0.4.0.0`.+* This also leads to a bug fix. Before, it could not write or parse+ attribute values of 'Nothing'.+* Add `FromGraphSON` and `ToJSON` instances to `NeighborType`.++ ## 0.3.1.0 -- 2019-10-04 * Expose an internal module `NetSpider.RPL.IPv6`.
net-spider-rpl.cabal view
@@ -1,5 +1,5 @@ name: net-spider-rpl-version: 0.3.1.0+version: 0.4.0.0 author: Toshio Ito <debug.ito@gmail.com> maintainer: Toshio Ito <debug.ito@gmail.com> license: BSD3@@ -34,8 +34,8 @@ NetSpider.RPL.IPv6 build-depends: base >=4.11.1.0 && <4.13, aeson >=1.3.1.1 && <1.5,- greskell >=0.2.3.0 && <0.3,- net-spider >=0.3.1.0 && <0.4,+ greskell >=1.0.0.0 && <1.1,+ net-spider >=0.4.0.0 && <0.5, text >=1.2.3.1 && <1.3, ip >=1.3.0 && <1.7, hashable >=1.2.7.0 && <1.4,@@ -70,6 +70,27 @@ hspec >=2.5.5, bytestring >=0.10.8.2 && <0.11, fast-logger >=2.4.11 && <2.5++flag server-test+ description: Do test with Gremlin Server.+ Note that this test clears ALL CONTENT of the server.+ Note also that this test should not be run in parallel with other server-tests.+ Use --jobs=1 option when running stack test.+ default: False+ manual: True++test-suite server-test-suite+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"+ main-is: ServerTest.hs+ default-extensions: OverloadedStrings+ if flag(server-test)+ build-depends: base, hspec, net-spider-rpl, net-spider, text,+ hspec-need-env >=0.1.0.0 && <0.2+ else+ buildable: False source-repository head type: git
src/NetSpider/RPL/DAO.hs view
@@ -23,12 +23,12 @@ import Control.Applicative ((<$>), (<*>)) import Data.Aeson (ToJSON(..)) import Data.Greskell- ( parseOneValue, parseListValues+ ( lookupAs', Key, pMapToFail, lookupAs, keyText )-import Data.Greskell.Extra (writePropertyKeyValues)+import Data.Greskell.Extra (writeKeyValues, (<=:>), (<=?>)) import Data.Maybe (listToMaybe) import NetSpider.Found (FoundNode)-import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..))+import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..), VFoundNode, EFinds) import qualified NetSpider.GraphML.Writer as GraphML import qualified NetSpider.Query as Query import NetSpider.Snapshot (SnapshotGraph)@@ -58,20 +58,18 @@ } deriving (Show,Eq,Ord) +keyDaoRouteNum :: Key VFoundNode (Maybe Word)+keyDaoRouteNum = "dao_route_num"+ instance NodeAttributes DAONode where- writeNodeAttributes dn = writePropertyKeyValues pairs- where- pairs =- case daoRouteNum dn of- Nothing -> []- Just n -> [("dao_route_num", toJSON n)]- parseNodeAttributes ps = fmap (DAONode . listToMaybe) $ parseListValues "dao_route_num" ps+ 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 -> [("dao_route_num", GraphML.AttrInt $ fromIntegral $ p)]+ Just p -> [(keyText keyDaoRouteNum, GraphML.AttrInt $ fromIntegral $ p)] -- | Link attributes about DAO.@@ -91,15 +89,18 @@ } deriving (Show,Eq,Ord) +keyPathLifetimeSec :: Key EFinds Word+keyPathLifetimeSec = "path_lifetime_sec"+ instance LinkAttributes DAOLink where- writeLinkAttributes dl = writePropertyKeyValues pairs+ writeLinkAttributes dl = fmap writeKeyValues $ sequence pairs where- pairs = [ ("path_lifetime_sec", toJSON $ pathLifetimeSec dl)+ pairs = [ keyPathLifetimeSec <=:> pathLifetimeSec dl ]- parseLinkAttributes ps = DAOLink <$> parseOneValue "path_lifetime_sec" ps+ parseLinkAttributes ps = DAOLink <$> (pMapToFail $ lookupAs keyPathLifetimeSec ps) instance GraphML.ToAttributes DAOLink where- toAttributes dl = [ ("path_lifetime_sec", GraphML.AttrInt $ fromIntegral $ pathLifetimeSec dl) ]+ toAttributes dl = [ (keyText keyPathLifetimeSec, GraphML.AttrInt $ fromIntegral $ pathLifetimeSec dl) ] -- | Default 'Query.Query' for DAO nodes. daoDefQuery :: [FindingID] -- ^ 'Query.startsFrom' field.@@ -110,6 +111,6 @@ Query.unifyLinkSamples = Unify.unifyStd daoUnifierConf } --- | 'UnifyStdConfig' for RPL DAO data. Used in 'defQuery'.+-- | 'UnifyStdConfig' for RPL DAO data. Used in 'daoDefQuery'. daoUnifierConf :: UnifyStdConfig FindingID DAONode DAOLink DAOLink () daoUnifierConf = Unify.defUnifyStdConfig { Unify.negatesLinkSample = \_ _ -> False }
src/NetSpider/RPL/DIO.hs view
@@ -27,15 +27,17 @@ import Data.Aeson (ToJSON(..)) import Data.Bifunctor (bimap) import Data.Greskell- ( PropertyMap, Property, GValue, parseOneValue,- Binder, Walk, SideEffect, Element, Parser+ ( Property, GValue,+ Binder, Walk, SideEffect, Element, Parser,+ Key, pMapToFail, lookupAs, lookupAs', keyText,+ FromGraphSON(..) )-import Data.Greskell.Extra (writePropertyKeyValues)+import Data.Greskell.Extra (writeKeyValues, (<=:>), (<=?>)) import Data.Monoid ((<>)) import Data.Text (Text, unpack) import Data.Word (Word32) import NetSpider.Found (FoundNode, LinkState(..))-import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..))+import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..), VFoundNode, EFinds) import qualified NetSpider.GraphML.Writer as GraphML import qualified NetSpider.Query as Query import NetSpider.Snapshot (SnapshotGraph)@@ -70,19 +72,25 @@ } deriving (Show,Eq,Ord) +keyRank :: Key VFoundNode Rank+keyRank = "rank"++keyDioInterval :: Key VFoundNode TrickleInterval+keyDioInterval = "dio_interval"+ instance NodeAttributes DIONode where- writeNodeAttributes ln = writePropertyKeyValues pairs+ writeNodeAttributes ln = fmap writeKeyValues $ sequence pairs where- pairs = [ ("rank", toJSON $ rank ln),- ("dio_interval", toJSON $ dioInterval ln)+ pairs = [ keyRank <=:> rank ln,+ keyDioInterval <=:> dioInterval ln ]- parseNodeAttributes ps = DIONode- <$> parseOneValue "rank" ps- <*> parseOneValue "dio_interval" ps+ parseNodeAttributes ps = pMapToFail $ DIONode+ <$> lookupAs keyRank ps+ <*> lookupAs keyDioInterval ps instance GraphML.ToAttributes DIONode where- toAttributes ln = [ ("rank", GraphML.AttrInt $ fromIntegral $ rank ln),- ("dio_interval", GraphML.AttrInt $ fromIntegral $ dioInterval ln)+ toAttributes ln = [ (keyText keyRank, GraphML.AttrInt $ fromIntegral $ rank ln),+ (keyText keyDioInterval, GraphML.AttrInt $ fromIntegral $ dioInterval ln) ] -- | Classification of RPL neighbors.@@ -112,12 +120,23 @@ adaptWalk :: (Element e1, Element e2) => Walk SideEffect e1 e1 -> Walk SideEffect e2 e2 adaptWalk = bimap undefined undefined -instance LinkAttributes NeighborType where- writeLinkAttributes nt = writePropertyKeyValues [("neighbor_type", neighborTypeToText nt)]- parseLinkAttributes ps = fromT =<< parseOneValue "neighbor_type" ps+keyNeighborType :: Key EFinds NeighborType+keyNeighborType = "neighbor_type"++-- | @since 0.4.0.0+instance FromGraphSON NeighborType where+ parseGraphSON gv = fromT =<< parseGraphSON gv where fromT t = maybe (fail ("Unknown neighbor type: " <> unpack t)) return $ neighborTypeFromText t +-- | @since 0.4.0.0+instance ToJSON NeighborType where+ toJSON n = toJSON $ neighborTypeToText n++instance LinkAttributes NeighborType where+ writeLinkAttributes nt = fmap writeKeyValues $ sequence [keyNeighborType <=:> nt]+ parseLinkAttributes ps = pMapToFail $ lookupAs keyNeighborType ps+ -- | Link attributes about DIO. -- -- Basically this represents information of a neighbor learned from@@ -135,20 +154,26 @@ } deriving (Show,Eq,Ord) +keyNeighborRank :: Key EFinds Rank+keyNeighborRank = "neighbor_rank"++keyMetric :: Key EFinds (Maybe Rank)+keyMetric = "metric"+ instance LinkAttributes DIOLink where writeLinkAttributes ll = do nt_steps <- writeLinkAttributes $ neighborType ll- other <- writePropertyKeyValues pairs+ other <- fmap writeKeyValues $ sequence pairs return (adaptWalk nt_steps <> other) where- pairs = [ ("neighbor_rank", toJSON $ neighborRank ll),- ("metric", toJSON $ metric ll)+ pairs = [ keyNeighborRank <=:> neighborRank ll,+ keyMetric <=?> metric ll ] parseLinkAttributes ps = DIOLink <$> parseLinkAttributes ps- <*> parseOneValue "neighbor_rank" ps- <*> parseOneValue "metric" ps+ <*> (pMapToFail $ lookupAs keyNeighborRank ps)+ <*> (pMapToFail $ lookupAs' keyMetric ps) -- | 'LinkState' that should be set for given 'DIOLink'. dioLinkState :: DIOLink -> LinkState@@ -158,15 +183,15 @@ _ -> LinkUnused instance GraphML.ToAttributes DIOLink where- toAttributes ll = [ ("neighbor_type", GraphML.AttrString $ neighborTypeToText $ neighborType ll),- ("neighbor_rank", GraphML.AttrInt $ fromIntegral $ neighborRank ll)+ toAttributes ll = [ (keyText keyNeighborType, GraphML.AttrString $ neighborTypeToText $ neighborType ll),+ (keyText keyNeighborRank, GraphML.AttrInt $ fromIntegral $ neighborRank ll) ] ++ at_metric where at_metric = case metric ll of Nothing -> []- Just m -> [("metric", GraphML.AttrInt $ fromIntegral m)]+ Just m -> [(keyText keyMetric, GraphML.AttrInt $ fromIntegral m)] -- | Link attributes merging two 'DIOLink's from the two end nodes
+ test/ServerTest.hs view
@@ -0,0 +1,162 @@+module Main (main,spec) where++import Control.Monad (mapM_)+import Data.List (sort)+import Data.Maybe (fromJust)+import Data.Text (Text)+import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(..))+import qualified NetSpider.Snapshot as Sn+import NetSpider.Spider (Spider, withSpider, addFoundNode, clearAll, getSnapshot)+import NetSpider.Spider.Config (Host, Port, defConfig, wsHost, wsPort)+import NetSpider.Timestamp (fromEpochMillisecond)+import Test.Hspec+import Test.Hspec.NeedEnv (needEnvHostPort, EnvMode(Need))++import NetSpider.RPL.DAO+ ( DAONode(..), DAOLink(..), daoDefQuery+ )+import NetSpider.RPL.DIO+ ( DIONode(..), DIOLink(..), NeighborType(..), dioDefQuery,+ MergedDIOLink(..)+ )+import NetSpider.RPL.FindingID (FindingID, idFromText)++main :: IO ()+main = hspec spec++withSpider' :: (Spider FindingID na fla -> IO ()) -> (Host, Port) -> IO ()+withSpider' act (h, p) = withSpider conf act+ where+ conf = defConfig { wsHost = h, wsPort = p }++sortBoth :: (Ord a, Ord b) => ([a], [b]) -> ([a], [b])+sortBoth (as, bs) = (sort as, sort bs)++idBoth :: (Text, Text) -> (FindingID, FindingID)+idBoth (a, b) = (fromJust $ idFromText a, fromJust $ idFromText b)++spec :: Spec+spec = before (needEnvHostPort Need "NET_SPIDER_TEST") $ describe "server test" $ do+ specify "DIONode and DIOLink" $ withSpider' $ \spider -> do+ let input = [ FoundNode+ { subjectNode = fromJust $ idFromText "dio://[fd00::1]",+ foundAt = fromEpochMillisecond 120,+ nodeAttributes = DIONode { rank = 256, dioInterval = 5 },+ neighborLinks = []+ },+ FoundNode+ { subjectNode = fromJust $ idFromText "dio://[fd00::2]",+ foundAt = fromEpochMillisecond 125,+ nodeAttributes = DIONode { rank = 556, dioInterval = 7 },+ neighborLinks =+ [ FoundLink+ { targetNode = fromJust $ idFromText "dio://[fd00::1]",+ linkState = LinkToTarget,+ linkAttributes =+ DIOLink+ { neighborType = PreferredParent,+ neighborRank = 256,+ metric = Just 300+ }+ }+ ]+ },+ FoundNode+ { subjectNode = fromJust $ idFromText "dio://[fd00::3]",+ foundAt = fromEpochMillisecond 122,+ nodeAttributes = DIONode { rank = 618 , dioInterval = 7 },+ neighborLinks =+ [ FoundLink+ { targetNode = fromJust $ idFromText "dio://[fd00::1]",+ linkState = LinkToTarget,+ linkAttributes =+ DIOLink+ { neighborType = PreferredParent,+ neighborRank = 256,+ metric = Nothing+ }+ }+ ]+ }+ ]+ clearAll spider+ mapM_ (addFoundNode spider) input+ let query = dioDefQuery $ map (fromJust . idFromText) ["dio://[fd00::2]", "dio://[fd00::3]"]+ (got_nodes, got_links) <- fmap sortBoth $ getSnapshot spider query+ map Sn.nodeId got_nodes `shouldBe`+ map (fromJust . idFromText) [ "dio://[fd00::1]",+ "dio://[fd00::2]",+ "dio://[fd00::3]"+ ]+ map Sn.nodeAttributes got_nodes `shouldBe`+ [ Just $ DIONode { rank = 256, dioInterval = 5 },+ Just $ DIONode { rank = 556, dioInterval = 7 },+ Just $ DIONode { rank = 618, dioInterval = 7 }+ ]+ map Sn.linkNodeTuple got_links `shouldBe`+ [ idBoth ("dio://[fd00::2]", "dio://[fd00::1]"),+ idBoth ("dio://[fd00::3]", "dio://[fd00::1]")+ ]+ map Sn.linkAttributes got_links `shouldBe`+ [ MergedDIOLink+ ( DIOLink+ { neighborType = PreferredParent,+ neighborRank = 256,+ metric = Just 300+ }+ )+ Nothing,+ MergedDIOLink+ ( DIOLink+ { neighborType = PreferredParent,+ neighborRank = 256,+ metric = Nothing+ }+ )+ Nothing+ ]+ specify "DAONode and DAOLink" $ withSpider' $ \spider -> do+ let input =+ [ FoundNode+ { subjectNode = fromJust $ idFromText "dao://[fd00::1]",+ foundAt = fromEpochMillisecond 100,+ nodeAttributes = DAONode { daoRouteNum = Just 1 },+ neighborLinks = []+ },+ FoundNode+ { subjectNode = fromJust $ idFromText "dao://[fd00::2]",+ foundAt = fromEpochMillisecond 100,+ nodeAttributes = DAONode { daoRouteNum = Nothing },+ neighborLinks =+ [ FoundLink+ { targetNode = fromJust $ idFromText "dao://[fd00::1]",+ linkState = LinkToTarget,+ linkAttributes =+ DAOLink+ { pathLifetimeSec = 1200+ }+ }+ ]+ }+ ]+ clearAll spider+ mapM_ (addFoundNode spider) input+ let query = daoDefQuery $ map (fromJust . idFromText) ["dao://[fd00::2]"]+ (got_nodes, got_links) <- fmap sortBoth $ getSnapshot spider query+ map Sn.nodeId got_nodes `shouldBe`+ map (fromJust . idFromText) [ "dao://[fd00::1]",+ "dao://[fd00::2]"+ ]+ map Sn.nodeAttributes got_nodes `shouldBe`+ [ Just $ DAONode { daoRouteNum = Just 1 },+ Just $ DAONode { daoRouteNum = Nothing }+ ]+ map Sn.linkNodeTuple got_links `shouldBe`+ [ idBoth ("dao://[fd00::2]", "dao://[fd00::1]")+ ]+ map Sn.linkAttributes got_links `shouldBe`+ [ DAOLink+ { pathLifetimeSec = 1200+ }+ ]+