-- |
-- Module: NetSpider.RPL.ContikiNG
-- Description: Parser for Contiki-NG logs about RPL
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- This module exports utility functions to read and parse log files
-- from Contiki-NG applications.
--
-- [Contiki-NG](http://contiki-ng.org/) is a tiny operation system for
-- wireless network devices. It supports RPL.
module NetSpider.RPL.ContikiNG
  ( -- * Parser functions
    parseFile,
    parseFileHandle,
    parseFileHandleM,
    parseStream,
    -- * Parser components
    -- ** Parsers for line stream
    parserFoundNodeDIO,
    parserFoundNodeDAO,
    Line,
    -- ** Parser for text
    Parser,
    pCoojaLogHead,
    pCoojaLogHead',
    pSyslogHead
  ) where

import Control.Applicative ((<|>), (<$>), (<*>), (*>), (<*), many, optional)
import Control.Exception.Safe (MonadThrow)
import Control.Monad (void)
import Control.Monad.Except (throwError, catchError)
import Control.Monad.Logger
  ( MonadLogger, runStderrLoggingT, filterLogger, LogLevel(LevelWarn),
    logInfoN, logWarnN
  )
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Trans (lift)
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 (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, stderr)
import qualified Text.ParserCombinators.ReadP as P
import Text.Read (readEither)

import NetSpider.RPL.FindingID (FindingID(FindingID), FindingType(..))
import NetSpider.RPL.IPv6 (isLinkLocal, setPrefix, getPrefix)
import qualified NetSpider.RPL.DIO as DIO
import NetSpider.RPL.DIO (FoundNodeDIO, dioLinkState, Rank)
import qualified NetSpider.RPL.DAO as DAO
import NetSpider.RPL.DAO (FoundNodeDAO)

type Parser = P.ReadP

runParser :: Parser a -> String -> Maybe a
runParser :: Parser a -> String -> Maybe a
runParser Parser a
p String
input = [(a, String)] -> Maybe a
forall a b. [(a, b)] -> Maybe a
extract ([(a, String)] -> Maybe a) -> [(a, String)] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [(a, String)] -> [(a, String)]
forall a a. [(a, [a])] -> [(a, [a])]
sortPairs ([(a, String)] -> [(a, String)]) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> a -> b
$ Parser a -> ReadS a
forall a. ReadP a -> ReadS a
P.readP_to_S Parser a
p String
input
  where
    sortPairs :: [(a, [a])] -> [(a, [a])]
sortPairs = ((a, [a]) -> Int) -> [(a, [a])] -> [(a, [a])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (((a, [a]) -> Int) -> [(a, [a])] -> [(a, [a])])
-> ((a, [a]) -> Int) -> [(a, [a])] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ \(a
_, [a]
rest) -> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
rest
    extract :: [(a, b)] -> Maybe a
extract [] = Maybe a
forall a. Maybe a
Nothing
    extract ((a
a,b
_) : [(a, b)]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

runParser' :: Parser a
           -> String -- ^ error message
           -> String -- ^ input
           -> Parser a
runParser' :: Parser a -> String -> String -> Parser a
runParser' Parser a
p String
err String
input =
  case Parser a -> String -> Maybe a
forall a. Parser a -> String -> Maybe a
runParser Parser a
p String
input of
    Maybe a
Nothing -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Just a
a -> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Read and parse a log file from a Contiki-NG application to make
-- 'FoundNodeDIO' and 'FoundNodeDAO'. This function may output warning
-- and error messages to STDERR.
--
-- Currently this parser function supports logs from \"rpl-lite\"
-- module only.
--
-- It assumes that each line of log file has prefix, and that the
-- prefix contains timestamp information. You have to pass the parser
-- for the prefix to this function. For example, if you read a log
-- file generated by Cooja simulator, use 'pCoojaLogHead'' parser.
--
-- One 'FoundNodeDIO' object is parsed from one block of log lines
-- from the rpl module. On the other hand, one or more 'FoundNodeDAO'
-- objects are parsed from one block of log lines from the rpl
-- module. The 'FoundNodeDAO' objects generated from the same log
-- block share the same timestamp.
parseFile :: Parser Timestamp -- ^ Parser for log prefix
          -> FilePath -- ^ File to read
          -> IO ([FoundNodeDIO], [FoundNodeDAO])
parseFile :: Parser Timestamp -> String -> IO ([FoundNodeDIO], [FoundNodeDAO])
parseFile Parser Timestamp
pt String
file = String
-> IOMode
-> (Handle -> IO ([FoundNodeDIO], [FoundNodeDAO]))
-> IO ([FoundNodeDIO], [FoundNodeDAO])
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
file IOMode
ReadMode ((Handle -> IO ([FoundNodeDIO], [FoundNodeDAO]))
 -> IO ([FoundNodeDIO], [FoundNodeDAO]))
-> (Handle -> IO ([FoundNodeDIO], [FoundNodeDAO]))
-> IO ([FoundNodeDIO], [FoundNodeDAO])
forall a b. (a -> b) -> a -> b
$ Parser Timestamp -> Handle -> IO ([FoundNodeDIO], [FoundNodeDAO])
parseFileHandle Parser Timestamp
pt

-- | Same as 'parseFile' but for a 'Handle'.
--
-- @since 0.2.2.0
parseFileHandle :: Parser Timestamp -- ^ Parser for log prefix
                -> Handle -- ^ File handle to read
                -> IO ([FoundNodeDIO], [FoundNodeDAO])
parseFileHandle :: Parser Timestamp -> Handle -> IO ([FoundNodeDIO], [FoundNodeDAO])
parseFileHandle Parser Timestamp
p Handle
h = LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
-> IO ([FoundNodeDIO], [FoundNodeDAO])
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStderrLoggingT (LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
 -> IO ([FoundNodeDIO], [FoundNodeDAO]))
-> LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
-> IO ([FoundNodeDIO], [FoundNodeDAO])
forall a b. (a -> b) -> a -> b
$ (LogSource -> LogLevel -> Bool)
-> LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
-> LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
forall (m :: * -> *) a.
(LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger LogSource -> LogLevel -> Bool
forall p. p -> LogLevel -> Bool
f (LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
 -> LoggingT IO ([FoundNodeDIO], [FoundNodeDAO]))
-> LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
-> LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
forall a b. (a -> b) -> a -> b
$ Parser Timestamp
-> Handle -> LoggingT IO ([FoundNodeDIO], [FoundNodeDAO])
forall (m :: * -> *).
(MonadIO m, MonadThrow m, MonadLogger m) =>
Parser Timestamp -> Handle -> m ([FoundNodeDIO], [FoundNodeDAO])
parseFileHandleM Parser Timestamp
p Handle
h
  where
    f :: p -> LogLevel -> Bool
f p
_ LogLevel
level = LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
LevelWarn

-- | Same as 'parseFileHandle', but in a generic monad.
--
-- @since 0.3.0.0
parseFileHandleM :: (MonadIO m, MonadThrow m, MonadLogger m)
                 => Parser Timestamp -- ^ Parser for log prefix
                 -> Handle -- ^ File handle to read
                 -> m ([FoundNodeDIO], [FoundNodeDAO])
parseFileHandleM :: Parser Timestamp -> Handle -> m ([FoundNodeDIO], [FoundNodeDAO])
parseFileHandleM Parser Timestamp
pTimestamp Handle
handle =
  ([Either FoundNodeDIO FoundNodeDAO]
 -> ([FoundNodeDIO], [FoundNodeDAO]))
-> m [Either FoundNodeDIO FoundNodeDAO]
-> m ([FoundNodeDIO], [FoundNodeDAO])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FoundNodeDIO FoundNodeDAO]
-> ([FoundNodeDIO], [FoundNodeDAO])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (m [Either FoundNodeDIO FoundNodeDAO]
 -> m ([FoundNodeDIO], [FoundNodeDAO]))
-> m [Either FoundNodeDIO FoundNodeDAO]
-> m ([FoundNodeDIO], [FoundNodeDAO])
forall a b. (a -> b) -> a -> b
$ ConduitT () Void m [Either FoundNodeDIO FoundNodeDAO]
-> m [Either FoundNodeDIO FoundNodeDAO]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () LogSource m ()
forall i. ConduitT i LogSource m ()
the_source ConduitT () LogSource m ()
-> ConduitM LogSource Void m [Either FoundNodeDIO FoundNodeDAO]
-> ConduitT () Void m [Either FoundNodeDIO FoundNodeDAO]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Parser Timestamp
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
forall (m :: * -> *).
(MonadThrow m, MonadLogger m) =>
Parser Timestamp
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
parseStream Parser Timestamp
pTimestamp ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
-> ConduitM
     (Either FoundNodeDIO FoundNodeDAO)
     Void
     m
     [Either FoundNodeDIO FoundNodeDAO]
-> ConduitM LogSource Void m [Either FoundNodeDIO FoundNodeDAO]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM
  (Either FoundNodeDIO FoundNodeDAO)
  Void
  m
  [Either FoundNodeDIO FoundNodeDAO]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume)
  where
    the_source :: ConduitT i LogSource m ()
the_source = do
      Bool
eof <- IO Bool -> ConduitT i LogSource m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ConduitT i LogSource m Bool)
-> IO Bool -> ConduitT i LogSource m Bool
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hIsEOF Handle
handle
      if Bool
eof
        then () -> ConduitT i LogSource m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else do
        LogSource -> ConduitT i LogSource m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (LogSource -> ConduitT i LogSource m ())
-> ConduitT i LogSource m LogSource -> ConduitT i LogSource m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO LogSource -> ConduitT i LogSource m LogSource
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LogSource -> ConduitT i LogSource m LogSource)
-> IO LogSource -> ConduitT i LogSource m LogSource
forall a b. (a -> b) -> a -> b
$ Handle -> IO LogSource
TIO.hGetLine Handle
handle)
        ConduitT i LogSource m ()
the_source

data ParseEntry = PEDIO FoundNodeDIO
                | PEDAO [FoundNodeDAO]
                | PELine (Maybe Line)
                deriving (Int -> ParseEntry -> ShowS
[ParseEntry] -> ShowS
ParseEntry -> String
(Int -> ParseEntry -> ShowS)
-> (ParseEntry -> String)
-> ([ParseEntry] -> ShowS)
-> Show ParseEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseEntry] -> ShowS
$cshowList :: [ParseEntry] -> ShowS
show :: ParseEntry -> String
$cshow :: ParseEntry -> String
showsPrec :: Int -> ParseEntry -> ShowS
$cshowsPrec :: Int -> ParseEntry -> ShowS
Show,ParseEntry -> ParseEntry -> Bool
(ParseEntry -> ParseEntry -> Bool)
-> (ParseEntry -> ParseEntry -> Bool) -> Eq ParseEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseEntry -> ParseEntry -> Bool
$c/= :: ParseEntry -> ParseEntry -> Bool
== :: ParseEntry -> ParseEntry -> Bool
$c== :: ParseEntry -> ParseEntry -> Bool
Eq)

-- | Same as 'parseFile' but as an conduit.
--
-- @since 0.3.0.0
parseStream :: (MonadThrow m, MonadLogger m)
            => Parser Timestamp -- ^ Parser for log prefix
            -> ConduitT Line (Either FoundNodeDIO FoundNodeDAO) m ()
parseStream :: Parser Timestamp
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
parseStream Parser Timestamp
pTimestamp = ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
go
  where
    go :: ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
go = do
      ParseEntry
got <- (Void -> Either FoundNodeDIO FoundNodeDAO)
-> ConduitT LogSource Void m ParseEntry
-> ConduitT
     LogSource (Either FoundNodeDIO FoundNodeDAO) m ParseEntry
forall (m :: * -> *) o1 o2 i r.
Monad m =>
(o1 -> o2) -> ConduitT i o1 m r -> ConduitT i o2 m r
mapOutput Void -> Either FoundNodeDIO FoundNodeDAO
forall a. Void -> a
absurd (ConduitT LogSource Void m ParseEntry
 -> ConduitT
      LogSource (Either FoundNodeDIO FoundNodeDAO) m ParseEntry)
-> ConduitT LogSource Void m ParseEntry
-> ConduitT
     LogSource (Either FoundNodeDIO FoundNodeDAO) m ParseEntry
forall a b. (a -> b) -> a -> b
$ ConduitParser LogSource m ParseEntry
-> ConduitT LogSource Void m ParseEntry
forall (m :: * -> *) i a.
MonadThrow m =>
ConduitParser i m a -> ConduitT i Void m a
CP.runConduitParser ConduitParser LogSource m ParseEntry
merged_parser
      case ParseEntry
got of
        PEDIO FoundNodeDIO
dio -> Either FoundNodeDIO FoundNodeDAO
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (FoundNodeDIO -> Either FoundNodeDIO FoundNodeDAO
forall a b. a -> Either a b
Left FoundNodeDIO
dio) ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
go
        PEDAO [FoundNodeDAO]
daos -> (FoundNodeDAO
 -> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ())
-> [FoundNodeDAO]
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Either FoundNodeDIO FoundNodeDAO
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either FoundNodeDIO FoundNodeDAO
 -> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ())
-> (FoundNodeDAO -> Either FoundNodeDIO FoundNodeDAO)
-> FoundNodeDAO
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundNodeDAO -> Either FoundNodeDIO FoundNodeDAO
forall a b. b -> Either a b
Right) [FoundNodeDAO]
daos ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
-> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
go
        PELine Maybe LogSource
Nothing -> () -> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        PELine (Just LogSource
_) -> ConduitT LogSource (Either FoundNodeDIO FoundNodeDAO) m ()
go
    merged_parser :: ConduitParser LogSource m ParseEntry
merged_parser = (FoundNodeDIO -> ParseEntry
PEDIO (FoundNodeDIO -> ParseEntry)
-> ConduitParser LogSource m FoundNodeDIO
-> ConduitParser LogSource m ParseEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Timestamp -> ConduitParser LogSource m FoundNodeDIO
forall (m :: * -> *).
MonadLogger m =>
Parser Timestamp -> ConduitParser LogSource m FoundNodeDIO
parserFoundNodeDIO Parser Timestamp
pTimestamp)
                    ConduitParser LogSource m ParseEntry
-> ConduitParser LogSource m ParseEntry
-> ConduitParser LogSource m ParseEntry
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([FoundNodeDAO] -> ParseEntry
PEDAO ([FoundNodeDAO] -> ParseEntry)
-> ConduitParser LogSource m [FoundNodeDAO]
-> ConduitParser LogSource m ParseEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Timestamp -> ConduitParser LogSource m [FoundNodeDAO]
forall (m :: * -> *).
MonadLogger m =>
Parser Timestamp -> ConduitParser LogSource m [FoundNodeDAO]
parserFoundNodeDAO Parser Timestamp
pTimestamp)
                    ConduitParser LogSource m ParseEntry
-> ConduitParser LogSource m ParseEntry
-> ConduitParser LogSource m ParseEntry
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe LogSource -> ParseEntry
PELine (Maybe LogSource -> ParseEntry)
-> ConduitParser LogSource m (Maybe LogSource)
-> ConduitParser LogSource m ParseEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitParser LogSource m (Maybe LogSource)
forall (m :: * -> *) i. Monad m => ConduitParser i m (Maybe i)
awaitM)

-- | One line text.
--
-- @since 0.2.3.0
type Line = Text

-- | Parse stream of log lines for a 'FoundNodeDIO'.
--
-- @since 0.3.0.0
parserFoundNodeDIO :: MonadLogger m
                   => Parser Timestamp -- ^ Text parser for log head.
                   -> ConduitParser Line m FoundNodeDIO
parserFoundNodeDIO :: Parser Timestamp -> ConduitParser LogSource m FoundNodeDIO
parserFoundNodeDIO Parser Timestamp
pTimestamp = do
  LogSource
line <- ConduitParser LogSource m LogSource
forall (m :: * -> *) i. Monad m => ConduitParser i m i
CP.await
  case Parser (Timestamp, (IPv6, DIONode))
-> String -> Maybe (Timestamp, (IPv6, DIONode))
forall a. Parser a -> String -> Maybe a
runParser Parser (Timestamp, (IPv6, DIONode))
pDIOHead (String -> Maybe (Timestamp, (IPv6, DIONode)))
-> String -> Maybe (Timestamp, (IPv6, DIONode))
forall a b. (a -> b) -> a -> b
$ LogSource -> String
unpack LogSource
line of
    Maybe (Timestamp, (IPv6, DIONode))
Nothing -> ConduitParserException -> ConduitParser LogSource m FoundNodeDIO
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException -> ConduitParser LogSource m FoundNodeDIO)
-> ConduitParserException -> ConduitParser LogSource m FoundNodeDIO
forall a b. (a -> b) -> a -> b
$ LogSource -> ConduitParserException
CP.Unexpected (LogSource
"Not a log line head of local findings about DIO.")
    Just (Timestamp
ts, (IPv6
self_addr, DIONode
dio_node)) -> Timestamp
-> IPv6 -> DIONode -> ConduitParser LogSource m FoundNodeDIO
forall (m :: * -> *).
MonadLogger m =>
Timestamp
-> IPv6 -> DIONode -> ConduitParser LogSource m FoundNodeDIO
proceedDIO Timestamp
ts IPv6
self_addr DIONode
dio_node
  where
    pDIOHead :: Parser (Timestamp, (IPv6, DIONode))
pDIOHead = (,) (Timestamp -> (IPv6, DIONode) -> (Timestamp, (IPv6, DIONode)))
-> Parser Timestamp
-> ReadP ((IPv6, DIONode) -> (Timestamp, (IPv6, DIONode)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Timestamp
pTimestamp ReadP ((IPv6, DIONode) -> (Timestamp, (IPv6, DIONode)))
-> ReadP (IPv6, DIONode) -> Parser (Timestamp, (IPv6, DIONode))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
pLogHead Parser () -> ReadP (IPv6, DIONode) -> ReadP (IPv6, DIONode)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP (IPv6, DIONode)
pDIONode)
    withPrefix :: ReadP b -> ReadP b
withPrefix ReadP b
p = Parser Timestamp
pTimestamp Parser Timestamp -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
pLogHead Parser () -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP b
p
    proceedDIO :: Timestamp
-> IPv6 -> DIONode -> ConduitParser LogSource m FoundNodeDIO
proceedDIO Timestamp
ts IPv6
addr DIONode
node = do
      [(IPv6, DIOLink)]
links <- LogSource
-> ConduitParser LogSource m [(IPv6, DIOLink)]
-> ConduitParser LogSource m [(IPv6, DIOLink)]
forall (m :: * -> *) r.
MonadLogger m =>
LogSource
-> ConduitParser LogSource m r -> ConduitParser LogSource m r
handleBlockError LogSource
"DIO" (ConduitParser LogSource m [(IPv6, DIOLink)]
 -> ConduitParser LogSource m [(IPv6, DIOLink)])
-> ConduitParser LogSource m [(IPv6, DIOLink)]
-> ConduitParser LogSource m [(IPv6, DIOLink)]
forall a b. (a -> b) -> a -> b
$ Parser (IPv6, DIOLink)
-> Parser () -> ConduitParser LogSource m [(IPv6, DIOLink)]
forall (m :: * -> *) a end.
Monad m =>
Parser a -> Parser end -> ConduitParser LogSource m [a]
readUntilCP (Parser (IPv6, DIOLink) -> Parser (IPv6, DIOLink)
forall b. ReadP b -> ReadP b
withPrefix Parser (IPv6, DIOLink)
pDIONeighbor) (Parser () -> Parser ()
forall b. ReadP b -> ReadP b
withPrefix Parser ()
pDIONeighborEnd)
      FoundNodeDIO -> ConduitParser LogSource m FoundNodeDIO
forall (m :: * -> *) a. Monad m => a -> m a
return (FoundNodeDIO -> ConduitParser LogSource m FoundNodeDIO)
-> FoundNodeDIO -> ConduitParser LogSource m FoundNodeDIO
forall a b. (a -> b) -> a -> b
$ Timestamp -> IPv6 -> DIONode -> [(IPv6, DIOLink)] -> FoundNodeDIO
makeFoundNodeDIO Timestamp
ts IPv6
addr DIONode
node ([(IPv6, DIOLink)] -> FoundNodeDIO)
-> [(IPv6, DIOLink)] -> FoundNodeDIO
forall a b. (a -> b) -> a -> b
$ ((IPv6, DIOLink) -> (IPv6, DIOLink))
-> [(IPv6, DIOLink)] -> [(IPv6, DIOLink)]
forall a b. (a -> b) -> [a] -> [b]
map ((IPv6 -> IPv6) -> (IPv6, DIOLink) -> (IPv6, DIOLink)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((IPv6 -> IPv6) -> (IPv6, DIOLink) -> (IPv6, DIOLink))
-> (IPv6 -> IPv6) -> (IPv6, DIOLink) -> (IPv6, DIOLink)
forall a b. (a -> b) -> a -> b
$ IPv6 -> IPv6 -> IPv6
setNonLocalPrefix IPv6
addr) [(IPv6, DIOLink)]
links

handleBlockError :: MonadLogger m => Text -> ConduitParser Line m r -> ConduitParser Line m r
handleBlockError :: LogSource
-> ConduitParser LogSource m r -> ConduitParser LogSource m r
handleBlockError LogSource
target ConduitParser LogSource m r
p = ConduitParser LogSource m r
p ConduitParser LogSource m r
-> (ConduitParserException -> ConduitParser LogSource m r)
-> ConduitParser LogSource m r
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\ConduitParserException
e -> (m () -> ConduitParser LogSource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitParser LogSource m ())
-> m () -> ConduitParser LogSource m ()
forall a b. (a -> b) -> a -> b
$ ConduitParserException -> m ()
forall (m :: * -> *).
MonadLogger m =>
ConduitParserException -> m ()
doLog ConduitParserException
e) ConduitParser LogSource m ()
-> ConduitParser LogSource m r -> ConduitParser LogSource m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitParserException -> ConduitParser LogSource m r
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ConduitParserException
e)
  where
    doLog :: ConduitParserException -> m ()
doLog ConduitParserException
CP.UnexpectedEndOfInput = do
      LogSource -> m ()
forall (m :: * -> *). MonadLogger m => LogSource -> m ()
logInfoN (LogSource
"EOF while parsing a block of " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
target LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
". The block is discarded.")
    doLog (CP.Unexpected LogSource
msg) = do
      LogSource -> m ()
forall (m :: * -> *). MonadLogger m => LogSource -> m ()
logWarnN (LogSource
"Unexpected input while parsing a block of " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
target LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
": " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
msg)
    doLog ConduitParserException
e = do
      LogSource -> m ()
forall (m :: * -> *). MonadLogger m => LogSource -> m ()
logWarnN (LogSource
"Error while parsing a block of " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
target LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
": " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> (String -> LogSource
pack (String -> LogSource) -> String -> LogSource
forall a b. (a -> b) -> a -> b
$ ConduitParserException -> String
forall a. Show a => a -> String
show ConduitParserException
e))

-- | Parse stream of log lines for a 'FoundNodeDAO'.
--
-- @since 0.3.0.0
parserFoundNodeDAO :: MonadLogger m
                   => Parser Timestamp -- ^ Text parser for log head.
                   -> ConduitParser Line m [FoundNodeDAO]
parserFoundNodeDAO :: Parser Timestamp -> ConduitParser LogSource m [FoundNodeDAO]
parserFoundNodeDAO Parser Timestamp
pTimestamp = do
  LogSource
line <- ConduitParser LogSource m LogSource
forall (m :: * -> *) i. Monad m => ConduitParser i m i
CP.await
  case Parser (Timestamp, Word) -> String -> Maybe (Timestamp, Word)
forall a. Parser a -> String -> Maybe a
runParser Parser (Timestamp, Word)
pDAOHead (String -> Maybe (Timestamp, Word))
-> String -> Maybe (Timestamp, Word)
forall a b. (a -> b) -> a -> b
$ LogSource -> String
unpack LogSource
line of
    Maybe (Timestamp, Word)
Nothing -> ConduitParserException -> ConduitParser LogSource m [FoundNodeDAO]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException
 -> ConduitParser LogSource m [FoundNodeDAO])
-> ConduitParserException
-> ConduitParser LogSource m [FoundNodeDAO]
forall a b. (a -> b) -> a -> b
$ LogSource -> ConduitParserException
CP.Unexpected (LogSource
"Not a log line head of local findings about DAO.")
    Just (Timestamp
ts, Word
r) -> LogSource
-> Timestamp -> Word -> ConduitParser LogSource m [FoundNodeDAO]
forall (m :: * -> *).
MonadLogger m =>
LogSource
-> Timestamp -> Word -> ConduitParser LogSource m [FoundNodeDAO]
proceedDAO LogSource
line Timestamp
ts Word
r
  where
    withPrefix :: ReadP b -> ReadP b
withPrefix ReadP b
p = Parser Timestamp
pTimestamp Parser Timestamp -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
pLogHead Parser () -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP b
p
    pDAOHead :: Parser (Timestamp, Word)
pDAOHead = (,) (Timestamp -> Word -> (Timestamp, Word))
-> Parser Timestamp -> ReadP (Word -> (Timestamp, Word))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Timestamp
pTimestamp ReadP (Word -> (Timestamp, Word))
-> ReadP Word -> Parser (Timestamp, Word)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
pLogHead Parser () -> ReadP Word -> ReadP Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP Word
pDAOLogHeader)
    proceedDAO :: LogSource
-> Timestamp -> Word -> ConduitParser LogSource m [FoundNodeDAO]
proceedDAO LogSource
line Timestamp
ts Word
route_num = do
      [(IPv6, Maybe (IPv6, Word))]
links <- LogSource
-> ConduitParser LogSource m [(IPv6, Maybe (IPv6, Word))]
-> ConduitParser LogSource m [(IPv6, Maybe (IPv6, Word))]
forall (m :: * -> *) r.
MonadLogger m =>
LogSource
-> ConduitParser LogSource m r -> ConduitParser LogSource m r
handleBlockError LogSource
"DAO" (ConduitParser LogSource m [(IPv6, Maybe (IPv6, Word))]
 -> ConduitParser LogSource m [(IPv6, Maybe (IPv6, Word))])
-> ConduitParser LogSource m [(IPv6, Maybe (IPv6, Word))]
-> ConduitParser LogSource m [(IPv6, Maybe (IPv6, Word))]
forall a b. (a -> b) -> a -> b
$ Parser (IPv6, Maybe (IPv6, Word))
-> Parser ()
-> ConduitParser LogSource m [(IPv6, Maybe (IPv6, Word))]
forall (m :: * -> *) a end.
Monad m =>
Parser a -> Parser end -> ConduitParser LogSource m [a]
readUntilCP (Parser (IPv6, Maybe (IPv6, Word))
-> Parser (IPv6, Maybe (IPv6, Word))
forall b. ReadP b -> ReadP b
withPrefix Parser (IPv6, Maybe (IPv6, Word))
pDAOLink) (Parser () -> Parser ()
forall b. ReadP b -> ReadP b
withPrefix Parser ()
pDAOLinkEnd)
      IPv6
root_address <- ConduitParser LogSource m IPv6
-> (IPv6 -> ConduitParser LogSource m IPv6)
-> Maybe IPv6
-> ConduitParser LogSource m IPv6
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LogSource -> ConduitParser LogSource m IPv6
forall (m :: * -> *).
MonadLogger m =>
LogSource -> ConduitParser LogSource m IPv6
rootAddressFailure LogSource
line) IPv6 -> ConduitParser LogSource m IPv6
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe IPv6 -> ConduitParser LogSource m IPv6)
-> Maybe IPv6 -> ConduitParser LogSource m IPv6
forall a b. (a -> b) -> a -> b
$ [(IPv6, Maybe (IPv6, Word))] -> Maybe IPv6
getRootAddress [(IPv6, Maybe (IPv6, Word))]
links
      [FoundNodeDAO] -> ConduitParser LogSource m [FoundNodeDAO]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FoundNodeDAO] -> ConduitParser LogSource m [FoundNodeDAO])
-> [FoundNodeDAO] -> ConduitParser LogSource m [FoundNodeDAO]
forall a b. (a -> b) -> a -> b
$ ((IPv6, [(IPv6, Word)]) -> FoundNodeDAO)
-> [(IPv6, [(IPv6, Word)])] -> [FoundNodeDAO]
forall a b. (a -> b) -> [a] -> [b]
map (IPv6 -> Word -> Timestamp -> (IPv6, [(IPv6, Word)]) -> FoundNodeDAO
makeDAONodeFromTuple IPv6
root_address Word
route_num Timestamp
ts) ([(IPv6, [(IPv6, Word)])] -> [FoundNodeDAO])
-> [(IPv6, [(IPv6, Word)])] -> [FoundNodeDAO]
forall a b. (a -> b) -> a -> b
$ [(IPv6, Maybe (IPv6, Word))] -> [(IPv6, [(IPv6, Word)])]
groupDAOLinks [(IPv6, Maybe (IPv6, Word))]
links
    rootAddressFailure :: MonadLogger m => Text -> ConduitParser Line m IPv6
    rootAddressFailure :: LogSource -> ConduitParser LogSource m IPv6
rootAddressFailure LogSource
line = do
      let msg :: LogSource
msg = (LogSource
"No root address found in DAO log: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
line)
      m () -> ConduitParser LogSource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitParser LogSource m ())
-> m () -> ConduitParser LogSource m ()
forall a b. (a -> b) -> a -> b
$ LogSource -> m ()
forall (m :: * -> *). MonadLogger m => LogSource -> m ()
logWarnN LogSource
msg
      ConduitParserException -> ConduitParser LogSource m IPv6
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException -> ConduitParser LogSource m IPv6)
-> ConduitParserException -> ConduitParser LogSource m IPv6
forall a b. (a -> b) -> a -> b
$ LogSource -> ConduitParserException
CP.Unexpected LogSource
msg
    getRootAddress :: [(IPv6, Maybe (IPv6, Word))] -> Maybe IPv6
    getRootAddress :: [(IPv6, Maybe (IPv6, Word))] -> Maybe IPv6
getRootAddress [(IPv6, Maybe (IPv6, Word))]
links = ((IPv6, Maybe (IPv6, Word)) -> IPv6)
-> Maybe (IPv6, Maybe (IPv6, Word)) -> Maybe IPv6
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IPv6, Maybe (IPv6, Word)) -> IPv6
forall a b. (a, b) -> a
fst (Maybe (IPv6, Maybe (IPv6, Word)) -> Maybe IPv6)
-> Maybe (IPv6, Maybe (IPv6, Word)) -> Maybe IPv6
forall a b. (a -> b) -> a -> b
$ [(IPv6, Maybe (IPv6, Word))] -> Maybe (IPv6, Maybe (IPv6, Word))
forall a. [a] -> Maybe a
listToMaybe ([(IPv6, Maybe (IPv6, Word))] -> Maybe (IPv6, Maybe (IPv6, Word)))
-> [(IPv6, Maybe (IPv6, Word))] -> Maybe (IPv6, Maybe (IPv6, Word))
forall a b. (a -> b) -> a -> b
$ ((IPv6, Maybe (IPv6, Word)) -> Bool)
-> [(IPv6, Maybe (IPv6, Word))] -> [(IPv6, Maybe (IPv6, Word))]
forall a. (a -> Bool) -> [a] -> [a]
filter (IPv6, Maybe (IPv6, Word)) -> Bool
forall a a. (a, Maybe a) -> Bool
isRootEntry [(IPv6, Maybe (IPv6, Word))]
links
      where
        isRootEntry :: (a, Maybe a) -> Bool
isRootEntry (a
_, Maybe a
Nothing) = Bool
True
        isRootEntry (a
_, Maybe a
_) = Bool
False
    groupDAOLinks :: [(IPv6, Maybe (IPv6, Word))] -> [(IPv6, [(IPv6, Word)])]
    groupDAOLinks :: [(IPv6, Maybe (IPv6, Word))] -> [(IPv6, [(IPv6, Word)])]
groupDAOLinks [(IPv6, Maybe (IPv6, Word))]
links = ([(IPv6, IPv6, Word)] -> (IPv6, [(IPv6, Word)]))
-> [[(IPv6, IPv6, Word)]] -> [(IPv6, [(IPv6, Word)])]
forall a b. (a -> b) -> [a] -> [b]
map [(IPv6, IPv6, Word)] -> (IPv6, [(IPv6, Word)])
forall a b b. [(a, b, b)] -> (b, [(a, b)])
toTuple ([[(IPv6, IPv6, Word)]] -> [(IPv6, [(IPv6, Word)])])
-> [[(IPv6, IPv6, Word)]] -> [(IPv6, [(IPv6, Word)])]
forall a b. (a -> b) -> a -> b
$ ((IPv6, IPv6, Word) -> IPv6)
-> [(IPv6, IPv6, Word)] -> [[(IPv6, IPv6, Word)]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith (IPv6, IPv6, Word) -> IPv6
forall a b c. (a, b, c) -> b
byParentAddr ([(IPv6, IPv6, Word)] -> [[(IPv6, IPv6, Word)]])
-> [(IPv6, IPv6, Word)] -> [[(IPv6, IPv6, Word)]]
forall a b. (a -> b) -> a -> b
$ ((IPv6, Maybe (IPv6, Word)) -> [(IPv6, IPv6, Word)]
forall a b c. (a, Maybe (b, c)) -> [(a, b, c)]
filterOutRoot ((IPv6, Maybe (IPv6, Word)) -> [(IPv6, IPv6, Word)])
-> [(IPv6, Maybe (IPv6, Word))] -> [(IPv6, IPv6, Word)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(IPv6, Maybe (IPv6, Word))]
links)
      where
        filterOutRoot :: (a, Maybe (b, c)) -> [(a, b, c)]
filterOutRoot (a
_, Maybe (b, c)
Nothing) = []
        filterOutRoot (a
c, Just (b
p, c
lt)) = [(a
c, b
p, c
lt)]
        byParentAddr :: (a, b, c) -> b
byParentAddr (a
_, b
p, c
_) = b
p
        toTuple :: [(a, b, b)] -> (b, [(a, b)])
toTuple [] = String -> (b, [(a, b)])
forall a. HasCallStack => String -> a
error String
"groupDAOLinks: this should not happen"
        toTuple entries :: [(a, b, b)]
entries@((a
_, b
p, b
_) : [(a, b, b)]
_) = (b
p, ((a, b, b) -> (a, b)) -> [(a, b, b)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (a, b, b) -> (a, b)
forall a b b. (a, b, b) -> (a, b)
extractChildAndLifetime [(a, b, b)]
entries)
        extractChildAndLifetime :: (a, b, b) -> (a, b)
extractChildAndLifetime (a
c, b
_, b
lt) = (a
c, b
lt)
    makeDAONodeFromTuple :: IPv6 -> Word -> Timestamp -> (IPv6, [(IPv6, Word)]) -> FoundNodeDAO
makeDAONodeFromTuple IPv6
root_addr Word
route_num Timestamp
ts (IPv6
parent_addr, [(IPv6, Word)]
children) =
      Timestamp -> Maybe Word -> IPv6 -> [(IPv6, Word)] -> FoundNodeDAO
makeFoundNodeDAO
      Timestamp
ts (if IPv6
parent_addr IPv6 -> IPv6 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv6
root_addr then Word -> Maybe Word
forall a. a -> Maybe a
Just Word
route_num else Maybe Word
forall a. Maybe a
Nothing)
      IPv6
parent_addr [(IPv6, Word)]
children

setNonLocalPrefix :: IPv6 -> IPv6 -> IPv6
setNonLocalPrefix :: IPv6 -> IPv6 -> IPv6
setNonLocalPrefix IPv6
prefix_addr IPv6
orig_addr =
  if IPv6 -> Bool
isLinkLocal IPv6
orig_addr
  then Prefix -> IPv6 -> IPv6
setPrefix (IPv6 -> Prefix
getPrefix IPv6
prefix_addr) IPv6
orig_addr
  else IPv6
orig_addr

awaitM :: Monad m => ConduitParser i m (Maybe i)
awaitM :: ConduitParser i m (Maybe i)
awaitM = do
  Maybe i
mnext <- ConduitParser i m (Maybe i)
forall (m :: * -> *) i. Monad m => ConduitParser i m (Maybe i)
CP.peek
  case Maybe i
mnext of
    Maybe i
Nothing -> Maybe i -> ConduitParser i m (Maybe i)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe i
forall a. Maybe a
Nothing
    Just i
_ -> (i -> Maybe i)
-> ConduitParser i m i -> ConduitParser i m (Maybe i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap i -> Maybe i
forall a. a -> Maybe a
Just (ConduitParser i m i -> ConduitParser i m (Maybe i))
-> ConduitParser i m i -> ConduitParser i m (Maybe i)
forall a b. (a -> b) -> a -> b
$ ConduitParser i m i
forall (m :: * -> *) i. Monad m => ConduitParser i m i
CP.await

readUntilCP :: Monad m => Parser a -> Parser end -> ConduitParser Line m [a]
readUntilCP :: Parser a -> Parser end -> ConduitParser LogSource m [a]
readUntilCP Parser a
pBody Parser end
pEnd = [a] -> ConduitParser LogSource m [a]
forall (m :: * -> *).
Monad m =>
[a] -> ConduitParser LogSource m [a]
go []
  where
    go :: [a] -> ConduitParser LogSource m [a]
go [a]
acc = do
      LogSource
line <- ConduitParser LogSource m LogSource
forall (m :: * -> *) i. Monad m => ConduitParser i m i
CP.await
      case Parser (Either end a) -> String -> Maybe (Either end a)
forall a. Parser a -> String -> Maybe a
runParser ((end -> Either end a
forall a b. a -> Either a b
Left (end -> Either end a) -> Parser end -> Parser (Either end a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser end
pEnd) Parser (Either end a)
-> Parser (Either end a) -> Parser (Either end a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Either end a
forall a b. b -> Either a b
Right (a -> Either end a) -> Parser a -> Parser (Either end a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
pBody)) (String -> Maybe (Either end a)) -> String -> Maybe (Either end a)
forall a b. (a -> b) -> a -> b
$ LogSource -> String
unpack LogSource
line of
        Maybe (Either end a)
Nothing -> ConduitParserException -> ConduitParser LogSource m [a]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException -> ConduitParser LogSource m [a])
-> ConduitParserException -> ConduitParser LogSource m [a]
forall a b. (a -> b) -> a -> b
$ LogSource -> ConduitParserException
CP.Unexpected LogSource
line
        Just (Left end
_) -> [a] -> ConduitParser LogSource m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ConduitParser LogSource m [a])
-> [a] -> ConduitParser LogSource m [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc
        Just (Right a
body) -> [a] -> ConduitParser LogSource m [a]
go (a
body a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)

makeFoundNodeDIO :: Timestamp -> IPv6 -> DIO.DIONode -> [(IPv6, DIO.DIOLink)] -> FoundNodeDIO
makeFoundNodeDIO :: Timestamp -> IPv6 -> DIONode -> [(IPv6, DIOLink)] -> FoundNodeDIO
makeFoundNodeDIO Timestamp
ts IPv6
self_addr DIONode
node_attr [(IPv6, DIOLink)]
neighbors =
  FoundNode :: forall n na la.
n -> Timestamp -> [FoundLink n la] -> na -> FoundNode n na la
FoundNode { subjectNode :: FindingID
subjectNode = FindingType -> IPv6 -> FindingID
FindingID FindingType
FindingDIO IPv6
self_addr,
              foundAt :: Timestamp
foundAt = Timestamp
ts,
              neighborLinks :: [FoundLink FindingID DIOLink]
neighborLinks = ((IPv6, DIOLink) -> FoundLink FindingID DIOLink)
-> [(IPv6, DIOLink)] -> [FoundLink FindingID DIOLink]
forall a b. (a -> b) -> [a] -> [b]
map (IPv6, DIOLink) -> FoundLink FindingID DIOLink
toFoundLink [(IPv6, DIOLink)]
neighbors,
              nodeAttributes :: DIONode
nodeAttributes = DIONode
node_attr
            }
  where
    toFoundLink :: (IPv6, DIOLink) -> FoundLink FindingID DIOLink
toFoundLink (IPv6
neighbor_addr, DIOLink
ll) =
      FoundLink :: forall n la. n -> LinkState -> la -> FoundLink n la
FoundLink { targetNode :: FindingID
targetNode = FindingType -> IPv6 -> FindingID
FindingID FindingType
FindingDIO IPv6
neighbor_addr,
                  linkState :: LinkState
linkState = DIOLink -> LinkState
dioLinkState DIOLink
ll,
                  linkAttributes :: DIOLink
linkAttributes = DIOLink
ll
                }

makeFoundNodeDAO :: Timestamp -> Maybe Word -> IPv6 -> [(IPv6, Word)] -> FoundNodeDAO
makeFoundNodeDAO :: Timestamp -> Maybe Word -> IPv6 -> [(IPv6, Word)] -> FoundNodeDAO
makeFoundNodeDAO Timestamp
ts Maybe Word
mroute_num IPv6
parent_addr [(IPv6, Word)]
children =
  FoundNode :: forall n na la.
n -> Timestamp -> [FoundLink n la] -> na -> FoundNode n na la
FoundNode { subjectNode :: FindingID
subjectNode = FindingType -> IPv6 -> FindingID
FindingID FindingType
FindingDAO IPv6
parent_addr,
              foundAt :: Timestamp
foundAt = Timestamp
ts,
              neighborLinks :: [FoundLink FindingID DAOLink]
neighborLinks = ((IPv6, Word) -> FoundLink FindingID DAOLink)
-> [(IPv6, Word)] -> [FoundLink FindingID DAOLink]
forall a b. (a -> b) -> [a] -> [b]
map (IPv6, Word) -> FoundLink FindingID DAOLink
toFoundLink [(IPv6, Word)]
children,
              nodeAttributes :: DAONode
nodeAttributes = Maybe Word -> DAONode
DAO.DAONode Maybe Word
mroute_num
            }
  where
    toFoundLink :: (IPv6, Word) -> FoundLink FindingID DAOLink
toFoundLink (IPv6
child_addr, Word
lifetime) =
      FoundLink :: forall n la. n -> LinkState -> la -> FoundLink n la
FoundLink { targetNode :: FindingID
targetNode = FindingType -> IPv6 -> FindingID
FindingID FindingType
FindingDAO IPv6
child_addr,
                  linkState :: LinkState
linkState = LinkState
LinkToTarget,
                  linkAttributes :: DAOLink
linkAttributes = Word -> DAOLink
DAO.DAOLink Word
lifetime
                }

isAddressChar :: Char -> Bool
isAddressChar :: Char -> Bool
isAddressChar Char
c = Char -> Bool
isHexDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'

pAddress :: Parser IPv6
pAddress :: Parser IPv6
pAddress = String -> Parser IPv6
forall (m :: * -> *). MonadFail m => String -> m IPv6
fromS (String -> Parser IPv6) -> ReadP String -> Parser IPv6
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> ReadP String
P.munch1 Char -> Bool
isAddressChar
  where
    fromS :: String -> m IPv6
fromS String
str =
      case LogSource -> Maybe IPv6
IPv6.decode (LogSource -> Maybe IPv6) -> LogSource -> Maybe IPv6
forall a b. (a -> b) -> a -> b
$ String -> LogSource
pack String
str of
        Maybe IPv6
Nothing -> String -> m IPv6
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid IPv6 address: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str)
        Just IPv6
addr -> IPv6 -> m IPv6
forall (m :: * -> *) a. Monad m => a -> m a
return IPv6
addr

data CompactID = CNodeID Int
               | CNodeAddress Word16
               deriving (Int -> CompactID -> ShowS
[CompactID] -> ShowS
CompactID -> String
(Int -> CompactID -> ShowS)
-> (CompactID -> String)
-> ([CompactID] -> ShowS)
-> Show CompactID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompactID] -> ShowS
$cshowList :: [CompactID] -> ShowS
show :: CompactID -> String
$cshow :: CompactID -> String
showsPrec :: Int -> CompactID -> ShowS
$cshowsPrec :: Int -> CompactID -> ShowS
Show,CompactID -> CompactID -> Bool
(CompactID -> CompactID -> Bool)
-> (CompactID -> CompactID -> Bool) -> Eq CompactID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactID -> CompactID -> Bool
$c/= :: CompactID -> CompactID -> Bool
== :: CompactID -> CompactID -> Bool
$c== :: CompactID -> CompactID -> Bool
Eq,Eq CompactID
Eq CompactID
-> (CompactID -> CompactID -> Ordering)
-> (CompactID -> CompactID -> Bool)
-> (CompactID -> CompactID -> Bool)
-> (CompactID -> CompactID -> Bool)
-> (CompactID -> CompactID -> Bool)
-> (CompactID -> CompactID -> CompactID)
-> (CompactID -> CompactID -> CompactID)
-> Ord CompactID
CompactID -> CompactID -> Bool
CompactID -> CompactID -> Ordering
CompactID -> CompactID -> CompactID
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 :: CompactID -> CompactID -> CompactID
$cmin :: CompactID -> CompactID -> CompactID
max :: CompactID -> CompactID -> CompactID
$cmax :: CompactID -> CompactID -> CompactID
>= :: CompactID -> CompactID -> Bool
$c>= :: CompactID -> CompactID -> Bool
> :: CompactID -> CompactID -> Bool
$c> :: CompactID -> CompactID -> Bool
<= :: CompactID -> CompactID -> Bool
$c<= :: CompactID -> CompactID -> Bool
< :: CompactID -> CompactID -> Bool
$c< :: CompactID -> CompactID -> Bool
compare :: CompactID -> CompactID -> Ordering
$ccompare :: CompactID -> CompactID -> Ordering
$cp1Ord :: Eq CompactID
Ord)

makeCompactAddress :: CompactID -> IPv6
makeCompactAddress :: CompactID -> IPv6
makeCompactAddress CompactID
cid =
  case CompactID
cid of
    CNodeID Int
nid -> Word32 -> Word32 -> Word32 -> Word32 -> IPv6
IPv6.fromWord32s Word32
0 Word32
0 Word32
0 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nid)
    CNodeAddress Word16
addr -> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
IPv6.fromWord16s Word16
0 Word16
0 Word16
0 Word16
0 Word16
0 Word16
0 Word16
0 Word16
addr

pHexWord16 :: String -> Parser Word16
pHexWord16 :: String -> Parser Word16
pHexWord16 String
input = Word16 -> String -> Parser Word16
forall (m :: * -> *) t.
(Bits t, Num t, MonadFail m) =>
t -> String -> m t
go Word16
0 String
input
  where
    go :: t -> String -> m t
go t
acc [] = t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return t
acc
    go t
acc (Char
c:String
rest) = do
      t
c_num <- m t
parseC
      t -> String -> m t
go ((t
acc t -> Int -> t
forall a. Bits a => a -> Int -> a
`shift` Int
8) t -> t -> t
forall a. Num a => a -> a -> a
+ t
c_num) String
rest
      where
        diffWord :: a -> a -> b
diffWord a
a a
b = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Enum a => a -> Int
fromEnum a
b)
        parseC :: m t
parseC = if Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
                 then t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> m t) -> t -> m t
forall a b. (a -> b) -> a -> b
$ Char -> Char -> t
forall b a a. (Num b, Enum a, Enum a) => a -> a -> b
diffWord Char
c Char
'0'
                 else if Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f'
                      then t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> m t) -> t -> m t
forall a b. (a -> b) -> a -> b
$ Char -> Char -> t
forall b a a. (Num b, Enum a, Enum a) => a -> a -> b
diffWord Char
c Char
'a'
                      else if Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F'
                           then t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> m t) -> t -> m t
forall a b. (a -> b) -> a -> b
$ Char -> Char -> t
forall b a a. (Num b, Enum a, Enum a) => a -> a -> b
diffWord Char
c Char
'A'
                           else String -> m t
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid hex number: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
input)

pCompactID :: Parser CompactID
pCompactID :: Parser CompactID
pCompactID = ((Int -> CompactID) -> ReadP Int -> Parser CompactID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CompactID
CNodeID (ReadP Int -> Parser CompactID) -> ReadP Int -> Parser CompactID
forall a b. (a -> b) -> a -> b
$ String -> ReadP Int
forall a. Read a => String -> Parser a
pRead (String -> ReadP Int) -> ReadP String -> ReadP Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
P.count Int
3 ((Char -> Bool) -> ReadP Char
P.satisfy Char -> Bool
isDigit))
             Parser CompactID -> Parser CompactID -> Parser CompactID
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Word16 -> CompactID) -> Parser Word16 -> Parser CompactID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> CompactID
CNodeAddress (Parser Word16 -> Parser CompactID)
-> Parser Word16 -> Parser CompactID
forall a b. (a -> b) -> a -> b
$ String -> Parser Word16
pHexWord16 (String -> Parser Word16) -> ReadP String -> Parser Word16
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
P.count Int
4 ((Char -> Bool) -> ReadP Char
P.satisfy Char -> Bool
isHexDigit))

pCompactAddress :: Parser IPv6
pCompactAddress :: Parser IPv6
pCompactAddress = do
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"6G-"  -- expecting unicast global address
  (CompactID -> IPv6) -> Parser CompactID -> Parser IPv6
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompactID -> IPv6
makeCompactAddress (Parser CompactID -> Parser IPv6)
-> Parser CompactID -> Parser IPv6
forall a b. (a -> b) -> a -> b
$ Parser CompactID
pCompactID

-- neighbor address can be logged in a "compact" form.
-- https://github.com/contiki-ng/contiki-ng/blob/develop/os/sys/log.c

pMaybeCompactAddress :: Parser IPv6
pMaybeCompactAddress :: Parser IPv6
pMaybeCompactAddress = Parser IPv6
pCompactAddress Parser IPv6 -> Parser IPv6 -> Parser IPv6
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser IPv6
pAddress

pRead :: Read a => String -> Parser a
pRead :: String -> Parser a
pRead = (String -> Parser a)
-> (a -> Parser a) -> Either String a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> Parser a)
-> (String -> Either String a) -> String -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a. Read a => String -> Either String a
readEither

pNum :: Read a => Parser a
pNum :: Parser a
pNum = String -> Parser a
forall a. Read a => String -> Parser a
pRead (String -> Parser a) -> ReadP String -> Parser a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> ReadP String
P.munch1 Char -> Bool
isDigit

pDIONode :: Parser (IPv6, DIO.DIONode)
pDIONode :: ReadP (IPv6, DIONode)
pDIONode = do
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"nbr: own state, addr "
  IPv6
addr <- Parser IPv6
pAddress
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
", DAG state: "
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
", MOP "
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch Char -> Bool
isDigit
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
" OCP "
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch Char -> Bool
isDigit
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
" rank "
  Word
rank <- ReadP Word
forall a. Read a => Parser a
pNum
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
" max-rank "
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch Char -> Bool
isDigit
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
", dioint "
  Word
dio_int <- ReadP Word
forall a. Read a => Parser a
pNum
  let node :: DIONode
node = DIONode :: Word -> Word -> DIONode
DIO.DIONode { rank :: Word
DIO.rank = Word
rank,
                           dioInterval :: Word
DIO.dioInterval = Word
dio_int
                         }
  (IPv6, DIONode) -> ReadP (IPv6, DIONode)
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv6
addr, DIONode
node)

pExpectChar :: Char -> Parser Bool
pExpectChar :: Char -> Parser Bool
pExpectChar Char
exp_c = (Maybe Char -> Bool) -> ReadP (Maybe Char) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
exp_c) (ReadP (Maybe Char) -> Parser Bool)
-> ReadP (Maybe Char) -> Parser Bool
forall a b. (a -> b) -> a -> b
$ ReadP Char -> ReadP (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ReadP Char
P.get

pNeighborAndRank :: Parser (IPv6, Rank)
pNeighborAndRank :: Parser (IPv6, Word)
pNeighborAndRank = Parser (IPv6, Word)
spaced Parser (IPv6, Word) -> Parser (IPv6, Word) -> Parser (IPv6, Word)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (IPv6, Word)
non_spaced
  where
    spaced :: Parser (IPv6, Word)
spaced = do
      IPv6
addr <- Parser IPv6
pMaybeCompactAddress
      Parser ()
P.skipSpaces
      Word
rank <- ReadP Word
forall a. Read a => Parser a
pNum
      ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
", "
      (IPv6, Word) -> Parser (IPv6, Word)
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv6
addr, Word
rank)
    non_spaced :: Parser (IPv6, Word)
non_spaced = do
      -- Rank is so large that there is no space between the address and rank.
      -- This case happens when the rank is 5 digits.
      String
addr_and_rank <- (Char -> Bool) -> ReadP String
P.munch Char -> Bool
isAddressChar
      ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
", "
      let (String
addr_str, String
rank_str) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
addr_and_rank Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) String
addr_and_rank
      IPv6
addr <- Parser IPv6 -> String -> String -> Parser IPv6
forall a. Parser a -> String -> String -> Parser a
runParser' Parser IPv6
pMaybeCompactAddress (String
"Failed to parse address:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
addr_str) String
addr_str
      Word
rank <- ReadP Word -> String -> String -> ReadP Word
forall a. Parser a -> String -> String -> Parser a
runParser' ReadP Word
forall a. Read a => Parser a
pNum (String
"Failed to parser rank:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
rank_str) String
rank_str
      (IPv6, Word) -> Parser (IPv6, Word)
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv6
addr, Word
rank)

pDIONeighbor :: Parser (IPv6, DIO.DIOLink)
pDIONeighbor :: Parser (IPv6, DIOLink)
pDIONeighbor = do
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"nbr: "
  (IPv6
neighbor_addr, Word
neighbor_rank) <- Parser (IPv6, Word)
pNeighborAndRank
  Parser ()
P.skipSpaces
  Word
metric <- ReadP Word
forall a. Read a => Parser a
pNum
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
" => "
  Parser ()
P.skipSpaces
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch Char -> Bool
isDigit -- rank_via_neighbor
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
" -- "
  Parser ()
P.skipSpaces
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch Char -> Bool
isDigit -- freshness
  Parser Bool -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Bool -> Parser ()) -> Parser Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Bool
pExpectChar Char
' '
  Parser Bool -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Bool -> Parser ()) -> Parser Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Bool
pExpectChar Char
'r'
  Parser Bool -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Bool -> Parser ()) -> Parser Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Bool
pExpectChar Char
'b'
  Bool
acceptable <- Char -> Parser Bool
pExpectChar Char
'a'
  Parser Bool -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Bool -> Parser ()) -> Parser Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Bool
pExpectChar Char
'f'
  Bool
preferred <- Char -> Parser Bool
pExpectChar Char
'p'
  (IPv6, DIOLink) -> Parser (IPv6, DIOLink)
forall (m :: * -> *) a. Monad m => a -> m a
return ( IPv6
neighbor_addr,
           DIOLink :: NeighborType -> Word -> Maybe Word -> DIOLink
DIO.DIOLink
           { neighborType :: NeighborType
DIO.neighborType = if Bool
preferred
                                  then NeighborType
DIO.PreferredParent
                                  else if Bool
acceptable
                                       then NeighborType
DIO.ParentCandidate
                                       else NeighborType
DIO.OtherNeighbor,
             neighborRank :: Word
DIO.neighborRank = Word
neighbor_rank,
             metric :: Maybe Word
DIO.metric = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
metric
           }
         )

pDIONeighborEnd :: Parser ()
pDIONeighborEnd :: Parser ()
pDIONeighborEnd = ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"nbr: end of list"

pLogHead :: Parser ()
pLogHead :: Parser ()
pLogHead = do
  ReadP Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> Parser ()) -> ReadP Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'['
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']'))
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"] "

pDAOLogHeader :: Parser Word
pDAOLogHeader :: ReadP Word
pDAOLogHeader = do
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"links: "
  Word
route_num <- ReadP Word
forall a. Read a => Parser a
pNum
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
" routing links in total "
  Word -> ReadP Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
route_num

pDAOLink :: Parser (IPv6, Maybe (IPv6, Word))
pDAOLink :: Parser (IPv6, Maybe (IPv6, Word))
pDAOLink = do
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"links: "
  IPv6
child <- Parser IPv6
pMaybeCompactAddress
  Maybe (IPv6, Word)
mparent <- Parser (IPv6, Word) -> ReadP (Maybe (IPv6, Word))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (IPv6, Word)
pParentAndLifetime
  (IPv6, Maybe (IPv6, Word)) -> Parser (IPv6, Maybe (IPv6, Word))
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv6
child, Maybe (IPv6, Word)
mparent)
  where
    pParentAndLifetime :: Parser (IPv6, Word)
pParentAndLifetime = (,)
                         (IPv6 -> Word -> (IPv6, Word))
-> Parser IPv6 -> ReadP (Word -> (IPv6, Word))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ReadP String
P.string String
"  to " ReadP String -> Parser IPv6 -> Parser IPv6
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser IPv6
pMaybeCompactAddress)
                         ReadP (Word -> (IPv6, Word)) -> ReadP Word -> Parser (IPv6, Word)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ReadP String
P.string String
" (lifetime: " ReadP String -> ReadP Word -> ReadP Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP Word
forall a. Read a => Parser a
pNum ReadP Word -> ReadP String -> ReadP Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ReadP String
P.string String
" seconds)")
                         

pDAOLinkEnd :: Parser ()
pDAOLinkEnd :: Parser ()
pDAOLinkEnd = ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"links: end of list"

-- | Parse the head of Cooja log line, and return the timestamp and
-- node ID.
pCoojaLogHead :: Parser (Timestamp, Int)
pCoojaLogHead :: Parser (Timestamp, Int)
pCoojaLogHead = do
  Int64
ts_min <- Parser Int64
forall a. Read a => Parser a
pNum
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
":"
  Int64
ts_sec <- Parser Int64
forall a. Read a => Parser a
pNum
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"."
  Int64
ts_msec <- Parser Int64
forall a. Read a => Parser a
pNum
  Parser ()
P.skipSpaces
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
P.string String
"ID:"
  Int
node_id <- ReadP Int
forall a. Read a => Parser a
pNum
  Parser ()
P.skipSpaces
  (Timestamp, Int) -> Parser (Timestamp, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Int64 -> Int64 -> Timestamp
makeTs Int64
ts_min Int64
ts_sec Int64
ts_msec, Int
node_id)
  where
    makeTs :: Int64 -> Int64 -> Int64 -> Timestamp
    makeTs :: Int64 -> Int64 -> Int64 -> Timestamp
makeTs Int64
ts_min Int64
ts_sec Int64
ts_msec = Int64 -> Timestamp
fromEpochMillisecond ((Int64
ts_min Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
60 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
ts_sec) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
ts_msec)

-- | Same as 'pCoojaLogHead', but it returns the timestamp only.
pCoojaLogHead' :: Parser Timestamp
pCoojaLogHead' :: Parser Timestamp
pCoojaLogHead' = ((Timestamp, Int) -> Timestamp)
-> Parser (Timestamp, Int) -> Parser Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Timestamp, Int) -> Timestamp
forall a b. (a, b) -> a
fst Parser (Timestamp, Int)
pCoojaLogHead

-- | Parser for head of syslog line with its default format.
-- @\"Mmm dd hh:mm:ss HOSTNAME TAG: \"@.
--
-- Because the format does not contain year, you have to pass it to
-- this function.
pSyslogHead :: Integer -- ^ year
            -> Maybe Time.TimeZone -- ^ optional time zone.
            -> Parser Timestamp
pSyslogHead :: Integer -> Maybe TimeZone -> Parser Timestamp
pSyslogHead Integer
year Maybe TimeZone
mtz = do
  Timestamp
ts <- Integer -> Maybe TimeZone -> Parser Timestamp
pSyslogTimestamp Integer
year Maybe TimeZone
mtz
  Parser ()
P.skipSpaces
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) -- hostname
  Parser ()
P.skipSpaces
  ReadP String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> Parser ()) -> ReadP String -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
P.munch (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) -- tag
  Parser ()
P.skipSpaces
  Timestamp -> Parser Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return Timestamp
ts

pSyslogTimestamp :: Integer -> Maybe Time.TimeZone -> Parser Timestamp
pSyslogTimestamp :: Integer -> Maybe TimeZone -> Parser Timestamp
pSyslogTimestamp Integer
year Maybe TimeZone
mtz = do
  Int
month <- ReadP Int
pMonth
  Parser ()
P.skipSpaces
  Int
day <- ReadP Int
forall a. Read a => Parser a
pNum
  Parser ()
P.skipSpaces
  Int
hour <- ReadP Int
forall a. Read a => Parser a
pNum ReadP Int -> ReadP String -> ReadP Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ReadP String
P.string String
":"
  Int
minute <- ReadP Int
forall a. Read a => Parser a
pNum ReadP Int -> ReadP String -> ReadP Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ReadP String
P.string String
":"
  Pico
sec <- Parser Pico
forall a. Read a => Parser a
pNum
  let lt :: LocalTime
lt = Day -> TimeOfDay -> LocalTime
Time.LocalTime (Integer -> Int -> Int -> Day
Time.fromGregorian Integer
year Int
month Int
day) (Int -> Int -> Pico -> TimeOfDay
Time.TimeOfDay Int
hour Int
minute Pico
sec)
  case Maybe TimeZone
mtz of
    Maybe TimeZone
Nothing -> Timestamp -> Parser Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> Parser Timestamp) -> Timestamp -> Parser Timestamp
forall a b. (a -> b) -> a -> b
$ LocalTime -> Timestamp
fromLocalTime LocalTime
lt
    Just TimeZone
tz -> Timestamp -> Parser Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> Parser Timestamp) -> Timestamp -> Parser Timestamp
forall a b. (a -> b) -> a -> b
$ ZonedTime -> Timestamp
fromZonedTime (ZonedTime -> Timestamp) -> ZonedTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeZone -> ZonedTime
Time.ZonedTime LocalTime
lt TimeZone
tz
  where
    pMonth :: ReadP Int
pMonth = do
      String
mstr <- (Char -> Bool) -> ReadP String
P.munch1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
      case String
mstr of
        String
"Jan" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
        String
"Feb" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
        String
"Mar" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
        String
"Apr" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
        String
"May" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
5
        String
"Jun" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
6
        String
"Jul" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
7
        String
"Aug" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
        String
"Sep" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
9
        String
"Oct" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
10
        String
"Nov" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
11
        String
"Dec" -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
12
        String
_ -> String -> ReadP Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid for a month: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
mstr)