From 74f30358c8aca2dfb51b0c495e2842af4232c3b6 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Wed, 11 Sep 2024 18:56:50 +0300 Subject: [PATCH] [Chore] Update development setup Problem: 1. Running `nix develop` in the project root does not provide a development environment of any sort, as evidenced by: ghc-pkg list printing only boot libraries. 2. Tests can fail with this error: xrefcheck-tests: Network.Socket.bind: resource busy (Address already in use) due to a potential conflict with an already running application. Solution: 1. flake.nix: inherit devShells 2. tests: configurable mock server port With these changes I've been able to build the project and run its tests as follows: nix shell nixpkgs#haskellPackages.hpack nixpkgs#cabal-install nix develop -c $SHELL hpack vsftpd \ -orun_as_launching_user=yes \ -olisten_port=2221 \ -olisten=yes \ -oftp_username=$(whoami) \ -oanon_root=./ftp-tests/ftp_root \ -opasv_min_port=2222 \ -ohide_file='{.*}' \ -odeny_file='{.*}' \ -oseccomp_sandbox=no \ -olog_ftp_protocol=yes \ -oxferlog_enable=yes \ -ovsftpd_log_file=./ftp.log & cabal test ftp-tests --test-options="--ftp-host ftp://127.0.0.1:2221" cabal test xrefcheck-tests --test-options="--mock-server-port 3001" --- flake.nix | 2 +- ftp-tests/Test/Xrefcheck/FtpLinks.hs | 6 +++--- package.yaml | 2 ++ tests/Main.hs | 7 ++++++- tests/Test/Xrefcheck/ConfigSpec.hs | 30 +++++++++++++++------------- tests/Test/Xrefcheck/Util.hs | 30 ++++++++++++++++++++++++++-- 6 files changed, 56 insertions(+), 21 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/ftp-tests/Test/Xrefcheck/FtpLinks.hs b/ftp-tests/Test/Xrefcheck/FtpLinks.hs index b063125f..3429325a 100644 --- a/ftp-tests/Test/Xrefcheck/FtpLinks.hs +++ b/ftp-tests/Test/Xrefcheck/FtpLinks.hs @@ -9,7 +9,7 @@ module Test.Xrefcheck.FtpLinks import Universum -import Data.Tagged (Tagged, untag) +import Data.Tagged (untag) import Options.Applicative (help, long, strOption) import Test.Tasty (TestTree, askOption, testGroup) import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) @@ -36,8 +36,8 @@ instance IsOption FtpHostOpt where optionHelp = "[Test.Xrefcheck.FtpLinks] FTP host without trailing slash" parseValue v = FtpHostOpt <$> safeRead v optionCLParser = FtpHostOpt <$> strOption - ( long (untag (optionName :: Tagged FtpHostOpt String)) - <> help (untag (optionHelp :: Tagged FtpHostOpt String)) + ( long (untag @FtpHostOpt optionName) + <> help (untag @FtpHostOpt optionHelp) ) config :: Config 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..49041e10 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 diff --git a/tests/Test/Xrefcheck/ConfigSpec.hs b/tests/Test/Xrefcheck/ConfigSpec.hs index 7ec9125d..06855d1f 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, askOption, testGroup) 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..fa05db29 100644 --- a/tests/Test/Xrefcheck/Util.hs +++ b/tests/Test/Xrefcheck/Util.hs @@ -7,7 +7,10 @@ module Test.Xrefcheck.Util where import Universum +import Data.Tagged (untag) import Network.HTTP.Types (forbidden403, unauthorized401) +import Options.Applicative (auto, help, long, option) +import Test.Tasty.Options as Tasty (IsOption (..), OptionDescription (Option), safeRead) import Web.Firefly (ToResponse (..), route, run) import Xrefcheck.Core (Flavor) @@ -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 @MockServerPort optionName) + <> help (untag @MockServerPort optionHelp) + )