79 lines
2.4 KiB
Haskell
79 lines
2.4 KiB
Haskell
module Nuthatch.Test.Path
|
|
( tests
|
|
) where
|
|
|
|
import Data.Either (isLeft)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Hedgehog
|
|
( Gen
|
|
, Property
|
|
, assert
|
|
, forAll
|
|
, property
|
|
, (===)
|
|
)
|
|
import qualified Hedgehog.Gen as Gen
|
|
import Nuthatch.Paths
|
|
( buildObjectKey
|
|
, encodeUserId
|
|
, listCacheAncestorPrefixes
|
|
)
|
|
import Nuthatch.Test.PathFixture
|
|
import Nuthatch.Types
|
|
import Test.Tasty (TestTree, testGroup)
|
|
import Test.Tasty.HUnit ((@?=), testCase)
|
|
import Test.Tasty.Hedgehog (testProperty)
|
|
|
|
tests :: TestTree
|
|
tests = testGroup "canonical paths"
|
|
[ testProperty "valid paths parse and render without rewriting" propPathRoundTrip
|
|
, testProperty "invalid paths are rejected" propInvalidPaths
|
|
, testProperty "constructed object keys remain under their root" propRootConfinement
|
|
, testCase "nested cache ancestors include every containing listing" $
|
|
listCacheAncestorPrefixes (RelativePath "docs/a/b.txt")
|
|
@?= ["", "docs", "docs/a"]
|
|
, testCase "root files invalidate the root listing" $
|
|
listCacheAncestorPrefixes (RelativePath "file.txt") @?= [""]
|
|
]
|
|
|
|
newtype InvalidPath = InvalidPath { getInvalidPath :: Text }
|
|
deriving stock (Show)
|
|
|
|
genInvalidPath :: Gen InvalidPath
|
|
genInvalidPath = do
|
|
ValidPath valid <- genValidPath
|
|
InvalidPath <$> Gen.element
|
|
[ ""
|
|
, "/" <> valid
|
|
, valid <> "/"
|
|
, valid <> "//tail"
|
|
, valid <> "/../tail"
|
|
, valid <> "/./tail"
|
|
, valid <> "/back\\slash"
|
|
, valid <> "/control\NUL"
|
|
, "e\x0301"
|
|
]
|
|
|
|
propPathRoundTrip :: Property
|
|
propPathRoundTrip = property $ do
|
|
ValidPath raw <- forAll genValidPath
|
|
validateRelativePath raw === Right (RelativePath raw)
|
|
|
|
propInvalidPaths :: Property
|
|
propInvalidPaths = property $ do
|
|
InvalidPath raw <- forAll genInvalidPath
|
|
assert (isLeft (validateRelativePath raw))
|
|
|
|
propRootConfinement :: Property
|
|
propRootConfinement = property $ do
|
|
ValidPath raw <- forAll genValidPath
|
|
let path = RelativePath raw
|
|
uid = encodeUserId "https://issuer.example" "subject"
|
|
personalPrefix = "users/" <> unUserId uid <> "/"
|
|
personalKey = unObjectKey (buildObjectKey Personal uid path)
|
|
sharedKey = unObjectKey (buildObjectKey Shared uid path)
|
|
assert (personalPrefix `T.isPrefixOf` personalKey)
|
|
assert ("shared/" `T.isPrefixOf` sharedKey)
|
|
assert (not ("shared/" `T.isPrefixOf` personalKey))
|
|
assert (not ("users/" `T.isPrefixOf` sharedKey))
|