diff --git a/CHANGES.md b/CHANGES.md index a4392864..f0635115 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,8 @@ Unreleased ========== * [#145](https://github.com/serokell/xrefcheck/pull/145) + Add check that there is no unknown fields in config. +* [#175](https://github.com/serokell/xrefcheck/pull/175) + + Reorganize top-level config keys. 0.2.1 ========== diff --git a/ftp-tests/Test/Xrefcheck/FtpLinks.hs b/ftp-tests/Test/Xrefcheck/FtpLinks.hs index 56fea15c..73caa377 100644 --- a/ftp-tests/Test/Xrefcheck/FtpLinks.hs +++ b/ftp-tests/Test/Xrefcheck/FtpLinks.hs @@ -15,7 +15,7 @@ import Test.Tasty (TestTree, askOption, testGroup) import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) import Test.Tasty.Options as Tasty (IsOption (..), OptionDescription (Option), safeRead) -import Xrefcheck.Config (Config' (cVerification), VerifyConfig, VerifyConfig' (vcIgnoreRefs), defConfig) +import Xrefcheck.Config (Config' (..), NetworkingConfig, NetworkingConfig' (..), defConfig) import Xrefcheck.Core (Flavor (GitHub)) import Xrefcheck.Verify (VerifyError (..), VerifyResult (VerifyResult), checkExternalResource, verifyErrors) @@ -41,8 +41,8 @@ instance IsOption FtpHostOpt where ) -config :: VerifyConfig -config = (cVerification $ defConfig GitHub) { vcIgnoreRefs = [] } +config :: NetworkingConfig +config = (cNetworking $ defConfig GitHub) { ncIgnoreRefs = [] } test_FtpLinks :: TestTree test_FtpLinks = askOption $ \(FtpHostOpt host) -> do diff --git a/src/Xrefcheck/CLI.hs b/src/Xrefcheck/CLI.hs index 5be9602e..db7e04d1 100644 --- a/src/Xrefcheck/CLI.hs +++ b/src/Xrefcheck/CLI.hs @@ -7,14 +7,15 @@ module Xrefcheck.CLI ( VerifyMode (..) - , shouldCheckLocal - , shouldCheckExternal + , ExclusionOptions (..) , Command (..) , Options (..) - , VerifyOptions (..) - , addVerifyOptions - , TraversalOptions (..) - , addTraversalOptions + , NetworkingOptions (..) + + , addNetworkingOptions + , shouldCheckLocal + , shouldCheckExternal + , addExclusionOptions , defaultConfigPaths , getCommand ) where @@ -33,7 +34,7 @@ import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, re import Options.Applicative.Help.Pretty qualified as Pretty import Paths_xrefcheck (version) -import Xrefcheck.Config (VerifyConfig, VerifyConfig' (..)) +import Xrefcheck.Config (NetworkingConfig, NetworkingConfig' (..)) import Xrefcheck.Core import Xrefcheck.Scan import Xrefcheck.Util (normaliseWithNoTrailing) @@ -69,34 +70,34 @@ data Command | DumpConfig Flavor FilePath data Options = Options - { oConfigPath :: Maybe FilePath - , oRoot :: FilePath - , oMode :: VerifyMode - , oVerbose :: Bool - , oShowProgressBar :: Maybe Bool - , oTraversalOptions :: TraversalOptions - , oVerifyOptions :: VerifyOptions + { oConfigPath :: Maybe FilePath + , oRoot :: FilePath + , oMode :: VerifyMode + , oVerbose :: Bool + , oShowProgressBar :: Maybe Bool + , oExclusionOptions :: ExclusionOptions + , oNetworkingOptions :: NetworkingOptions } -data TraversalOptions = TraversalOptions +data ExclusionOptions = ExclusionOptions { toIgnored :: [RelGlobPattern] } -addTraversalOptions :: TraversalConfig -> TraversalOptions -> TraversalConfig -addTraversalOptions TraversalConfig{..} (TraversalOptions ignored) = - TraversalConfig - { tcIgnored = tcIgnored ++ ignored +addExclusionOptions :: ExclusionConfig -> ExclusionOptions -> ExclusionConfig +addExclusionOptions ExclusionConfig{..} (ExclusionOptions ignored) = + ExclusionConfig + { ecIgnored = ecIgnored ++ ignored , .. } -data VerifyOptions = VerifyOptions - { voMaxRetries :: Maybe Int +data NetworkingOptions = NetworkingOptions + { noMaxRetries :: Maybe Int } -addVerifyOptions :: VerifyConfig -> VerifyOptions -> VerifyConfig -addVerifyOptions VerifyConfig{..} (VerifyOptions maxRetries) = - VerifyConfig - { vcMaxRetries = fromMaybe vcMaxRetries maxRetries +addNetworkingOptions :: NetworkingConfig -> NetworkingOptions -> NetworkingConfig +addNetworkingOptions NetworkingConfig{..} (NetworkingOptions maxRetries) = + NetworkingConfig + { ncMaxRetries = fromMaybe ncMaxRetries maxRetries , .. } @@ -170,29 +171,29 @@ optionsParser = do help "Do not display progress bar during verification." , pure Nothing ] - oTraversalOptions <- traversalOptionsParser - oVerifyOptions <- verifyOptionsParser + oExclusionOptions <- exclusionOptionsParser + oNetworkingOptions <- networkingOptionsParser return Options{..} -traversalOptionsParser :: Parser TraversalOptions -traversalOptionsParser = do +exclusionOptionsParser :: Parser ExclusionOptions +exclusionOptionsParser = do toIgnored <- many . globOption $ long "ignored" <> metavar "GLOB PATTERN" <> help "Files which we pretend do not exist.\ \ Glob patterns that contain wildcards MUST be enclosed\ \ in quotes to avoid being expanded by shell." - return TraversalOptions{..} + return ExclusionOptions{..} -verifyOptionsParser :: Parser VerifyOptions -verifyOptionsParser = do - voMaxRetries <- option (Just <$> auto) $ +networkingOptionsParser :: Parser NetworkingOptions +networkingOptionsParser = do + noMaxRetries <- option (Just <$> auto) $ long "retries" <> metavar "INT" <> value Nothing <> help "How many attempts to retry an external link after getting \ \a \"429 Too Many Requests\" response." - return VerifyOptions{..} + return NetworkingOptions{..} dumpConfigOptions :: Parser Command dumpConfigOptions = hsubparser $ diff --git a/src/Xrefcheck/Command.hs b/src/Xrefcheck/Command.hs index f97afb2d..3e06ea8b 100644 --- a/src/Xrefcheck/Command.hs +++ b/src/Xrefcheck/Command.hs @@ -13,7 +13,7 @@ import Data.Yaml (decodeFileEither, prettyPrintParseException) import Fmt (blockListF', build, fmt, fmtLn, indentF) import System.Directory (doesFileExist) -import Xrefcheck.CLI (Options (..), addTraversalOptions, addVerifyOptions, defaultConfigPaths) +import Xrefcheck.CLI (Options (..), addExclusionOptions, addNetworkingOptions, defaultConfigPaths) import Xrefcheck.Config (Config, Config' (..), ScannersConfig, ScannersConfig' (..), defConfig, normaliseConfigFilePaths, overrideConfig) @@ -59,7 +59,7 @@ defaultAction Options{..} = do let showProgressBar = oShowProgressBar ?: not withinCI (ScanResult scanErrs repoInfo) <- allowRewrite showProgressBar $ \rw -> do - let fullConfig = addTraversalOptions (cTraversal config) oTraversalOptions + let fullConfig = addExclusionOptions (cExclusions config) oExclusionOptions scanRepo rw (formats $ cScanners config) fullConfig oRoot when oVerbose $ @@ -68,7 +68,8 @@ defaultAction Options{..} = do unless (null scanErrs) . reportScanErrs $ sortBy (compare `on` seFile) scanErrs verifyRes <- allowRewrite showProgressBar $ \rw -> do - let fullConfig = addVerifyOptions (cVerification config) oVerifyOptions + let fullConfig = config + { cNetworking = addNetworkingOptions (cNetworking config) oNetworkingOptions } verifyRepo rw fullConfig oMode oRoot repoInfo case verifyErrors verifyRes of diff --git a/src/Xrefcheck/Config.hs b/src/Xrefcheck/Config.hs index e2161890..9e0eaa09 100644 --- a/src/Xrefcheck/Config.hs +++ b/src/Xrefcheck/Config.hs @@ -27,7 +27,6 @@ import Time (KnownRatName, Second, Time(..), unitsP) import Xrefcheck.Core import Xrefcheck.Scan import Xrefcheck.Scanners.Markdown -import Xrefcheck.System (RelGlobPattern, normaliseGlobPattern) import Xrefcheck.Util (aesonConfigOption, postfixFields, (-:), Field) import Xrefcheck.Config.Default import Text.Regex.TDFA.Common @@ -40,58 +39,52 @@ type ConfigOptional = Config' Maybe -- | Overall config. data Config' f = Config - { cTraversal :: Field f (TraversalConfig' f) - , cVerification :: Field f (VerifyConfig' f) - , cScanners :: Field f (ScannersConfig' f) + { cExclusions :: Field f (ExclusionConfig' f) + , cNetworking :: Field f (NetworkingConfig' f) + , cScanners :: Field f (ScannersConfig' f) } deriving stock (Generic) normaliseConfigFilePaths :: Config -> Config normaliseConfigFilePaths Config{..} = Config - { cTraversal = normaliseTraversalConfigFilePaths cTraversal - , cVerification = normaliseVerifyConfigFilePaths cVerification - , cScanners + { cExclusions = normaliseExclusionConfigFilePaths cExclusions + , .. } --- | Type alias for VerifyConfig' with all required fields. -type VerifyConfig = VerifyConfig' Identity - --- | Config of verification. -data VerifyConfig' f = VerifyConfig - { vcAnchorSimilarityThreshold :: Field f Double - , vcExternalRefCheckTimeout :: Field f (Time Second) - , vcVirtualFiles :: Field f [RelGlobPattern] - -- ^ Files which we pretend do exist. - , vcNotScanned :: Field f [RelGlobPattern] - -- ^ Files, references in which we should not analyze. - , vcIgnoreRefs :: Field f [Regex] +-- | Type alias for NetworkingConfig' with all required fields. +type NetworkingConfig = NetworkingConfig' Identity + +-- | Config of networking. +data NetworkingConfig' f = NetworkingConfig + { ncExternalRefCheckTimeout :: Field f (Time Second) + -- ^ When checking external references, how long to wait on request before + -- declaring "Response timeout". + , ncIgnoreRefs :: Field f [Regex] -- ^ Regular expressions that match external references we should not verify. - , vcIgnoreAuthFailures :: Field f Bool + , ncIgnoreAuthFailures :: Field f Bool -- ^ If True - links which return 403 or 401 code will be skipped, -- otherwise – will be marked as broken, because we can't check it. - , vcDefaultRetryAfter :: Field f (Time Second) + , ncDefaultRetryAfter :: Field f (Time Second) -- ^ Default Retry-After delay, applicable when we receive a 429 response -- and it does not contain a @Retry-After@ header. - , vcMaxRetries :: Field f Int + , ncMaxRetries :: Field f Int + -- ^ How many attempts to retry an external link after getting + -- a "429 Too Many Requests" response. } deriving stock (Generic) -normaliseVerifyConfigFilePaths :: VerifyConfig -> VerifyConfig -normaliseVerifyConfigFilePaths vc@VerifyConfig{ vcVirtualFiles, vcNotScanned} - = vc - { vcVirtualFiles = map normaliseGlobPattern vcVirtualFiles - , vcNotScanned = map normaliseGlobPattern vcNotScanned - } - -- | Type alias for ScannersConfig' with all required fields. type ScannersConfig = ScannersConfig' Identity -- | Configs for all the supported scanners. data ScannersConfig' f = ScannersConfig { scMarkdown :: Field f (MarkdownConfig' f) + , scAnchorSimilarityThreshold :: Field f Double + -- ^ On 'anchor not found' error, how much similar anchors should be displayed as + -- hint. Number should be between 0 and 1, larger value means stricter filter. } deriving stock (Generic) makeLensesWith postfixFields ''Config' -makeLensesWith postfixFields ''VerifyConfig' +makeLensesWith postfixFields ''NetworkingConfig' -- | Picks raw config with @:PLACEHOLDER::@ and fills the specified fields -- in it, picking a replacement suitable for the given key. Only strings and lists @@ -209,34 +202,44 @@ defConfig flavor = normaliseConfigFilePaths $ overrideConfig :: ConfigOptional -> Config overrideConfig config = Config - { cTraversal = TraversalConfig ignored - , cVerification = maybe defVerification overrideVerify $ cVerification config - , cScanners = ScannersConfig (MarkdownConfig flavor) + { cExclusions = maybe defExclusions overrideExclusions $ cExclusions config + , cNetworking = maybe defNetworking overrideNetworking $ cNetworking config + , cScanners = ScannersConfig + { scMarkdown = MarkdownConfig flavor + , scAnchorSimilarityThreshold = + fromMaybe (scAnchorSimilarityThreshold defScanners) + $ scAnchorSimilarityThreshold =<< cScanners config + } } where flavor = fromMaybe GitHub $ mcFlavor =<< scMarkdown =<< cScanners config - defTraversal = cTraversal $ defConfig flavor - - ignored = fromMaybe (tcIgnored defTraversal) $ tcIgnored =<< cTraversal config + defScanners = cScanners $ defConfig flavor + defExclusions = cExclusions $ defConfig flavor + defNetworking = cNetworking $ defConfig flavor - defVerification = cVerification $ defConfig flavor - - overrideVerify verifyConfig - = VerifyConfig - { vcAnchorSimilarityThreshold = overrideField vcAnchorSimilarityThreshold - , vcExternalRefCheckTimeout = overrideField vcExternalRefCheckTimeout - , vcVirtualFiles = overrideField vcVirtualFiles - , vcNotScanned = overrideField vcNotScanned - , vcIgnoreRefs = overrideField vcIgnoreRefs - , vcIgnoreAuthFailures = overrideField vcIgnoreAuthFailures - , vcDefaultRetryAfter = overrideField vcDefaultRetryAfter - , vcMaxRetries = overrideField vcMaxRetries + overrideExclusions exclusionConfig + = ExclusionConfig + { ecIgnored = overrideField ecIgnored + , ecVirtualFiles = overrideField ecVirtualFiles + , ecNotScanned = overrideField ecNotScanned + } + where + overrideField :: (forall f. ExclusionConfig' f -> Field f a) -> a + overrideField field = fromMaybe (field defExclusions) $ field exclusionConfig + + overrideNetworking networkingConfig + = NetworkingConfig + { ncExternalRefCheckTimeout = overrideField ncExternalRefCheckTimeout + , ncIgnoreRefs = overrideField ncIgnoreRefs + , ncIgnoreAuthFailures = overrideField ncIgnoreAuthFailures + , ncDefaultRetryAfter = overrideField ncDefaultRetryAfter + , ncMaxRetries = overrideField ncMaxRetries } where - overrideField :: (forall f. VerifyConfig' f -> Field f a) -> a - overrideField field = fromMaybe (field defVerification) $ field verifyConfig + overrideField :: (forall f. NetworkingConfig' f -> Field f a) -> a + overrideField field = fromMaybe (field defNetworking) $ field networkingConfig ----------------------------------------------------------- -- Yaml instances @@ -272,10 +275,10 @@ instance FromJSON (ConfigOptional) where instance FromJSON (Config) where parseJSON = genericParseJSON aesonConfigOption -instance FromJSON (VerifyConfig' Maybe) where +instance FromJSON (NetworkingConfig' Maybe) where parseJSON = genericParseJSON aesonConfigOption -instance FromJSON (VerifyConfig) where +instance FromJSON (NetworkingConfig) where parseJSON = genericParseJSON aesonConfigOption instance FromJSON (ScannersConfig' Maybe) where diff --git a/src/Xrefcheck/Config/Default.hs b/src/Xrefcheck/Config/Default.hs index 8f40464e..898f34ce 100644 --- a/src/Xrefcheck/Config/Default.hs +++ b/src/Xrefcheck/Config/Default.hs @@ -13,8 +13,8 @@ import Text.RawString.QQ defConfigUnfilled :: ByteString defConfigUnfilled = - [r|# Parameters of repository traversal. -traversal: + [r|# Exclusion parameters. +exclusions: # Glob patterns describing files which we pretend do not exist # (so they are neither analyzed nor can be referenced). ignored: @@ -24,16 +24,6 @@ traversal: # Stack files - .stack-work/**/* -# Verification parameters. -verification: - # On 'anchor not found' error, how much similar anchors should be displayed as - # hint. Number should be between 0 and 1, larger value means stricter filter. - anchorSimilarityThreshold: 0.5 - - # When checking external references, how long to wait on request before - # declaring "Response timeout". - externalRefCheckTimeout: 10s - # Glob patterns describing the files, references in which should not be analyzed. notScanned: - :PLACEHOLDER:notScanned: @@ -43,6 +33,12 @@ verification: virtualFiles: - :PLACEHOLDER:virtualFiles: +# Networking parameters. +networking: + # When checking external references, how long to wait on request before + # declaring "Response timeout". + externalRefCheckTimeout: 10s + # POSIX extended regular expressions that match external references # that have to be ignored (not verified). ignoreRefs: @@ -63,6 +59,10 @@ verification: # Parameters of scanners for various file types. scanners: + # On 'anchor not found' error, how much similar anchors should be displayed as + # hint. Number should be between 0 and 1, larger value means stricter filter. + anchorSimilarityThreshold: 0.5 + markdown: # Flavor of markdown, e.g. GitHub-flavor. # diff --git a/src/Xrefcheck/Scan.hs b/src/Xrefcheck/Scan.hs index f8d7c83f..cada5260 100644 --- a/src/Xrefcheck/Scan.hs +++ b/src/Xrefcheck/Scan.hs @@ -6,8 +6,8 @@ -- | Generalised repo scanner and analyser. module Xrefcheck.Scan - ( TraversalConfig - , TraversalConfig' (..) + ( ExclusionConfig + , ExclusionConfig' (..) , Extension , ScanAction , FormatsSupport @@ -15,13 +15,18 @@ module Xrefcheck.Scan , ScanError (..) , ScanResult (..) - , normaliseTraversalConfigFilePaths + , normaliseExclusionConfigFilePaths , scanRepo , specificFormatsSupport + , ecIgnoredL + , ecVirtualFilesL + , ecNotScannedL ) where import Universum + +import Control.Lens (makeLensesWith) import Data.Aeson(FromJSON (..), genericParseJSON) import Data.Foldable qualified as F import Data.Map qualified as M @@ -34,25 +39,36 @@ import System.FilePath (dropTrailingPathSeparator, takeDirectory, takeExtension, import Xrefcheck.Core import Xrefcheck.Progress import Xrefcheck.System (readingSystem, RelGlobPattern, normaliseGlobPattern, matchesGlobPatterns) -import Xrefcheck.Util (aesonConfigOption, normaliseWithNoTrailing, Field) +import Xrefcheck.Util (aesonConfigOption, normaliseWithNoTrailing, Field, postfixFields) --- | Type alias for TraversalConfig' with all required fields. -type TraversalConfig = TraversalConfig' Identity +-- | Type alias for ExclusionConfig' with all required fields. +type ExclusionConfig = ExclusionConfig' Identity --- | Config of repositry traversal. -data TraversalConfig' f = TraversalConfig - { tcIgnored :: Field f [RelGlobPattern] +-- | Config of repositry exclusions. +data ExclusionConfig' f = ExclusionConfig + { ecIgnored :: Field f [RelGlobPattern] -- ^ Files and folders, files in which we completely ignore. + , ecVirtualFiles :: Field f [RelGlobPattern] + -- ^ Files which we pretend do exist. + , ecNotScanned :: Field f [RelGlobPattern] + -- ^ Files, references in which we should not analyze. } deriving stock (Generic) -instance FromJSON (TraversalConfig' Maybe) where +makeLensesWith postfixFields ''ExclusionConfig' + +instance FromJSON (ExclusionConfig' Maybe) where parseJSON = genericParseJSON aesonConfigOption -instance FromJSON (TraversalConfig) where +instance FromJSON (ExclusionConfig) where parseJSON = genericParseJSON aesonConfigOption -normaliseTraversalConfigFilePaths :: TraversalConfig -> TraversalConfig -normaliseTraversalConfigFilePaths = TraversalConfig . map normaliseGlobPattern . tcIgnored +normaliseExclusionConfigFilePaths :: ExclusionConfig -> ExclusionConfig +normaliseExclusionConfigFilePaths ec@ExclusionConfig{..} + = ec + { ecIgnored = map normaliseGlobPattern ecIgnored + , ecVirtualFiles = map normaliseGlobPattern ecVirtualFiles + , ecNotScanned = map normaliseGlobPattern ecNotScanned + } -- | File extension, dot included. type Extension = String @@ -91,7 +107,7 @@ specificFormatsSupport formats = \ext -> M.lookup ext formatsMap scanRepo :: MonadIO m - => Rewrite -> FormatsSupport -> TraversalConfig -> FilePath -> m ScanResult + => Rewrite -> FormatsSupport -> ExclusionConfig -> FilePath -> m ScanResult scanRepo rw formatsSupport config root = do putTextRewrite rw "Scanning repository..." @@ -116,7 +132,7 @@ scanRepo rw formatsSupport config root = do else forM mscanner ($ file) dropSndMaybes l = [(a, b) | (a, Just b) <- l] - isIgnored = matchesGlobPatterns root $ tcIgnored config + isIgnored = matchesGlobPatterns root $ ecIgnored config -- The context location of the root. -- This is done by removing the last component from the path. diff --git a/src/Xrefcheck/Verify.hs b/src/Xrefcheck/Verify.hs index 05528870..070e4ef4 100644 --- a/src/Xrefcheck/Verify.hs +++ b/src/Xrefcheck/Verify.hs @@ -70,6 +70,7 @@ import Xrefcheck.Config import Xrefcheck.Core import Xrefcheck.Orphans () import Xrefcheck.Progress +import Xrefcheck.Scan import Xrefcheck.System import Xrefcheck.Util @@ -245,21 +246,21 @@ forConcurrentlyCaching list needsCaching action = go [] M.empty list verifyRepo :: Rewrite - -> VerifyConfig + -> Config -> VerifyMode -> FilePath -> RepoInfo -> IO (VerifyResult $ WithReferenceLoc VerifyError) verifyRepo rw - config@VerifyConfig{..} + config@Config{..} mode root repoInfo'@(RepoInfo repoInfo) = do let toScan = do (file, fileInfo) <- M.toList repoInfo - guard . not $ matchesGlobPatterns root vcNotScanned file + guard . not $ matchesGlobPatterns root (ecNotScanned cExclusions) file ref <- _fiReferences fileInfo return (file, ref) @@ -292,7 +293,7 @@ shouldCheckLocType mode locType | otherwise = False verifyReference - :: VerifyConfig + :: Config -> VerifyMode -> IORef VerifyProgress -> RepoInfo @@ -301,7 +302,7 @@ verifyReference -> Reference -> IO (VerifyResult $ WithReferenceLoc VerifyError) verifyReference - config@VerifyConfig{..} + Config{..} mode progressRef (RepoInfo repoInfo) @@ -317,7 +318,7 @@ verifyReference (normalise $ takeDirectory fileWithReference toString (canonizeLocalRef rLink)) AbsoluteLoc -> checkRef rAnchor (root <> toString rLink) - ExternalLoc -> checkExternalResource config rLink + ExternalLoc -> checkExternalResource cNetworking rLink OtherLoc -> verifying pass else return mempty where @@ -337,8 +338,8 @@ verifyReference Date date | utcTimeToTimeSecond date >= now -> utcTimeToTimeSecond date -:- now _ -> sec 0 - let toRetry = any isFixable ves && numberOfRetries < vcMaxRetries - currentRetryAfter = fromMaybe vcDefaultRetryAfter $ + let toRetry = any isFixable ves && numberOfRetries < ncMaxRetries cNetworking + currentRetryAfter = fromMaybe (ncDefaultRetryAfter cNetworking) $ extractRetryAfterInfo res <&> toSeconds let moveProgress = alterOverallProgress numberOfRetries @@ -379,17 +380,17 @@ verifyReference -> Progress a -> Progress a alterProgressErrors res@(VerifyResult ves) retryNumber - | vcMaxRetries == 0 = + | (ncMaxRetries cNetworking) == 0 = if ok then id else incProgressUnfixableErrors | retryNumber == 0 = if ok then id else if fixable then incProgressFixableErrors else incProgressUnfixableErrors - | retryNumber == vcMaxRetries = + | retryNumber == (ncMaxRetries cNetworking) = if ok then decProgressFixableErrors else fixableToUnfixable - -- 0 < retryNumber < vcMaxRetries + -- 0 < retryNumber < ncMaxRetries | otherwise = if ok then decProgressFixableErrors else if fixable then id @@ -414,7 +415,7 @@ verifyReference let fileExists = readingSystem $ doesFileExist file let dirExists = readingSystem $ doesDirectoryExist file - let isVirtual = matchesGlobPatterns root vcVirtualFiles file + let isVirtual = matchesGlobPatterns root (ecVirtualFiles cExclusions) file unless (fileExists || dirExists || isVirtual) $ throwError (LocalFileDoesNotExist file) @@ -443,7 +444,7 @@ verifyReference case find ((== anchor) . aName) givenAnchors of Just _ -> pass Nothing -> - let isSimilar = (>= vcAnchorSimilarityThreshold) + let isSimilar = (>= scAnchorSimilarityThreshold cScanners) similarAnchors = filter (isSimilar . realToFrac . damerauLevenshteinNorm anchor . aName) givenAnchors @@ -484,8 +485,8 @@ parseUri link = do & handleJust (fromException @ParseExceptionBs) (throwError . ExternalResourceUriConversionError) -checkExternalResource :: VerifyConfig -> Text -> IO (VerifyResult VerifyError) -checkExternalResource VerifyConfig{..} link +checkExternalResource :: NetworkingConfig -> Text -> IO (VerifyResult VerifyError) +checkExternalResource NetworkingConfig{..} link | isIgnored = return mempty | otherwise = fmap toVerifyRes $ runExceptT $ do uri <- parseUri link @@ -496,7 +497,7 @@ checkExternalResource VerifyConfig{..} link Just "ftps" -> checkFtp uri True _ -> throwError ExternalResourceUnknownProtocol where - isIgnored = doesMatchAnyRegex link vcIgnoreRefs + isIgnored = doesMatchAnyRegex link ncIgnoreRefs doesMatchAnyRegex :: Text -> ([Regex] -> Bool) doesMatchAnyRegex src = any $ \regex -> @@ -533,7 +534,7 @@ checkExternalResource VerifyConfig{..} link runReq defaultHttpConfig $ req method url NoReqBody ignoreResponse option - let maxTime = Time @Second $ unTime vcExternalRefCheckTimeout * timeoutFrac + let maxTime = Time @Second $ unTime ncExternalRefCheckTimeout * timeoutFrac mres <- liftIO (timeout maxTime $ void reqLink) `catch` (either throwError (\() -> return (Just ())) . interpretErrors) @@ -542,7 +543,7 @@ checkExternalResource VerifyConfig{..} link isAllowedErrorCode = or . sequence -- We have to stay conservative - if some URL can be accessed under -- some circumstances, we should do our best to report it as fine. - [ if vcIgnoreAuthFailures -- unauthorized access + [ if ncIgnoreAuthFailures -- unauthorized access then flip elem [403, 401] else const False , (405 ==) -- method mismatch @@ -602,7 +603,7 @@ checkExternalResource VerifyConfig{..} link loginResp <- login handle "anonymous" "" -- check login status when (frStatus loginResp /= Success) $ - if vcIgnoreAuthFailures + if ncIgnoreAuthFailures then pure () else throwError $ ExternalFtpException $ UnsuccessfulException loginResp -- If the response is non-null, the path is definitely a directory; diff --git a/tests/Test/Xrefcheck/ConfigSpec.hs b/tests/Test/Xrefcheck/ConfigSpec.hs index 9dc81019..315abf7b 100644 --- a/tests/Test/Xrefcheck/ConfigSpec.hs +++ b/tests/Test/Xrefcheck/ConfigSpec.hs @@ -19,7 +19,7 @@ import Test.Tasty.QuickCheck (ioProperty, testProperty) import Test.Tasty.HUnit (testCase, assertFailure, (@?=)) -import Xrefcheck.Config (Config, Config' (..), VerifyConfig' (..), defConfig, defConfigText) +import Xrefcheck.Config (Config, Config' (..), NetworkingConfig' (..), defConfig, defConfigText) import Xrefcheck.Core (Flavor (GitHub), allFlavors) import Xrefcheck.Verify (VerifyError (..), VerifyResult (..), checkExternalResource) @@ -46,24 +46,24 @@ test_config = ] ] , testGroup "`ignoreAuthFailures` working as expected" $ - let config = (cVerification $ defConfig GitHub) { vcIgnoreRefs = [] } + let config = (cNetworking $ defConfig GitHub) { ncIgnoreRefs = [] } in [ testCase "when True - assume 401 status is valid" $ - checkLinkWithServer (config { vcIgnoreAuthFailures = True }) + checkLinkWithServer (config { ncIgnoreAuthFailures = True }) "http://127.0.0.1:3000/401" $ VerifyResult [] , testCase "when False - assume 401 status is invalid" $ - checkLinkWithServer (config { vcIgnoreAuthFailures = False }) + checkLinkWithServer (config { ncIgnoreAuthFailures = False }) "http://127.0.0.1:3000/401" $ VerifyResult [ ExternalHttpResourceUnavailable $ Status { statusCode = 401, statusMessage = "Unauthorized" } ] , testCase "when True - assume 403 status is valid" $ - checkLinkWithServer (config { vcIgnoreAuthFailures = True }) + checkLinkWithServer (config { ncIgnoreAuthFailures = True }) "http://127.0.0.1:3000/403" $ VerifyResult [] , testCase "when False - assume 403 status is invalid" $ - checkLinkWithServer (config { vcIgnoreAuthFailures = False }) + checkLinkWithServer (config { ncIgnoreAuthFailures = False }) "http://127.0.0.1:3000/403" $ VerifyResult [ ExternalHttpResourceUnavailable $ Status { statusCode = 403, statusMessage = "Forbidden" } diff --git a/tests/Test/Xrefcheck/IgnoreRegexSpec.hs b/tests/Test/Xrefcheck/IgnoreRegexSpec.hs index 06ae7ed2..91267ee8 100644 --- a/tests/Test/Xrefcheck/IgnoreRegexSpec.hs +++ b/tests/Test/Xrefcheck/IgnoreRegexSpec.hs @@ -37,10 +37,10 @@ test_ignoreRegex = in testGroup "Regular expressions performance" [ testCase "Check that only not matched links are verified" $ do scanResult <- allowRewrite showProgressBar $ \rw -> - scanRepo rw formats (config ^. cTraversalL) root + scanRepo rw formats (config ^. cExclusionsL) root verifyRes <- allowRewrite showProgressBar $ \rw -> - verifyRepo rw (config ^. cVerificationL) verifyMode root $ srRepoInfo scanResult + verifyRepo rw config verifyMode root $ srRepoInfo scanResult let brokenLinks = pickBrokenLinks verifyRes @@ -85,4 +85,4 @@ test_ignoreRegex = in map (either (error . show) id) errOrRegexs setIgnoreRefs :: [Regex] -> Config -> Config - setIgnoreRefs regexs = (cVerificationL . vcIgnoreRefsL) .~ regexs + setIgnoreRefs regexs = (cNetworkingL . ncIgnoreRefsL) .~ regexs diff --git a/tests/Test/Xrefcheck/TooManyRequestsSpec.hs b/tests/Test/Xrefcheck/TooManyRequestsSpec.hs index 739cd047..221ac25b 100644 --- a/tests/Test/Xrefcheck/TooManyRequestsSpec.hs +++ b/tests/Test/Xrefcheck/TooManyRequestsSpec.hs @@ -197,7 +197,7 @@ test_tooManyRequests = testGroup "429 response tests" verifyReferenceWithProgress :: Reference -> IORef VerifyProgress -> IO (VerifyResult VerifyError) verifyReferenceWithProgress reference progRef = do fmap wrlItem <$> verifyReference - ((cVerification $ defConfig GitHub) { vcIgnoreRefs = [] }) FullMode + (defConfig GitHub & cNetworkingL . ncIgnoreRefsL .~ []) FullMode progRef (RepoInfo M.empty) "." "" reference -- | When called for the first time, returns with a 429 and `Retry-After: @retryAfter@`. diff --git a/tests/Test/Xrefcheck/TrailingSlashSpec.hs b/tests/Test/Xrefcheck/TrailingSlashSpec.hs index 3852a95b..09874362 100644 --- a/tests/Test/Xrefcheck/TrailingSlashSpec.hs +++ b/tests/Test/Xrefcheck/TrailingSlashSpec.hs @@ -27,7 +27,7 @@ test_slash = testGroup "Trailing forward slash detection" $ root <> "\" should exist") $ do (ScanResult _ (RepoInfo repoInfo)) <- allowRewrite False $ \rw -> - scanRepo rw format TraversalConfig{ tcIgnored = [] } root + scanRepo rw format (cExclusions config & ecIgnoredL .~ []) root nonExistentFiles <- lefts <$> forM (keys repoInfo) (\filePath -> do predicate <- doesFileExist filePath return $ if predicate diff --git a/tests/configs/github-config.yaml b/tests/configs/github-config.yaml index 6276020f..80a33abf 100644 --- a/tests/configs/github-config.yaml +++ b/tests/configs/github-config.yaml @@ -1,5 +1,5 @@ -# Parameters of repository traversal. -traversal: +# Exclusion parameters. +exclusions: # Glob patterns describing files which we pretend do not exist # (so they are neither analyzed nor can be referenced). ignored: @@ -9,16 +9,6 @@ traversal: # Stack files - .stack-work/**/* -# Verification parameters. -verification: - # On 'anchor not found' error, how much similar anchors should be displayed as - # hint. Number should be between 0 and 1, larger value means stricter filter. - anchorSimilarityThreshold: 0.5 - - # When checking external references, how long to wait on request before - # declaring "Response timeout". - externalRefCheckTimeout: 10s - # Glob patterns describing the files, references in which should not be analyzed. notScanned: - .github/pull_request_template.md @@ -34,6 +24,12 @@ verification: - ../../../pulls - ../../../pulls/* +# Networking parameters. +networking: + # When checking external references, how long to wait on request before + # declaring "Response timeout". + externalRefCheckTimeout: 10s + # POSIX extended regular expressions that match external references # that have to be ignored (not verified). ignoreRefs: @@ -54,6 +50,10 @@ verification: # Parameters of scanners for various file types. scanners: + # On 'anchor not found' error, how much similar anchors should be displayed as + # hint. Number should be between 0 and 1, larger value means stricter filter. + anchorSimilarityThreshold: 0.5 + markdown: # Flavor of markdown, e.g. GitHub-flavor. # diff --git a/tests/golden/check-cli/config-no-scan-ignored.yaml b/tests/golden/check-cli/config-no-scan-ignored.yaml index f494ff77..752dd336 100644 --- a/tests/golden/check-cli/config-no-scan-ignored.yaml +++ b/tests/golden/check-cli/config-no-scan-ignored.yaml @@ -2,5 +2,5 @@ # # SPDX-License-Identifier: Unlicense -verification: +exclusions: notScanned: [ "to-ignore/broken-link.md" ] diff --git a/tests/golden/check-ignoreRefs/config-check-disabled.yaml b/tests/golden/check-ignoreRefs/config-check-disabled.yaml index 35a20d15..42a0d6d6 100644 --- a/tests/golden/check-ignoreRefs/config-check-disabled.yaml +++ b/tests/golden/check-ignoreRefs/config-check-disabled.yaml @@ -2,6 +2,6 @@ # # SPDX-License-Identifier: Unlicense -verification: +networking: ignoreRefs: - ^(https?|ftps?)://(localhost|127\.0\.0\.1).* diff --git a/tests/golden/check-ignoreRefs/config-check-enabled.yaml b/tests/golden/check-ignoreRefs/config-check-enabled.yaml index 2fe0cf0e..eec6fe44 100644 --- a/tests/golden/check-ignoreRefs/config-check-enabled.yaml +++ b/tests/golden/check-ignoreRefs/config-check-enabled.yaml @@ -2,5 +2,5 @@ # # SPDX-License-Identifier: Unlicense -verification: +networking: ignoreRefs: [] diff --git a/tests/golden/check-ignored/config-ignored.yaml b/tests/golden/check-ignored/config-ignored.yaml index b911b566..b9a91466 100644 --- a/tests/golden/check-ignored/config-ignored.yaml +++ b/tests/golden/check-ignored/config-ignored.yaml @@ -2,6 +2,6 @@ # # SPDX-License-Identifier: Unlicense -traversal: +exclusions: ignored: - ./to-ignore/inner-directory/broken_annotation.md diff --git a/tests/golden/check-notScanned/config-directory.yaml b/tests/golden/check-notScanned/config-directory.yaml index 7bd99eaa..c2675d27 100644 --- a/tests/golden/check-notScanned/config-directory.yaml +++ b/tests/golden/check-notScanned/config-directory.yaml @@ -2,6 +2,6 @@ # # SPDX-License-Identifier: Unlicense -verification: +exclusions: notScanned: - notScanned/inner-directory diff --git a/tests/golden/check-notScanned/config-full-path.yaml b/tests/golden/check-notScanned/config-full-path.yaml index a0529839..6513746d 100644 --- a/tests/golden/check-notScanned/config-full-path.yaml +++ b/tests/golden/check-notScanned/config-full-path.yaml @@ -2,6 +2,6 @@ # # SPDX-License-Identifier: Unlicense -verification: +exclusions: notScanned: - ./notScanned/inner-directory/bad-reference.md diff --git a/tests/golden/check-notScanned/config-nested-directories.yaml b/tests/golden/check-notScanned/config-nested-directories.yaml index c8eb3a4e..3bf33d5b 100644 --- a/tests/golden/check-notScanned/config-nested-directories.yaml +++ b/tests/golden/check-notScanned/config-nested-directories.yaml @@ -2,6 +2,6 @@ # # SPDX-License-Identifier: Unlicense -verification: +exclusions: notScanned: - ./**/* diff --git a/tests/golden/check-notScanned/config-wildcard.yaml b/tests/golden/check-notScanned/config-wildcard.yaml index f867ff81..a8500a28 100644 --- a/tests/golden/check-notScanned/config-wildcard.yaml +++ b/tests/golden/check-notScanned/config-wildcard.yaml @@ -2,6 +2,6 @@ # # SPDX-License-Identifier: Unlicense -verification: +exclusions: notScanned: - ./notScanned/inner-directory/* diff --git a/tests/golden/check-virtualFiles/config-virtualFiles.yaml b/tests/golden/check-virtualFiles/config-virtualFiles.yaml index 65ecf5f1..0259d552 100644 --- a/tests/golden/check-virtualFiles/config-virtualFiles.yaml +++ b/tests/golden/check-virtualFiles/config-virtualFiles.yaml @@ -2,7 +2,7 @@ # # SPDX-License-Identifier: Unlicense -verification: +exclusions: virtualFiles: - ./one/a.md - ./two/*