mirror of
https://github.com/serokell/xrefcheck.git
synced 2024-10-26 15:35:29 +03:00
[#149] Replace hspec with tasty
Problem: `hspec` and `tasty` are testing frameworks with almost same functionality, for historical reasons in xrefcheck we used different frameworks for tests and links-tests, and in Serokell we prefer `tasty` now. Solution: use only `tasty`, rewrite code that use `hspec` using correspondance between - `testGroup` and `describe` - `testCase` and `it` - `shouldBe` and `@?=`
This commit is contained in:
parent
955e0ea9cf
commit
b412781020
@ -4,7 +4,7 @@ Files: .github/pull_request_template.md .github/ISSUE_TEMPLATE/*.md
|
|||||||
Copyright: 2018-2019 Serokell <https://serokell.io>
|
Copyright: 2018-2019 Serokell <https://serokell.io>
|
||||||
License: Unlicense
|
License: Unlicense
|
||||||
|
|
||||||
Files: links-tests/ftp_root/**/*
|
Files: ftp-tests/ftp_root/**/*
|
||||||
Copyright: 2021 Serokell <https://serokell.io>
|
Copyright: 2021 Serokell <https://serokell.io>
|
||||||
License: Unlicense
|
License: Unlicense
|
||||||
|
|
||||||
|
14
package.yaml
14
package.yaml
@ -133,6 +133,7 @@ tests:
|
|||||||
xrefcheck-tests:
|
xrefcheck-tests:
|
||||||
main: Main.hs
|
main: Main.hs
|
||||||
source-dirs: tests
|
source-dirs: tests
|
||||||
|
build-tools: tasty-discover:tasty-discover
|
||||||
generated-other-modules:
|
generated-other-modules:
|
||||||
- Paths_xrefcheck
|
- Paths_xrefcheck
|
||||||
dependencies:
|
dependencies:
|
||||||
@ -140,28 +141,25 @@ tests:
|
|||||||
- containers
|
- containers
|
||||||
- cmark-gfm
|
- cmark-gfm
|
||||||
- firefly
|
- firefly
|
||||||
- hspec
|
|
||||||
- hspec-expectations
|
|
||||||
- QuickCheck
|
|
||||||
- xrefcheck
|
- xrefcheck
|
||||||
- bytestring
|
- bytestring
|
||||||
- directory
|
- directory
|
||||||
- fmt
|
- fmt
|
||||||
- http-types
|
- http-types
|
||||||
- HUnit
|
|
||||||
- o-clock
|
- o-clock
|
||||||
- regex-tdfa
|
- regex-tdfa
|
||||||
|
- tasty
|
||||||
|
- tasty-hunit
|
||||||
|
- tasty-quickcheck
|
||||||
- time
|
- time
|
||||||
- universum
|
- universum
|
||||||
- modern-uri
|
- modern-uri
|
||||||
- uri-bytestring
|
- uri-bytestring
|
||||||
- yaml
|
- yaml
|
||||||
build-tools:
|
|
||||||
- hspec-discover
|
|
||||||
|
|
||||||
links-tests:
|
ftp-tests:
|
||||||
main: Main.hs
|
main: Main.hs
|
||||||
source-dirs: links-tests
|
source-dirs: ftp-tests
|
||||||
build-tools: tasty-discover:tasty-discover
|
build-tools: tasty-discover:tasty-discover
|
||||||
generated-other-modules:
|
generated-other-modules:
|
||||||
- Paths_xrefcheck
|
- Paths_xrefcheck
|
||||||
|
@ -1,12 +1,15 @@
|
|||||||
{- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
|
-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
|
||||||
-
|
--
|
||||||
- SPDX-License-Identifier: MPL-2.0
|
-- SPDX-License-Identifier: MPL-2.0
|
||||||
-}
|
|
||||||
|
module Main
|
||||||
|
( main
|
||||||
|
) where
|
||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Spec (spec)
|
import Test.Tasty
|
||||||
import Test.Hspec (hspec)
|
import Tree (tests)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec spec
|
main = tests >>= defaultMain
|
||||||
|
@ -1,6 +0,0 @@
|
|||||||
{- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
|
|
||||||
-
|
|
||||||
- SPDX-License-Identifier: MPL-2.0
|
|
||||||
-}
|
|
||||||
|
|
||||||
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
|
|
@ -7,21 +7,21 @@ module Test.Xrefcheck.AnchorsInHeadersSpec where
|
|||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
|
import Test.Tasty.HUnit (testCase, (@?=))
|
||||||
|
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Test.Xrefcheck.Util
|
import Test.Xrefcheck.Util
|
||||||
|
|
||||||
spec :: Spec
|
test_anchorsInHeaders :: TestTree
|
||||||
spec = do
|
test_anchorsInHeaders = testGroup "Anchors in headers"
|
||||||
describe "Anchors in headers" $ do
|
[ testCase "Check if anchors in headers are recognized" $ do
|
||||||
it "Check if anchors in headers are recognized" $ do
|
fi <- getFI GitHub "tests/markdowns/without-annotations/anchors_in_headers.md"
|
||||||
fi <- getFI GitHub "tests/markdowns/without-annotations/anchors_in_headers.md"
|
getAnchors fi @?= ["some-stuff", "stuff-section"]
|
||||||
getAnchors fi `shouldBe` ["some-stuff", "stuff-section"]
|
, testCase "Check if anchors with id attributes are recognized" $ do
|
||||||
|
fi <- getFI GitHub "tests/markdowns/without-annotations/anchors_in_headers_with_id_attribute.md"
|
||||||
it "Check if anchors with id attributes are recognized" $ do
|
getAnchors fi @?= ["some-stuff-with-id-attribute", "stuff-section-with-id-attribute"]
|
||||||
fi <- getFI GitHub "tests/markdowns/without-annotations/anchors_in_headers_with_id_attribute.md"
|
]
|
||||||
getAnchors fi `shouldBe` ["some-stuff-with-id-attribute", "stuff-section-with-id-attribute"]
|
where
|
||||||
where
|
getAnchors :: FileInfo -> [Text]
|
||||||
getAnchors :: FileInfo -> [Text]
|
getAnchors fi = map aName $ fi ^. fiAnchors
|
||||||
getAnchors fi = map aName $ fi ^. fiAnchors
|
|
||||||
|
@ -3,37 +3,36 @@
|
|||||||
- SPDX-License-Identifier: MPL-2.0
|
- SPDX-License-Identifier: MPL-2.0
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Test.Xrefcheck.AnchorsSpec (spec) where
|
module Test.Xrefcheck.AnchorsSpec (test_anchors) where
|
||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
import Test.Tasty (testGroup, TestTree)
|
||||||
import Test.QuickCheck ((===))
|
import Test.Tasty.HUnit ((@?=), testCase)
|
||||||
|
|
||||||
import Test.Xrefcheck.Util
|
import Test.Xrefcheck.Util
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
|
|
||||||
checkHeaderConversions
|
checkHeaderConversions :: Flavor -> [(Text, Text)] -> TestTree
|
||||||
:: HasCallStack
|
|
||||||
=> Flavor -> [(Text, Text)] -> Spec
|
|
||||||
checkHeaderConversions fl suites =
|
checkHeaderConversions fl suites =
|
||||||
describe (show fl) $ do
|
testGroup (show fl) $
|
||||||
forM_ suites $ \(a, b) ->
|
[testCase (show a <> " == " <> show b) $ headerToAnchor fl a @?= b | (a,b) <- suites]
|
||||||
it (show a <> " == " <> show b) $ headerToAnchor fl a === b
|
++
|
||||||
it "Non-stripped header name should be stripped" $ do
|
[ testCase "Non-stripped header name should be stripped" $ do
|
||||||
fi <- getFI fl "tests/markdowns/without-annotations/non_stripped_spaces.md"
|
fi <- getFI fl "tests/markdowns/without-annotations/non_stripped_spaces.md"
|
||||||
getAnchors fi `shouldBe` [ case fl of GitHub -> "header--with-leading-spaces"
|
getAnchors fi @?= [ case fl of GitHub -> "header--with-leading-spaces"
|
||||||
GitLab -> "header-with-leading-spaces"
|
GitLab -> "header-with-leading-spaces"
|
||||||
, "edge-case"
|
, "edge-case"
|
||||||
]
|
]
|
||||||
|
]
|
||||||
where
|
where
|
||||||
getAnchors :: FileInfo -> [Text]
|
getAnchors :: FileInfo -> [Text]
|
||||||
getAnchors fi = map aName $ fi ^. fiAnchors
|
getAnchors fi = map aName $ fi ^. fiAnchors
|
||||||
|
|
||||||
spec :: Spec
|
test_anchors :: TestTree
|
||||||
spec = do
|
test_anchors = do
|
||||||
describe "Header-to-anchor conversion" $ do
|
testGroup "Header-to-anchor conversion"
|
||||||
checkHeaderConversions GitHub
|
[ checkHeaderConversions GitHub
|
||||||
[ ( "Some header"
|
[ ( "Some header"
|
||||||
, "some-header"
|
, "some-header"
|
||||||
)
|
)
|
||||||
@ -92,8 +91,7 @@ spec = do
|
|||||||
, "white_check_mark-checklist-for-your-pull-request"
|
, "white_check_mark-checklist-for-your-pull-request"
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
, checkHeaderConversions GitLab
|
||||||
checkHeaderConversions GitLab
|
|
||||||
[ ( "a # b"
|
[ ( "a # b"
|
||||||
, "a-b"
|
, "a-b"
|
||||||
)
|
)
|
||||||
@ -134,3 +132,4 @@ spec = do
|
|||||||
, "white_check_mark-checklist-for-your-pull-request"
|
, "white_check_mark-checklist-for-your-pull-request"
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
]
|
||||||
|
@ -12,63 +12,63 @@ import Control.Exception qualified as E
|
|||||||
|
|
||||||
import Data.ByteString qualified as BS
|
import Data.ByteString qualified as BS
|
||||||
import Network.HTTP.Types (Status (..))
|
import Network.HTTP.Types (Status (..))
|
||||||
import Test.Hspec (Spec, before, describe, it, shouldBe)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Hspec.Expectations (expectationFailure)
|
import Test.Tasty.QuickCheck (ioProperty, testProperty)
|
||||||
import Test.QuickCheck (ioProperty, once)
|
|
||||||
|
|
||||||
import Xrefcheck.Config (Config, Config' (..), VerifyConfig' (..), defConfig, defConfigText)
|
import Xrefcheck.Config (Config, Config' (..), VerifyConfig' (..), defConfig, defConfigText)
|
||||||
import Xrefcheck.Core (Flavor (GitHub), allFlavors)
|
import Xrefcheck.Core (Flavor (GitHub), allFlavors)
|
||||||
import Xrefcheck.Verify (VerifyError (..), VerifyResult (..), checkExternalResource)
|
import Xrefcheck.Verify (VerifyError (..), VerifyResult (..), checkExternalResource)
|
||||||
|
|
||||||
import Test.Xrefcheck.Util (mockServer)
|
import Test.Xrefcheck.Util (mockServer)
|
||||||
|
import Test.Tasty.HUnit (testCase, assertFailure, (@?=))
|
||||||
|
|
||||||
spec :: Spec
|
test_config :: [TestTree]
|
||||||
spec = do
|
test_config =
|
||||||
describe "Default config is valid" $
|
[ testGroup "Default config is valid" [
|
||||||
forM_ allFlavors $ \flavor ->
|
testProperty (show flavor) $
|
||||||
it (show flavor) $
|
ioProperty $ evaluateWHNF_ @_ @Config (defConfig flavor)
|
||||||
once . ioProperty $ evaluateWHNF_ @_ @Config (defConfig flavor)
|
| flavor <- allFlavors]
|
||||||
|
|
||||||
describe "Filled default config matches the expected format" $
|
, testGroup "Filled default config matches the expected format" [
|
||||||
before (BS.readFile "tests/configs/github-config.yaml") $
|
-- The config we match against can be regenerated with
|
||||||
-- The config we match against can be regenerated with
|
-- stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml
|
||||||
-- stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml
|
testCase "Config matches" $ do
|
||||||
it "Config matches" $
|
config <- BS.readFile "tests/configs/github-config.yaml"
|
||||||
\config ->
|
when (config /= defConfigText GitHub) $
|
||||||
when (config /= defConfigText GitHub) $
|
assertFailure $ toString $ unwords
|
||||||
expectationFailure $ toString $ unwords
|
[ "Config does not match the expected format."
|
||||||
[ "Config does not match the expected format."
|
, "Run"
|
||||||
, "Run"
|
, "`stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml`"
|
||||||
, "`stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml`"
|
, "and verify changes"
|
||||||
, "and verify changes"
|
]
|
||||||
|
]
|
||||||
|
, testGroup "`ignoreAuthFailures` working as expected" $
|
||||||
|
let config = (cVerification $ defConfig GitHub) { vcIgnoreRefs = [] }
|
||||||
|
in [ testCase "when True - assume 401 status is valid" $
|
||||||
|
checkLinkWithServer (config { vcIgnoreAuthFailures = True })
|
||||||
|
"http://127.0.0.1:3000/401" $ VerifyResult []
|
||||||
|
|
||||||
|
, testCase "when False - assume 401 status is invalid" $
|
||||||
|
checkLinkWithServer (config { vcIgnoreAuthFailures = False })
|
||||||
|
"http://127.0.0.1:3000/401" $ VerifyResult
|
||||||
|
[ ExternalHttpResourceUnavailable $
|
||||||
|
Status { statusCode = 401, statusMessage = "Unauthorized" }
|
||||||
]
|
]
|
||||||
|
|
||||||
describe "`ignoreAuthFailures` working as expected" $ do
|
, testCase "when True - assume 403 status is valid" $
|
||||||
let config = (cVerification $ defConfig GitHub) { vcIgnoreRefs = [] }
|
checkLinkWithServer (config { vcIgnoreAuthFailures = True })
|
||||||
|
"http://127.0.0.1:3000/403" $ VerifyResult []
|
||||||
|
|
||||||
it "when True - assume 401 status is valid" $
|
, testCase "when False - assume 403 status is invalid" $
|
||||||
checkLinkWithServer (config { vcIgnoreAuthFailures = True })
|
checkLinkWithServer (config { vcIgnoreAuthFailures = False })
|
||||||
"http://127.0.0.1:3000/401" $ VerifyResult []
|
"http://127.0.0.1:3000/403" $ VerifyResult
|
||||||
|
[ ExternalHttpResourceUnavailable $
|
||||||
it "when False - assume 401 status is invalid" $
|
Status { statusCode = 403, statusMessage = "Forbidden" }
|
||||||
checkLinkWithServer (config { vcIgnoreAuthFailures = False })
|
]
|
||||||
"http://127.0.0.1:3000/401" $ VerifyResult
|
]
|
||||||
[ ExternalHttpResourceUnavailable $
|
]
|
||||||
Status { statusCode = 401, statusMessage = "Unauthorized" }
|
|
||||||
]
|
|
||||||
|
|
||||||
it "when True - assume 403 status is valid" $
|
|
||||||
checkLinkWithServer (config { vcIgnoreAuthFailures = True })
|
|
||||||
"http://127.0.0.1:3000/403" $ VerifyResult []
|
|
||||||
|
|
||||||
it "when False - assume 403 status is invalid" $
|
|
||||||
checkLinkWithServer (config { vcIgnoreAuthFailures = False })
|
|
||||||
"http://127.0.0.1:3000/403" $ VerifyResult
|
|
||||||
[ ExternalHttpResourceUnavailable $
|
|
||||||
Status { statusCode = 403, statusMessage = "Forbidden" }
|
|
||||||
]
|
|
||||||
where
|
where
|
||||||
checkLinkWithServer config link expectation =
|
checkLinkWithServer config link expectation =
|
||||||
E.bracket (forkIO mockServer) killThread $ \_ -> do
|
E.bracket (forkIO mockServer) killThread $ \_ -> do
|
||||||
result <- checkExternalResource config link
|
result <- checkExternalResource config link
|
||||||
result `shouldBe` expectation
|
result @?= expectation
|
||||||
|
@ -7,46 +7,52 @@ module Test.Xrefcheck.IgnoreAnnotationsSpec where
|
|||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import CMarkGFM (PosInfo (..))
|
import CMarkGFM (PosInfo(..))
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe, shouldReturn)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
|
import Test.Tasty.HUnit (testCase, (@?=))
|
||||||
|
|
||||||
import Test.Xrefcheck.Util
|
import Test.Xrefcheck.Util
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
import Xrefcheck.Scanners.Markdown
|
import Xrefcheck.Scanners.Markdown
|
||||||
|
|
||||||
spec :: Spec
|
test_ignoreAnnotations :: [TestTree]
|
||||||
spec = do
|
test_ignoreAnnotations =
|
||||||
describe "Parsing failures" $ do
|
[ testGroup "Parsing failures"
|
||||||
it "Check if broken link annotation produce error" do
|
[ testCase "Check if broken link annotation produce error" do
|
||||||
let file = "tests/markdowns/with-annotations/no_link.md"
|
let file = "tests/markdowns/with-annotations/no_link.md"
|
||||||
getErrs file `shouldReturn`
|
errs <- getErrs file
|
||||||
makeError (Just $ PosInfo 7 1 7 31) file Link ""
|
errs @?= makeError (Just $ PosInfo 7 1 7 31) file Link ""
|
||||||
it "Check if broken paragraph annotation produce error" do
|
, testCase "Check if broken paragraph annotation produce error" do
|
||||||
let file = "tests/markdowns/with-annotations/no_paragraph.md"
|
let file = "tests/markdowns/with-annotations/no_paragraph.md"
|
||||||
getErrs file `shouldReturn`
|
errs <- getErrs file
|
||||||
makeError (Just $ PosInfo 7 1 7 35) file Paragraph "HEADING"
|
errs @?= makeError (Just $ PosInfo 7 1 7 35) file Paragraph "HEADING"
|
||||||
it "Check if broken ignore file annotation produce error" do
|
, testCase "Check if broken ignore file annotation produce error" do
|
||||||
let file = "tests/markdowns/with-annotations/unexpected_ignore_file.md"
|
let file = "tests/markdowns/with-annotations/unexpected_ignore_file.md"
|
||||||
getErrs file `shouldReturn`
|
errs <- getErrs file
|
||||||
makeError (Just $ PosInfo 9 1 9 30) file File ""
|
errs @?= makeError (Just $ PosInfo 9 1 9 30) file File ""
|
||||||
it "Check if broken unrecognised annotation produce error" do
|
, testCase "Check if broken unrecognised annotation produce error" do
|
||||||
let file = "tests/markdowns/with-annotations/unrecognised_option.md"
|
let file = "tests/markdowns/with-annotations/unrecognised_option.md"
|
||||||
getErrs file `shouldReturn`
|
errs <- getErrs file
|
||||||
makeError (Just $ PosInfo 7 1 7 46) file None "unrecognised-option"
|
errs @?= makeError (Just $ PosInfo 7 1 7 46) file None "unrecognised-option"
|
||||||
describe "\"ignore link\" mode" $ do
|
]
|
||||||
it "Check \"ignore link\" performance" $ do
|
, testGroup "\"ignore link\" mode"
|
||||||
fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_link.md"
|
[ testCase "Check \"ignore link\" performance" $ do
|
||||||
getRefs fi `shouldBe`
|
fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_link.md"
|
||||||
["team", "team", "team", "hire-us", "how-we-work", "privacy", "link2", "link2"]
|
getRefs fi @?=
|
||||||
describe "\"ignore paragraph\" mode" $ do
|
["team", "team", "team", "hire-us", "how-we-work", "privacy", "link2", "link2"]
|
||||||
it "Check \"ignore paragraph\" performance" $ do
|
]
|
||||||
fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_paragraph.md"
|
, testGroup "\"ignore paragraph\" mode"
|
||||||
getRefs fi `shouldBe` ["blog", "contacts"]
|
[ testCase "Check \"ignore paragraph\" performance" $ do
|
||||||
describe "\"ignore file\" mode" $ do
|
fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_paragraph.md"
|
||||||
it "Check \"ignore file\" performance" $ do
|
getRefs fi @?= ["blog", "contacts"]
|
||||||
fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_file.md"
|
]
|
||||||
getRefs fi `shouldBe` []
|
, testGroup "\"ignore file\" mode"
|
||||||
|
[ testCase "Check \"ignore file\" performance" $ do
|
||||||
|
fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_file.md"
|
||||||
|
getRefs fi @?= []
|
||||||
|
]
|
||||||
|
]
|
||||||
where
|
where
|
||||||
getRefs :: FileInfo -> [Text]
|
getRefs :: FileInfo -> [Text]
|
||||||
getRefs fi = map rName $ fi ^. fiReferences
|
getRefs fi = map rName $ fi ^. fiReferences
|
||||||
|
@ -8,8 +8,8 @@ module Test.Xrefcheck.IgnoreRegexSpec where
|
|||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Data.Yaml (decodeEither')
|
import Data.Yaml (decodeEither')
|
||||||
import Test.HUnit (assertFailure)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Hspec (Spec, describe, it)
|
import Test.Tasty.HUnit (testCase, assertFailure)
|
||||||
import Text.Regex.TDFA (Regex)
|
import Text.Regex.TDFA (Regex)
|
||||||
|
|
||||||
import Xrefcheck.Config
|
import Xrefcheck.Config
|
||||||
@ -19,22 +19,23 @@ import Xrefcheck.Scan (scanRepo, specificFormatsSupport, ScanResult (..))
|
|||||||
import Xrefcheck.Scanners.Markdown
|
import Xrefcheck.Scanners.Markdown
|
||||||
import Xrefcheck.Verify (VerifyError, VerifyResult, WithReferenceLoc (..), verifyErrors, verifyRepo)
|
import Xrefcheck.Verify (VerifyError, VerifyResult, WithReferenceLoc (..), verifyErrors, verifyRepo)
|
||||||
|
|
||||||
spec :: Spec
|
test_ignoreRegex :: TestTree
|
||||||
spec = do
|
test_ignoreRegex =
|
||||||
describe "Regular expressions performance" $ do
|
let root = "tests/markdowns/without-annotations"
|
||||||
let root = "tests/markdowns/without-annotations"
|
showProgressBar = False
|
||||||
let showProgressBar = False
|
formats = specificFormatsSupport [markdownSupport defGithubMdConfig]
|
||||||
let formats = specificFormatsSupport [markdownSupport defGithubMdConfig]
|
verifyMode = ExternalOnlyMode
|
||||||
let verifyMode = ExternalOnlyMode
|
|
||||||
|
|
||||||
let linksTxt =
|
linksTxt =
|
||||||
[ "https://bad.((external.)?)reference(/?)"
|
[ "https://bad.((external.)?)reference(/?)"
|
||||||
, "https://bad.reference.(org|com)"
|
, "https://bad.reference.(org|com)"
|
||||||
]
|
]
|
||||||
let regexs = linksToRegexs linksTxt
|
regexs = linksToRegexs linksTxt
|
||||||
let config = setIgnoreRefs regexs (defConfig GitHub)
|
config = setIgnoreRefs regexs (defConfig GitHub)
|
||||||
|
|
||||||
it "Check that only not matched links are verified" $ do
|
|
||||||
|
in testGroup "Regular expressions performance"
|
||||||
|
[ testCase "Check that only not matched links are verified" $ do
|
||||||
scanResult <- allowRewrite showProgressBar $ \rw ->
|
scanResult <- allowRewrite showProgressBar $ \rw ->
|
||||||
scanRepo rw formats (config ^. cTraversalL) root
|
scanRepo rw formats (config ^. cTraversalL) root
|
||||||
|
|
||||||
@ -69,6 +70,7 @@ spec = do
|
|||||||
assertFailure $
|
assertFailure $
|
||||||
"Link \"" <> show link <>
|
"Link \"" <> show link <>
|
||||||
"\" is not considered as broken but it is (and shouldn't be ignored)"
|
"\" is not considered as broken but it is (and shouldn't be ignored)"
|
||||||
|
]
|
||||||
|
|
||||||
where
|
where
|
||||||
pickBrokenLinks :: VerifyResult (WithReferenceLoc VerifyError) -> [Text]
|
pickBrokenLinks :: VerifyResult (WithReferenceLoc VerifyError) -> [Text]
|
||||||
|
@ -7,19 +7,19 @@ module Test.Xrefcheck.LocalSpec where
|
|||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Test.Hspec (Spec, describe, it)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.QuickCheck ((===))
|
import Test.Tasty.HUnit (testCase, (@?=))
|
||||||
|
|
||||||
import Xrefcheck.Core (canonizeLocalRef)
|
import Xrefcheck.Core (canonizeLocalRef)
|
||||||
|
|
||||||
spec :: Spec
|
test_local_refs_canonizing :: TestTree
|
||||||
spec = do
|
test_local_refs_canonizing = testGroup "Local refs canonizing" $
|
||||||
describe "Local refs canonizing" $ do
|
[ testCase "Strips ./" $
|
||||||
it "Strips ./" $
|
canonizeLocalRef "./AnchorsSpec.hs" @?= "AnchorsSpec.hs"
|
||||||
canonizeLocalRef "./AnchorsSpec.hs" === "AnchorsSpec.hs"
|
|
||||||
|
|
||||||
it "Strips ././" $
|
, testCase "Strips ././" $
|
||||||
canonizeLocalRef "././AnchorsSpec.hs" === "AnchorsSpec.hs"
|
canonizeLocalRef "././AnchorsSpec.hs" @?= "AnchorsSpec.hs"
|
||||||
|
|
||||||
it "Leaves plain other intact" $
|
, testCase "Leaves plain other intact" $
|
||||||
canonizeLocalRef "../AnchorsSpec.hs" === "../AnchorsSpec.hs"
|
canonizeLocalRef "../AnchorsSpec.hs" @?= "../AnchorsSpec.hs"
|
||||||
|
]
|
||||||
|
@ -16,8 +16,8 @@ import Data.Time.Clock.POSIX (getPOSIXTime)
|
|||||||
import Fmt (indentF, pretty, unlinesF)
|
import Fmt (indentF, pretty, unlinesF)
|
||||||
import Network.HTTP.Types (Status (..), ok200, serviceUnavailable503, tooManyRequests429)
|
import Network.HTTP.Types (Status (..), ok200, serviceUnavailable503, tooManyRequests429)
|
||||||
import Network.HTTP.Types.Header (hRetryAfter)
|
import Network.HTTP.Types.Header (hRetryAfter)
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
import Test.Tasty (testGroup, TestTree)
|
||||||
import Test.HUnit (assertBool)
|
import Test.Tasty.HUnit (testCase, (@?=), assertBool)
|
||||||
import Time (sec, (-:-))
|
import Time (sec, (-:-))
|
||||||
import Web.Firefly (ToResponse (toResponse), route, run, getMethod)
|
import Web.Firefly (ToResponse (toResponse), route, run, getMethod)
|
||||||
|
|
||||||
@ -27,19 +27,18 @@ import Xrefcheck.Progress
|
|||||||
import Xrefcheck.Util
|
import Xrefcheck.Util
|
||||||
import Xrefcheck.Verify
|
import Xrefcheck.Verify
|
||||||
|
|
||||||
spec :: Spec
|
test_tooManyRequests :: TestTree
|
||||||
spec = do
|
test_tooManyRequests = testGroup "429 response tests"
|
||||||
describe "429 response tests" $ do
|
[ testCase "Returns 200 eventually" $ do
|
||||||
it "Returns 200 eventually" $ do
|
|
||||||
let prog = Progress{ pTotal = 1
|
let prog = Progress{ pTotal = 1
|
||||||
, pCurrent = 1
|
, pCurrent = 1
|
||||||
, pErrorsUnfixable = 0
|
, pErrorsUnfixable = 0
|
||||||
, pErrorsFixable = 0
|
, pErrorsFixable = 0
|
||||||
, pTaskTimestamp = Nothing
|
, pTaskTimestamp = Nothing
|
||||||
}
|
}
|
||||||
checkLinkAndProgressWithServer (mock429 "1" ok200)
|
checkLinkAndProgressWithServer (mock429 "1" ok200)
|
||||||
"http://127.0.0.1:5000/429" prog $ VerifyResult []
|
"http://127.0.0.1:5000/429" prog $ VerifyResult []
|
||||||
it "Returns 503 eventually" $ do
|
, testCase "Returns 503 eventually" $ do
|
||||||
let prog = Progress{ pTotal = 1
|
let prog = Progress{ pTotal = 1
|
||||||
, pCurrent = 1
|
, pCurrent = 1
|
||||||
, pErrorsUnfixable = 1
|
, pErrorsUnfixable = 1
|
||||||
@ -51,7 +50,7 @@ spec = do
|
|||||||
[ ExternalHttpResourceUnavailable $
|
[ ExternalHttpResourceUnavailable $
|
||||||
Status { statusCode = 503, statusMessage = "Service Unavailable"}
|
Status { statusCode = 503, statusMessage = "Service Unavailable"}
|
||||||
]
|
]
|
||||||
it "Successfully updates the new retry-after value (as seconds)" $ do
|
, testCase "Successfully updates the new retry-after value (as seconds)" $ do
|
||||||
E.bracket (forkIO $ mock429 "2" ok200) killThread $ \_ -> do
|
E.bracket (forkIO $ mock429 "2" ok200) killThread $ \_ -> do
|
||||||
now <- getPOSIXTime <&> posixTimeToTimeSecond
|
now <- getPOSIXTime <&> posixTimeToTimeSecond
|
||||||
progressRef <- newIORef VerifyProgress
|
progressRef <- newIORef VerifyProgress
|
||||||
@ -72,7 +71,7 @@ spec = do
|
|||||||
flip assertBool (ttc == Just (sec 2)) $
|
flip assertBool (ttc == Just (sec 2)) $
|
||||||
"Expected time to completion be equal to " ++ show (Just $ sec 2) ++
|
"Expected time to completion be equal to " ++ show (Just $ sec 2) ++
|
||||||
", but instead it's " ++ show ttc
|
", but instead it's " ++ show ttc
|
||||||
it "Successfully updates the new retry-after value (as date)" $ do
|
, testCase "Successfully updates the new retry-after value (as date)" $ do
|
||||||
utctime <- getCurrentTime
|
utctime <- getCurrentTime
|
||||||
let
|
let
|
||||||
-- Set the @Retry-After@ response header value as (current datetime + 4 seconds)
|
-- Set the @Retry-After@ response header value as (current datetime + 4 seconds)
|
||||||
@ -97,7 +96,8 @@ spec = do
|
|||||||
flip assertBool (sec 3 <= ttc && ttc <= sec 4) $
|
flip assertBool (sec 3 <= ttc && ttc <= sec 4) $
|
||||||
"Expected time to completion be within range (seconds): 3 <= x <= 4" ++
|
"Expected time to completion be within range (seconds): 3 <= x <= 4" ++
|
||||||
", but instead it's " ++ show ttc
|
", but instead it's " ++ show ttc
|
||||||
it "Sets the new retry-after to 0 seconds if its value is a date && has already passed" $ do
|
, testCase "Sets the new retry-after to 0 seconds if\
|
||||||
|
\ its value is a date && has already passed" $ do
|
||||||
utctime <- getCurrentTime
|
utctime <- getCurrentTime
|
||||||
let
|
let
|
||||||
-- Set the @Retry-After@ response header value as (current datetime - 4 seconds)
|
-- Set the @Retry-After@ response header value as (current datetime - 4 seconds)
|
||||||
@ -122,7 +122,7 @@ spec = do
|
|||||||
flip assertBool (ttc == Just (sec 0)) $
|
flip assertBool (ttc == Just (sec 0)) $
|
||||||
"Expected time to completion be 0 seconds" ++
|
"Expected time to completion be 0 seconds" ++
|
||||||
", but instead it's " ++ show ttc
|
", but instead it's " ++ show ttc
|
||||||
it "The GET request should not be attempted after catching a 429" $ do
|
, testCase "The GET request should not be attempted after catching a 429" $ do
|
||||||
let
|
let
|
||||||
mock429WithGlobalIORef :: IORef [(Text, Status)] -> IO ()
|
mock429WithGlobalIORef :: IORef [(Text, Status)] -> IO ()
|
||||||
mock429WithGlobalIORef infoReverseAccumulatorRef = do
|
mock429WithGlobalIORef infoReverseAccumulatorRef = do
|
||||||
@ -151,11 +151,12 @@ spec = do
|
|||||||
E.bracket (forkIO $ mock429WithGlobalIORef infoReverseAccumulatorRef) killThread $ \_ -> do
|
E.bracket (forkIO $ mock429WithGlobalIORef infoReverseAccumulatorRef) killThread $ \_ -> do
|
||||||
_ <- verifyLink "http://127.0.0.1:5000/429grandfinale"
|
_ <- verifyLink "http://127.0.0.1:5000/429grandfinale"
|
||||||
infoReverseAccumulator <- readIORef infoReverseAccumulatorRef
|
infoReverseAccumulator <- readIORef infoReverseAccumulatorRef
|
||||||
reverse infoReverseAccumulator `shouldBe`
|
reverse infoReverseAccumulator @?=
|
||||||
[ ("HEAD", tooManyRequests429)
|
[ ("HEAD", tooManyRequests429)
|
||||||
, ("HEAD", serviceUnavailable503)
|
, ("HEAD", serviceUnavailable503)
|
||||||
, ("GET", ok200)
|
, ("GET", ok200)
|
||||||
]
|
]
|
||||||
|
]
|
||||||
where
|
where
|
||||||
checkLinkAndProgressWithServer mock link progress vrExpectation =
|
checkLinkAndProgressWithServer mock link progress vrExpectation =
|
||||||
E.bracket (forkIO mock) killThread $ \_ -> do
|
E.bracket (forkIO mock) killThread $ \_ -> do
|
||||||
|
@ -9,7 +9,8 @@ import Universum
|
|||||||
|
|
||||||
import Fmt (blockListF, pretty, unlinesF)
|
import Fmt (blockListF, pretty, unlinesF)
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
import Test.Hspec (Spec, describe, expectationFailure, it)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
|
import Test.Tasty.HUnit (testCase, assertFailure)
|
||||||
|
|
||||||
import Xrefcheck.Config
|
import Xrefcheck.Config
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
@ -17,25 +18,24 @@ import Xrefcheck.Progress
|
|||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
import Xrefcheck.Scanners.Markdown
|
import Xrefcheck.Scanners.Markdown
|
||||||
|
|
||||||
spec :: Spec
|
test_slash :: TestTree
|
||||||
spec = do
|
test_slash = testGroup "Trailing forward slash detection" $
|
||||||
describe "Trailing forward slash detection" $ do
|
let config = defConfig GitHub
|
||||||
let config = defConfig GitHub
|
format = specificFormatsSupport [markdownSupport (scMarkdown (cScanners config))]
|
||||||
let format = specificFormatsSupport [markdownSupport (scMarkdown (cScanners config))]
|
in roots <&> \root ->
|
||||||
forM_ roots $ \root -> do
|
testCase ("All the files within the root \"" <>
|
||||||
it ("All the files within the root \"" <>
|
root <>
|
||||||
root <>
|
"\" should exist") $ do
|
||||||
"\" should exist") $ do
|
|
||||||
(ScanResult _ (RepoInfo repoInfo)) <- allowRewrite False $ \rw ->
|
(ScanResult _ (RepoInfo repoInfo)) <- allowRewrite False $ \rw ->
|
||||||
scanRepo rw format TraversalConfig{ tcIgnored = [] } root
|
scanRepo rw format TraversalConfig{ tcIgnored = [] } root
|
||||||
nonExistentFiles <- lefts <$> forM (keys repoInfo) (\filePath -> do
|
nonExistentFiles <- lefts <$> forM (keys repoInfo) (\filePath -> do
|
||||||
predicate <- doesFileExist filePath
|
predicate <- doesFileExist filePath
|
||||||
return $ if predicate
|
return $ if predicate
|
||||||
then Right ()
|
then Right ()
|
||||||
else Left filePath)
|
else Left filePath)
|
||||||
if null nonExistentFiles
|
if null nonExistentFiles
|
||||||
then pass
|
then pass
|
||||||
else expectationFailure $ pretty $ unlinesF
|
else assertFailure $ pretty $ unlinesF
|
||||||
[ "Expected all filepaths to be valid, but these filepaths do not exist:"
|
[ "Expected all filepaths to be valid, but these filepaths do not exist:"
|
||||||
, blockListF nonExistentFiles
|
, blockListF nonExistentFiles
|
||||||
]
|
]
|
||||||
|
@ -9,45 +9,49 @@ module Test.Xrefcheck.URIParsingSpec where
|
|||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Test.Hspec (Spec, describe, it, shouldReturn)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
|
import Test.Tasty.HUnit (testCase, (@?=))
|
||||||
import Text.URI (URI)
|
import Text.URI (URI)
|
||||||
import Text.URI.QQ (uri)
|
import Text.URI.QQ (uri)
|
||||||
import URI.ByteString (URIParseError (..), SchemaError (..))
|
import URI.ByteString (SchemaError (..), URIParseError (..))
|
||||||
|
|
||||||
import Xrefcheck.Verify (parseUri, VerifyError (..))
|
import Xrefcheck.Verify (VerifyError (..), parseUri)
|
||||||
|
|
||||||
spec :: Spec
|
test_uri :: [TestTree]
|
||||||
spec = do
|
test_uri =
|
||||||
describe "URI parsing should be successful" $ do
|
[ testGroup "URI parsing should be successful"
|
||||||
it "Without the special characters in the query strings" do
|
[ testCase "Without the special characters in the query strings" do
|
||||||
parseUri' "https://example.com/?q=a&p=b#fragment" `shouldReturn`
|
parseUri' "https://example.com/?q=a&p=b#fragment" >>=
|
||||||
Right [uri|https://example.com/?q=a&p=b#fragment|]
|
(@?= Right [uri|https://example.com/?q=a&p=b#fragment|])
|
||||||
|
parseUri' "https://example.com/path/to/smth?q=a&p=b" >>=
|
||||||
|
(@?= Right [uri|https://example.com/path/to/smth?q=a&p=b|])
|
||||||
|
|
||||||
parseUri' "https://example.com/path/to/smth?q=a&p=b" `shouldReturn`
|
, testCase "With the special characters in the query strings" do
|
||||||
Right [uri|https://example.com/path/to/smth?q=a&p=b|]
|
parseUri' "https://example.com/?q=[a]&<p>={b}#fragment" >>=
|
||||||
|
(@?= Right
|
||||||
|
[uri|https://example.com/?q=%5Ba%5D&%3Cp%3E=%7Bb%7D#fragment|])
|
||||||
|
|
||||||
it "With the special characters in the query strings" do
|
parseUri' "https://example.com/path/to/smth?q=[a]&<p>={b}" >>=
|
||||||
parseUri' "https://example.com/?q=[a]&<p>={b}#fragment" `shouldReturn`
|
(@?= Right
|
||||||
Right [uri|https://example.com/?q=%5Ba%5D&%3Cp%3E=%7Bb%7D#fragment|]
|
[uri|https://example.com/path/to/smth?q=%5Ba%5D&%3Cp%3E=%7Bb%7D|])
|
||||||
|
]
|
||||||
|
, testGroup "URI parsing should be unsuccessful"
|
||||||
|
[ testCase "With the special characters anywhere else" do
|
||||||
|
parseUri' "https://exa<mple.co>m/?q=a&p=b#fra{g}ment" >>=
|
||||||
|
(@?= Left (ExternalResourceInvalidUri MalformedPath))
|
||||||
|
|
||||||
parseUri' "https://example.com/path/to/smth?q=[a]&<p>={b}" `shouldReturn`
|
parseUri' "https://example.com/pa[t]h/to[/]smth?q=a&p=b" >>=
|
||||||
Right [uri|https://example.com/path/to/smth?q=%5Ba%5D&%3Cp%3E=%7Bb%7D|]
|
(@?= Left (ExternalResourceInvalidUri MalformedPath))
|
||||||
|
|
||||||
describe "URI parsing should be unsuccessful" $ do
|
, testCase "With malformed scheme" do
|
||||||
it "With the special characters anywhere else" do
|
parseUri' "https//example.com/" >>=
|
||||||
parseUri' "https://exa<mple.co>m/?q=a&p=b#fra{g}ment" `shouldReturn`
|
(@?= Left (ExternalResourceInvalidUri $ MalformedScheme MissingColon))
|
||||||
Left (ExternalResourceInvalidUri MalformedPath)
|
|
||||||
|
|
||||||
parseUri' "https://example.com/pa[t]h/to[/]smth?q=a&p=b" `shouldReturn`
|
, testCase "With malformed fragment" do
|
||||||
Left (ExternalResourceInvalidUri MalformedPath)
|
parseUri' "https://example.com/?q=a&p=b#fra{g}ment" >>=
|
||||||
|
(@?= Left (ExternalResourceInvalidUri MalformedFragment))
|
||||||
it "With malformed scheme" do
|
]
|
||||||
parseUri' "https//example.com/" `shouldReturn`
|
]
|
||||||
Left (ExternalResourceInvalidUri $ MalformedScheme MissingColon)
|
|
||||||
|
|
||||||
it "With malformed fragment" do
|
|
||||||
parseUri' "https://example.com/?q=a&p=b#fra{g}ment" `shouldReturn`
|
|
||||||
Left (ExternalResourceInvalidUri MalformedFragment)
|
|
||||||
where
|
where
|
||||||
parseUri' :: Text -> IO $ Either VerifyError URI
|
parseUri' :: Text -> IO $ Either VerifyError URI
|
||||||
parseUri' = runExceptT . parseUri
|
parseUri' = runExceptT . parseUri
|
||||||
|
5
tests/Tree.hs
Normal file
5
tests/Tree.hs
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
|
||||||
|
--
|
||||||
|
-- SPDX-License-Identifier: MPL-2.0
|
||||||
|
|
||||||
|
{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display -optF --generated-module -optF Tree #-}
|
@ -15,7 +15,7 @@ let
|
|||||||
[ "-Werror" ];
|
[ "-Werror" ];
|
||||||
|
|
||||||
components.tests = {
|
components.tests = {
|
||||||
links-tests = {
|
ftp-tests = {
|
||||||
build-tools = [ pkgs.vsftpd ];
|
build-tools = [ pkgs.vsftpd ];
|
||||||
preCheck = ''
|
preCheck = ''
|
||||||
echo "Starting vsftpd..."
|
echo "Starting vsftpd..."
|
||||||
@ -25,7 +25,7 @@ let
|
|||||||
-olisten_port=2221 \
|
-olisten_port=2221 \
|
||||||
-olisten=yes \
|
-olisten=yes \
|
||||||
-oftp_username=$(whoami) \
|
-oftp_username=$(whoami) \
|
||||||
-oanon_root=${./links-tests/ftp_root} \
|
-oanon_root=${./ftp-tests/ftp_root} \
|
||||||
-opasv_min_port=2222 \
|
-opasv_min_port=2222 \
|
||||||
-ohide_file='{.*}' \
|
-ohide_file='{.*}' \
|
||||||
-odeny_file='{.*}' \
|
-odeny_file='{.*}' \
|
||||||
|
Loading…
Reference in New Issue
Block a user