diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,29 @@ # Revision history for net-spider +## 0.4.1.0 -- 2020-01-26 + +* Add `GraphML.Attribute` module. `AttributeValue` and related types + in `GraphML.Writer` module are moved to `GraphML.Attribute` module. +* Add `ToAttributes` instance to `TimeZone`. +* Add `FromJSON` and `ToJSON` instances to `AttributeValue`. +* Add `attributesToAeson` function. + +### Timestamp module + +* Add `FromJSON`, `ToJSON` and `ToAttributes` instances to + `Timestamp`. + +### Found module + +* Add `FromJSON` and `ToJSON` instances to `LinkState`, `FoundLink` + and `FoundNode`. +* Add `Ord` instance to `FoundNode`. + +### Snapshot module + +* Add `FromJSON` and `ToJSON` instances to `SnapshotLink` and + `SnapshotNode`. + ## 0.4.0.1 -- 2019-12-29 * Confirm test with `data-interval-2.0.1`. diff --git a/net-spider.cabal b/net-spider.cabal --- a/net-spider.cabal +++ b/net-spider.cabal @@ -1,5 +1,5 @@ name: net-spider -version: 0.4.0.1 +version: 0.4.1.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -43,6 +43,7 @@ NetSpider.Log, NetSpider.Snapshot.Internal, NetSpider.GraphML.Writer, + NetSpider.GraphML.Attribute, NetSpider.Interval other-modules: NetSpider.Graph.Internal, NetSpider.Spider.Internal.Graph, @@ -64,7 +65,8 @@ data-interval >=1.3.0 && <2.1, extended-reals >=0.2.3.0 && <0.3, monad-logger >=0.3.28.1 && <0.4, - scientific >=0.3.6.2 && <0.4 + scientific >=0.3.6.2 && <0.4, + regex-applicative >=0.3.3 && <0.4 -- executable net-spider -- default-language: Haskell2010 @@ -85,8 +87,12 @@ -- default-extensions: other-extensions: OverloadedStrings, DeriveGeneric - other-modules: NetSpider.GraphML.WriterSpec - build-depends: base, net-spider, vector, text, aeson, + other-modules: NetSpider.GraphML.WriterSpec, + NetSpider.TimestampSpec, + NetSpider.FoundSpec, + NetSpider.SnapshotSpec, + JSONUtil + build-depends: base, net-spider, vector, text, aeson, bytestring, time, hspec >=2.4.4 flag server-test diff --git a/src/NetSpider/Found.hs b/src/NetSpider/Found.hs --- a/src/NetSpider/Found.hs +++ b/src/NetSpider/Found.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} -- | -- Module: NetSpider.Found -- Description: Types about local findings @@ -13,9 +13,15 @@ linkStateFromText ) where +import qualified Control.Monad.Fail as Fail +import Data.Aeson (FromJSON(..), ToJSON(..)) +import qualified Data.Aeson as Aeson import Data.Bifunctor (Bifunctor(..)) +import Data.Char (isUpper, toLower) import Data.Greskell (FromGraphSON(..)) import Data.Text (Text, unpack) +import GHC.Generics (Generic) +import qualified Text.Regex.Applicative as RE import NetSpider.Timestamp (Timestamp) @@ -46,13 +52,37 @@ "bidirectional" -> Just LinkBidirectional _ -> Nothing +linkStateFromTextF :: Fail.MonadFail m => Text -> m LinkState +linkStateFromTextF t = + case linkStateFromText t of + Just ls -> return ls + Nothing -> Fail.fail ("Unrecognized LinkState: " ++ unpack t) + instance FromGraphSON LinkState where - parseGraphSON gv = fromText =<< parseGraphSON gv - where - fromText t = case linkStateFromText t of - Just ls -> return ls - Nothing -> fail ("Unrecognized LinkState: " ++ unpack t) + parseGraphSON gv = linkStateFromTextF =<< parseGraphSON gv +-- | Parse a JSON string to 'LinkState'. +-- +-- @since 0.4.1.0 +instance FromJSON LinkState where + parseJSON v = linkStateFromTextF =<< parseJSON v + +-- | Convert 'LinkState' to a JSON string. +-- +-- @since 0.4.1.0 +instance ToJSON LinkState where + toJSON = toJSON . linkStateToText + +aesonOpt :: Aeson.Options +aesonOpt = Aeson.defaultOptions + { Aeson.fieldLabelModifier = modifier + } + where + modifier = RE.replace reSnake . RE.replace reAttr + reAttr = fmap (const "Attrs") $ RE.string "Attributes" + reSnake = RE.msym $ \c -> if isUpper c then Just ['_', toLower c] else Nothing + + -- | A link found at a 'FoundNode'. The link connects from the subject -- node (the found node) to the target node. The link may be -- directional or non-directional. @@ -65,7 +95,7 @@ linkState :: LinkState, linkAttributes :: la } - deriving (Show,Eq,Ord) + deriving (Show,Eq,Ord,Generic) -- | @since 0.3.0.0 instance Functor (FoundLink n) where @@ -77,12 +107,23 @@ linkAttributes = fla $ linkAttributes l } +-- | @since 0.4.1.0 +instance (FromJSON n, FromJSON la) => FromJSON (FoundLink n la) where + parseJSON = Aeson.genericParseJSON aesonOpt + +-- | @since 0.4.1.0 +instance (ToJSON n, ToJSON la) => ToJSON (FoundLink n la) where + toJSON = Aeson.genericToJSON aesonOpt + toEncoding = Aeson.genericToEncoding aesonOpt + -- | 'FoundNode' is a node (the subject node) observed at a specific -- time. It has a set of neighbor links found at the moment. -- -- - type @n@: node ID. -- - type @na@: node attributes. -- - type @la@: link attributes. +-- +-- 'Ord' instance is added in net-spider-0.4.1.0. data FoundNode n na la = FoundNode { subjectNode :: n, @@ -90,7 +131,7 @@ neighborLinks :: [FoundLink n la], nodeAttributes :: na } - deriving (Show,Eq) + deriving (Show,Eq,Ord,Generic) -- | @since 0.3.0.0 instance Functor (FoundNode n na) where @@ -101,3 +142,12 @@ bimap fna fla n = n { neighborLinks = (fmap . fmap) fla $ neighborLinks n, nodeAttributes = fna $ nodeAttributes n } + +-- | @since 0.4.1.0 +instance (FromJSON n, FromJSON na, FromJSON la) => FromJSON (FoundNode n na la) where + parseJSON = Aeson.genericParseJSON aesonOpt + +-- | @since 0.4.1.0 +instance (ToJSON n, ToJSON na, ToJSON la) => ToJSON (FoundNode n na la) where + toJSON = Aeson.genericToJSON aesonOpt + toEncoding = Aeson.genericToEncoding aesonOpt diff --git a/src/NetSpider/GraphML/Attribute.hs b/src/NetSpider/GraphML/Attribute.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/GraphML/Attribute.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE OverloadedStrings, FlexibleInstances #-} +-- | +-- Module: NetSpider.GraphML.Attribute +-- Description: GraphML attribute types +-- Maintainer: Toshio Ito +-- +-- @since 0.4.1.0 +module NetSpider.GraphML.Attribute + ( AttributeKey, + AttributeValue(..), + ToAttributes(..), + valueFromAeson, + attributesFromAeson, + attributesToAeson + ) where + +import Control.Applicative (empty) +import Data.Aeson (FromJSON(..), ToJSON(..)) +import qualified Data.Aeson as Aeson +import qualified Data.HashMap.Strict as HM +import qualified Data.Scientific as Sci +import Data.Text (Text, pack) +import Data.Time (TimeZone(..)) + +-- | Key of attribute. +type AttributeKey = Text + +-- | Typed value of attribute. +data AttributeValue = AttrBoolean Bool + | AttrInt Int + | AttrLong Integer + | AttrFloat Float + | AttrDouble Double + | AttrString Text + deriving (Show,Eq,Ord) + +-- | Based on 'valueFromAeson'. +-- +-- @since 0.4.1.0 +instance FromJSON AttributeValue where + parseJSON v = maybe empty return $ valueFromAeson v + +-- | @since 0.4.1.0 +instance ToJSON AttributeValue where + toJSON v = + case v of + AttrBoolean b -> toJSON b + AttrInt i -> toJSON i + AttrLong l -> toJSON l + AttrFloat f -> toJSON f + AttrDouble d -> toJSON d + AttrString t -> toJSON t + +-- | Type that can be converted to list of attributes. +class ToAttributes a where + toAttributes :: a -> [(AttributeKey, AttributeValue)] + +instance ToAttributes () where + toAttributes _ = [] + +instance ToAttributes [(AttributeKey, AttributeValue)] where + toAttributes = id + +-- | 'Nothing' is mapped to empty attributes. +instance ToAttributes a => ToAttributes (Maybe a) where + toAttributes Nothing = [] + toAttributes (Just a) = toAttributes a + +-- | @since 0.4.1.0 +instance ToAttributes TimeZone where + toAttributes tz = + [ ("@tz_offset_min", AttrInt $ timeZoneMinutes tz), + ("@tz_summer_only", AttrBoolean $ timeZoneSummerOnly tz), + ("@tz_name", AttrString $ pack $ timeZoneName tz) + ] + +-- | Make 'AttributeValue' from aeson's 'Aeson.Value'. It returns +-- 'Nothing', if the input is null, an object or an array. If the +-- input is a number, the output uses 'AttrDouble'. +valueFromAeson :: Aeson.Value -> Maybe AttributeValue +valueFromAeson v = + case v of + Aeson.String t -> Just $ AttrString t + Aeson.Bool b -> Just $ AttrBoolean b + Aeson.Number n -> Just $ AttrDouble $ Sci.toRealFloat n + _ -> Nothing + +-- | Make attributes from aeson's 'Aeson.Value'. It assumes the input +-- is an object, and its values can be converted by +-- 'valueFromAeson'. Otherwise, it returns 'Nothing'. +attributesFromAeson :: Aeson.Value -> Maybe [(AttributeKey, AttributeValue)] +attributesFromAeson v = + case v of + Aeson.Object o -> mapM convElem $ HM.toList o + _ -> Nothing + where + convElem (k, val) = fmap ((,) k) $ valueFromAeson val + +-- | Make aeson 'Aeson.Object' as 'Aeson.Value' from attributes. +-- +-- @since 0.4.1.0 +attributesToAeson :: [(AttributeKey, AttributeValue)] -> Aeson.Value +attributesToAeson = Aeson.Object . HM.fromList . (fmap . fmap) toJSON diff --git a/src/NetSpider/GraphML/Writer.hs b/src/NetSpider/GraphML/Writer.hs --- a/src/NetSpider/GraphML/Writer.hs +++ b/src/NetSpider/GraphML/Writer.hs @@ -22,7 +22,7 @@ NodeID, ToNodeID(..), nodeIDByShow, - -- * Attributes + -- * Attributes (re-exports) AttributeKey, AttributeValue(..), ToAttributes(..), @@ -30,7 +30,6 @@ attributesFromAeson ) where -import qualified Data.Aeson as Aeson import Data.Foldable (foldl') import Data.Greskell.Graph (Property(..)) import Data.Hashable (Hashable(..)) @@ -39,7 +38,6 @@ import Data.Int (Int8, Int16, Int32, Int64) import Data.Maybe (catMaybes) import Data.Monoid ((<>), Monoid(..), mconcat) -import qualified Data.Scientific as Sci import Data.Semigroup (Semigroup(..)) import Data.Text (Text, pack, unpack) import qualified Data.Text.Lazy as TL @@ -48,6 +46,13 @@ import Data.Word (Word8, Word16, Word32, Word64) import GHC.Generics (Generic) +import NetSpider.GraphML.Attribute + ( AttributeKey, + AttributeValue(..), + ToAttributes(..), + valueFromAeson, + attributesFromAeson + ) import NetSpider.Snapshot ( SnapshotNode, nodeId, nodeTimestamp, isOnBoundary, nodeAttributes, SnapshotLink, sourceNode, destinationNode, linkTimestamp, isDirected, linkAttributes, @@ -118,55 +123,6 @@ toNodeID True = "true" toNodeID False = "false" --- | Key of attribute. -type AttributeKey = Text - --- | Typed value of attribute. -data AttributeValue = AttrBoolean Bool - | AttrInt Int - | AttrLong Integer - | AttrFloat Float - | AttrDouble Double - | AttrString Text - deriving (Show,Eq,Ord) - --- | Type that can be converted to list of attributes. -class ToAttributes a where - toAttributes :: a -> [(AttributeKey, AttributeValue)] - -instance ToAttributes () where - toAttributes _ = [] - -instance ToAttributes [(AttributeKey, AttributeValue)] where - toAttributes = id - --- | 'Nothing' is mapped to empty attributes. -instance ToAttributes a => ToAttributes (Maybe a) where - toAttributes Nothing = [] - toAttributes (Just a) = toAttributes a - --- | Make 'AttributeValue' from aeson's 'Aeson.Value'. It returns --- 'Nothing', if the input is null, an object or an array. If the --- input is a number, the output uses 'AttrDouble'. -valueFromAeson :: Aeson.Value -> Maybe AttributeValue -valueFromAeson v = - case v of - Aeson.String t -> Just $ AttrString t - Aeson.Bool b -> Just $ AttrBoolean b - Aeson.Number n -> Just $ AttrDouble $ Sci.toRealFloat n - _ -> Nothing - --- | Make attributes from aeson's 'Aeson.Value'. It assumes the input --- is an object, and its values can be converted by --- 'valueFromAeson'. Otherwise, it returns 'Nothing'. -attributesFromAeson :: Aeson.Value -> Maybe [(AttributeKey, AttributeValue)] -attributesFromAeson v = - case v of - Aeson.Object o -> mapM convElem $ HM.toList o - _ -> Nothing - where - convElem (k, val) = fmap ((,) k) $ valueFromAeson val - sbuild :: Show a => a -> TLB.Builder sbuild = TLB.fromString . show @@ -289,20 +245,6 @@ name_str = encodeXML $ kmName km type_str = showAttributeType $ kmType km -timestampAttrs :: Timestamp -> [(AttributeKey, AttributeValue)] -timestampAttrs t = - [ ("@timestamp", AttrLong $ toInteger $ epochTime t), - ("@timestamp_str", AttrString $ showTimestamp t) - ] ++ timezone_attrs - where - timezone_attrs = - case timeZone t of - Nothing -> [] - Just tz -> [ ("@tz_offset_min", AttrInt $ timeZoneMinutes tz), - ("@tz_summer_only", AttrBoolean $ timeZoneSummerOnly tz), - ("@tz_name", AttrString $ pack $ timeZoneName tz) - ] - nodeMetaKeys :: ToAttributes na => SnapshotNode n na -> [KeyMeta] nodeMetaKeys n = map fst $ nodeMetaValues n @@ -311,7 +253,7 @@ where timestamp = case nodeTimestamp n of Nothing -> [] - Just t -> timestampAttrs t + Just t -> toAttributes t base = timestamp <> [("@is_on_boundary", AttrBoolean $ isOnBoundary n)] attrs = toAttributes $ nodeAttributes n convert (k, v) = makeMetaValue DomainNode k v @@ -322,7 +264,7 @@ linkMetaValues :: ToAttributes la => SnapshotLink n la -> [(KeyMeta, AttributeValue)] linkMetaValues l = map convert $ base <> attrs where - base = timestampAttrs $ linkTimestamp l + base = toAttributes $ linkTimestamp l attrs = toAttributes $ linkAttributes l convert (k, v) = makeMetaValue DomainEdge k v diff --git a/src/NetSpider/Snapshot/Internal.hs b/src/NetSpider/Snapshot/Internal.hs --- a/src/NetSpider/Snapshot/Internal.hs +++ b/src/NetSpider/Snapshot/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} -- | -- Module: NetSpider.Snapshot.Internal -- Description: Implementation of Snapshot graph types @@ -17,9 +18,15 @@ SnapshotNode(..) ) where +import Control.Applicative (many, (*>)) +import Data.Aeson (ToJSON(..), FromJSON(..)) +import qualified Data.Aeson as Aeson import Data.Bifunctor (Bifunctor(..)) +import Data.Char (isUpper, toLower) +import GHC.Generics (Generic) import NetSpider.Pair (Pair(..)) import NetSpider.Timestamp (Timestamp) +import qualified Text.Regex.Applicative as RE -- | The snapshot graph, which is a collection nodes and links. -- @@ -45,7 +52,7 @@ -- Maybe it's a good idea to include 'observationLogs', which can -- contain warnings or other logs about making this SnapshotLink. } - deriving (Show,Eq) + deriving (Show,Eq,Generic) -- | Comparison by node-tuple (source node, destination node). instance (Ord n, Eq la) => Ord (SnapshotLink n la) where @@ -62,6 +69,32 @@ _destinationNode = fn $ _destinationNode l } +aesonOpt :: Aeson.Options +aesonOpt = Aeson.defaultOptions + { Aeson.fieldLabelModifier = modifier + } + where + modifier = RE.replace reSnake . RE.replace reAttr . RE.replace reDest . RE.replace reTime + reDest = fmap (const "dest") $ RE.string "destination" + reAttr = fmap (const "Attrs") $ RE.string "Attributes" + reTime = fmap (const "timestamp") (many RE.anySym *> RE.string "Timestamp") + reSnake = RE.msym $ \c -> + if c == '_' + then Just "" + else if isUpper c + then Just ['_', toLower c] + else Nothing + +-- | @since 0.4.1.0 +instance (FromJSON n, FromJSON la) => FromJSON (SnapshotLink n la) where + parseJSON = Aeson.genericParseJSON aesonOpt + +-- | @since 0.4.1.0 +instance (ToJSON n, ToJSON la) => ToJSON (SnapshotLink n la) where + toJSON = Aeson.genericToJSON aesonOpt + toEncoding = Aeson.genericToEncoding aesonOpt + + -- | Node-tuple (source node, destination node) of the link. linkNodeTuple :: SnapshotLink n la -> (n, n) linkNodeTuple link = (_sourceNode link, _destinationNode link) @@ -78,7 +111,7 @@ _nodeTimestamp :: Maybe Timestamp, _nodeAttributes :: Maybe na } - deriving (Show,Eq) + deriving (Show,Eq,Generic) -- | Comparison by node ID. instance (Ord n, Eq na) => Ord (SnapshotNode n na) where @@ -93,3 +126,13 @@ bimap fn fna n = n { _nodeAttributes = fmap fna $ _nodeAttributes n, _nodeId = fn $ _nodeId n } + +-- | @since 0.4.1.0 +instance (FromJSON n, FromJSON na) => FromJSON (SnapshotNode n na) where + parseJSON = Aeson.genericParseJSON aesonOpt + +-- | @since 0.4.1.0 +instance (ToJSON n, ToJSON na) => ToJSON (SnapshotNode n na) where + toJSON = Aeson.genericToJSON aesonOpt + toEncoding = Aeson.genericToEncoding aesonOpt + diff --git a/src/NetSpider/Timestamp.hs b/src/NetSpider/Timestamp.hs --- a/src/NetSpider/Timestamp.hs +++ b/src/NetSpider/Timestamp.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- | -- Module: NetSpider.Timestamp -- Description: Timestamp type @@ -26,12 +27,15 @@ showEpochTime ) where -import Control.Applicative ((<$>), (<*>), (<*), (*>), optional) +import Control.Applicative ((<$>), (<*>), (<*), (*>), optional, empty) +import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), (.:), (.=)) +import qualified Data.Aeson as Aeson import Data.Char (isDigit) import Data.Int (Int64) import Data.List (sortOn) import Data.Monoid ((<>)) -import Data.Text (Text, pack) +import Data.Text (Text, pack, unpack) +import qualified Data.Text as Text import Data.Time.Calendar (Day, fromGregorian) import Data.Time.Clock (UTCTime) import Data.Time.Clock.System (utcToSystemTime, SystemTime(..), systemToUTCTime) @@ -45,6 +49,11 @@ import Text.Read (readEither) import Text.Printf (printf) +import NetSpider.GraphML.Attribute + ( ToAttributes(..), + AttributeValue(..) + ) + -- | Timestamp when graph elements are observed. data Timestamp = Timestamp @@ -58,6 +67,48 @@ -- | Compare by 'epochTime' only. 'timeZone' is not used. instance Ord Timestamp where compare l r = compare (epochTime l) (epochTime r) + + +-- | It can parse JSON string or object. If the input is a JSON +-- string, it is parsed by 'parseTimestamp'. +-- +-- @since 0.4.1.0 +instance FromJSON Timestamp where + parseJSON (String t) = maybe (fail err_msg) return $ parseTimestamp ts + where + ts = unpack t + err_msg = "Invalid Timestamp string: " ++ ts + parseJSON (Object o) = Timestamp <$> (o .: "epoch_time") <*> parseTZ o + where + parseTZ ob = optional $ TimeZone + <$> (ob .: "tz_offset_min") + <*> (ob .: "tz_summer_only") + <*> (ob .: "tz_name") + parseJSON _ = empty + + + +-- | Convert to a JSON object. +-- +-- @since 0.4.1.0 +instance ToJSON Timestamp where + toJSON t = Aeson.object $ + [ "epoch_time" .= epochTime t + ] + ++ tz_fields + where + tz_fields = (fmap . fmap) toJSON $ map fixKeyPrefix $ toAttributes $ timeZone t + fixKeyPrefix (k, v) = (Text.tail k, v) + + +-- | @since 0.4.1.0 +instance ToAttributes Timestamp where + toAttributes t = + [ ("@timestamp", AttrLong $ toInteger $ epochTime t), + ("@timestamp_str", AttrString $ showTimestamp t) + ] ++ timezone_attrs + where + timezone_attrs = maybe [] toAttributes $ timeZone t -- | Make 'Timestamp' from milliseconds from the epoch. 'timeZone' is -- 'Nothing'. diff --git a/test/JSONUtil.hs b/test/JSONUtil.hs new file mode 100644 --- /dev/null +++ b/test/JSONUtil.hs @@ -0,0 +1,24 @@ +module JSONUtil + ( specJSONFromTo + ) where + +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as BSL +import Data.Either (isRight) +import Test.Hspec + +specJSONFromTo :: (FromJSON a, ToJSON a, Show a, Eq a) + => String -- ^ spec name + -> BSL.ByteString -- ^ JSON document + -> a -- ^ expected data + -> Spec +specJSONFromTo spec_name json_doc exp_data = do + specify ("JSONFromTo: " ++ spec_name) $ do + let got_dec = Aeson.eitherDecode json_doc + got_enc_v :: Either String Aeson.Value + got_enc_v = Aeson.eitherDecode $ Aeson.encode exp_data + exp_enc = Aeson.eitherDecode json_doc + got_dec `shouldBe` Right exp_data + isRight exp_enc `shouldBe` True + got_enc_v `shouldBe` exp_enc diff --git a/test/NetSpider/FoundSpec.hs b/test/NetSpider/FoundSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/FoundSpec.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} +module NetSpider.FoundSpec (main,spec) where + +import qualified Data.Aeson as Aeson +import Data.Monoid ((<>)) +import Data.Text (Text) +import Test.Hspec + +import JSONUtil (specJSONFromTo) + +import NetSpider.Found (FoundLink(..), LinkState(..), FoundNode(..)) +import NetSpider.Timestamp (fromEpochMillisecond) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "FoundLink" $ do + specJSONFromTo + "Int attribute" + "{\"target_node\":\"target\", \"link_state\": \"to_target\", \"link_attrs\":125}" + FoundLink + { targetNode = ("target" :: Text), + linkState = LinkToTarget, + linkAttributes = (125 :: Int) + } + describe "FoundNode" $ do + specJSONFromTo + "Text attribute, () attribute (encoded as an empty array [])" + ( "{\"subject_node\": \"foobar\"," + <> " \"found_at\": {\"epoch_time\": 99200}," + <> " \"node_attrs\": \"hoge\"," + <> " \"neighbor_links\": [" + <> " {\"target_node\": \"quux\", \"link_state\": \"to_subject\", \"link_attrs\": []}" + <> " ]}" + ) + FoundNode + { subjectNode = ("foobar" :: Text), + foundAt = fromEpochMillisecond 99200, + nodeAttributes = ("hoge" :: Text), + neighborLinks = + [ FoundLink + { targetNode = ("quux" :: Text), + linkState = LinkToSubject, + linkAttributes = () + } + ] + } diff --git a/test/NetSpider/SnapshotSpec.hs b/test/NetSpider/SnapshotSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/SnapshotSpec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +module NetSpider.SnapshotSpec (main,spec) where + +import Data.Monoid ((<>)) +import Data.Text (Text) +import Test.Hspec + +import JSONUtil (specJSONFromTo) + +import NetSpider.Timestamp (fromEpochMillisecond) +import NetSpider.Snapshot.Internal (SnapshotLink(..), SnapshotNode(..)) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "SnapshotLink" $ do + specJSONFromTo + "Text ID, () link attribute" + ( "{\"source_node\": \"s\", \"dest_node\": \"d\"," + <> " \"is_directed\": false, \"link_attrs\": []," + <> " \"timestamp\": {\"epoch_time\": 5000} }" + ) + SnapshotLink + { _sourceNode = ("s" :: Text), + _destinationNode = ("d" :: Text), + _isDirected = False, + _linkTimestamp = fromEpochMillisecond 5000, + _linkAttributes = () + } + describe "SnapshotNode" $ do + specJSONFromTo + "Int ID, null timestamp, Text attribute" + ( "{\"node_id\": 999, \"is_on_boundary\": true," + <> " \"timestamp\": null, \"node_attrs\": \"foobar\"}" + ) + SnapshotNode + { _nodeId = (999 :: Int), + _isOnBoundary = True, + _nodeTimestamp = Nothing, + _nodeAttributes = Just ("foobar" :: Text) + } diff --git a/test/NetSpider/TimestampSpec.hs b/test/NetSpider/TimestampSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/TimestampSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} +module NetSpider.TimestampSpec (main,spec) where + +import Data.Aeson (encode, eitherDecode, ToJSON(..)) +import qualified Data.ByteString.Lazy as BSL +import Data.Time (TimeZone(..)) +import Test.Hspec + +import NetSpider.Timestamp (Timestamp(..), fromS, fromEpochMillisecond) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "FromJSON and ToJSON" $ do + specTS $ fromS "2019-12-31T18:46" + specTS $ fromS "2019-12-31T18:46:10" + specTS $ fromS "2019-12-31 18:46:11.037" + specTS $ fromS "2019-09-21T00:32Z" + specTS $ fromS "2019-08-07 11:18:43+07:00" + specTS $ fromS "2019-08-07T11:18:43.112-02:30" + describe "ToJSON" $ do + specToJSON (fromEpochMillisecond 1000) "{\"epoch_time\":1000}" + specToJSON (fromS "2019-09-21T00:32Z") + "{\"epoch_time\":1569025920000, \"tz_offset_min\": 0, \"tz_summer_only\":false, \"tz_name\":\"UTC\"}" + specToJSON (fromS "2019-08-07 11:18:43+07:00") + "{\"epoch_time\":1565151523000, \"tz_offset_min\": 420, \"tz_summer_only\": false, \"tz_name\":\"\"}" + describe "FromJSON - string" $ do + specFromJSON "\"2019-12-31 18:46:11.037\"" (Timestamp 1577817971037 Nothing) + specFromJSON "\"2020-08-07T11:18:43.112-02:30\"" (Timestamp 1596808123112 $ Just $ TimeZone (-150) False "") + describe "FromJSON - object" $ do + specFromJSON "{\"epoch_time\": 1000}" (Timestamp 1000 Nothing) + specFromJSON "{\"epoch_time\": 1000, \"tz_offset_min\": 180, \"tz_summer_only\": true, \"tz_name\": \"\"}" + (Timestamp 1000 $ Just $ TimeZone 180 True "") + specFromJSON "{\"epoch_time\": 1000, \"tz_offset_min\": 0, \"tz_summer_only\": false, \"tz_name\": \"UTC\"}" + (Timestamp 1000 $ Just $ TimeZone 0 False "UTC") + + +specTS :: Timestamp -> Spec +specTS t = specify (show t) $ do + (eitherDecode $ encode t) `shouldBe` Right t + +specToJSON :: Timestamp -> BSL.ByteString -> Spec +specToJSON input_ts expected = do + specify (show input_ts) $ do + (Right $ toJSON input_ts) `shouldBe` (eitherDecode expected) + +specFromJSON :: BSL.ByteString -> Timestamp -> Spec +specFromJSON input expected = do + specify (show input) $ do + eitherDecode input `shouldBe` Right expected