{-# 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 (Show,Eq,Ord,Enum,Bounded,Generic)
instance Hashable FindingType
typeToText :: FindingType -> Text
typeToText ft =
case ft of
FindingDIO -> "dio"
FindingDAO -> "dao"
typeFromText :: Text -> Maybe FindingType
typeFromText t =
case t of
"dio" -> Just FindingDIO
"dao" -> Just FindingDAO
_ -> Nothing
instance FromJSON FindingType where
parseJSON (Aeson.String t) = maybe (fail err_msg) return $ typeFromText t
where
err_msg = "Invalid string as FindingType: " <> show t
parseJSON _ = empty
instance ToJSON FindingType where
toJSON = Aeson.String . typeToText
data FindingID =
FindingID
{ findingType :: FindingType,
nodeAddress :: IPv6
}
deriving (Show,Eq,Ord,Generic)
idToText :: FindingID -> Text
idToText fid = ft_str <> "://[" <> addr_str <> "]"
where
ft_str = typeToText $ findingType fid
addr_str = ipv6ToText $ IPv6ID $ nodeAddress fid
idFromText :: Text -> Maybe FindingID
idFromText t = FindingID <$> m_ft <*> m_addr
where
(ft_str, rest) = T.breakOn "://[" t
(addr_str, _) = T.breakOn "]" $ T.drop 4 rest
m_ft = typeFromText ft_str
m_addr = fmap unIPv6ID $ ipv6FromText addr_str
instance ToJSON FindingID where
toJSON = Aeson.String . idToText
parseFromText :: MonadFail m => Text -> m FindingID
parseFromText t =
case idFromText t of
Nothing -> fail ("Invalid FindingID: " <> T.unpack t)
Just fid -> return fid
instance FromJSON FindingID where
parseJSON v = parseFromText =<< parseJSON v
instance FromGraphSON FindingID where
parseGraphSON gv = parseFromText =<< parseGraphSON gv
instance Hashable FindingID where
hashWithSalt s fid = s `hashWithSalt` ft `hashWithSalt` addr_id
where
ft = findingType fid
addr_id = IPv6ID $ nodeAddress fid
instance ToNodeID FindingID where
toNodeID = idToText
newtype IPv6ID = IPv6ID { unIPv6ID :: IPv6 }
deriving (Show,Eq,Ord,Generic)
instance Hashable IPv6ID where
hashWithSalt s (IPv6ID a) =
s `hashWithSalt` getPrefix a `hashWithSalt` getInterfaceID a
ipv6ToText :: IPv6ID -> Text
ipv6ToText (IPv6ID a) = IPv6.encode a
ipv6FromText :: Text -> Maybe IPv6ID
ipv6FromText = fmap IPv6ID . IPv6.decode
parseIPv6IDFromText :: MonadFail m => Text -> m IPv6ID
parseIPv6IDFromText t =
case ipv6FromText t of
Nothing -> fail ("Invalid IPv6 address: " <> T.unpack t)
Just a -> return a
instance FromJSON IPv6ID where
parseJSON v = parseIPv6IDFromText =<< parseJSON v
instance ToJSON IPv6ID where
toJSON = Aeson.String . ipv6ToText
instance FromGraphSON IPv6ID where
parseGraphSON gv = parseIPv6IDFromText =<< parseGraphSON gv
instance ToNodeID IPv6ID where
toNodeID = ipv6ToText
ipv6Only :: FindingID -> IPv6ID
ipv6Only = IPv6ID . nodeAddress