Merge pull request #72 from input-output-hk/jdral/71-fspath

Only generate valid names for `FsPath` tests

fs-api/CHANGELOG.md

@@ -29,9 +29,8 @@
 
 ### Patch
 
-* Add a clarification in the documentation of `fsPathFromList` that each path
-  component should be non-empty, because directories/files with empty names are
-  not valid! Also, add an `assert`ion to `fsPathFromList` for this precondition.
+* Add a clarification in the documentation of `FsPath` that the user is
+  responsible for picking sensible directory/file names.
 
 ## 0.2.0.1 -- 2023-10-30
 

fs-api/src/System/FS/API/Types.hs

@@ -101,14 +101,34 @@ allowExisting openMode = case openMode of
 -------------------------------------------------------------------------------}
 
 -- | A relative path.
+--
+-- === Invariant
+--
+-- The user of this library is tasked with picking sensible names of
+-- directories/files on a path. Amongst others, the following should hold:
+--
+-- * Names are non-empty
+--
+-- * Names are monotonic, i.e., they are not equal to @..@
+--
+-- * Names should not contain path separators or drive letters
+--
+-- In particular, names that satisfy these invariants should result in an
+-- 'FsPath' that remains relative to the HasFS instance root. For example, an
+-- @'FsPath' ["/"]@ would try to access the root folder, which is most likely
+-- outside of the scope of the HasFS instance.
+--
+-- \"@..@\" should not be used because @fs-sim@ will not be able to follow these
+-- types of back-links. @fs-sim@ will interpret \"@..@\" as a directory name
+-- instead.
 newtype FsPath = UnsafeFsPath { fsPathToList :: [Strict.Text] }
   deriving (Eq, Ord, Generic)
   deriving newtype NFData
 
 -- | Create a path from a list of directory/file names. All of the names should
 -- be non-empty.
 fsPathFromList :: [Strict.Text] -> FsPath
-fsPathFromList xs = assert (not (any Strict.null xs)) $ UnsafeFsPath (force xs)
+fsPathFromList xs = UnsafeFsPath (force xs)
 
 instance Show FsPath where
   show = intercalate "/" . map Strict.unpack . fsPathToList

fs-api/test/Test/System/FS/API/FsPath.hs

@@ -19,8 +19,16 @@ tests = testGroup "Test.System.FS.API.FsPath" [
 
 -- | Orphan instance that generates a __non-empty__ text!
 instance Arbitrary Text where
-  arbitrary = Text.pack <$> (arbitrary `suchThat` (not . null))
-  shrink x = [Text.pack x'' | let x' = Text.unpack x, x'' <- shrink x']
+  arbitrary = Text.pack <$> QC.listOf (QC.elements validChars) `suchThat` (not . null)
+  shrink x = [ x''' | let x' = Text.unpack x
+                    , x'' <- shrink x'
+                    , not (null x'')
+                    , let x''' = Text.pack x'' ]
+
+-- | We pick a small subset of characters to use in directory/file names, so
+-- that we don't break the invariant of 'FsPath'.
+validChars :: [Char]
+validChars = concat [['a'..'z'], ['A'..'Z'], ['0'..'9']]
 
 -- | Commutativity property for 'FS.</>' and 'FilePath.</>'.
 --
@@ -65,7 +73,7 @@ prop_addExtensionCommutes mnt path ext =
     .&&. FilePath.makeValid lhs === FilePath.makeValid rhs
   where
     mnt' = filePathFromList mnt
-    mnt'' = FS.MountPoint (filePathFromList mnt)
+    mnt'' = FS.MountPoint mnt'
     fsp = FS.fsPathFromList path FS.<.> ext
     lhs = FS.fsToFilePath mnt'' fsp
     rhs = mnt' FilePath.</> filePathFromList path FilePath.<.> ext