net-spider-rpl 0.2.2.0 → 0.2.3.0

raw patch · 3 files changed

+119/−71 lines, 3 filesdep +conduitdep +conduit-parsedep +mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: conduit, conduit-parse, mtl, safe-exceptions

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• net-spider-rpl.cabal +7/−3
• src/NetSpider/RPL/ContikiNG.hs +105/−68

@@ -1,5 +1,12 @@ # Revision history for net-spider-rpl +## 0.2.3.0  -- 2019-09-24++### ContikiNG module++* Add `parseStream`, `parserFoundNodeDIO`, `parserFoundNodeDAO` functions.++ ## 0.2.2.0  -- 2019-09-23  ### RPL module

@@ -1,5 +1,5 @@ name:                   net-spider-rpl-version:                0.2.2.0+version:                0.2.3.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -22,7 +22,7 @@   default-language:     Haskell2010   hs-source-dirs:       src   ghc-options:          -Wall -fno-warn-unused-imports-  default-extensions:   StrictData+  default-extensions:   StrictData, OverloadedStrings   other-extensions:     OverloadedStrings, DeriveGeneric   exposed-modules:      NetSpider.RPL,                         NetSpider.RPL.FindingID,@@ -38,7 +38,11 @@                         text >=1.2.3.1 && <1.3,                         ip >=1.3.0 && <1.5,                         hashable >=1.2.7.0 && <1.3,-                        time >=1.8.0.2 && <1.9+                        time >=1.8.0.2 && <1.9,+                        conduit-parse >=0.2.1.0 && <0.3,+                        conduit >=1.3.1 && <1.4,+                        mtl >=2.2.2 && <2.3,+                        safe-exceptions >=0.1.7.0 && <0.2  -- executable net-spider-rpl --   default-language:     Haskell2010

@@ -12,7 +12,13 @@   ( -- * Parser functions     parseFile,     parseFileHandle,+    parseStream,     -- * Parser components+    -- ** Parsers for line stream+    parserFoundNodeDIO,+    parserFoundNodeDAO,+    Line,+    -- ** Parser for text     Parser,     pCoojaLogHead,     pCoojaLogHead',@@ -20,23 +26,33 @@   ) where  import Control.Applicative ((<|>), (<$>), (<*>), (*>), (<*), many, optional)-import Control.Exception (Exception, throwIO)+import Control.Exception.Safe (MonadThrow) import Control.Monad (void)+import Control.Monad.Except (throwError)+import Control.Monad.IO.Class (liftIO, MonadIO)+import Data.Bifunctor (Bifunctor(first)) import Data.Bits (shift) import Data.Char (isDigit, isHexDigit, isSpace)+import Data.Conduit (ConduitT, mapOutput, yield, runConduit, (.|))+import qualified Data.Conduit.List as CL+import Data.Conduit.Parser (ConduitParser)+import qualified Data.Conduit.Parser as CP+import Data.Either (partitionEithers) import Data.Int (Int64) import Data.List (sortOn, reverse) import Data.Maybe (listToMaybe) import Data.Monoid ((<>))-import Data.Text (pack)+import Data.Text (Text, pack, unpack)+import qualified Data.Text.IO as TIO import qualified Data.Time as Time+import Data.Void (absurd) import Data.Word (Word16) import GHC.Exts (groupWith) import Net.IPv6 (IPv6) import qualified Net.IPv6 as IPv6 import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(LinkToTarget)) import NetSpider.Timestamp (Timestamp, fromEpochMillisecond, fromLocalTime, fromZonedTime)-import System.IO (withFile, IOMode(ReadMode), hGetLine, hIsEOF, Handle)+import System.IO (withFile, IOMode(ReadMode), hGetLine, hIsEOF, Handle, stderr) import qualified Text.ParserCombinators.ReadP as P import Text.Read (readEither) @@ -49,11 +65,6 @@  type Parser = P.ReadP -data ParseError = ParseError String-                deriving (Show,Eq,Ord)--instance Exception ParseError- runParser :: Parser a -> String -> Maybe a runParser p input = extract $ sortPairs $ P.readP_to_S p input   where@@ -97,53 +108,83 @@ parseFileHandle :: Parser Timestamp -- ^ Parser for log prefix                 -> Handle -- ^ File handle to read                 -> IO ([FoundNodeDIO], [FoundNodeDAO])-parseFileHandle pTimestamp handle = go ([], [])+parseFileHandle pTimestamp handle =+  fmap partitionEithers $ runConduit (the_source .| parseStream pTimestamp .| CL.consume)   where-    go (acc_dio, acc_dao) = do-      mentry <- parseOneEntry pTimestamp $ tryGetLine handle-      case mentry of-        Nothing -> return (reverse acc_dio, reverse acc_dao)-        Just (PEDIO fl) -> go (fl : acc_dio, acc_dao)-        Just (PEDAO srs) -> go (acc_dio, srs ++ acc_dao)-        Just PEMisc -> go (acc_dio, acc_dao)-    tryGetLine h = do-      eof <- hIsEOF h+    the_source = do+      eof <- liftIO $ hIsEOF handle       if eof-        then return Nothing-        else Just <$> hGetLine h+        then return ()+        else do+        yield =<< (liftIO $ TIO.hGetLine handle)+        the_source  data ParseEntry = PEDIO FoundNodeDIO                 | PEDAO [FoundNodeDAO]-                | PEMisc+                | PELine (Maybe Line)                 deriving (Show,Eq) --- | Return 'Nothing' when it finishes reading.-parseOneEntry :: Parser Timestamp -> IO (Maybe String) -> IO (Maybe ParseEntry)-parseOneEntry pTimestamp getL = impl+-- | Same as 'parseFile' but as an conduit.+--+-- @since 0.2.3.0+parseStream :: (MonadThrow m)+            => Parser Timestamp -- ^ Parser for log prefix+            -> ConduitT Line (Either FoundNodeDIO FoundNodeDAO) m ()+parseStream pTimestamp = go   where-    impl = do-      mline <- getL-      case mline of-        Nothing -> return Nothing-        Just line ->-          case runParser ((,) <$> pTimestamp <*> (pLogHead *> pHeading)) line of-            Nothing -> return $ Just PEMisc-            Just (ts, HDIO addr node) -> proceedDIO ts addr node-            Just (ts, HDAO route_num) -> proceedDAO ts route_num+    go = do+      got <- mapOutput absurd $ CP.runConduitParser merged_parser+      case got of+        PEDIO dio -> yield (Left dio) >> go+        PEDAO daos -> mapM_ (yield . Right) daos >> go+        PELine Nothing -> return ()+        PELine (Just _) -> go+    merged_parser = (PEDIO <$> parserFoundNodeDIO pTimestamp)+                    <|> (PEDAO <$> parserFoundNodeDAO pTimestamp)+                    <|> (PELine <$> awaitM)++-- | One line text.+--+-- @since 0.2.3.0+type Line = Text++-- | Parse stream of log lines for a 'FoundNodeDIO'.+--+-- @since 0.2.3.0+parserFoundNodeDIO :: Monad m+                   => Parser Timestamp -- ^ Text parser for log head.+                   -> ConduitParser Line m FoundNodeDIO+parserFoundNodeDIO pTimestamp = do+  line <- CP.await+  case runParser pDIOHead $ unpack line of+    Nothing -> throwError $ CP.Unexpected ("Not a log line head of local findings about DIO.")+    Just (ts, (self_addr, dio_node)) -> proceedDIO ts self_addr dio_node+  where+    pDIOHead = (,) <$> pTimestamp <*> (pLogHead *> pDIONode)     withPrefix p = pTimestamp *> pLogHead *> p     proceedDIO ts addr node = do-      mlinks <- readUntil getL (withPrefix pDIONeighbor) (withPrefix pDIONeighborEnd)-      case mlinks of-        Nothing -> return Nothing-        Just links -> return $ Just $ PEDIO $ makeFoundNodeDIO ts addr node $ map (setAddressPrefix addr) links+      links <- readUntilCP (withPrefix pDIONeighbor) (withPrefix pDIONeighborEnd)+      return $ makeFoundNodeDIO ts addr node $ map (first $ setNonLocalPrefix addr) links++-- | Parse stream of log lines for a 'FoundNodeDAO'.+--+-- @since 0.2.3.0+parserFoundNodeDAO :: Monad m+                   => Parser Timestamp -- ^ Text parser for log head.+                   -> ConduitParser Line m [FoundNodeDAO]+parserFoundNodeDAO pTimestamp = do+  line <- CP.await+  case runParser pDAOHead $ unpack line of+    Nothing -> throwError $ CP.Unexpected ("Not a log line head of local findings about DAO.")+    Just (ts, r) -> proceedDAO ts r+  where+    withPrefix p = pTimestamp *> pLogHead *> p+    pDAOHead = (,) <$> pTimestamp <*> (pLogHead *> pDAOLogHeader)     proceedDAO ts route_num = do-      mlinks <- readUntil getL (withPrefix pDAOLink) (withPrefix pDAOLinkEnd)-      case mlinks of-        Nothing -> return Nothing-        Just links -> do-          root_address <- maybe (throwIO $ ParseError "No root address found in SR log") return-                          $ getRootAddress links-          return $ Just $ PEDAO $ map (makeDAONodeFromTuple root_address route_num ts) $ groupDAOLinks links+      links <- readUntilCP (withPrefix pDAOLink) (withPrefix pDAOLinkEnd)+      root_address <- maybe (throwError $ CP.Unexpected "No root address found in SR log") return+                      $ getRootAddress links+      return $ map (makeDAONodeFromTuple root_address route_num ts) $ groupDAOLinks links     getRootAddress :: [(IPv6, Maybe (IPv6, Word))] -> Maybe IPv6     getRootAddress links = fmap fst $ listToMaybe $ filter isRootEntry links       where@@ -162,24 +203,29 @@       makeFoundNodeDAO       ts (if parent_addr == root_addr then Just route_num else Nothing)       parent_addr children-    setAddressPrefix self_addr (neighbor_addr, ll) = (modified_addr, ll)-      where-        modified_addr = if isLinkLocal neighbor_addr-                        then setPrefix (getPrefix self_addr) neighbor_addr-                        else neighbor_addr -readUntil :: IO (Maybe String) -> Parser a -> Parser end -> IO (Maybe [a])-readUntil getL pBody pEnd = go []+setNonLocalPrefix :: IPv6 -> IPv6 -> IPv6+setNonLocalPrefix prefix_addr orig_addr =+  if isLinkLocal orig_addr+  then setPrefix (getPrefix prefix_addr) orig_addr+  else orig_addr++awaitM :: Monad m => ConduitParser i m (Maybe i)+awaitM = do+  mnext <- CP.peek+  case mnext of+    Nothing -> return Nothing+    Just _ -> fmap Just $ CP.await++readUntilCP :: Monad m => Parser a -> Parser end -> ConduitParser Line m [a]+readUntilCP pBody pEnd = go []   where     go acc = do-      mline <- getL-      case mline of-        Nothing -> return Nothing-        Just line ->-          case runParser ((Left <$> pEnd) <|> (Right <$> pBody)) line of-            Nothing -> throwIO $ ParseError ("Parse error at line: " <> line)-            Just (Left _) -> return $ Just $ reverse acc-            Just (Right body) -> go (body : acc)+      line <- CP.await+      case runParser ((Left <$> pEnd) <|> (Right <$> pBody)) $ unpack line of+        Nothing -> throwError $ CP.Unexpected ("Parse error at line: " <> line)+        Just (Left _) -> return $ reverse acc+        Just (Right body) -> go (body : acc)  makeFoundNodeDIO :: Timestamp -> IPv6 -> DIO.DIONode -> [(IPv6, DIO.DIOLink)] -> FoundNodeDIO makeFoundNodeDIO ts self_addr node_attr neighbors =@@ -208,15 +254,6 @@                   linkState = LinkToTarget,                   linkAttributes = DAO.DAOLink lifetime                 }---data Heading = HDIO IPv6 DIO.DIONode-             | HDAO Word-             deriving (Show,Eq,Ord)--pHeading :: Parser Heading-pHeading = (fmap (uncurry HDIO) $ pDIONode)-           <|> (HDAO <$> pDAOLogHeader)  isAddressChar :: Char -> Bool isAddressChar c = isHexDigit c || c == ':'