From 1905f602bf92a59d13831bb3b102813d3722c490 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Wed, 11 Sep 2024 20:34:57 +0300 Subject: [PATCH 01/10] [Chore] Update flake.lock --- flake.lock | 234 ++++++++++++++++++++++++++++++++++------------------- 1 file changed, 151 insertions(+), 83 deletions(-) diff --git a/flake.lock b/flake.lock index 95128aef..28fb17c1 100644 --- a/flake.lock +++ b/flake.lock @@ -348,11 +348,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1685518550, - "narHash": "sha256-o2d0KcvaXzTrPRIo0kOLV0/QXHhDQ5DTi+OxcjO8xqY=", + "lastModified": 1710146030, + "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=", "owner": "numtide", "repo": "flake-utils", - "rev": "a1720a10a6cfe8234c0e93907ffe81be440f4cef", + "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a", "type": "github" }, "original": { @@ -422,16 +422,16 @@ "get-tested-src": { "flake": false, "locked": { - "lastModified": 1687355864, - "narHash": "sha256-yQ4coxfnp2Jsw1kvwf2/Zn72Kltze2WrfHN54eLR070=", - "owner": "Sereja313", + "lastModified": 1704576937, + "narHash": "sha256-STgnzFljXb4deHTGrIQc56YMX7Unmiy8P9NWwkChbYI=", + "owner": "Kleidukos", "repo": "get-tested", - "rev": "455bbd047374ed907900b49641a4ea7f0a905709", + "rev": "64f016a0c53edfe52c237301ce062455344b51ac", "type": "github" }, "original": { - "owner": "Sereja313", - "ref": "issue-8-emit-ghc-versions", + "owner": "Kleidukos", + "ref": "v0.1.6.0", "repo": "get-tested", "type": "github" } @@ -470,43 +470,6 @@ "type": "github" } }, - "ghc98X": { - "flake": false, - "locked": { - "lastModified": 1696643148, - "narHash": "sha256-E02DfgISH7EvvNAu0BHiPvl1E5FGMDi0pWdNZtIBC9I=", - "ref": "ghc-9.8", - "rev": "443e870d977b1ab6fc05f47a9a17bc49296adbd6", - "revCount": 61642, - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - }, - "original": { - "ref": "ghc-9.8", - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - } - }, - "ghc99": { - "flake": false, - "locked": { - "lastModified": 1701580282, - "narHash": "sha256-drA01r3JrXnkKyzI+owMZGxX0JameMzjK0W5jJE/+V4=", - "ref": "refs/heads/master", - "rev": "f5eb0f2982e9cf27515e892c4bdf634bcfb28459", - "revCount": 62197, - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - }, - "original": { - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" - } - }, "gitignore-nix": { "flake": false, "locked": { @@ -545,11 +508,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1704846187, - "narHash": "sha256-eCxEI6PXPsxHSTgnnpEg2fxVbGxIn4ZFYX1M394Tcwc=", + "lastModified": 1722990360, + "narHash": "sha256-FkfLz/+j02/3t9QZaZBOXmn/noA2Gt0MlkvSNlhT4QM=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "5889a4e063c158261aaad4ad0720ddc4ee6a4a20", + "rev": "b21329e3b7431ad475ffc848e55be3b7a795ea9c", "type": "github" }, "original": { @@ -583,14 +546,17 @@ "cardano-shell": "cardano-shell", "flake-compat": "flake-compat", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", - "ghc98X": "ghc98X", - "ghc99": "ghc99", "hackage": "hackage", "hls-1.10": "hls-1.10", "hls-2.0": "hls-2.0", "hls-2.2": "hls-2.2", "hls-2.3": "hls-2.3", "hls-2.4": "hls-2.4", + "hls-2.5": "hls-2.5", + "hls-2.6": "hls-2.6", + "hls-2.7": "hls-2.7", + "hls-2.8": "hls-2.8", + "hls-2.9": "hls-2.9", "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", @@ -605,16 +571,17 @@ "nixpkgs-2211": "nixpkgs-2211", "nixpkgs-2305": "nixpkgs-2305", "nixpkgs-2311": "nixpkgs-2311", + "nixpkgs-2405": "nixpkgs-2405", "nixpkgs-unstable": "nixpkgs-unstable", "old-ghc-nix": "old-ghc-nix", "stackage": "stackage" }, "locked": { - "lastModified": 1704847818, - "narHash": "sha256-LQzIY21CkCirSSR+7fB5uQjlFGBzCvjA0x/TuPXT3V8=", + "lastModified": 1722991826, + "narHash": "sha256-iCUh65fJZq9XbEUNTWrpOeC07kYR8rSboD9hg9CIhFE=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "28fceff2ef63b5bd0717371df5500a58ace98ee6", + "rev": "ed955c92e9bc2240b3d402ff1c9c8479e3fa1e4a", "type": "github" }, "original": { @@ -749,6 +716,91 @@ "type": "github" } }, + "hls-2.5": { + "flake": false, + "locked": { + "lastModified": 1701080174, + "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.5.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.6": { + "flake": false, + "locked": { + "lastModified": 1705325287, + "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.6.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.7": { + "flake": false, + "locked": { + "lastModified": 1708965829, + "narHash": "sha256-LfJ+TBcBFq/XKoiNI7pc4VoHg4WmuzsFxYJ3Fu+Jf+M=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "50322b0a4aefb27adc5ec42f5055aaa8f8e38001", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.7.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.8": { + "flake": false, + "locked": { + "lastModified": 1715153580, + "narHash": "sha256-Vi/iUt2pWyUJlo9VrYgTcbRviWE0cFO6rmGi9rmALw0=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "dd1be1beb16700de59e0d6801957290bcf956a0a", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.8.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.9": { + "flake": false, + "locked": { + "lastModified": 1718469202, + "narHash": "sha256-THXSz+iwB1yQQsr/PY151+2GvtoJnTIB2pIQ4OzfjD4=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "40891bccb235ebacce020b598b083eab9dda80f1", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.9.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hpc-coveralls": { "flake": false, "locked": { @@ -855,18 +907,18 @@ "iserv-proxy": { "flake": false, "locked": { - "lastModified": 1691634696, - "narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=", - "ref": "hkm/remote-iserv", - "rev": "43a979272d9addc29fbffc2e8542c5d96e993d73", - "revCount": 14, - "type": "git", - "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" + "lastModified": 1717479972, + "narHash": "sha256-7vE3RQycHI1YT9LHJ1/fUaeln2vIpYm6Mmn8FTpYeVo=", + "owner": "stable-haskell", + "repo": "iserv-proxy", + "rev": "2ed34002247213fc435d0062350b91bab920626e", + "type": "github" }, "original": { - "ref": "hkm/remote-iserv", - "type": "git", - "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" + "owner": "stable-haskell", + "ref": "iserv-syms", + "repo": "iserv-proxy", + "type": "github" } }, "iserv-proxy_2": { @@ -1298,11 +1350,11 @@ }, "nixpkgs-2305": { "locked": { - "lastModified": 1701362232, - "narHash": "sha256-GVdzxL0lhEadqs3hfRLuj+L1OJFGiL/L7gCcelgBlsw=", + "lastModified": 1705033721, + "narHash": "sha256-K5eJHmL1/kev6WuqyqqbS1cdNnSidIZ3jeqJ7GbrYnQ=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "d2332963662edffacfddfad59ff4f709dde80ffe", + "rev": "a1982c92d8980a0114372973cbdfe0a307f1bdea", "type": "github" }, "original": { @@ -1314,11 +1366,11 @@ }, "nixpkgs-2311": { "locked": { - "lastModified": 1701386440, - "narHash": "sha256-xI0uQ9E7JbmEy/v8kR9ZQan6389rHug+zOtZeZFiDJk=", + "lastModified": 1719957072, + "narHash": "sha256-gvFhEf5nszouwLAkT9nWsDzocUTqLWHuL++dvNjMp9I=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "293822e55ec1872f715a66d0eda9e592dc14419f", + "rev": "7144d6241f02d171d25fba3edeaf15e0f2592105", "type": "github" }, "original": { @@ -1328,6 +1380,22 @@ "type": "github" } }, + "nixpkgs-2405": { + "locked": { + "lastModified": 1720122915, + "narHash": "sha256-Nby8WWxj0elBu1xuRaUcRjPi/rU3xVbkAt2kj4QwX2U=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "835cf2d3f37989c5db6585a28de967a667a75fb1", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-24.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-regression": { "locked": { "lastModified": 1643052045, @@ -1362,17 +1430,17 @@ }, "nixpkgs-unstable": { "locked": { - "lastModified": 1694822471, - "narHash": "sha256-6fSDCj++lZVMZlyqOe9SIOL8tYSBz1bI8acwovRwoX8=", + "lastModified": 1720181791, + "narHash": "sha256-i4vJL12/AdyuQuviMMd1Hk2tsGt02hDNhA0Zj1m16N8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", + "rev": "4284c2b73c8bce4b46a6adf23e16d9e2ec8da4bb", "type": "github" }, "original": { "owner": "NixOS", + "ref": "nixpkgs-unstable", "repo": "nixpkgs", - "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" } }, @@ -1488,11 +1556,11 @@ }, "nixpkgs_8": { "locked": { - "lastModified": 1674736538, - "narHash": "sha256-/DszFMkAgYyB9dTWKkoZa9i0zcrA6Z4hYrOr/u/FSxY=", + "lastModified": 1702386253, + "narHash": "sha256-gWyY0ZnlyugHRthZQBmFfxeKNDq2o6g7kaSU1lwyj74=", "owner": "serokell", "repo": "nixpkgs", - "rev": "1dfdbb65d77430fc0935e8592d0abc4addcce711", + "rev": "4a0f28c92f803406ca2eed0cce08230447ad9d01", "type": "github" }, "original": { @@ -1568,11 +1636,11 @@ "nixpkgs": "nixpkgs_8" }, "locked": { - "lastModified": 1695391091, - "narHash": "sha256-vYBB7s9bJxgmMQXFg4XWSd3VW4CYjnBRy7mkv1QXsiE=", + "lastModified": 1721225510, + "narHash": "sha256-NWFcvwjMLRAANuCGih76qN/Kn8qEbucix6MmUdyMfy4=", "owner": "serokell", "repo": "serokell.nix", - "rev": "567820afeec19e53b134038a3f307171eaa6668f", + "rev": "3642b7829241f64bf697462cd47f6108c7920613", "type": "github" }, "original": { @@ -1583,11 +1651,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1704845382, - "narHash": "sha256-nzbV0Z9KIEjglN/I1qNIRvi80y8EqebxLI7hn8EvJMI=", + "lastModified": 1722989507, + "narHash": "sha256-5jKfvNA9HW7juL7z1Hf6827FbzCy5S9RmMBG4jGqLdw=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "518634e42dfbecf2bae7f3af3eb6fa8fe4fcdca2", + "rev": "cb1856fdb81fa9a5b1fb5cd8e48db1fa131699d5", "type": "github" }, "original": { From 9efa059ba24e630ad6f5a472a5f0cab633d7eb08 Mon Sep 17 00:00:00 2001 From: Ivan Gromakovskii Date: Mon, 25 Sep 2023 19:21:19 +0200 Subject: [PATCH 02/10] [Chore] Use nyan-interpolation from Hackage Problem: we take nyan-interpolation from GitHub, which is harder to manage than if we take it from Hackage. Fortunately, the latest version is now available and suits us. Solution: specify Hackage version of nyan-interpoation[-core] in extra-deps. --- stack.yaml | 7 ++----- stack.yaml.lock | 28 ++++++++-------------------- 2 files changed, 10 insertions(+), 25 deletions(-) diff --git a/stack.yaml b/stack.yaml index 7f46f782..2558ee00 100644 --- a/stack.yaml +++ b/stack.yaml @@ -12,8 +12,5 @@ packages: extra-deps: - firefly-0.2.1.0@sha256:e9d73486464c3e223ec457e02b30ddd5b550fdbf6292b268c64581e2b07d888b,1519 - cmark-gfm-0.2.5 -- git: https://github.com/serokell/nyan-interpolation - commit: 348355385466d6d0116251b463a2842ecce0360d - subdirs: - - full - - core +- nyan-interpolation-core-0.9.2 +- nyan-interpolation-0.9.2 diff --git a/stack.yaml.lock b/stack.yaml.lock index b6cd5bcb..429b3b51 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -19,31 +19,19 @@ packages: original: hackage: cmark-gfm-0.2.5 - completed: - commit: 348355385466d6d0116251b463a2842ecce0360d - git: https://github.com/serokell/nyan-interpolation - name: nyan-interpolation + hackage: nyan-interpolation-core-0.9.2@sha256:930202fafc4e9472f9aed3d216a459e23454db500bfd0e0a5af2a4e5c5202096,4523 pantry-tree: - sha256: ede424e6010640f31a223865f2136570ca1870b5ae5ffeeebfc499c4f7043482 - size: 714 - subdir: full - version: '0.9' + sha256: 5781e80383996a6bea95a545e4f0e70466bebf0fe2d388f334cd42e9f35469d5 + size: 1464 original: - commit: 348355385466d6d0116251b463a2842ecce0360d - git: https://github.com/serokell/nyan-interpolation - subdir: full + hackage: nyan-interpolation-core-0.9.2 - completed: - commit: 348355385466d6d0116251b463a2842ecce0360d - git: https://github.com/serokell/nyan-interpolation - name: nyan-interpolation-core + hackage: nyan-interpolation-0.9.2@sha256:fb0b07ef6a9f8ca4d2e1db2f2df841c649556d9f6cff894ebf6b9ffbb7c25003,4276 pantry-tree: - sha256: 4802161ce5d38f895e3b5106c789bfbe20b8d12c2f6c5fcba3999bec105283bc - size: 1516 - subdir: core - version: '0.9' + sha256: 258878b8660782bef633fe3800c08fff2fa90165fd2a0793fa73836d8ff274c3 + size: 662 original: - commit: 348355385466d6d0116251b463a2842ecce0360d - git: https://github.com/serokell/nyan-interpolation - subdir: core + hackage: nyan-interpolation-0.9.2 snapshots: - completed: sha256: ef98d70e4018bf01feb00ccdcd33ab26d056dbb71b38057c78fdd0d1ec671c85 From 2e3cf431153c8a1ffd397132b40e27bcc969c588 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Wed, 11 Sep 2024 20:50:24 +0300 Subject: [PATCH 03/10] [Chore] Bump Stackage to LTS-22.32 --- .github/workflows/ci.yml | 4 ++-- flake.nix | 6 ------ stack.yaml | 5 +++-- stack.yaml.lock | 15 +++++++++++---- 4 files changed, 16 insertions(+), 14 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f4faaa22..da73929d 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -47,9 +47,9 @@ jobs: strategy: matrix: stack: ["2.7.5"] - ghc: ["9.0.2"] + ghc: ["9.6.6"] include: - - ghc: "9.0.2" + - ghc: "9.6.6" stackyaml: stack.yaml steps: - uses: actions/checkout@v4 diff --git a/flake.nix b/flake.nix index e4033234..58b1894b 100644 --- a/flake.nix +++ b/flake.nix @@ -12,12 +12,6 @@ pkgs = haskell-nix.legacyPackages.${system}.extend (haskell-nix.legacyPackages.${system}.lib.composeManyExtensions [ serokell-nix.overlay - # silly workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/21254 - (final: prev: prev.lib.recursiveUpdate prev { - haskell-nix.iserv-proxy-exes.ghc902.iserv-proxy-interpreter.override = - attrs: prev.haskell-nix.iserv-proxy-exes.ghc902.iserv-proxy-interpreter.override - (attrs // { enableDebugRTS = false; }); - }) ]); flake = (pkgs.haskell-nix.stackProject { diff --git a/stack.yaml b/stack.yaml index 2558ee00..b550c583 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,10 +1,10 @@ -# SPDX-FileCopyrightText: 2018-2020 Serokell +# SPDX-FileCopyrightText: 2018-2023 Serokell # # SPDX-License-Identifier: MPL-2.0 # To update hackage and stackage indexes used by CI run: # $ niv update hackage.nix; niv update stackage.nix -resolver: lts-19.13 +resolver: lts-22.32 packages: - . @@ -14,3 +14,4 @@ extra-deps: - cmark-gfm-0.2.5 - nyan-interpolation-core-0.9.2 - nyan-interpolation-0.9.2 +- ftp-client-0.5.1.6@sha256:fab127defe1efb165af58f84dbc0f57a39334e39cca9829946149b363a71d1ca,1694 diff --git a/stack.yaml.lock b/stack.yaml.lock index 429b3b51..67bd5359 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -32,9 +32,16 @@ packages: size: 662 original: hackage: nyan-interpolation-0.9.2 +- completed: + hackage: ftp-client-0.5.1.6@sha256:fab127defe1efb165af58f84dbc0f57a39334e39cca9829946149b363a71d1ca,1694 + pantry-tree: + sha256: 721799835406e36c6f14b032b1de9c95ae038261807c228a694342a1da8375bd + size: 322 + original: + hackage: ftp-client-0.5.1.6@sha256:fab127defe1efb165af58f84dbc0f57a39334e39cca9829946149b363a71d1ca,1694 snapshots: - completed: - sha256: ef98d70e4018bf01feb00ccdcd33ab26d056dbb71b38057c78fdd0d1ec671c85 - size: 618740 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/13.yaml - original: lts-19.13 + sha256: 417fa04a2ed8916cdae74c475ff97ac80857fed5000f19dce4f9564b5e635294 + size: 720000 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/32.yaml + original: lts-22.32 From 243af8c21e671340d0b27db64084c2095affda5e Mon Sep 17 00:00:00 2001 From: Ivan Gromakovskii Date: Tue, 26 Sep 2023 22:24:50 +0200 Subject: [PATCH 04/10] [Chore] Disable the `missing-kind-signatures` warning Problem: this is a new warning which wants us to provide an explicit kind signature for each type we define. It sounds too verbose to do. Solution: disable this warning. --- package.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/package.yaml b/package.yaml index 41e4aa5c..63328c3e 100644 --- a/package.yaml +++ b/package.yaml @@ -65,6 +65,7 @@ ghc-options: - -Wno-all-missed-specialisations - -Wno-prepositive-qualified-module - -Wno-monomorphism-restriction + - -Wno-missing-kind-signatures # This option avoids a warning on case-insensitive systems: # https://github.com/haskell/cabal/issues/4739 From 1faa50aad756654590018482e7822a4c4528f351 Mon Sep 17 00:00:00 2001 From: Ivan Gromakovskii Date: Wed, 27 Sep 2023 23:00:08 +0200 Subject: [PATCH 05/10] [Chore] Fix a compilation error due to new Universum Problem: retryAfterInfo doesn't compile because the type of readMaybe got more polymorphic in Universum. Solution: specify explicitly that the argument is Text. N.B. In the previous version it was String (due to the old type of readMaybe), but Text is generally preferable, so we're changing it. --- src/Xrefcheck/Verify.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Xrefcheck/Verify.hs b/src/Xrefcheck/Verify.hs index 7468ae12..e8c4fcbc 100644 --- a/src/Xrefcheck/Verify.hs +++ b/src/Xrefcheck/Verify.hs @@ -768,7 +768,9 @@ checkExternalResource followed config@Config{..} link other -> throwError $ ExternalResourceSomeError $ show other where retryAfterInfo :: Response a -> Maybe RetryAfter - retryAfterInfo = readMaybe . decodeUtf8 <=< L.lookup hRetryAfter . responseHeaders + retryAfterInfo = + readMaybe @_ @Text . decodeUtf8 <=< + L.lookup hRetryAfter . responseHeaders checkFtp :: URI -> Bool -> ExceptT VerifyError IO () checkFtp uri secure = do From f774ba47ef7a06643390be072ac28a8b22e9f690 Mon Sep 17 00:00:00 2001 From: Ivan Gromakovskii Date: Wed, 27 Sep 2023 22:55:47 +0200 Subject: [PATCH 06/10] [Chore] Do not use deprecated things from Universum Problem: some lens-related things that we use got deprecated in Universum. Solution: do not use them, import them from Control.Lens instead. --- ftp-tests/Test/Xrefcheck/FtpLinks.hs | 3 ++- package.yaml | 2 ++ src/Xrefcheck/Config.hs | 4 ++-- src/Xrefcheck/Core.hs | 4 ++-- src/Xrefcheck/Scan.hs | 4 ++-- src/Xrefcheck/Scanners/Markdown.hs | 4 ++-- src/Xrefcheck/Util.hs | 4 ++-- tests/Test/Xrefcheck/AnchorsInHeadersSpec.hs | 3 ++- tests/Test/Xrefcheck/AnchorsSpec.hs | 3 ++- tests/Test/Xrefcheck/ConfigSpec.hs | 3 ++- tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs | 3 ++- tests/Test/Xrefcheck/IgnoreRegexSpec.hs | 3 ++- tests/Test/Xrefcheck/RedirectChainSpec.hs | 3 ++- tests/Test/Xrefcheck/RedirectConfigSpec.hs | 3 ++- tests/Test/Xrefcheck/TimeoutSpec.hs | 3 ++- tests/Test/Xrefcheck/TrailingSlashSpec.hs | 3 ++- tests/Test/Xrefcheck/UtilRequests.hs | 3 ++- 17 files changed, 34 insertions(+), 21 deletions(-) diff --git a/ftp-tests/Test/Xrefcheck/FtpLinks.hs b/ftp-tests/Test/Xrefcheck/FtpLinks.hs index 3429325a..9655f92b 100644 --- a/ftp-tests/Test/Xrefcheck/FtpLinks.hs +++ b/ftp-tests/Test/Xrefcheck/FtpLinks.hs @@ -7,8 +7,9 @@ module Test.Xrefcheck.FtpLinks , test_FtpLinks ) where -import Universum +import Universum hiding ((.~)) +import Control.Lens ((.~)) import Data.Tagged (untag) import Options.Applicative (help, long, strOption) import Test.Tasty (TestTree, askOption, testGroup) diff --git a/package.yaml b/package.yaml index 63328c3e..15989a85 100644 --- a/package.yaml +++ b/package.yaml @@ -151,6 +151,7 @@ tests: - directory - firefly - http-types + - lens - modern-uri - nyan-interpolation - o-clock @@ -172,6 +173,7 @@ tests: generated-other-modules: - Paths_xrefcheck dependencies: + - lens - optparse-applicative - tagged - tasty diff --git a/src/Xrefcheck/Config.hs b/src/Xrefcheck/Config.hs index 263b4306..0c130196 100644 --- a/src/Xrefcheck/Config.hs +++ b/src/Xrefcheck/Config.hs @@ -11,9 +11,9 @@ module Xrefcheck.Config , defConfigText ) where -import Universum +import Universum hiding ((.~)) -import Control.Lens (makeLensesWith) +import Control.Lens (makeLensesWith, (.~)) import Data.Aeson (genericParseJSON) import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withText) import Text.Regex.TDFA.Text () diff --git a/src/Xrefcheck/Core.hs b/src/Xrefcheck/Core.hs index 2379cb9c..9519e1ac 100644 --- a/src/Xrefcheck/Core.hs +++ b/src/Xrefcheck/Core.hs @@ -9,9 +9,9 @@ module Xrefcheck.Core where -import Universum +import Universum hiding ((^..)) -import Control.Lens (folded, makeLenses, makePrisms, to, united) +import Control.Lens (folded, makeLenses, makePrisms, to, united, (^..)) import Data.Aeson (FromJSON (..), withText) import Data.Char (isAlphaNum) import Data.Char qualified as C diff --git a/src/Xrefcheck/Scan.hs b/src/Xrefcheck/Scan.hs index 54ff7f59..f6a910b7 100644 --- a/src/Xrefcheck/Scan.hs +++ b/src/Xrefcheck/Scan.hs @@ -31,9 +31,9 @@ module Xrefcheck.Scan , scanRepo ) where -import Universum +import Universum hiding (_1, (%~)) -import Control.Lens (makeLensesWith) +import Control.Lens (_1, makeLensesWith, (%~)) import Data.Aeson (FromJSON (..), genericParseJSON, withText) import Data.Map qualified as M import Data.Reflection (Given) diff --git a/src/Xrefcheck/Scanners/Markdown.hs b/src/Xrefcheck/Scanners/Markdown.hs index 0c3480e9..d3cc6962 100644 --- a/src/Xrefcheck/Scanners/Markdown.hs +++ b/src/Xrefcheck/Scanners/Markdown.hs @@ -16,11 +16,11 @@ module Xrefcheck.Scanners.Markdown , makeError ) where -import Universum +import Universum hiding (use) import CMarkGFM (Node (..), NodeType (..), PosInfo (..), commonmarkToNode, extAutolink, optFootnotes) -import Control.Lens (_Just, makeLenses, makeLensesFor, (.=)) +import Control.Lens (_Just, makeLenses, makeLensesFor, use, (.=)) import Control.Monad.Trans.Writer.CPS (Writer, runWriter, tell) import Data.Aeson (FromJSON (..), genericParseJSON) import Data.ByteString.Lazy qualified as BSL diff --git a/src/Xrefcheck/Util.hs b/src/Xrefcheck/Util.hs index 47d8fc12..022532e8 100644 --- a/src/Xrefcheck/Util.hs +++ b/src/Xrefcheck/Util.hs @@ -17,9 +17,9 @@ module Xrefcheck.Util , module Xrefcheck.Util.Interpolate ) where -import Universum +import Universum hiding ((.~)) -import Control.Lens (LensRules, lensField, lensRules, mappingNamer) +import Control.Lens (LensRules, lensField, lensRules, mappingNamer, (.~)) import Data.Aeson qualified as Aeson import Data.Aeson.Casing (aesonPrefix, camelCase) import Data.Fixed (Fixed (MkFixed), HasResolution (resolution)) diff --git a/tests/Test/Xrefcheck/AnchorsInHeadersSpec.hs b/tests/Test/Xrefcheck/AnchorsInHeadersSpec.hs index bd53245e..7b4bf057 100644 --- a/tests/Test/Xrefcheck/AnchorsInHeadersSpec.hs +++ b/tests/Test/Xrefcheck/AnchorsInHeadersSpec.hs @@ -5,8 +5,9 @@ module Test.Xrefcheck.AnchorsInHeadersSpec where -import Universum +import Universum hiding ((^.)) +import Control.Lens ((^.)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) diff --git a/tests/Test/Xrefcheck/AnchorsSpec.hs b/tests/Test/Xrefcheck/AnchorsSpec.hs index 4f87dadf..e5f14496 100644 --- a/tests/Test/Xrefcheck/AnchorsSpec.hs +++ b/tests/Test/Xrefcheck/AnchorsSpec.hs @@ -5,8 +5,9 @@ module Test.Xrefcheck.AnchorsSpec where -import Universum +import Universum hiding ((^.)) +import Control.Lens ((^.)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) diff --git a/tests/Test/Xrefcheck/ConfigSpec.hs b/tests/Test/Xrefcheck/ConfigSpec.hs index 06855d1f..6158d613 100644 --- a/tests/Test/Xrefcheck/ConfigSpec.hs +++ b/tests/Test/Xrefcheck/ConfigSpec.hs @@ -5,10 +5,11 @@ module Test.Xrefcheck.ConfigSpec where -import Universum +import Universum hiding ((.~)) import Control.Concurrent (forkIO, killThread) import Control.Exception qualified as E +import Control.Lens ((.~)) import Data.List (isInfixOf) import Data.Yaml (ParseException (..), decodeEither') diff --git a/tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs b/tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs index 8091d912..c390f2c6 100644 --- a/tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs +++ b/tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs @@ -5,9 +5,10 @@ module Test.Xrefcheck.IgnoreAnnotationsSpec where -import Universum +import Universum hiding ((^.)) import CMarkGFM (PosInfo (..)) +import Control.Lens ((^.)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) diff --git a/tests/Test/Xrefcheck/IgnoreRegexSpec.hs b/tests/Test/Xrefcheck/IgnoreRegexSpec.hs index c6af37e9..a6755647 100644 --- a/tests/Test/Xrefcheck/IgnoreRegexSpec.hs +++ b/tests/Test/Xrefcheck/IgnoreRegexSpec.hs @@ -5,8 +5,9 @@ module Test.Xrefcheck.IgnoreRegexSpec where -import Universum +import Universum hiding ((.~), (^.)) +import Control.Lens ((.~), (^.)) import Data.Reflection (give) import Data.Yaml (decodeEither') import Test.Tasty (TestTree, testGroup) diff --git a/tests/Test/Xrefcheck/RedirectChainSpec.hs b/tests/Test/Xrefcheck/RedirectChainSpec.hs index 4b7a4752..dff1b0f7 100644 --- a/tests/Test/Xrefcheck/RedirectChainSpec.hs +++ b/tests/Test/Xrefcheck/RedirectChainSpec.hs @@ -5,8 +5,9 @@ module Test.Xrefcheck.RedirectChainSpec where -import Universum +import Universum hiding ((.~)) +import Control.Lens ((.~)) import Data.CaseInsensitive qualified as CI import Data.Map qualified as M import Network.HTTP.Types (mkStatus) diff --git a/tests/Test/Xrefcheck/RedirectConfigSpec.hs b/tests/Test/Xrefcheck/RedirectConfigSpec.hs index 01f1f52f..c54683cf 100644 --- a/tests/Test/Xrefcheck/RedirectConfigSpec.hs +++ b/tests/Test/Xrefcheck/RedirectConfigSpec.hs @@ -5,8 +5,9 @@ module Test.Xrefcheck.RedirectConfigSpec where -import Universum +import Universum hiding ((%~), (.~)) +import Control.Lens ((%~), (.~)) import Data.CaseInsensitive qualified as CI import Data.Map qualified as M import Network.HTTP.Types (mkStatus) diff --git a/tests/Test/Xrefcheck/TimeoutSpec.hs b/tests/Test/Xrefcheck/TimeoutSpec.hs index 496b6b4b..b6774a6b 100644 --- a/tests/Test/Xrefcheck/TimeoutSpec.hs +++ b/tests/Test/Xrefcheck/TimeoutSpec.hs @@ -5,8 +5,9 @@ module Test.Xrefcheck.TimeoutSpec where -import Universum +import Universum hiding ((.~)) +import Control.Lens ((.~)) import Data.CaseInsensitive qualified as CI import Data.Map qualified as M import Data.Set qualified as S diff --git a/tests/Test/Xrefcheck/TrailingSlashSpec.hs b/tests/Test/Xrefcheck/TrailingSlashSpec.hs index 7e7ec1d5..213488a7 100644 --- a/tests/Test/Xrefcheck/TrailingSlashSpec.hs +++ b/tests/Test/Xrefcheck/TrailingSlashSpec.hs @@ -5,8 +5,9 @@ module Test.Xrefcheck.TrailingSlashSpec where -import Universum +import Universum hiding ((.~)) +import Control.Lens ((.~)) import System.Directory (doesFileExist) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase) diff --git a/tests/Test/Xrefcheck/UtilRequests.hs b/tests/Test/Xrefcheck/UtilRequests.hs index 2587b9ff..f1a8d1a5 100644 --- a/tests/Test/Xrefcheck/UtilRequests.hs +++ b/tests/Test/Xrefcheck/UtilRequests.hs @@ -15,10 +15,11 @@ module Test.Xrefcheck.UtilRequests , VerifyLinkTestEntry (..) ) where -import Universum +import Universum hiding ((.~)) import Control.Concurrent (forkIO, killThread) import Control.Exception qualified as E +import Control.Lens ((.~)) import Data.Map qualified as M import Data.Set qualified as S import Test.Tasty.HUnit (assertBool) From 74ed94155c56aa9dc6fd09953e27131d740ce63a Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Wed, 18 Sep 2024 01:47:46 +0300 Subject: [PATCH 07/10] [Chore] Do not use removed functions from Options.Applicative.Help.Pretty MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem: build failure with newer versions of optparse-applicative Module ‘Options.Applicative.Help.Pretty’ does not export ‘displayS’ Module ‘Options.Applicative.Help.Pretty’ does not export ‘renderPretty’ Module ‘Options.Applicative.Help.Pretty’ does not export ‘text’ Solution: stop using functions that have been removed. --- src/Xrefcheck/CLI.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/Xrefcheck/CLI.hs b/src/Xrefcheck/CLI.hs index 2db27f43..58d7094f 100644 --- a/src/Xrefcheck/CLI.hs +++ b/src/Xrefcheck/CLI.hs @@ -31,7 +31,7 @@ import Options.Applicative (Mod, OptionFields, Parser, ReadM, auto, command, eitherReader, execParser, flag, flag', footerDoc, fullDesc, help, helpDoc, helper, hsubparser, info, infoOption, long, metavar, option, progDesc, short, strOption, switch, value) -import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, renderPretty, text) +import Options.Applicative.Help.Pretty (Doc, fill, fillSep, indent, pretty) import Options.Applicative.Help.Pretty qualified as Pretty import Text.Interpolation.Nyan @@ -289,17 +289,13 @@ getCommand = do footerDoc (pure ignoreModesMsg) ignoreModesMsg :: Doc -ignoreModesMsg = text $ header <> body +ignoreModesMsg = text header <> body where header = "To ignore a link in your markdown, \ \include \"\"\n\ \comment with one of these modes:\n" - body = displayS (renderPretty pageParam pageWidth doc) "" - pageWidth = 80 - pageParam = 1 - - doc = fillSep $ map formatDesc modeDescr + body = fillSep $ map formatDesc modeDescr modeDescr = [ (" \"link\"", L.words "Ignore the link right after the comment.") @@ -314,3 +310,6 @@ ignoreModesMsg = text $ header <> body formatDesc (mode, descr) = fill modeIndent (text mode) <> indent descrIndent (fillSep $ map text descr) + +text :: String -> Doc +text = pretty From 1c9f4874f4c01fda68375913a9c87946813b00fe Mon Sep 17 00:00:00 2001 From: Roman Melnikov Date: Mon, 1 Apr 2024 15:54:04 +0200 Subject: [PATCH 08/10] [Chore] Fix issues with windows cross-compilation via nix Problem: Cross-compilation to windows is broken. Solution: Build 'bitvec' without 'simd' flag --- flake.nix | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/flake.nix b/flake.nix index 58b1894b..ba5d45f2 100644 --- a/flake.nix +++ b/flake.nix @@ -19,7 +19,7 @@ name = "xrefcheck"; path = ./.; }; - modules = [{ + modules = [({ pkgs, ... }: { packages.xrefcheck = { ghcOptions = [ "-Werror" ]; @@ -51,7 +51,10 @@ xrefcheck-tests.build-tools = [ pkgs.git ]; }; }; - }]; + # bitvec compilation on mingw64 with 'simd' flag fails with + # unknown symbol `__cpu_model' + packages.bitvec.flags.simd = !pkgs.stdenv.targetPlatform.isWindows; + })]; }).flake { crossPlatforms = p: [ p.musl64 p.mingwW64 ]; }; in From a59030a75dc1bdc51da1050b0954c3b59e56dea6 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Wed, 18 Sep 2024 13:04:29 +0300 Subject: [PATCH 09/10] [Chore] Use newer stack on Windows CI --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index da73929d..82a4cd0e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -46,7 +46,7 @@ jobs: runs-on: windows-latest strategy: matrix: - stack: ["2.7.5"] + stack: ["3.1.1"] ghc: ["9.6.6"] include: - ghc: "9.6.6" From 7d43d9c6d3f2cb5a14e38682095e45342ea523cc Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Sun, 13 Oct 2024 01:48:27 +0300 Subject: [PATCH 10/10] [Chore] Replace firefly with scotty in tests Problem: `firefly` depends on `regex-pcre`, which fails to build in certain configurations: regex-pcre > regex-pcre-0.95.0.0: library-dirs: /usr/lib is a relative path which makes no regex-pcre > sense (as there is nothing for it to be relative to). You can make paths regex-pcre > relative to the package database itself by using ${pkgroot}. (use --force to regex-pcre > override) regex-pcre > regex-pcre-0.95.0.0: dynamic-library-dirs: /usr/lib is a relative path which regex-pcre > makes no sense (as there is nothing for it to be relative to). You can make regex-pcre > paths relative to the package database itself by using ${pkgroot}. (use regex-pcre > --force to override) The problem only occurs with `stack` on Windows. Therefore, there are two possible workarounds: (a) use `cabal`, (b) drop Windows support. However, we would like to support both build tools on all platforms if possible. Solution: replace `firefly` with `scotty`, a different web server library that does not depend on `regex-pcre`. --- .github/workflows/ci.yml | 13 ----- package.yaml | 4 +- stack.yaml | 1 - stack.yaml.lock | 7 --- tests/Test/Xrefcheck/RedirectChainSpec.hs | 58 +++++++++++++-------- tests/Test/Xrefcheck/RedirectConfigSpec.hs | 43 ++++++++------- tests/Test/Xrefcheck/RedirectDefaultSpec.hs | 18 ++++--- tests/Test/Xrefcheck/TimeoutSpec.hs | 29 ++++++----- tests/Test/Xrefcheck/TooManyRequestsSpec.hs | 49 ++++++++--------- tests/Test/Xrefcheck/Util.hs | 10 ++-- 10 files changed, 119 insertions(+), 113 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 82a4cd0e..c783cc21 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -75,19 +75,6 @@ jobs: path: ~/AppData/Local/Programs/stack key: ${{ runner.os }}-${{ matrix.ghc }}-appdata-stack - -# When editing this action, make sure it can run without using cached folders. -# Yes, it tries to install mingw-w64-x86_64-pcre twice - - name: install pacman dependencies - run: | - stack --system-ghc exec -- pacman -S --needed --noconfirm pkgconf; - stack --system-ghc exec -- pacman -S --needed --noconfirm msys2-keyring; - stack --system-ghc exec -- pacman --noconfirm -Syuu; - stack --system-ghc exec -- pacman -S --needed --noconfirm mingw-w64-x86_64-pcre; - stack --system-ghc exec -- pacman --noconfirm -Syuu; - stack --system-ghc exec -- pacman -S --needed --noconfirm mingw-w64-x86_64-pcre; - stack --system-ghc exec -- pacman -S --needed --noconfirm pcre-devel; - - name: Build run: | stack build --system-ghc --stack-yaml ${{ matrix.stackyaml }} --test --bench --no-run-tests --no-run-benchmarks --ghc-options '-Werror' diff --git a/package.yaml b/package.yaml index 15989a85..0dd6b026 100644 --- a/package.yaml +++ b/package.yaml @@ -149,7 +149,9 @@ tests: - cmark-gfm - containers - directory - - firefly + - wai + - warp + - scotty - http-types - lens - modern-uri diff --git a/stack.yaml b/stack.yaml index b550c583..a2d2a9de 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,7 +10,6 @@ packages: - . extra-deps: -- firefly-0.2.1.0@sha256:e9d73486464c3e223ec457e02b30ddd5b550fdbf6292b268c64581e2b07d888b,1519 - cmark-gfm-0.2.5 - nyan-interpolation-core-0.9.2 - nyan-interpolation-0.9.2 diff --git a/stack.yaml.lock b/stack.yaml.lock index 67bd5359..33fa87bd 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -4,13 +4,6 @@ # https://docs.haskellstack.org/en/stable/lock_files packages: -- completed: - hackage: firefly-0.2.1.0@sha256:e9d73486464c3e223ec457e02b30ddd5b550fdbf6292b268c64581e2b07d888b,1519 - pantry-tree: - sha256: 51d4bf283e1d9ae37e43cd387b112919e45f2fc088f57cbd33c8bad9b0c179f1 - size: 600 - original: - hackage: firefly-0.2.1.0@sha256:e9d73486464c3e223ec457e02b30ddd5b550fdbf6292b268c64581e2b07d888b,1519 - completed: hackage: cmark-gfm-0.2.5@sha256:a53b3c6ed20b5476ae18df5f28ababbb6ec8543f9a0758f0381a532d7a879fc0,5188 pantry-tree: diff --git a/tests/Test/Xrefcheck/RedirectChainSpec.hs b/tests/Test/Xrefcheck/RedirectChainSpec.hs index dff1b0f7..5a71d829 100644 --- a/tests/Test/Xrefcheck/RedirectChainSpec.hs +++ b/tests/Test/Xrefcheck/RedirectChainSpec.hs @@ -9,12 +9,12 @@ import Universum hiding ((.~)) import Control.Lens ((.~)) import Data.CaseInsensitive qualified as CI -import Data.Map qualified as M -import Network.HTTP.Types (mkStatus) -import Network.HTTP.Types.Header (hLocation) +import Network.HTTP.Types (movedPermanently301) +import Network.HTTP.Types.Header (HeaderName, hLocation) +import Network.Wai.Handler.Warp qualified as Web import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) -import Web.Firefly (App, ToResponse (toResponse), route, run) +import Web.Scotty qualified as Web import Test.Xrefcheck.UtilRequests import Xrefcheck.Config @@ -115,32 +115,48 @@ test_redirectRequests = testGroup "Redirect chain tests" & cNetworkingL . ncExternalRefRedirectsL .~ [RedirectRule Nothing Nothing Nothing RROFollow] & cNetworkingL . ncMaxRedirectFollowsL .~ limit - redirectRoute :: Text -> Maybe Text -> App () - redirectRoute name to = route name $ pure $ toResponse - ( "" :: Text - , mkStatus 301 "Permanent redirect" - , M.fromList [(CI.map (decodeUtf8 @Text) hLocation, maybeToList to)] - ) + setHeader :: HeaderName -> Text -> Web.ActionM () + setHeader hdr value = Web.setHeader (decodeUtf8 (CI.original hdr)) (fromStrict value) mockRedirect :: IO () mockRedirect = do - run 5000 do + Web.run 5000 <=< Web.scottyApp $ do -- A set of redirect routes that correspond to a broken chain. - redirectRoute "/broken1" $ Just $ link "/broken2" - redirectRoute "/broken2" $ Just $ link "/broken3" - redirectRoute "/broken3" Nothing + Web.matchAny "/broken1" $ do + setHeader hLocation (link "/broken2") + Web.status movedPermanently301 + Web.matchAny "/broken2" $ do + setHeader hLocation (link "/broken3") + Web.status movedPermanently301 + Web.matchAny "/broken3" $ do + -- hLocation: no value + Web.status movedPermanently301 -- A set of redirect routes that correspond to a cycle. - redirectRoute "/cycle1" $ Just $ link "/cycle2" - redirectRoute "/cycle2" $ Just $ link "/cycle3" - redirectRoute "/cycle3" $ Just $ link "/cycle4" - redirectRoute "/cycle4" $ Just $ link "/cycle2" + Web.matchAny "/cycle1" $ do + setHeader hLocation (link "/cycle2") + Web.status movedPermanently301 + Web.matchAny "/cycle2" $ do + setHeader hLocation (link "/cycle3") + Web.status movedPermanently301 + Web.matchAny "/cycle3" $ do + setHeader hLocation (link "/cycle4") + Web.status movedPermanently301 + Web.matchAny "/cycle4" $ do + setHeader hLocation (link "/cycle2") + Web.status movedPermanently301 -- Relative redirects. - redirectRoute "/relative/host" $ Just "/cycle2" - redirectRoute "/relative/path" $ Just "host" + Web.matchAny "/relative/host" $ do + setHeader hLocation "/cycle2" + Web.status movedPermanently301 + Web.matchAny "/relative/path" $ do + setHeader hLocation "host" + Web.status movedPermanently301 -- To other host otherMockRedirect :: IO () otherMockRedirect = - run 5001 $ redirectRoute "/other/host" $ Just $ link "/relative/host" + Web.run 5001 <=< Web.scottyApp $ Web.matchAny "/other/host" $ do + setHeader hLocation (link "/relative/host") + Web.status movedPermanently301 diff --git a/tests/Test/Xrefcheck/RedirectConfigSpec.hs b/tests/Test/Xrefcheck/RedirectConfigSpec.hs index c54683cf..cfad57ad 100644 --- a/tests/Test/Xrefcheck/RedirectConfigSpec.hs +++ b/tests/Test/Xrefcheck/RedirectConfigSpec.hs @@ -9,13 +9,13 @@ import Universum hiding ((%~), (.~)) import Control.Lens ((%~), (.~)) import Data.CaseInsensitive qualified as CI -import Data.Map qualified as M -import Network.HTTP.Types (mkStatus) -import Network.HTTP.Types.Header (hLocation) +import Network.HTTP.Types (found302, movedPermanently301, temporaryRedirect307) +import Network.HTTP.Types.Header (HeaderName, hLocation) +import Network.Wai.Handler.Warp qualified as Web import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import Text.Regex.TDFA.Text qualified as R -import Web.Firefly (App, Status, ToResponse (toResponse), route, run) +import Web.Scotty qualified as Web import Test.Xrefcheck.UtilRequests import Xrefcheck.Config @@ -156,20 +156,13 @@ test_redirectRequests = testGroup "Redirect config tests" regex :: Text -> Maybe R.Regex regex = rightToMaybe . R.compile defaultCompOption defaultExecOption - status :: Int -> Status - status code = mkStatus code "Redirect" - configMod :: [RedirectRule] -> [R.Regex] -> Config -> Config configMod rules exclussions config = config & cNetworkingL . ncExternalRefRedirectsL %~ (rules <>) & cExclusionsL . ecIgnoreExternalRefsToL .~ exclussions - redirectRoute :: Text -> Int -> Maybe Text -> App () - redirectRoute name code to = route name $ pure $ toResponse - ( "" :: Text - , status code - , M.fromList [(CI.map (decodeUtf8 @Text) hLocation, fmap link $ maybeToList to)] - ) + setHeader :: HeaderName -> Text -> Web.ActionM () + setHeader hdr value = Web.setHeader (decodeUtf8 (CI.original hdr)) (fromStrict value) progress :: Bool -> Progress Int Text progress shouldSucceed = report "" $ initProgress 1 @@ -181,10 +174,20 @@ test_redirectRequests = testGroup "Redirect config tests" mockRedirect :: IO () mockRedirect = - run 5000 do - route "/ok" $ pure $ toResponse ("Ok" :: Text) - redirectRoute "/permanent-redirect" 301 $ Just "/ok" - redirectRoute "/temporary-redirect" 302 $ Just "/ok" - redirectRoute "/follow1" 301 $ Just "/follow2" - redirectRoute "/follow2" 302 $ Just "/follow3" - redirectRoute "/follow3" 307 $ Just "/ok" + Web.run 5000 <=< Web.scottyApp $ do + Web.matchAny "/ok" $ Web.raw "Ok" + Web.matchAny "/permanent-redirect" $ do + setHeader hLocation "/ok" + Web.status movedPermanently301 + Web.matchAny "/temporary-redirect" $ do + setHeader hLocation "/ok" + Web.status found302 + Web.matchAny "/follow1" $ do + setHeader hLocation "/follow2" + Web.status movedPermanently301 + Web.matchAny "/follow2" $ do + setHeader hLocation "/follow3" + Web.status found302 + Web.matchAny "/follow3" $ do + setHeader hLocation "/ok" + Web.status temporaryRedirect307 diff --git a/tests/Test/Xrefcheck/RedirectDefaultSpec.hs b/tests/Test/Xrefcheck/RedirectDefaultSpec.hs index 1f06503c..5184d0a0 100644 --- a/tests/Test/Xrefcheck/RedirectDefaultSpec.hs +++ b/tests/Test/Xrefcheck/RedirectDefaultSpec.hs @@ -8,13 +8,13 @@ module Test.Xrefcheck.RedirectDefaultSpec where import Universum import Data.CaseInsensitive qualified as CI -import Data.Map qualified as M import Data.Set qualified as S import Network.HTTP.Types (Status, mkStatus) -import Network.HTTP.Types.Header (hLocation) +import Network.HTTP.Types.Header (HeaderName, hLocation) +import Network.Wai.Handler.Warp qualified as Web import Test.Tasty (TestName, TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase) -import Web.Firefly (ToResponse (toResponse), route, run) +import Web.Scotty qualified as Web import Test.Xrefcheck.UtilRequests import Xrefcheck.Config @@ -78,8 +78,10 @@ test_redirectRequests = testGroup "Redirect response defaults" mockRedirect :: Maybe Text -> Status -> IO () mockRedirect expectedLocation expectedStatus = - run 5000 $ route "/redirect" $ pure $ toResponse - ( "" :: Text - , expectedStatus - , M.fromList [(CI.map (decodeUtf8 @Text) hLocation, maybeToList expectedLocation)] - ) + Web.run 5000 <=< Web.scottyApp $ + Web.matchAny "/redirect" $ do + whenJust expectedLocation (setHeader hLocation) + Web.status expectedStatus + + setHeader :: HeaderName -> Text -> Web.ActionM () + setHeader hdr value = Web.setHeader (decodeUtf8 (CI.original hdr)) (fromStrict value) diff --git a/tests/Test/Xrefcheck/TimeoutSpec.hs b/tests/Test/Xrefcheck/TimeoutSpec.hs index b6774a6b..1ab08fcb 100644 --- a/tests/Test/Xrefcheck/TimeoutSpec.hs +++ b/tests/Test/Xrefcheck/TimeoutSpec.hs @@ -9,14 +9,14 @@ import Universum hiding ((.~)) import Control.Lens ((.~)) import Data.CaseInsensitive qualified as CI -import Data.Map qualified as M import Data.Set qualified as S import Network.HTTP.Types (ok200, tooManyRequests429) -import Network.HTTP.Types.Header (hRetryAfter) +import Network.HTTP.Types.Header (HeaderName, hRetryAfter) +import Network.Wai.Handler.Warp qualified as Web import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import Time (Second, Time, sec, threadDelay) -import Web.Firefly (ToResponse (toResponse), route, run) +import Web.Scotty qualified as Web import Test.Xrefcheck.UtilRequests import Xrefcheck.Config @@ -122,24 +122,25 @@ test_timeout = testGroup "Timeout tests" mockTimeout :: Time Second -> [MockTimeoutBehaviour] -> IO () mockTimeout timeout behList = do ref <- newIORef @_ behList - run 5000 $ do - route "/timeout" $ handler ref - route "/timeoutother" $ handler ref + Web.run 5000 <=< Web.scottyApp $ do + Web.matchAny "/timeout" $ handler ref + Web.matchAny "/timeoutother" $ handler ref where handler ref = do mbCurrentAction <- atomicModifyIORef' ref $ \case b : bs -> (bs, Just b) [] -> ([], Nothing) - let success = toResponse ("" :: Text, ok200, M.empty @(CI.CI Text) @[Text]) case mbCurrentAction of - Nothing -> pure success - Just Ok -> pure success + Nothing -> Web.status ok200 + Just Ok -> Web.status ok200 Just Delay -> do threadDelay timeout - pure $ toResponse ("" :: Text, ok200, M.empty @(CI.CI Text) @[Text]) - Just Respond429 -> - pure $ toResponse - ("" :: Text, tooManyRequests429, - M.fromList [(CI.map (decodeUtf8 @Text) hRetryAfter, ["1" :: Text])]) + Web.status ok200 + Just Respond429 -> do + setHeader hRetryAfter "1" + Web.status tooManyRequests429 + + setHeader :: HeaderName -> Text -> Web.ActionM () + setHeader hdr value = Web.setHeader (decodeUtf8 (CI.original hdr)) (fromStrict value) data MockTimeoutBehaviour = Respond429 | Delay | Ok diff --git a/tests/Test/Xrefcheck/TooManyRequestsSpec.hs b/tests/Test/Xrefcheck/TooManyRequestsSpec.hs index 172ff033..806f0cef 100644 --- a/tests/Test/Xrefcheck/TooManyRequestsSpec.hs +++ b/tests/Test/Xrefcheck/TooManyRequestsSpec.hs @@ -10,16 +10,17 @@ import Universum import Control.Concurrent (forkIO, killThread) import Control.Exception qualified as E import Data.CaseInsensitive qualified as CI -import Data.Map qualified as M import Data.Set qualified as S import Data.Time (addUTCTime, defaultTimeLocale, formatTime, getCurrentTime, rfc822DateFormat) import Data.Time.Clock.POSIX (getPOSIXTime) import Network.HTTP.Types (Status (..), ok200, serviceUnavailable503, tooManyRequests429) -import Network.HTTP.Types.Header (hRetryAfter) +import Network.HTTP.Types.Header (HeaderName, hRetryAfter) +import Network.Wai (requestMethod) +import Network.Wai.Handler.Warp qualified as Web import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, testCase, (@?=)) import Time (sec, (-:-)) -import Web.Firefly (ToResponse (toResponse), getMethod, route, run) +import Web.Scotty qualified as Web import Test.Xrefcheck.UtilRequests import Xrefcheck.Core @@ -113,9 +114,10 @@ test_tooManyRequests = testGroup "429 response tests" mock429WithGlobalIORef :: IORef [(Text, Status)] -> IO () mock429WithGlobalIORef infoReverseAccumulatorRef = do callCountRef <- newIORef @_ @Int 0 - run 5000 $ do - route "/429grandfinale" $ do - m <- getMethod + Web.run 5000 <=< Web.scottyApp $ + Web.matchAny "/429grandfinale" $ do + req <- Web.request + let m = decodeUtf8 (requestMethod req) callCount <- atomicModifyIORef' callCountRef $ \cc -> (cc + 1, cc) atomicModifyIORef' infoReverseAccumulatorRef $ \lst -> ( ( m @@ -125,14 +127,12 @@ test_tooManyRequests = testGroup "429 response tests" ) : lst , () ) - pure $ if - | m == "GET" -> toResponse ("" :: Text, ok200) - | callCount == 0 -> toResponse - ( "" :: Text - , tooManyRequests429 - , M.fromList [(CI.map (decodeUtf8 @Text) hRetryAfter, ["1" :: Text])] - ) - | otherwise -> toResponse ("" :: Text, serviceUnavailable503) + if + | m == "GET" -> Web.status ok200 + | callCount == 0 -> do + Web.status tooManyRequests429 + setHeader hRetryAfter "1" + | otherwise -> Web.status serviceUnavailable503 infoReverseAccumulatorRef <- newIORef [] setRef <- newIORef S.empty E.bracket (forkIO $ mock429WithGlobalIORef infoReverseAccumulatorRef) killThread $ \_ -> do @@ -150,14 +150,15 @@ test_tooManyRequests = testGroup "429 response tests" mock429 :: Text -> Status -> IO () mock429 retryAfter status = do callCountRef <- newIORef @_ @Int 0 - run 5000 $ - route "/429" $ do + Web.run 5000 <=< Web.scottyApp $ + Web.matchAny "/429" $ do callCount <- atomicModifyIORef' callCountRef $ \cc -> (cc + 1, cc) - pure $ - if callCount == 0 - then toResponse - ( "" :: Text - , tooManyRequests429 - , M.fromList [(CI.map (decodeUtf8 @Text) hRetryAfter, [retryAfter])] - ) - else toResponse ("" :: Text, status) + if callCount == 0 + then do + setHeader hRetryAfter retryAfter + Web.status tooManyRequests429 + else do + Web.status status + + setHeader :: HeaderName -> Text -> Web.ActionM () + setHeader hdr value = Web.setHeader (decodeUtf8 (CI.original hdr)) (fromStrict value) diff --git a/tests/Test/Xrefcheck/Util.hs b/tests/Test/Xrefcheck/Util.hs index fa05db29..713deab8 100644 --- a/tests/Test/Xrefcheck/Util.hs +++ b/tests/Test/Xrefcheck/Util.hs @@ -9,9 +9,10 @@ import Universum import Data.Tagged (untag) import Network.HTTP.Types (forbidden403, unauthorized401) +import Network.Wai.Handler.Warp qualified as Web import Options.Applicative (auto, help, long, option) import Test.Tasty.Options as Tasty (IsOption (..), OptionDescription (Option), safeRead) -import Web.Firefly (ToResponse (..), route, run) +import Web.Scotty qualified as Web import Xrefcheck.Core (Flavor) import Xrefcheck.Scan (ScanAction) @@ -25,9 +26,10 @@ 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) +mockServer (MockServerPort port) = + Web.run port <=< Web.scottyApp $ do + Web.matchAny "/401" $ Web.status unauthorized401 + Web.matchAny "/403" $ Web.status forbidden403 -- | All options needed to configure the mock server. mockServerOptions :: [OptionDescription]