fixup! fixup! [#25] Redirect links with configuration rules

serokell · Dec 29, 2022 · 8da9d37 · 8da9d37
1 parent 521a44b
commit 8da9d37
Showing 1 changed file with 2 additions and 3 deletions.
diff --git a/src/Xrefcheck/Verify.hs b/src/Xrefcheck/Verify.hs
@@ -670,6 +670,7 @@ checkExternalResource :: [Text] -> Config -> Text -> IO (VerifyResult VerifyErro
 checkExternalResource followed config@Config{..} link
   | isIgnored = return mempty
   | otherwise = fmap toVerifyRes $ runExceptT $ do
+      when (link `elem` followed) $ throwError $ RedirectCycle (link : followed)
       uri <- parseUri link
       case toString <$> uriScheme uri of
         Just "http" -> checkHttp uri
@@ -723,10 +724,8 @@ checkExternalResource followed config@Config{..} link
         Nothing -> throwError $ ExternalResourceSomeError "Response timeout"
         Just RRDone -> pure ()
         Just (RRFollow nextLink) -> do
-          when (nextLink `elem` followed) $
-            throwError $ RedirectCycle (nextLink : followed)
           (VerifyResult errs) <- liftIO $
-            checkExternalResource (nextLink : followed) config nextLink
+            checkExternalResource (link : followed) config nextLink
           mapM_ throwError errs
 
     isAllowedErrorCode :: Int -> Bool