From f96ebee5db34f8a3a75554bd6d69ae9591a3b603 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Wed, 11 Sep 2024 18:56:50 +0300 Subject: [PATCH] Update development setup * flake.nix: inherit devShells, so that `nix develop` works * tests: configurable mock server port to avoid conflicts --- flake.nix | 2 +- package.yaml | 2 ++ tests/Main.hs | 7 ++++++- tests/Test/Xrefcheck/ConfigSpec.hs | 30 ++++++++++++++++-------------- tests/Test/Xrefcheck/Util.hs | 30 ++++++++++++++++++++++++++++-- 5 files changed, 53 insertions(+), 18 deletions(-) diff --git a/flake.nix b/flake.nix index f1cffc19..e4033234 100644 --- a/flake.nix +++ b/flake.nix @@ -62,7 +62,7 @@ in pkgs.lib.lists.foldr pkgs.lib.recursiveUpdate {} [ - { inherit (flake) packages apps; } + { inherit (flake) packages apps devShells; } { legacyPackages = pkgs; diff --git a/package.yaml b/package.yaml index 8df1d052..41e4aa5c 100644 --- a/package.yaml +++ b/package.yaml @@ -142,6 +142,8 @@ tests: generated-other-modules: - Paths_xrefcheck dependencies: + - optparse-applicative + - tagged - case-insensitive - cmark-gfm - containers diff --git a/tests/Main.hs b/tests/Main.hs index d7df1487..202aac14 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -9,7 +9,12 @@ module Main import Universum import Test.Tasty +import Test.Tasty.Ingredients (Ingredient) +import Test.Xrefcheck.Util (mockServerOptions) import Tree (tests) main :: IO () -main = tests >>= defaultMain +main = tests >>= defaultMainWithIngredients ingredients + +ingredients :: [Ingredient] +ingredients = includingOptions mockServerOptions : defaultIngredients \ No newline at end of file diff --git a/tests/Test/Xrefcheck/ConfigSpec.hs b/tests/Test/Xrefcheck/ConfigSpec.hs index 7ec9125d..e8618bc0 100644 --- a/tests/Test/Xrefcheck/ConfigSpec.hs +++ b/tests/Test/Xrefcheck/ConfigSpec.hs @@ -13,7 +13,7 @@ import Control.Exception qualified as E import Data.List (isInfixOf) import Data.Yaml (ParseException (..), decodeEither') import Network.HTTP.Types (Status (..)) -import Test.Tasty (TestTree, testGroup) +import Test.Tasty (TestTree, testGroup, askOption) import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) import Test.Tasty.QuickCheck (ioProperty, testProperty) @@ -22,7 +22,7 @@ import Xrefcheck.Core (Flavor (GitHub), allFlavors) import Xrefcheck.Scan (ecIgnoreExternalRefsToL) import Xrefcheck.Verify (VerifyError (..), checkExternalResource) -import Test.Xrefcheck.Util (mockServer) +import Test.Xrefcheck.Util (mockServer, mockServerUrl) test_config :: [TestTree] test_config = @@ -43,28 +43,29 @@ test_config = , "and verify changes" ] ] - , testGroup "`ignoreAuthFailures` working as expected" $ + , askOption $ \mockServerPort -> + testGroup "`ignoreAuthFailures` working as expected" $ let config = defConfig GitHub & cExclusionsL . ecIgnoreExternalRefsToL .~ [] setIgnoreAuthFailures value = config & cNetworkingL . ncIgnoreAuthFailuresL .~ value in [ testCase "when True - assume 401 status is valid" $ - checkLinkWithServer (setIgnoreAuthFailures True) - "http://127.0.0.1:3000/401" $ Right () + checkLinkWithServer mockServerPort (setIgnoreAuthFailures True) + "/401" $ Right () , testCase "when False - assume 401 status is invalid" $ - checkLinkWithServer (setIgnoreAuthFailures False) - "http://127.0.0.1:3000/401" $ + checkLinkWithServer mockServerPort (setIgnoreAuthFailures False) + "/401" $ Left $ ExternalHttpResourceUnavailable $ Status { statusCode = 401, statusMessage = "Unauthorized" } , testCase "when True - assume 403 status is valid" $ - checkLinkWithServer (setIgnoreAuthFailures True) - "http://127.0.0.1:3000/403" $ Right () + checkLinkWithServer mockServerPort (setIgnoreAuthFailures True) + "/403" $ Right () , testCase "when False - assume 403 status is invalid" $ - checkLinkWithServer (setIgnoreAuthFailures False) - "http://127.0.0.1:3000/403" $ + checkLinkWithServer mockServerPort (setIgnoreAuthFailures False) + "/403" $ Left $ ExternalHttpResourceUnavailable $ Status { statusCode = 403, statusMessage = "Forbidden" } ] @@ -80,7 +81,8 @@ test_config = ] where - checkLinkWithServer config link expectation = - E.bracket (forkIO mockServer) killThread $ \_ -> do - result <- runExceptT $ checkExternalResource emptyChain config link + checkLinkWithServer mockServerPort config link expectation = + E.bracket (forkIO (mockServer mockServerPort)) killThread $ \_ -> do + let url = (mockServerUrl mockServerPort link) + result <- runExceptT $ checkExternalResource emptyChain config url result @?= expectation diff --git a/tests/Test/Xrefcheck/Util.hs b/tests/Test/Xrefcheck/Util.hs index 75529c38..c2d8f532 100644 --- a/tests/Test/Xrefcheck/Util.hs +++ b/tests/Test/Xrefcheck/Util.hs @@ -7,8 +7,11 @@ module Test.Xrefcheck.Util where import Universum +import Data.Tagged (Tagged, untag) +import Options.Applicative (help, long, option, auto) import Network.HTTP.Types (forbidden403, unauthorized401) import Web.Firefly (ToResponse (..), route, run) +import Test.Tasty.Options as Tasty (IsOption (..), OptionDescription (Option), safeRead) import Xrefcheck.Core (Flavor) import Xrefcheck.Scan (ScanAction) @@ -18,7 +21,30 @@ parse :: Flavor -> ScanAction parse fl path = markdownScanner MarkdownConfig { mcFlavor = fl } path -mockServer :: IO () -mockServer = run 3000 $ do +mockServerUrl :: MockServerPort -> Text -> Text +mockServerUrl (MockServerPort port) s = toText ("http://127.0.0.1:" <> show port <> s) + +mockServer :: MockServerPort -> IO () +mockServer (MockServerPort port) = run port $ do route "/401" $ pure $ toResponse ("" :: Text, unauthorized401) route "/403" $ pure $ toResponse ("" :: Text, forbidden403) + +-- | All options needed to configure the mock server. +mockServerOptions :: [OptionDescription] +mockServerOptions = + [ Tasty.Option (Proxy @MockServerPort) + ] + +-- | Option specifying FTP host. +newtype MockServerPort = MockServerPort Int + deriving stock (Show, Eq) + +instance IsOption MockServerPort where + defaultValue = MockServerPort 3000 + optionName = "mock-server-port" + optionHelp = "[Test.Xrefcheck.Util] Mock server port" + parseValue v = MockServerPort <$> safeRead v + optionCLParser = MockServerPort <$> option auto + ( long (untag (optionName :: Tagged MockServerPort String)) + <> help (untag (optionHelp :: Tagged MockServerPort String)) + ) \ No newline at end of file