EdgeCaseSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Link.Canonical.EdgeCaseSpec (tests) where

import Data.Either (fromRight)
import Data.Text (Text)
import Data.Text qualified as T
import Link.Canonical
import Test.Tasty
import Test.Tasty.HUnit
import Text.URI qualified as URI

tests :: TestTree
tests =
  testGroup
    "Edge Cases"
    [ testGroup
        "Empty and minimal URLs"
        [ testCase "handles URL with no path" $ do
            let uri = unsafeParseURI "https://example.com"
                result = normalizeUri defaultConfig [] uri
            URI.render result @?= "https://example.com",
          testCase "handles URL with just root path" $ do
            let uri = unsafeParseURI "https://example.com/"
                result = normalizeUri defaultConfig [] uri
            -- Trailing slash behavior depends on config
            assertBool "Should be valid" (T.isPrefixOf "https://example.com" (URI.render result)),
          testCase "handles URL with empty query" $ do
            let uri = unsafeParseURI "https://example.com/path?"
                result = normalizeUri defaultConfig [] uri
            -- Empty query should be removed or preserved based on implementation
            assertBool "Should be valid" (T.isPrefixOf "https://example.com/path" (URI.render result))
        ],
      testGroup
        "Case sensitivity"
        [ testCase "normalizes mixed-case scheme" $ do
            let uri = unsafeParseURI "HtTpS://example.com/path"
                result = normalizeUri defaultConfig [] uri
            T.isPrefixOf "https://" (URI.render result) @?= True,
          testCase "normalizes mixed-case host" $ do
            let uri = unsafeParseURI "https://ExAmPlE.CoM/path"
                result = normalizeUri defaultConfig [] uri
            T.isInfixOf "example.com" (URI.render result) @?= True,
          testCase "preserves case in path" $ do
            let uri = unsafeParseURI "https://example.com/Path/To/Resource"
                result = normalizeUri defaultConfig [] uri
            T.isInfixOf "Path/To/Resource" (URI.render result) @?= True,
          testCase "preserves case in query values" $ do
            let uri = unsafeParseURI "https://example.com/?Name=Value"
                result = normalizeUri defaultConfig [] uri
            T.isInfixOf "Name=Value" (URI.render result) @?= True
        ],
      testGroup
        "Special characters"
        [ testCase "handles spaces encoded as %20" $ do
            let uri = unsafeParseURI "https://example.com/path%20with%20spaces"
                result = normalizeUri defaultConfig [] uri
            -- Should preserve or normalize spaces
            assertBool "Should be valid URL" (T.isPrefixOf "https://example.com/" (URI.render result)),
          testCase "handles plus signs in query" $ do
            let uri = unsafeParseURI "https://example.com/?q=hello+world"
                result = normalizeUri defaultConfig [] uri
            assertBool "Should preserve query" (T.isInfixOf "q=" (URI.render result)),
          testCase "handles unicode in path" $ do
            let uri = unsafeParseURI "https://example.com/caf%C3%A9"
                result = normalizeUri defaultConfig [] uri
            assertBool "Should be valid URL" (T.isPrefixOf "https://example.com/" (URI.render result))
        ],
      testGroup
        "Path normalization edge cases"
        [ testCase "handles multiple slashes (collapsed by parser)" $ do
            -- Note: modern-uri may normalize multiple slashes during parsing
            let uri = unsafeParseURI "https://example.com/a/b/c"
                result = normalizeUri defaultConfig [] uri
            T.isInfixOf "/a/b/c" (URI.render result) @?= True,
          testCase "handles dot at end of path" $ do
            let uri = unsafeParseURI "https://example.com/path/."
                result = normalizeUri defaultConfig [] uri
            -- Dot should be removed by normalization
            URI.render result @?= "https://example.com/path/",
          testCase "handles double dot at end of path" $ do
            let uri = unsafeParseURI "https://example.com/a/b/.."
                result = normalizeUri defaultConfig [] uri
            -- Should resolve to /a/
            URI.render result @?= "https://example.com/a/"
        ],
      testGroup
        "Query parameter edge cases"
        [ testCase "handles empty parameter value" $ do
            let uri = unsafeParseURI "https://example.com/?key="
                result = normalizeUri defaultConfig [] uri
            T.isInfixOf "key=" (URI.render result) @?= True,
          testCase "handles parameter with no value (flag)" $ do
            let uri = unsafeParseURI "https://example.com/?flag"
                result = normalizeUri defaultConfig [] uri
            T.isInfixOf "flag" (URI.render result) @?= True,
          testCase "handles duplicate parameter names" $ do
            let uri = unsafeParseURI "https://example.com/?a=1&a=2"
                result = normalizeUri defaultConfig [] uri
            -- Both should be preserved
            let rendered = URI.render result
            T.isInfixOf "a=1" rendered @?= True,
          testCase "sorts multiple parameters alphabetically" $ do
            let uri = unsafeParseURI "https://example.com/?z=3&a=1&m=2"
                result = normalizeUri defaultConfig [] uri
                rendered = URI.render result
            -- With sorting, 'a' should come before 'm' before 'z'
            let aPos = T.breakOn "a=" rendered
                mPos = T.breakOn "m=" rendered
                zPos = T.breakOn "z=" rendered
            (T.length (fst aPos) < T.length (fst mPos)) @?= True
        ],
      testGroup
        "Domain rule edge cases"
        [ testCase "YouTube: handles video ID at minimum length" $ do
            let uri = unsafeParseURI "https://youtu.be/abc"
                result = applyDomainRules defaultDomainRules uri
            T.isInfixOf "youtube.com" (URI.render result) @?= True,
          testCase "Amazon: handles ASIN with special characters" $ do
            -- ASINs are alphanumeric, 10 characters
            let uri = unsafeParseURI "https://www.amazon.com/dp/B0ABCD1234"
                result = applyDomainRules defaultDomainRules uri
            T.isInfixOf "B0ABCD1234" (URI.render result) @?= True,
          testCase "Twitter: handles numeric user ID in path" $ do
            let uri = unsafeParseURI "https://twitter.com/i/user/12345"
                result = applyDomainRules defaultDomainRules uri
            T.isInfixOf "x.com" (URI.render result) @?= True,
          testCase "GitHub: handles very long file paths" $ do
            let uri = unsafeParseURI "https://github.com/owner/repo/blob/main/src/very/deep/nested/path/to/file.hs"
                result = applyDomainRules defaultDomainRules uri
            T.isInfixOf "very/deep/nested" (URI.render result) @?= True,
          testCase "Reddit: handles subreddit with underscores" $ do
            let uri = unsafeParseURI "https://old.reddit.com/r/programming_languages"
                result = applyDomainRules defaultDomainRules uri
            T.isInfixOf "www.reddit.com" (URI.render result) @?= True
        ],
      testGroup
        "Tracking parameter edge cases"
        [ testCase "strips utm_campaign matching utm_* pattern" $ do
            let uri = unsafeParseURI "https://example.com/?utm_campaign=test&keep=me"
                result = normalizeUri defaultConfig [] uri
                rendered = URI.render result
            -- utm_campaign should be stripped (matches utm_*)
            assertBool "utm_campaign should be stripped" (not $ T.isInfixOf "utm_campaign" rendered),
          testCase "preserves parameter that starts with utm but isn't tracking" $ do
            let uri = unsafeParseURI "https://example.com/?utmost=value"
                result = normalizeUri defaultConfig [] uri
            -- 'utmost' should be preserved since it's not 'utm_*'
            T.isInfixOf "utmost=value" (URI.render result) @?= True,
          testCase "handles URL with only tracking parameters" $ do
            let uri = unsafeParseURI "https://example.com/page?utm_source=test&utm_medium=social"
                result = normalizeUri defaultConfig [] uri
            -- All params stripped, should just be the path
            let rendered = URI.render result
            assertBool "Should not contain utm_source" (not $ T.isInfixOf "utm_source" rendered)
        ],
      testGroup
        "Fragment handling"
        [ testCase "strips fragment by default" $ do
            let uri = unsafeParseURI "https://example.com/page#section"
                result = normalizeUri defaultConfig [] uri
            T.isInfixOf "#" (URI.render result) @?= False,
          testCase "GitHub preserves line number fragment" $ do
            let uri = unsafeParseURI "https://github.com/owner/repo/blob/main/file.hs#L42"
                result = applyDomainRules defaultDomainRules uri
            T.isInfixOf "#L42" (URI.render result) @?= True,
          testCase "GitHub preserves line range fragment" $ do
            let uri = unsafeParseURI "https://github.com/owner/repo/blob/main/file.hs#L10-L20"
                result = applyDomainRules defaultDomainRules uri
            T.isInfixOf "#L10-L20" (URI.render result) @?= True
        ]
    ]

-- | Parse a URI, failing if invalid
unsafeParseURI :: Text -> URI.URI
unsafeParseURI t = fromRight (error $ "Failed to parse: " <> show t) $ URI.mkURI t