module NetSpider.RPL.ContikiNG
(
parseFile,
parseFileHandle,
parseFileHandleM,
parseStream,
parserFoundNodeDIO,
parserFoundNodeDAO,
Line,
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
-> String
-> 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
parseFile :: Parser Timestamp
-> FilePath
-> 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
parseFileHandle :: Parser Timestamp
-> Handle
-> 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
parseFileHandleM :: (MonadIO m, MonadThrow m, MonadLogger m)
=> Parser Timestamp
-> Handle
-> 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)
parseStream :: (MonadThrow m, MonadLogger m)
=> Parser Timestamp
-> 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)
type Line = Text
parserFoundNodeDIO :: MonadLogger m
=> Parser Timestamp
-> 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))
parserFoundNodeDAO :: MonadLogger m
=> Parser Timestamp
-> 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-"
(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
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
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
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
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
= 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"
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)
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
pSyslogHead :: Integer
-> Maybe Time.TimeZone
-> 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)
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)
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)