[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

@@ -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'

package.yaml

@@ -149,7 +149,8 @@ tests:
       - cmark-gfm
       - containers
       - directory
-      - firefly
+      - wai
+      - scotty
       - http-types
       - lens
       - modern-uri

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

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:

tests/Test/Xrefcheck/RedirectChainSpec.hs

@@ -9,12 +9,11 @@ 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 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 +114,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.scotty 5000 $ 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.scotty 5001 $ Web.matchAny "/other/host" $ do
+        setHeader hLocation (link "/relative/host")
+        Web.status movedPermanently301

tests/Test/Xrefcheck/RedirectConfigSpec.hs

@@ -9,13 +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 (found302, movedPermanently301, temporaryRedirect307)
+import Network.HTTP.Types.Header (HeaderName, hLocation)
 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 +155,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 +173,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.scotty 5000 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

tests/Test/Xrefcheck/RedirectDefaultSpec.hs

@@ -8,13 +8,12 @@ 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 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 +77,9 @@ 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.scotty 5000 $ 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)

tests/Test/Xrefcheck/TimeoutSpec.hs

@@ -9,14 +9,13 @@ 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 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 +121,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.scotty 5000 $ 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

tests/Test/Xrefcheck/TooManyRequestsSpec.hs

@@ -10,16 +10,16 @@ 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 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 +113,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.scotty 5000 $ do
+            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 +126,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 +149,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.scotty 5000 $
+        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)

tests/Test/Xrefcheck/Util.hs

@@ -11,7 +11,7 @@ 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 Web.Scotty qualified as Web
 
 import Xrefcheck.Core (Flavor)
 import Xrefcheck.Scan (ScanAction)
@@ -25,9 +25,9 @@ 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.scotty port $ do
+  Web.matchAny "/401" $ Web.status unauthorized401
+  Web.matchAny "/403" $ Web.status forbidden403
 
 -- | All options needed to configure the mock server.
 mockServerOptions :: [OptionDescription]