net-spider-rpl 0.4.0.1 → 0.4.1.0

raw patch · 11 files changed

+325/−21 lines, 11 filesdep +regex-applicativedep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: regex-applicative

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−0
• net-spider-rpl.cabal +10/−4
• src/NetSpider/RPL/Combined.hs +25/−3
• src/NetSpider/RPL/DAO.hs +24/−4
• src/NetSpider/RPL/DIO.hs +49/−9
• src/NetSpider/RPL/FindingID.hs +16/−1
• src/NetSpider/RPL/JSONUtil.hs +41/−0
• test/JSONUtil.hs +24/−0
• test/NetSpider/RPL/CombinedSpec.hs +53/−0
• test/NetSpider/RPL/DAOSpec.hs +24/−0
• test/NetSpider/RPL/DIOSpec.hs +44/−0

@@ -1,5 +1,20 @@ # Revision history for net-spider-rpl +## 0.4.1.0  -- 2020-01-26++* Add `FromJSON` and `ToJSON` instances to the following+  types.+    * `DIONode`+    * `DIOLink`+    * `NeighborType`+    * `MergedDIOLink`+    * `DAONode`+    * `DAOLink`+    * `CombinedNode`+    * `CombinedLink`+    * `FindingType`+* Add `ToJSON` instance to `IPv6ID`.+ ## 0.4.0.1  -- 2019-12-29  * Confirm `ip-1.7.0` and `fast-logger-3.0.0`.

@@ -1,5 +1,5 @@ name:                   net-spider-rpl-version:                0.4.0.1+version:                0.4.1.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -32,6 +32,7 @@                         NetSpider.RPL.Combined,                         NetSpider.RPL.ContikiNG,                         NetSpider.RPL.IPv6+  other-modules:        NetSpider.RPL.JSONUtil   build-depends:        base >=4.11.1.0 && <4.13,                         aeson >=1.3.1.1 && <1.5,                         greskell >=1.0.0.0 && <1.1,@@ -44,7 +45,8 @@                         conduit >=1.3.1 && <1.4,                         mtl >=2.2.2 && <2.3,                         safe-exceptions >=0.1.7.0 && <0.2,-                        monad-logger >=0.3.28.1 && <0.4+                        monad-logger >=0.3.28.1 && <0.4,+                        regex-applicative >=0.3.3 && <0.4  -- executable net-spider-rpl --   default-language:     Haskell2010@@ -65,8 +67,12 @@   -- default-extensions:      other-extensions:     OverloadedStrings   other-modules:        NetSpider.RPL.ContikiNGSpec,-                        NetSpider.RPL.IPv6Spec-  build-depends:        base, net-spider-rpl, net-spider, text, monad-logger, ip,+                        NetSpider.RPL.IPv6Spec,+                        NetSpider.RPL.DIOSpec,+                        NetSpider.RPL.DAOSpec,+                        NetSpider.RPL.CombinedSpec,+                        JSONUtil+  build-depends:        base, net-spider-rpl, net-spider, text, monad-logger, ip, aeson,                         hspec >=2.5.5,                         bytestring >=0.10.8.2 && <0.11,                         fast-logger >=2.4.11 && <3.1

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} -- | -- Module: NetSpider.RPL.Combined -- Description: Snapshot graph combining DIO and DAO graphs@@ -19,12 +19,15 @@     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,@@ -34,6 +37,7 @@ 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 =@@ -41,7 +45,7 @@   { attrsDIO :: Maybe DIONode,     attrsDAO :: Maybe DAONode   }-  deriving (Show,Eq,Ord)+  deriving (Show,Eq,Ord,Generic)  -- | Based on instance of 'First'. instance Semigroup CombinedNode where@@ -59,16 +63,34 @@   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)+                  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

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} -- | -- Module: NetSpider.RPL.DAO -- Description: Node and link information based on DAO (Destination Advertisement Object)@@ -21,12 +21,14 @@   )    import Control.Applicative ((<$>), (<*>))-import Data.Aeson (ToJSON(..))+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@@ -36,6 +38,7 @@ import qualified NetSpider.Unify as Unify  import NetSpider.RPL.FindingID (FindingID)+import NetSpider.RPL.JSONUtil (optSnake)  -- | 'FoundNode' for a network described by DAOs. type FoundNodeDAO = FoundNode FindingID DAONode DAOLink@@ -56,7 +59,7 @@     -- supposed to be 'Nothing', because they don't have a downward     -- routing table.   }-  deriving (Show,Eq,Ord)+  deriving (Show,Eq,Ord,Generic)  keyDaoRouteNum :: Key VFoundNode (Maybe Word) keyDaoRouteNum = "dao_route_num"@@ -71,7 +74,15 @@       Nothing -> []       Just p -> [(keyText keyDaoRouteNum, GraphML.AttrInt $ fromIntegral $ p)] +-- | @since 0.4.1.0+instance FromJSON DAONode where+  parseJSON = Aeson.genericParseJSON optSnake +-- | @since 0.4.1.0+instance ToJSON DAONode where+  toJSON = Aeson.genericToJSON optSnake+  toEncoding = Aeson.genericToEncoding optSnake+ -- | Link attributes about DAO. -- -- In Storing mode of RPL, a 'DAOLink' represents a link between the@@ -87,7 +98,7 @@     -- Lifetime is advertised in Transit Information Option in DAO,     -- and managed in the routing table.   }-  deriving (Show,Eq,Ord)+  deriving (Show,Eq,Ord,Generic)  keyPathLifetimeSec :: Key EFinds Word keyPathLifetimeSec = "path_lifetime_sec"@@ -101,6 +112,15 @@  instance GraphML.ToAttributes DAOLink where   toAttributes dl = [ (keyText keyPathLifetimeSec, GraphML.AttrInt $ fromIntegral $ pathLifetimeSec dl) ]++-- | @since 0.4.1.0+instance FromJSON DAOLink where+  parseJSON = Aeson.genericParseJSON optSnake++-- | @since 0.4.1.0+instance ToJSON DAOLink where+  toJSON = Aeson.genericToJSON optSnake+  toEncoding = Aeson.genericToEncoding optSnake  -- | Default 'Query.Query' for DAO nodes. daoDefQuery :: [FindingID] -- ^ 'Query.startsFrom' field.

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} -- | -- Module: NetSpider.RPL.DIO -- Description: Node and link information based on DIO (DODAG Information Object)@@ -23,8 +23,9 @@     dioUnifierConf   ) where -import Control.Applicative ((<$>), (<*>))-import Data.Aeson (ToJSON(..))+import Control.Applicative ((<$>), (<*>), empty)+import Data.Aeson (ToJSON(..), FromJSON(..))+import qualified Data.Aeson as Aeson import Data.Bifunctor (bimap) import Data.Greskell   ( Property, GValue,@@ -36,6 +37,7 @@ import Data.Monoid ((<>)) import Data.Text (Text, unpack) import Data.Word (Word32)+import GHC.Generics (Generic) import NetSpider.Found (FoundNode, LinkState(..)) import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..), VFoundNode, EFinds) import qualified NetSpider.GraphML.Writer as GraphML@@ -45,6 +47,7 @@ import qualified NetSpider.Unify as Unify  import NetSpider.RPL.FindingID (FindingID)+import NetSpider.RPL.JSONUtil (optSnake)  -- | 'FoundNode' for a network described by DIOs. type FoundNodeDIO = FoundNode FindingID DIONode DIOLink@@ -70,7 +73,7 @@     dioInterval :: TrickleInterval     -- ^ Current interval of Trickle timer for DIO transmission.   }-  deriving (Show,Eq,Ord)+  deriving (Show,Eq,Ord,Generic)  keyRank :: Key VFoundNode Rank keyRank = "rank"@@ -93,6 +96,15 @@                       (keyText keyDioInterval, GraphML.AttrInt $ fromIntegral $ dioInterval ln)                     ] +-- | @since 0.4.1.0+instance FromJSON DIONode where+  parseJSON = Aeson.genericParseJSON optSnake++-- | @since 0.4.1.0+instance ToJSON DIONode where+  toJSON = Aeson.genericToJSON optSnake+  toEncoding = Aeson.genericToEncoding optSnake+ -- | Classification of RPL neighbors. data NeighborType = PreferredParent                     -- ^ The neighbor is the preferred parent.@@ -101,7 +113,7 @@                     -- is in the parent set.                   | OtherNeighbor                     -- ^ The neighbor is not in the parent set.-                  deriving (Show,Eq,Ord,Enum,Bounded)+                  deriving (Show,Eq,Ord,Enum,Bounded,Generic)  neighborTypeToText :: NeighborType -> Text neighborTypeToText nt = case nt of@@ -129,10 +141,21 @@     where       fromT t = maybe (fail ("Unknown neighbor type: " <> unpack t)) return $ neighborTypeFromText t --- | @since 0.4.0.0+-- | Encode to a JSON string.+--+-- @since 0.4.0.0 instance ToJSON NeighborType where   toJSON n = toJSON $ neighborTypeToText n +-- | Decode from a JSON string.+--+-- @since 0.4.1.0+instance FromJSON NeighborType where+  parseJSON (Aeson.String t) = maybe (fail err_msg) return $ neighborTypeFromText t+    where+      err_msg = "Invalid string for NeighborType: " <> show t+  parseJSON _ = empty+ instance LinkAttributes NeighborType where   writeLinkAttributes nt = fmap writeKeyValues $ sequence [keyNeighborType <=:> nt]   parseLinkAttributes ps = pMapToFail $ lookupAs keyNeighborType ps@@ -152,7 +175,7 @@     -- Rank computation is up to the Objective Function, this field is     -- optional.   }-  deriving (Show,Eq,Ord)+  deriving (Show,Eq,Ord,Generic)  keyNeighborRank :: Key EFinds Rank keyNeighborRank = "neighbor_rank"@@ -192,8 +215,16 @@         case metric ll of           Nothing -> []           Just m -> [(keyText keyMetric, GraphML.AttrInt $ fromIntegral m)]-                     +-- | @since 0.4.1.0+instance FromJSON DIOLink where+  parseJSON = Aeson.genericParseJSON optSnake++-- | @since 0.4.1.0+instance ToJSON DIOLink where+  toJSON = Aeson.genericToJSON optSnake+  toEncoding = Aeson.genericToEncoding optSnake+ -- | Link attributes merging two 'DIOLink's from the two end nodes -- of the link. data MergedDIOLink =@@ -201,7 +232,7 @@   { fromSource :: DIOLink,     fromDest :: Maybe DIOLink   }-  deriving (Show,Eq,Ord)+  deriving (Show,Eq,Ord,Generic)  withKeyPrefix :: Monoid k               => k@@ -255,3 +286,12 @@         Nothing -> []         Just dl -> withKeyPrefix "dest_" $ GraphML.toAttributes dl     )++-- | @since 0.4.1.0+instance FromJSON MergedDIOLink where+  parseJSON = Aeson.genericParseJSON optSnake++-- | @since 0.4.1.0+instance ToJSON MergedDIOLink where+  toJSON = Aeson.genericToJSON optSnake+  toEncoding = Aeson.genericToEncoding optSnake

@@ -21,7 +21,7 @@     ipv6Only   ) where -import Control.Applicative ((<$>), (<*>))+import Control.Applicative ((<$>), (<*>), empty) import Control.Monad.Fail (MonadFail) import Data.Bits (shiftL, (.|.)) import Data.Monoid ((<>))@@ -61,6 +61,17 @@     "dao" -> Just FindingDAO     _ -> Nothing +-- | @since 0.4.1.0+instance FromJSON FindingType where+  parseJSON (Aeson.String t) = maybe (fail err_msg) return $ typeFromText t+    where+      err_msg = "Invalid string as FindingType: " <> show t+  parseJSON _ = empty++-- | @since 0.4.1.0+instance ToJSON FindingType where+  toJSON = Aeson.String . typeToText+ -- | The node ID. -- -- Basically a node is identified by its IPv6 address in RPL@@ -136,6 +147,10 @@  instance FromJSON IPv6ID where   parseJSON v = parseIPv6IDFromText =<< parseJSON v++-- | @since 0.4.1.0+instance ToJSON IPv6ID where+  toJSON = Aeson.String . ipv6ToText  instance FromGraphSON IPv6ID where   parseGraphSON gv = parseIPv6IDFromText =<< parseGraphSON gv

@@ -0,0 +1,41 @@+-- |+-- Module: NetSpider.RPL.JSONUtil+-- Description: +-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- __This is an internal module. End-users should not use it.__+module NetSpider.RPL.JSONUtil+  ( optSnake,+    optCombinedNode,+    optCombinedLink+  ) where++import Control.Applicative ((*>), (<*), (<|>))+import qualified Data.Aeson as Aeson+import Data.Char (isUpper, toLower)+import qualified Text.Regex.Applicative as RE++toSnake :: String -> String+toSnake = RE.replace $ RE.msym (\c -> if isUpper c then Just ['_', toLower c] else Nothing)++optSnake :: Aeson.Options+optSnake = Aeson.defaultOptions { Aeson.fieldLabelModifier = toSnake }++optCombinedNode :: Aeson.Options+optCombinedNode = Aeson.defaultOptions { Aeson.fieldLabelModifier = modifier }+  where+    modifier = map toLower . RE.replace (fmap (const "") $ RE.string "attrs")++optCombinedLink :: Aeson.Options+optCombinedLink =+  Aeson.defaultOptions+  { Aeson.constructorTagModifier = tag_modifier,+    Aeson.sumEncoding =+      Aeson.TaggedObject+      { Aeson.tagFieldName = "link_type",+        Aeson.contentsFieldName = "link"+      }+  }+  where+    tag_modifier = RE.replace regex+    regex = fmap (map toLower) (RE.string "Combined" *> (RE.string "DIO" <|> RE.string "DAO") <* RE.string "Link")

@@ -0,0 +1,24 @@+module JSONUtil+  ( specJSONFromTo+  ) where++import Data.Aeson (FromJSON, ToJSON)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as BSL+import Data.Either (isRight)+import Test.Hspec++specJSONFromTo :: (FromJSON a, ToJSON a, Show a, Eq a)+               => String -- ^ spec name+               -> BSL.ByteString -- ^ JSON document+               -> a -- ^ expected data+               -> Spec+specJSONFromTo spec_name json_doc exp_data = do+  specify ("JSONFromTo: " ++ spec_name) $ do+    let got_dec = Aeson.eitherDecode json_doc+        got_enc_v :: Either String Aeson.Value+        got_enc_v = Aeson.eitherDecode $ Aeson.encode exp_data+        exp_enc = Aeson.eitherDecode json_doc+    got_dec `shouldBe` Right exp_data+    isRight exp_enc `shouldBe` True+    got_enc_v `shouldBe` exp_enc

@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+module NetSpider.RPL.CombinedSpec (main,spec) where++import Data.Monoid ((<>))+import Test.Hspec++import JSONUtil (specJSONFromTo)++import NetSpider.RPL.DIO (DIONode(..), MergedDIOLink(..), DIOLink(..), NeighborType(..))+import NetSpider.RPL.DAO (DAONode(..), DAOLink(..))+import NetSpider.RPL.Combined (CombinedNode(..), CombinedLink(..))++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "CombinedNode" $ do+    specJSONFromTo+      "non-empty DIO and DAO attributes"+      "{\"dio\": {\"rank\": 256, \"dio_interval\": 12}, \"dao\": {\"dao_route_num\": null}}"+      CombinedNode+      { attrsDIO = Just $ DIONode { rank = 256, dioInterval = 12 },+        attrsDAO = Just $ DAONode { daoRouteNum = Nothing }+      }+  describe "CombinedLink" $ do+    specJSONFromTo+      "case DIOLink"+      (    "{\"link_type\": \"dio\", \"link\": "+        <> "  {\"from_dest\": null, \"from_source\": {\"neighbor_type\": \"preferred_parent\", \"neighbor_rank\": 332, \"metric\": 183}}}"+      )+      ( CombinedDIOLink $+        MergedDIOLink+        { fromDest = Nothing,+          fromSource =+            DIOLink+            { neighborType = PreferredParent,+              neighborRank = 332,+              metric = Just 183+            }+        }+      )+    specJSONFromTo+      "case DAOLink"+      (    "{\"link_type\": \"dao\", \"link\": "+        <> "  {\"path_lifetime_sec\": 1990}}"+      )+      ( CombinedDAOLink $+        DAOLink+        { pathLifetimeSec = 1990+        }+      )+      

@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}+module NetSpider.RPL.DAOSpec (main,spec) where++import Test.Hspec++import JSONUtil (specJSONFromTo)++import NetSpider.RPL.DAO (DAONode(..), DAOLink(..))++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "DAONode" $ do+    specJSONFromTo+      "non-empty daoRouteNum"+      "{\"dao_route_num\": 25}"+      DAONode { daoRouteNum = Just 25 }+  describe "DAOLink" $ do+    specJSONFromTo+      "normal"+      "{\"path_lifetime_sec\": 2560}"+      (DAOLink 2560)

@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}+module NetSpider.RPL.DIOSpec (main,spec) where++import Test.Hspec++import JSONUtil (specJSONFromTo)++import NetSpider.RPL.DIO+  ( DIONode(..), NeighborType(..), DIOLink(..), MergedDIOLink(..)+  )++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "DIONode" $ do+    specJSONFromTo+      "DIONode"+      "{\"rank\": 355, \"dio_interval\": 5}"+      (DIONode 355 5)+  describe "NeighborType" $ do+    specJSONFromTo "PreferredParent" "\"preferred_parent\"" PreferredParent+    specJSONFromTo "ParentCandidate" "\"parent_candidate\"" ParentCandidate+    specJSONFromTo "OtherNeighbor" "\"other_neighbor\"" OtherNeighbor+  describe "DIOLink" $ do+    specJSONFromTo+      "DIOLink with non-empty metric"+      "{\"neighbor_type\": \"parent_candidate\", \"neighbor_rank\": 590, \"metric\": 132}"+      DIOLink+      { neighborType = ParentCandidate,+        neighborRank = 590,+        metric = Just 132+      }+  describe "MergedDIOLink" $ do+    specJSONFromTo+      "MergedDIOLink with non-empty fromDest"+      (    "{\"from_source\": {\"neighbor_type\": \"preferred_parent\", \"neighbor_rank\": 590, \"metric\": 132},"+        <> " \"from_dest\": {\"neighbor_type\": \"other_neighbor\", \"neighbor_rank\": 722, \"metric\": null}}"+      )+      MergedDIOLink+      { fromSource = DIOLink PreferredParent 590 (Just 132),+        fromDest = Just $ DIOLink OtherNeighbor 722 Nothing+      }