diff --git a/src/Xrefcheck/System.hs b/src/Xrefcheck/System.hs index 2882387d..38f432b1 100644 --- a/src/Xrefcheck/System.hs +++ b/src/Xrefcheck/System.hs @@ -92,7 +92,12 @@ getDirsBetweenRootAndFile root@(UnsafeCanonicalPath rootPath) file = getRelativeChild :: CanonicalPath -> CanonicalPath -> Maybe FilePath getRelativeChild (UnsafeCanonicalPath root) (UnsafeCanonicalPath child) = - dropWhile FP.isPathSeparator <$> stripPrefix root child + prepare <$> stripPrefix root child + where + prepare :: FilePath -> FilePath + prepare path = case dropWhile FP.isPathSeparator path of + "" -> "./" + other -> other getRelativeOrAbsoluteChild :: CanonicalPath -> CanonicalPath -> FilePath getRelativeOrAbsoluteChild root child@(UnsafeCanonicalPath c) = diff --git a/tests/Test/Xrefcheck/CanonicalPathSpec.hs b/tests/Test/Xrefcheck/CanonicalPathSpec.hs new file mode 100644 index 00000000..a07210ab --- /dev/null +++ b/tests/Test/Xrefcheck/CanonicalPathSpec.hs @@ -0,0 +1,47 @@ +{- SPDX-FileCopyrightText: 2022 Serokell + - + - SPDX-License-Identifier: MPL-2.0 + -} + +module Test.Xrefcheck.CanonicalPathSpec where + +import Universum + +import System.Directory (getCurrentDirectory) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase, (@?=)) + +import Xrefcheck.System + +test_canonicalPath :: TestTree +test_canonicalPath = testGroup "Path canonicalization" + [ testCase "Trailing separator" $ do + path <- canonicalizePath "./example/dir/" + current <- getCurrentDirectory >>= canonicalizePath + getRelativeOrAbsoluteChild current path @?= "example/dir", + testCase "Parent directory indirection" $ do + path <- canonicalizePath "dir1/../dir2" + current <- getCurrentDirectory >>= canonicalizePath + getRelativeOrAbsoluteChild current path @?= "dir2", + testCase "Through parent directory indirection" $ do + path <- canonicalizePath "dir1/../../../dir2" + current <- getCurrentDirectory >>= canonicalizePath + root <- current >= canonicalizePath + getRelativeOrAbsoluteChild current path @?= "dir1/dir2", + testCase "Mixed indirections result in current directory" $ do + path <- canonicalizePath "././dir1/./.././dir2/./../" + current <- getCurrentDirectory >>= canonicalizePath + getRelativeOrAbsoluteChild current path @?= "./", + testCase "Child directory" $ do + path <- canonicalizePath "./dir1/dir2/" + current <- getCurrentDirectory >>= canonicalizePath + getRelativeChild current path @?= Just "dir1/dir2", + testCase "Not a child directory" $ do + root <- canonicalizePath "./dir1/dir2/" + path <- canonicalizePath "./dir1/dir3/" + getRelativeChild root path @?= Nothing + ] diff --git a/tests/Test/Xrefcheck/RedirectRequestsSpec.hs b/tests/Test/Xrefcheck/RedirectRequestsSpec.hs index fa6f27d5..c9dfbc02 100644 --- a/tests/Test/Xrefcheck/RedirectRequestsSpec.hs +++ b/tests/Test/Xrefcheck/RedirectRequestsSpec.hs @@ -1,4 +1,4 @@ -{- SPDX-FileCopyrightText: 2021 Serokell +{- SPDX-FileCopyrightText: 2022 Serokell - - SPDX-License-Identifier: MPL-2.0 -}