diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for net-spider-cli + +## 0.1.0.0 -- 2019-08-04 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Toshio Ito + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Toshio Ito nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +# net-spider-cli + + +## Author + +Toshio Ito diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/net-spider-cli.cabal b/net-spider-cli.cabal new file mode 100644 --- /dev/null +++ b/net-spider-cli.cabal @@ -0,0 +1,71 @@ +name: net-spider-cli +version: 0.1.0.0 +author: Toshio Ito +maintainer: Toshio Ito +license: BSD3 +license-file: LICENSE +synopsis: CLI option parsers for NetSpider objects +description: CLI option parsers for NetSpider objects. See "NetSpider.CLI". +category: Database +cabal-version: >= 1.10 +build-type: Simple +extra-source-files: README.md, ChangeLog.md +homepage: https://github.com/debug-ito/net-spider +bug-reports: https://github.com/debug-ito/net-spider/issues + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall -fno-warn-unused-imports + default-extensions: OverloadedStrings, StrictData + -- other-extensions: + exposed-modules: NetSpider.CLI, + NetSpider.CLI.Spider, + NetSpider.CLI.Snapshot + -- other-modules: + build-depends: base >=4.11.1.0 && <4.13, + net-spider >=0.3.1.0 && <0.4, + optparse-applicative >=0.14.3.0 && <0.16, + aeson >=1.2.4 && <1.5, + hashable >=1.2.6.1 && <1.3, + greskell-core >=0.1.2.4 && <0.2, + text >=1.2.2.2 && <1.3 + +-- executable net-spider-cli +-- default-language: Haskell2010 +-- hs-source-dirs: app +-- main-is: Main.hs +-- ghc-options: -Wall -fno-warn-unused-imports +-- -- other-modules: +-- default-extensions: OverloadedStrings, StrictData +-- -- other-extensions: +-- build-depends: base + +test-suite spec + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" + main-is: Spec.hs + default-extensions: OverloadedStrings, StrictData + -- other-extensions: + other-modules: NetSpider.CLI.SpiderSpec, + NetSpider.CLI.SnapshotSpec, + NetSpider.CLI.TestCommon + build-depends: base, net-spider-cli, net-spider, optparse-applicative, + hspec >=2.4.4 + + +test-suite doctest + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" + main-is: DocTest.hs + build-depends: base, + doctest >=0.13 && <0.17, + doctest-discover >=0.1.0.7 && <0.3 + +source-repository head + type: git + location: https://github.com/debug-ito/net-spider.git diff --git a/src/NetSpider/CLI.hs b/src/NetSpider/CLI.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/CLI.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings, StrictData #-} +-- | +-- Module: NetSpider.CLI +-- Description: CLI option parsers for NetSpider objects +-- Maintainer: Toshio Ito +-- +-- This module defines CLI option parsers for NetSpider objects, such +-- as configuration for Spider object and a query for a snapshot +-- graph. The option parsers are based on 'Parser' from +-- "Options.Applicative" (optparse-applicative package), so you can +-- easily integrade those parsers into the CLI option parser of your +-- own executable program. +module NetSpider.CLI + ( module NetSpider.CLI.Spider, + module NetSpider.CLI.Snapshot + ) where + +import Options.Applicative (Parser) + +import NetSpider.CLI.Spider +import NetSpider.CLI.Snapshot diff --git a/src/NetSpider/CLI/Snapshot.hs b/src/NetSpider/CLI/Snapshot.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/CLI/Snapshot.hs @@ -0,0 +1,81 @@ +-- | +-- Module: NetSpider.CLI.Snapshot +-- Description: CLI option parser for Query for snapshot graphs +-- Maintainer: Toshio Ito +-- +-- This module defines CLI option parser for 'Q.Query' for snapshot +-- graphs. +module NetSpider.CLI.Snapshot + ( parserSnapshotQuery, + SnapshotConfig(..) + ) where + +import Control.Applicative ((<$>), (<*>), many) +import qualified NetSpider.Query as Q +import qualified Options.Applicative as Opt +import NetSpider.Interval (interval, parseTimeIntervalEnd) + +-- | Configuration for option parser for Snapshot 'Q.Query'. +data SnapshotConfig n na fla sla = + SnapshotConfig + { nodeIDReader :: Opt.ReadM n, + -- ^ Parser that reads a CLI option to generate a node ID. + basisSnapshotQuery :: Q.Query n na fla sla, + -- ^ Basis for queries for snapshot graphs. Fields in this basis + -- are overwritten by CLI options. + startsFromAsArguments :: Bool + -- ^ If 'True', the 'Q.startsFrom' field is read from CLI + -- arguments. If 'False', arguments are not parsed. In either + -- case, \"-s\" option is always parsed to generate + -- 'Q.startsFrom'. + } + +-- | CLI option parser for 'Q.Query'. +parserSnapshotQuery :: SnapshotConfig n na fla sla + -> Opt.Parser (Q.Query n na fla sla) +parserSnapshotQuery conf = fmap fromParsedElement the_parser + where + basis = basisSnapshotQuery conf + fromParsedElement (sf, ti) = basis { Q.startsFrom = sf, Q.timeInterval = ti } + the_parser = (,) <$> ((++) <$> pStartsFrom <*> pStartsFromArgs) <*> pTimeInterval + rNodeID = nodeIDReader conf + nodeID_metavar = "NODE-ID" + pStartsFrom = many $ Opt.option rNodeID $ mconcat + [ Opt.short 's', + Opt.long "starts-from", + Opt.help "ID of a node from which the Spider starts traversing the history graph. You can specify this option multiple times.", + Opt.metavar nodeID_metavar + ] + pStartsFromArgs = if not $ startsFromAsArguments conf + then pure [] + else many $ Opt.argument rNodeID $ mconcat + [ Opt.help $ "Same as -s option.", + Opt.metavar $ nodeID_metavar + ] + pTimeInterval = interval <$> pTimeLower <*> pTimeUpper + pTimeLower = Opt.option (Opt.eitherReader parseTimeIntervalEnd) $ mconcat + [ Opt.short 'f', + Opt.long "time-from", + Opt.help ( "Lower bound of query timestamp. " + ++ "Local findings with timestamp newer than this value are used to create the snapshot graph. " + ++ "ISO 8601 format is used for timestamps (e.g. `2019-03-22T10:20:12+09:00`). " + ++ "The timezone is optional. " + ++ "By default, the lower bound is inclusive. " + ++ "Add prefix 'x' to make it exclusive (e.g. `x2019-03-22T10:20:12+09:00`). " + ++ "Prefix of 'i' explicitly mark the lower bound is inclusive. " + ++ "Special value `x-inf` indicates there is no lower bound. " + ++ "Default: x-inf"), + Opt.metavar "TIMESTAMP", + Opt.value (Q.NegInf, False) + ] + pTimeUpper = Opt.option (Opt.eitherReader parseTimeIntervalEnd) $ mconcat + [ Opt.short 't', + Opt.long "time-to", + Opt.help ( "Upper bound of query timestamp. " + ++ "Local findings with timestamp older than this value are used to create the snapshot graph. " + ++ "See --time-from for format of timestamps. " + ++ "Special value `x+inf` indicates there is no upper bound. " + ++ "Default: x+inf"), + Opt.metavar "TIMESTAMP", + Opt.value (Q.PosInf, False) + ] diff --git a/src/NetSpider/CLI/Spider.hs b/src/NetSpider/CLI/Spider.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/CLI/Spider.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings, StrictData #-} +-- | +-- Module: NetSpider.CLI.Spider +-- Description: CLI option parser for Spider's Config +-- Maintainer: Toshio Ito +-- +-- This module define CLI option parser for 'SpiderConfig'. +module NetSpider.CLI.Spider + ( parserSpiderConfig, + SpiderConfig + ) where + +import Control.Applicative ((<$>), (<*>), many, pure) +import Data.Greskell.Greskell (toGremlin) +import Data.Monoid (mconcat) +import Data.Text (unpack) +import qualified NetSpider.Spider.Config as SConf +import qualified NetSpider.Spider as Sp +import qualified Options.Applicative as Opt + +-- | 'SConf.Config' of the Spider. +type SpiderConfig = SConf.Config + +-- | Command-line option parser for 'SConf.Config' of 'Spider'. +parserSpiderConfig :: Opt.Parser (SpiderConfig n na fla) +parserSpiderConfig = + SConf.Config <$> host <*> port <*> node_id_key <*> log_thresh + where + host = Opt.strOption $ mconcat + [ Opt.long "host", + Opt.help "Hostname or address of Gremlin Server", + Opt.metavar "HOSTNAME", + Opt.value "localhost", + Opt.showDefault + ] + port = Opt.option Opt.auto $ mconcat + [ Opt.long "port", + Opt.help "Port number of Gremlin Server WebSocket endpoint", + Opt.metavar "PORT", + Opt.value 8182, + Opt.showDefault + ] + node_id_key = Opt.strOption $ mconcat + [ Opt.long "node-id-key", + Opt.help "Name of vertex attriute that stores Node ID.", + Opt.metavar "KEY", + Opt.value "@node_id", + Opt.showDefaultWith (unpack . toGremlin) + ] + log_thresh = fmap (logLevelFromVerbosity . length) $ many $ Opt.flag' () $ mconcat + [ Opt.short 'v', + Opt.long "verbose", + Opt.help "Verbose log output. Specify multiple times to make it more verbose." + ] + +logLevelFromVerbosity :: Int -> SConf.LogLevel +logLevelFromVerbosity 2 = SConf.LevelDebug +logLevelFromVerbosity 1 = SConf.LevelInfo +logLevelFromVerbosity _ = SConf.LevelWarn diff --git a/test/DocTest.hs b/test/DocTest.hs new file mode 100644 --- /dev/null +++ b/test/DocTest.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} diff --git a/test/NetSpider/CLI/SnapshotSpec.hs b/test/NetSpider/CLI/SnapshotSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/CLI/SnapshotSpec.hs @@ -0,0 +1,68 @@ +module NetSpider.CLI.SnapshotSpec (main,spec) where + +import NetSpider.Interval (interval, Extended(..)) +import NetSpider.Query + ( startsFrom, defQuery, timeInterval, + foundNodePolicy, policyAppend + ) +import NetSpider.Timestamp (fromEpochMillisecond) +import qualified Options.Applicative as Opt +import Test.Hspec + +import NetSpider.CLI.TestCommon (runP) +import NetSpider.CLI.Snapshot (SnapshotConfig(..), parserSnapshotQuery) + +defConfig :: SnapshotConfig Int () () () +defConfig = + SnapshotConfig + { nodeIDReader = Opt.auto, + basisSnapshotQuery = (defQuery []) { foundNodePolicy = policyAppend }, + startsFromAsArguments = False + } + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "parserSnapshotQuery" $ do + specify "default" $ do + let (Right got) = runP (parserSnapshotQuery defConfig) [] + startsFrom got `shouldBe` [] + timeInterval got `shouldBe` interval (NegInf, False) (PosInf, False) + foundNodePolicy got `shouldBe` policyAppend + specify "time-from" $ do + let (Right got) = runP (parserSnapshotQuery defConfig) + ["--time-from", "2019-02-19T11:12:00"] + timeInterval got `shouldBe` + interval (Finite $ fromEpochMillisecond 1550574720000, True) + (PosInf, False) + specify "time-to with exclusive" $ do + let (Right got) = runP (parserSnapshotQuery defConfig) + ["--time-to", "x2017-12-20T19:22:02"] + timeInterval got `shouldBe` + interval (NegInf, False) + (Finite $ fromEpochMillisecond 1513797722000, False) + specify "both time-from and time-to with inclusive" $ do + let (Right got) = runP (parserSnapshotQuery defConfig) + ["-f", "i2018-10-11T14:13:33", "-t", "i2018-10-11T14:13:50.332"] + timeInterval got `shouldBe` + interval (Finite $ fromEpochMillisecond 1539267213000, True) + (Finite $ fromEpochMillisecond 1539267230332, True) + specify "explicit infinity" $ do + let (Right got) = runP (parserSnapshotQuery defConfig) + ["--time-from", "-inf", "--time-to", "+inf"] + timeInterval got `shouldBe` interval (NegInf, True) (PosInf, True) + specify "multiple starts-from" $ do + let (Right got) = runP (parserSnapshotQuery defConfig) + ["-s", "10", "-s", "12", "-s", "15"] + startsFrom got `shouldBe` [10,12,15] + let argsConfig = defConfig { startsFromAsArguments = True } + specify "startsFromAsArguments" $ do + let (Right got) = runP (parserSnapshotQuery argsConfig) + ["143", "200", "473","21"] + startsFrom got `shouldBe` [143, 200, 473, 21] + specify "startsFromAsArguments - -s still enabled" $ do + let (Right got) = runP (parserSnapshotQuery argsConfig) + ["90", "-s", "181"] + startsFrom got `shouldBe` [181, 90] + diff --git a/test/NetSpider/CLI/SpiderSpec.hs b/test/NetSpider/CLI/SpiderSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/CLI/SpiderSpec.hs @@ -0,0 +1,31 @@ +module NetSpider.CLI.SpiderSpec (main,spec) where + +import Data.Monoid (mempty) +import NetSpider.Spider.Config (Config(..), LogLevel(..)) +import Test.Hspec + +import NetSpider.CLI.Spider (parserSpiderConfig) + +import NetSpider.CLI.TestCommon (runP) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "parserSpiderConfig" $ do + specify "host and port" $ do + let (Right sconf) = runP parserSpiderConfig + [ "--host", "foo.example.com", + "--port", "18822", + "--node-id-key", "@foo" + ] + wsHost sconf `shouldBe` "foo.example.com" + wsPort sconf `shouldBe` 18822 + nodeIdKey sconf `shouldBe` "@foo" + specify "verbosity" $ do + let (Right warn) = runP parserSpiderConfig [] + (Right info) = runP parserSpiderConfig ["-v"] + (Right debug) = runP parserSpiderConfig ["-vv"] + logThreshold warn `shouldBe` LevelWarn + logThreshold info `shouldBe` LevelInfo + logThreshold debug `shouldBe` LevelDebug diff --git a/test/NetSpider/CLI/TestCommon.hs b/test/NetSpider/CLI/TestCommon.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/CLI/TestCommon.hs @@ -0,0 +1,21 @@ +-- | +-- Module: NetSpider.CLI.TestCommon +-- Description: common utils for test +-- Maintainer: Toshio Ito +-- +-- +module NetSpider.CLI.TestCommon + ( runP + ) where + +import qualified Options.Applicative as Opt + +runP :: Opt.Parser a -> [String] -> Either String a +runP p args = toEither $ Opt.execParserPure prefs pinfo args + where + prefs = Opt.prefs mempty + pinfo = Opt.info p mempty + toEither (Opt.Success a) = Right a + toEither (Opt.Failure f) = Left $ show f + toEither (Opt.CompletionInvoked c) = Left $ show c + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}