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))