RedirectConfigSpec.hs

{- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

module Test.Xrefcheck.RedirectConfigSpec where

import Universum hiding ((%~), (.~))

import Control.Lens ((%~), (.~))
import Data.CaseInsensitive qualified as CI
import Network.HTTP.Types (found302, movedPermanently301, temporaryRedirect307)
import Network.HTTP.Types.Header (HeaderName, hLocation)
import Network.Wai qualified as Web
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)
import Text.Regex.TDFA.Text qualified as R
import Web.Scotty qualified as Web

import Test.Xrefcheck.UtilRequests
import Xrefcheck.Config
import Xrefcheck.Progress
import Xrefcheck.Scan
import Xrefcheck.Verify

test_redirectRequests :: TestTree
test_redirectRequests = testGroup "Redirect config tests"
  [ testGroup "Match"
      [ testGroup "By \"on\""
          [ testCase "Do match" $ do
              setRef <- newIORef mempty
              checkLinkAndProgressWithServer
                (configMod [RedirectRule Nothing Nothing (Just RROTemporary) RROInvalid] [])
                setRef
                (5000, mockRedirect)
                (link "/temporary-redirect")
                (progress False)
                (VerifyResult [RedirectRuleError (chain ["/temporary-redirect", "/ok"]) (Just RROTemporary)])
          , testCase "Do not match" $ do
              setRef <- newIORef mempty
              checkLinkAndProgressWithServer
                (configMod [RedirectRule Nothing Nothing (Just RROPermanent) RROInvalid] [])
                setRef
                (5000, mockRedirect)
                (link "/temporary-redirect")
                (progress True)
                (VerifyResult [])
          ]
      , testGroup "By \"to\""
          [ testCase "Do match" $ do
              setRef <- newIORef mempty
              checkLinkAndProgressWithServer
                (configMod [RedirectRule Nothing (regex ".*/ok") Nothing RROValid] [])
                setRef
                (5000, mockRedirect)
                (link "/permanent-redirect")
                (progress True)
                (VerifyResult [])
          , testCase "Do not match" $ do
              setRef <- newIORef mempty
              checkLinkAndProgressWithServer
                (configMod [RedirectRule Nothing (regex ".*/no-ok") (Just RROPermanent) RROValid] [])
                setRef
                (5000, mockRedirect)
                (link "/permanent-redirect")
                (progress False)
                (VerifyResult [RedirectRuleError (chain ["/permanent-redirect", "/ok"]) (Just RROPermanent)])
          ]
      , testGroup "By \"from\""
          [ testCase "Do match" $ do
              setRef <- newIORef mempty
              checkLinkAndProgressWithServer
                (configMod [RedirectRule (regex ".*/permanent-.*") Nothing Nothing RROValid] [])
                setRef
                (5000, mockRedirect)
                (link "/permanent-redirect")
                (progress True)
                (VerifyResult [])
          , testCase "Do not match" $ do
              setRef <- newIORef mempty
              checkLinkAndProgressWithServer
                (configMod [RedirectRule (regex ".*/temporary-.*") Nothing (Just RROPermanent) RROValid] [])
                setRef
                (5000, mockRedirect)
                (link "/permanent-redirect")
                (progress False)
                (VerifyResult [RedirectRuleError (chain ["/permanent-redirect", "/ok"]) (Just RROPermanent)])
          ]
      , testGroup "By \"from\", \"to\" and \"on\""
        [ testCase "Do match" $ do
            setRef <- newIORef mempty
            checkLinkAndProgressWithServer
              (configMod [RedirectRule (regex ".*/follow[0-9]") (regex "^.*/ok$") (Just (RROCode 307)) RROInvalid] [])
              setRef
              (5000, mockRedirect)
              (link "/follow3")
              (progress False)
              (VerifyResult [RedirectRuleError (chain ["/follow3", "/ok"]) (Just (RROCode 307))])
        , testCase "Do not match" $ do
            setRef <- newIORef mempty
            checkLinkAndProgressWithServer
              (configMod [RedirectRule (regex ".*/follow[0-9]") (regex "^.*/ok$") (Just (RROCode 307)) RROInvalid] [])
              setRef
              (5000, mockRedirect)
              (link "/follow2")
              (progress True)
              (VerifyResult [])
        ]
      , testCase "By any" $ do
          setRef <- newIORef mempty
          checkLinkAndProgressWithServer
            (configMod [RedirectRule Nothing Nothing Nothing RROValid] [])
            setRef
            (5000, mockRedirect)
            (link "/follow1")
            (progress True)
            (VerifyResult [])
      ]
  , testGroup "Chain"
      [ testCase "End valid" $ do
          setRef <- newIORef mempty
          checkLinkAndProgressWithServer
            (configMod [RedirectRule Nothing Nothing Nothing RROFollow] [])
            setRef
            (5000, mockRedirect)
            (link "/follow1")
            (progress True)
            (VerifyResult [])
      , testCase "End invalid" $ do
          setRef <- newIORef mempty
          checkLinkAndProgressWithServer
            (configMod [RedirectRule Nothing Nothing (Just (RROCode 307)) RROInvalid, RedirectRule Nothing Nothing Nothing RROFollow] [])
            setRef
            (5000, mockRedirect)
            (link "/follow1")
            (progress False)
            (VerifyResult [RedirectRuleError (chain ["/follow1", "/follow2", "/follow3", "/ok"]) (Just (RROCode 307))])
      , testCase "Mixed with ignore" $ do
          setRef <- newIORef mempty
          checkLinkAndProgressWithServer
            (configMod [RedirectRule Nothing Nothing (Just (RROCode 307)) RROInvalid, RedirectRule Nothing Nothing Nothing RROFollow] (maybeToList (regex ".*/follow3")))
            setRef
            (5000, mockRedirect)
            (link "/follow1")
            (progress True)
            (VerifyResult [])
      ]
  ]
  where
    link :: Text -> Text
    link = ("http://127.0.0.1:5000" <>)

    chain :: [Text] -> RedirectChain
    chain = fromList . fmap link

    regex :: Text -> Maybe R.Regex
    regex = rightToMaybe . R.compile defaultCompOption defaultExecOption

    configMod :: [RedirectRule] -> [R.Regex] -> Config -> Config
    configMod rules exclussions config = config
      & cNetworkingL . ncExternalRefRedirectsL %~ (rules <>)
      & cExclusionsL . ecIgnoreExternalRefsToL .~ exclussions

    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
      where
        report =
          if shouldSucceed
          then reportSuccess
          else reportError

    mockRedirect :: IO Web.Application
    mockRedirect =
      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