{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module NetSpider.RPL.FindingID
(
FindingID(..),
idToText,
idFromText,
FindingType(..),
typeToText,
typeFromText,
IPv6ID(..),
ipv6ToText,
ipv6FromText,
ipv6Only
) where
import Control.Applicative ((<$>), (<*>), empty)
import Control.Monad.Fail (MonadFail)
import Data.Bits (shiftL, (.|.))
import Data.Monoid ((<>))
import Data.Aeson (FromJSON(..), ToJSON(..))
import qualified Data.Aeson as Aeson
import Data.Greskell (FromGraphSON(..))
import Data.Hashable (Hashable(..))
import Data.Text (Text)
import Data.Word (Word64, Word32)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Net.IPv6 (IPv6)
import qualified Net.IPv6 as IPv6
import NetSpider.GraphML.Writer (ToNodeID(..))
import NetSpider.RPL.IPv6 (getPrefix, getInterfaceID)
data FindingType = FindingDIO
| FindingDAO
deriving (Int -> FindingType -> ShowS
[FindingType] -> ShowS
FindingType -> String
(Int -> FindingType -> ShowS)
-> (FindingType -> String)
-> ([FindingType] -> ShowS)
-> Show FindingType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FindingType] -> ShowS
$cshowList :: [FindingType] -> ShowS
show :: FindingType -> String
$cshow :: FindingType -> String
showsPrec :: Int -> FindingType -> ShowS
$cshowsPrec :: Int -> FindingType -> ShowS
Show,FindingType -> FindingType -> Bool
(FindingType -> FindingType -> Bool)
-> (FindingType -> FindingType -> Bool) -> Eq FindingType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FindingType -> FindingType -> Bool
$c/= :: FindingType -> FindingType -> Bool
== :: FindingType -> FindingType -> Bool
$c== :: FindingType -> FindingType -> Bool
Eq,Eq FindingType
Eq FindingType
-> (FindingType -> FindingType -> Ordering)
-> (FindingType -> FindingType -> Bool)
-> (FindingType -> FindingType -> Bool)
-> (FindingType -> FindingType -> Bool)
-> (FindingType -> FindingType -> Bool)
-> (FindingType -> FindingType -> FindingType)
-> (FindingType -> FindingType -> FindingType)
-> Ord FindingType
FindingType -> FindingType -> Bool
FindingType -> FindingType -> Ordering
FindingType -> FindingType -> FindingType
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 :: FindingType -> FindingType -> FindingType
$cmin :: FindingType -> FindingType -> FindingType
max :: FindingType -> FindingType -> FindingType
$cmax :: FindingType -> FindingType -> FindingType
>= :: FindingType -> FindingType -> Bool
$c>= :: FindingType -> FindingType -> Bool
> :: FindingType -> FindingType -> Bool
$c> :: FindingType -> FindingType -> Bool
<= :: FindingType -> FindingType -> Bool
$c<= :: FindingType -> FindingType -> Bool
< :: FindingType -> FindingType -> Bool
$c< :: FindingType -> FindingType -> Bool
compare :: FindingType -> FindingType -> Ordering
$ccompare :: FindingType -> FindingType -> Ordering
$cp1Ord :: Eq FindingType
Ord,Int -> FindingType
FindingType -> Int
FindingType -> [FindingType]
FindingType -> FindingType
FindingType -> FindingType -> [FindingType]
FindingType -> FindingType -> FindingType -> [FindingType]
(FindingType -> FindingType)
-> (FindingType -> FindingType)
-> (Int -> FindingType)
-> (FindingType -> Int)
-> (FindingType -> [FindingType])
-> (FindingType -> FindingType -> [FindingType])
-> (FindingType -> FindingType -> [FindingType])
-> (FindingType -> FindingType -> FindingType -> [FindingType])
-> Enum FindingType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FindingType -> FindingType -> FindingType -> [FindingType]
$cenumFromThenTo :: FindingType -> FindingType -> FindingType -> [FindingType]
enumFromTo :: FindingType -> FindingType -> [FindingType]
$cenumFromTo :: FindingType -> FindingType -> [FindingType]
enumFromThen :: FindingType -> FindingType -> [FindingType]
$cenumFromThen :: FindingType -> FindingType -> [FindingType]
enumFrom :: FindingType -> [FindingType]
$cenumFrom :: FindingType -> [FindingType]
fromEnum :: FindingType -> Int
$cfromEnum :: FindingType -> Int
toEnum :: Int -> FindingType
$ctoEnum :: Int -> FindingType
pred :: FindingType -> FindingType
$cpred :: FindingType -> FindingType
succ :: FindingType -> FindingType
$csucc :: FindingType -> FindingType
Enum,FindingType
FindingType -> FindingType -> Bounded FindingType
forall a. a -> a -> Bounded a
maxBound :: FindingType
$cmaxBound :: FindingType
minBound :: FindingType
$cminBound :: FindingType
Bounded,(forall x. FindingType -> Rep FindingType x)
-> (forall x. Rep FindingType x -> FindingType)
-> Generic FindingType
forall x. Rep FindingType x -> FindingType
forall x. FindingType -> Rep FindingType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FindingType x -> FindingType
$cfrom :: forall x. FindingType -> Rep FindingType x
Generic)
instance Hashable FindingType
typeToText :: FindingType -> Text
typeToText :: FindingType -> Text
typeToText FindingType
ft =
case FindingType
ft of
FindingType
FindingDIO -> Text
"dio"
FindingType
FindingDAO -> Text
"dao"
typeFromText :: Text -> Maybe FindingType
typeFromText :: Text -> Maybe FindingType
typeFromText Text
t =
case Text
t of
Text
"dio" -> FindingType -> Maybe FindingType
forall a. a -> Maybe a
Just FindingType
FindingDIO
Text
"dao" -> FindingType -> Maybe FindingType
forall a. a -> Maybe a
Just FindingType
FindingDAO
Text
_ -> Maybe FindingType
forall a. Maybe a
Nothing
instance FromJSON FindingType where
parseJSON :: Value -> Parser FindingType
parseJSON (Aeson.String Text
t) = Parser FindingType
-> (FindingType -> Parser FindingType)
-> Maybe FindingType
-> Parser FindingType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser FindingType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err_msg) FindingType -> Parser FindingType
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FindingType -> Parser FindingType)
-> Maybe FindingType -> Parser FindingType
forall a b. (a -> b) -> a -> b
$ Text -> Maybe FindingType
typeFromText Text
t
where
err_msg :: String
err_msg = String
"Invalid string as FindingType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t
parseJSON Value
_ = Parser FindingType
forall (f :: * -> *) a. Alternative f => f a
empty
instance ToJSON FindingType where
toJSON :: FindingType -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (FindingType -> Text) -> FindingType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindingType -> Text
typeToText
data FindingID =
FindingID
{ FindingID -> FindingType
findingType :: FindingType,
FindingID -> IPv6
nodeAddress :: IPv6
}
deriving (Int -> FindingID -> ShowS
[FindingID] -> ShowS
FindingID -> String
(Int -> FindingID -> ShowS)
-> (FindingID -> String)
-> ([FindingID] -> ShowS)
-> Show FindingID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FindingID] -> ShowS
$cshowList :: [FindingID] -> ShowS
show :: FindingID -> String
$cshow :: FindingID -> String
showsPrec :: Int -> FindingID -> ShowS
$cshowsPrec :: Int -> FindingID -> ShowS
Show,FindingID -> FindingID -> Bool
(FindingID -> FindingID -> Bool)
-> (FindingID -> FindingID -> Bool) -> Eq FindingID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FindingID -> FindingID -> Bool
$c/= :: FindingID -> FindingID -> Bool
== :: FindingID -> FindingID -> Bool
$c== :: FindingID -> FindingID -> Bool
Eq,Eq FindingID
Eq FindingID
-> (FindingID -> FindingID -> Ordering)
-> (FindingID -> FindingID -> Bool)
-> (FindingID -> FindingID -> Bool)
-> (FindingID -> FindingID -> Bool)
-> (FindingID -> FindingID -> Bool)
-> (FindingID -> FindingID -> FindingID)
-> (FindingID -> FindingID -> FindingID)
-> Ord FindingID
FindingID -> FindingID -> Bool
FindingID -> FindingID -> Ordering
FindingID -> FindingID -> FindingID
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 :: FindingID -> FindingID -> FindingID
$cmin :: FindingID -> FindingID -> FindingID
max :: FindingID -> FindingID -> FindingID
$cmax :: FindingID -> FindingID -> FindingID
>= :: FindingID -> FindingID -> Bool
$c>= :: FindingID -> FindingID -> Bool
> :: FindingID -> FindingID -> Bool
$c> :: FindingID -> FindingID -> Bool
<= :: FindingID -> FindingID -> Bool
$c<= :: FindingID -> FindingID -> Bool
< :: FindingID -> FindingID -> Bool
$c< :: FindingID -> FindingID -> Bool
compare :: FindingID -> FindingID -> Ordering
$ccompare :: FindingID -> FindingID -> Ordering
$cp1Ord :: Eq FindingID
Ord,(forall x. FindingID -> Rep FindingID x)
-> (forall x. Rep FindingID x -> FindingID) -> Generic FindingID
forall x. Rep FindingID x -> FindingID
forall x. FindingID -> Rep FindingID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FindingID x -> FindingID
$cfrom :: forall x. FindingID -> Rep FindingID x
Generic)
idToText :: FindingID -> Text
idToText :: FindingID -> Text
idToText FindingID
fid = Text
ft_str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"://[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
addr_str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
where
ft_str :: Text
ft_str = FindingType -> Text
typeToText (FindingType -> Text) -> FindingType -> Text
forall a b. (a -> b) -> a -> b
$ FindingID -> FindingType
findingType FindingID
fid
addr_str :: Text
addr_str = IPv6ID -> Text
ipv6ToText (IPv6ID -> Text) -> IPv6ID -> Text
forall a b. (a -> b) -> a -> b
$ IPv6 -> IPv6ID
IPv6ID (IPv6 -> IPv6ID) -> IPv6 -> IPv6ID
forall a b. (a -> b) -> a -> b
$ FindingID -> IPv6
nodeAddress FindingID
fid
idFromText :: Text -> Maybe FindingID
idFromText :: Text -> Maybe FindingID
idFromText Text
t = FindingType -> IPv6 -> FindingID
FindingID (FindingType -> IPv6 -> FindingID)
-> Maybe FindingType -> Maybe (IPv6 -> FindingID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FindingType
m_ft Maybe (IPv6 -> FindingID) -> Maybe IPv6 -> Maybe FindingID
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe IPv6
m_addr
where
(Text
ft_str, Text
rest) = Text -> Text -> (Text, Text)
T.breakOn Text
"://[" Text
t
(Text
addr_str, Text
_) = Text -> Text -> (Text, Text)
T.breakOn Text
"]" (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
4 Text
rest
m_ft :: Maybe FindingType
m_ft = Text -> Maybe FindingType
typeFromText Text
ft_str
m_addr :: Maybe IPv6
m_addr = (IPv6ID -> IPv6) -> Maybe IPv6ID -> Maybe IPv6
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv6ID -> IPv6
unIPv6ID (Maybe IPv6ID -> Maybe IPv6) -> Maybe IPv6ID -> Maybe IPv6
forall a b. (a -> b) -> a -> b
$ Text -> Maybe IPv6ID
ipv6FromText Text
addr_str
instance ToJSON FindingID where
toJSON :: FindingID -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (FindingID -> Text) -> FindingID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindingID -> Text
idToText
parseFromText :: MonadFail m => Text -> m FindingID
parseFromText :: Text -> m FindingID
parseFromText Text
t =
case Text -> Maybe FindingID
idFromText Text
t of
Maybe FindingID
Nothing -> String -> m FindingID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid FindingID: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t)
Just FindingID
fid -> FindingID -> m FindingID
forall (m :: * -> *) a. Monad m => a -> m a
return FindingID
fid
instance FromJSON FindingID where
parseJSON :: Value -> Parser FindingID
parseJSON Value
v = Text -> Parser FindingID
forall (m :: * -> *). MonadFail m => Text -> m FindingID
parseFromText (Text -> Parser FindingID) -> Parser Text -> Parser FindingID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance FromGraphSON FindingID where
parseGraphSON :: GValue -> Parser FindingID
parseGraphSON GValue
gv = Text -> Parser FindingID
forall (m :: * -> *). MonadFail m => Text -> m FindingID
parseFromText (Text -> Parser FindingID) -> Parser Text -> Parser FindingID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GValue -> Parser Text
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue
gv
instance Hashable FindingID where
hashWithSalt :: Int -> FindingID -> Int
hashWithSalt Int
s FindingID
fid = Int
s Int -> FindingType -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` FindingType
ft Int -> IPv6ID -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` IPv6ID
addr_id
where
ft :: FindingType
ft = FindingID -> FindingType
findingType FindingID
fid
addr_id :: IPv6ID
addr_id = IPv6 -> IPv6ID
IPv6ID (IPv6 -> IPv6ID) -> IPv6 -> IPv6ID
forall a b. (a -> b) -> a -> b
$ FindingID -> IPv6
nodeAddress FindingID
fid
instance ToNodeID FindingID where
toNodeID :: FindingID -> Text
toNodeID = FindingID -> Text
idToText
newtype IPv6ID = IPv6ID { IPv6ID -> IPv6
unIPv6ID :: IPv6 }
deriving (Int -> IPv6ID -> ShowS
[IPv6ID] -> ShowS
IPv6ID -> String
(Int -> IPv6ID -> ShowS)
-> (IPv6ID -> String) -> ([IPv6ID] -> ShowS) -> Show IPv6ID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPv6ID] -> ShowS
$cshowList :: [IPv6ID] -> ShowS
show :: IPv6ID -> String
$cshow :: IPv6ID -> String
showsPrec :: Int -> IPv6ID -> ShowS
$cshowsPrec :: Int -> IPv6ID -> ShowS
Show,IPv6ID -> IPv6ID -> Bool
(IPv6ID -> IPv6ID -> Bool)
-> (IPv6ID -> IPv6ID -> Bool) -> Eq IPv6ID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv6ID -> IPv6ID -> Bool
$c/= :: IPv6ID -> IPv6ID -> Bool
== :: IPv6ID -> IPv6ID -> Bool
$c== :: IPv6ID -> IPv6ID -> Bool
Eq,Eq IPv6ID
Eq IPv6ID
-> (IPv6ID -> IPv6ID -> Ordering)
-> (IPv6ID -> IPv6ID -> Bool)
-> (IPv6ID -> IPv6ID -> Bool)
-> (IPv6ID -> IPv6ID -> Bool)
-> (IPv6ID -> IPv6ID -> Bool)
-> (IPv6ID -> IPv6ID -> IPv6ID)
-> (IPv6ID -> IPv6ID -> IPv6ID)
-> Ord IPv6ID
IPv6ID -> IPv6ID -> Bool
IPv6ID -> IPv6ID -> Ordering
IPv6ID -> IPv6ID -> IPv6ID
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 :: IPv6ID -> IPv6ID -> IPv6ID
$cmin :: IPv6ID -> IPv6ID -> IPv6ID
max :: IPv6ID -> IPv6ID -> IPv6ID
$cmax :: IPv6ID -> IPv6ID -> IPv6ID
>= :: IPv6ID -> IPv6ID -> Bool
$c>= :: IPv6ID -> IPv6ID -> Bool
> :: IPv6ID -> IPv6ID -> Bool
$c> :: IPv6ID -> IPv6ID -> Bool
<= :: IPv6ID -> IPv6ID -> Bool
$c<= :: IPv6ID -> IPv6ID -> Bool
< :: IPv6ID -> IPv6ID -> Bool
$c< :: IPv6ID -> IPv6ID -> Bool
compare :: IPv6ID -> IPv6ID -> Ordering
$ccompare :: IPv6ID -> IPv6ID -> Ordering
$cp1Ord :: Eq IPv6ID
Ord,(forall x. IPv6ID -> Rep IPv6ID x)
-> (forall x. Rep IPv6ID x -> IPv6ID) -> Generic IPv6ID
forall x. Rep IPv6ID x -> IPv6ID
forall x. IPv6ID -> Rep IPv6ID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IPv6ID x -> IPv6ID
$cfrom :: forall x. IPv6ID -> Rep IPv6ID x
Generic)
instance Hashable IPv6ID where
hashWithSalt :: Int -> IPv6ID -> Int
hashWithSalt Int
s (IPv6ID IPv6
a) =
Int
s Int -> Prefix -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` IPv6 -> Prefix
getPrefix IPv6
a Int -> Prefix -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` IPv6 -> Prefix
getInterfaceID IPv6
a
ipv6ToText :: IPv6ID -> Text
ipv6ToText :: IPv6ID -> Text
ipv6ToText (IPv6ID IPv6
a) = IPv6 -> Text
IPv6.encode IPv6
a
ipv6FromText :: Text -> Maybe IPv6ID
ipv6FromText :: Text -> Maybe IPv6ID
ipv6FromText = (IPv6 -> IPv6ID) -> Maybe IPv6 -> Maybe IPv6ID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv6 -> IPv6ID
IPv6ID (Maybe IPv6 -> Maybe IPv6ID)
-> (Text -> Maybe IPv6) -> Text -> Maybe IPv6ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe IPv6
IPv6.decode
parseIPv6IDFromText :: MonadFail m => Text -> m IPv6ID
parseIPv6IDFromText :: Text -> m IPv6ID
parseIPv6IDFromText Text
t =
case Text -> Maybe IPv6ID
ipv6FromText Text
t of
Maybe IPv6ID
Nothing -> String -> m IPv6ID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid IPv6 address: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t)
Just IPv6ID
a -> IPv6ID -> m IPv6ID
forall (m :: * -> *) a. Monad m => a -> m a
return IPv6ID
a
instance FromJSON IPv6ID where
parseJSON :: Value -> Parser IPv6ID
parseJSON Value
v = Text -> Parser IPv6ID
forall (m :: * -> *). MonadFail m => Text -> m IPv6ID
parseIPv6IDFromText (Text -> Parser IPv6ID) -> Parser Text -> Parser IPv6ID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance ToJSON IPv6ID where
toJSON :: IPv6ID -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (IPv6ID -> Text) -> IPv6ID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6ID -> Text
ipv6ToText
instance FromGraphSON IPv6ID where
parseGraphSON :: GValue -> Parser IPv6ID
parseGraphSON GValue
gv = Text -> Parser IPv6ID
forall (m :: * -> *). MonadFail m => Text -> m IPv6ID
parseIPv6IDFromText (Text -> Parser IPv6ID) -> Parser Text -> Parser IPv6ID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GValue -> Parser Text
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue
gv
instance ToNodeID IPv6ID where
toNodeID :: IPv6ID -> Text
toNodeID = IPv6ID -> Text
ipv6ToText
ipv6Only :: FindingID -> IPv6ID
ipv6Only :: FindingID -> IPv6ID
ipv6Only = IPv6 -> IPv6ID
IPv6ID (IPv6 -> IPv6ID) -> (FindingID -> IPv6) -> FindingID -> IPv6ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindingID -> IPv6
nodeAddress