diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,17 @@ # Revision history for hpath-io -## 0.9.3 -- YYYY-mm-dd +## 0.10.1 -- 2020-01-13 -* First version. Released on an unsuspecting world. +* Move file check functions to HPath.IO +* Add 'doesExist' +* Exception handling of `doesExist`, `doesFileExist`, `doesDirectoryExist` has changed: only eNOENT is catched +* Exception handling of `isWritable` has changed: just a wrapper around `access` now +* switch exception handling to `safe-exceptions` +* Redo file reading API (readFileEOF dropped and now using streamly under the hood, added `readFileStream`) + + +## 0.10.0 -- 2020-01-04 + +* First version. Split from 'hpath', contains only the IO parts. +* Now uses streamly for 'copyFile' +* Fixed tmpdir in hspec diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,6 +4,8 @@ High-level IO operations on files/directories, utilizing type-safe Paths. +This package is part of the HPath suite, also check out [hpath](https://hackage.haskell.org/package/hpath) and [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath). + ## Motivation The motivation came during development of diff --git a/hpath-io.cabal b/hpath-io.cabal --- a/hpath-io.cabal +++ b/hpath-io.cabal @@ -1,5 +1,5 @@ name: hpath-io -version: 0.10.0 +version: 0.10.1 synopsis: High-level IO operations on files/directories description: High-level IO operations on files/directories, utilizing type-safe Paths -- bug-reports: @@ -32,17 +32,20 @@ System.Posix.FD c-sources: cbits/dirutils.c - -- other-modules: + other-modules: Streamly.ByteString -- other-extensions: build-depends: base >= 4.8 && <5 , IfElse , bytestring >= 0.10.0.0 , hpath >= 0.10 && < 0.11 , hpath-filepath >= 0.10 && < 0.11 + , safe-exceptions >= 0.1 , streamly >= 0.7 , unix >= 2.5 , unix-bytestring , utf8-string + if !impl(ghc>=7.11) + build-depends: transformers hs-source-dirs: src default-language: Haskell2010 @@ -73,7 +76,6 @@ HPath.IO.GetFileTypeSpec HPath.IO.MoveFileOverwriteSpec HPath.IO.MoveFileSpec - HPath.IO.ReadFileEOFSpec HPath.IO.ReadFileSpec HPath.IO.RecreateSymlinkOverwriteSpec HPath.IO.RecreateSymlinkSpec diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -36,6 +36,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} module HPath.IO ( @@ -66,13 +67,19 @@ , moveFile -- * File reading , readFile - , readFileEOF + , readFileStream -- * File writing , writeFile , appendFile -- * File permissions , newFilePerms , newDirPerms + -- * File checks + , doesExist + , doesFileExist + , doesDirectoryExist + , isWritable + , canOpenDirectory -- * Directory reading , getDirsFiles -- * Filetype operations @@ -88,7 +95,7 @@ ( (<$>) ) -import Control.Exception +import Control.Exception.Safe ( IOException , bracket @@ -175,8 +182,14 @@ import HPath.Internal import HPath.IO.Errors import Prelude hiding (appendFile, readFile, writeFile) +import Streamly +import Streamly.ByteString +import qualified Streamly.Data.Fold as FL +import Streamly.Memory.Array import qualified Streamly.FileSystem.Handle as FH +import qualified Streamly.Internal.Data.Unfold as SU import qualified Streamly.Internal.FileSystem.Handle as IFH +import qualified Streamly.Internal.Memory.ArrayStream as AS import qualified Streamly.Prelude as S import qualified System.IO as SIO import System.IO.Error @@ -191,7 +204,9 @@ import System.Posix.Directory.ByteString ( createDirectory + , closeDirStream , getWorkingDirectory + , openDirStream , removeDirectory ) import System.Posix.Directory.Traversals @@ -201,6 +216,7 @@ import System.Posix.Files.ByteString ( createSymbolicLink + , fileAccess , fileMode , getFdStatus , groupExecuteMode @@ -446,7 +462,9 @@ case cm of Strict -> return () Overwrite -> do - writable <- toAbs newsym >>= isWritable + writable <- toAbs newsym >>= (\p -> do + e <- doesExist p + if e then isWritable p else pure False) isfile <- doesFileExist newsym isdir <- doesDirectoryExist newsym when (writable && isfile) (deleteFile newsym) @@ -830,7 +848,10 @@ easyDelete from Overwrite -> do ft <- getFileType from - writable <- toAbs to >>= isWritable + writable <- toAbs to >>= (\p -> do + e <- doesFileExist p + if e then isWritable p else pure False) + case ft of RegularFile -> do exists <- doesFileExist to @@ -853,19 +874,14 @@ -------------------- --- |Read the given file at once into memory as a strict ByteString. +-- |Read the given file *at once* into memory as a lazy ByteString. -- Symbolic links are followed, no sanity checks on file size --- or file type. File must exist. --- --- Note: the size of the file is determined in advance, as to only --- have one allocation. +-- or file type. File must exist. Uses Builders under the hood +-- (hence lazy ByteString). -- -- Safety/reliability concerns: -- --- * since amount of bytes to read is determined in advance, --- the file might be read partially only if something else is --- appending to it while reading --- * the whole file is read into memory! +-- * the whole file is read into memory, this doesn't read lazily -- -- Throws: -- @@ -873,21 +889,15 @@ -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -readFile :: Path b -> IO ByteString -readFile (MkPath fp) = - bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> do - stat <- PF.getFdStatus fd - let fsize = PF.fileSize stat - SPB.fdRead fd (fromIntegral fsize) +readFile :: Path b -> IO L.ByteString +readFile path = do + stream <- readFileStream path + toLazyByteString <$> S.fold FL.mconcat (fmap byteString stream) --- |Read the given file in chunks of size `8192` into memory until --- `fread` returns 0. Returns a lazy ByteString, because it uses --- Builders under the hood. --- --- Safety/reliability concerns: --- --- * the whole file is read into memory! + +-- | Open the given file as a filestream. Once the filestream is +-- exits, the filehandle is cleaned up. -- -- Throws: -- @@ -895,23 +905,13 @@ -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -readFileEOF :: Path b -> IO L.ByteString -readFileEOF (MkPath fp) = - bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> - allocaBytes (fromIntegral bufSize) $ \buf -> read' fd buf mempty - where - bufSize :: CSize - bufSize = 8192 - read' :: Fd -> Ptr Word8 -> Builder -> IO L.ByteString - read' fd buf builder = do - size <- SPB.fdReadBuf fd buf bufSize - if size == 0 - then return $ toLazyByteString builder - else do - readBS <- unsafePackCStringFinalizer buf - (fromIntegral size) - (return ()) - read' fd buf (builder <> byteString readBS) +readFileStream :: Path b + -> IO (SerialT IO ByteString) +readFileStream (MkPath fp) = do + fd <- openFd fp SPI.ReadOnly [] Nothing + handle <- SPI.fdToHandle fd + let stream = (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) >>= arrayToByteString + pure stream @@ -977,6 +977,72 @@ `unionFileModes` groupReadMode `unionFileModes` otherExecuteMode `unionFileModes` otherReadMode + + + + + ------------------- + --[ File checks ]-- + ------------------- + + +-- |Checks if the given file exists. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesExist :: Path b -> IO Bool +doesExist (MkPath bs) = + catchErrno [eNOENT] (do + _ <- PF.getSymbolicLinkStatus bs + return $ True) + $ return False + + +-- |Checks if the given file exists and is not a directory. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesFileExist :: Path b -> IO Bool +doesFileExist (MkPath bs) = + catchErrno [eNOENT] (do + fs <- PF.getSymbolicLinkStatus bs + return $ not . PF.isDirectory $ fs) + $ return False + + +-- |Checks if the given file exists and is a directory. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesDirectoryExist :: Path b -> IO Bool +doesDirectoryExist (MkPath bs) = + catchErrno [eNOENT] (do + fs <- PF.getSymbolicLinkStatus bs + return $ PF.isDirectory fs) + $ return False + + +-- |Checks whether a file or folder is writable. +-- +-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False). +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isWritable :: Path b -> IO Bool +isWritable (MkPath bs) = fileAccess bs False True False + + +-- |Checks whether the directory at the given path exists and can be +-- opened. This invokes `openDirStream` which follows symlinks. +canOpenDirectory :: Path b -> IO Bool +canOpenDirectory (MkPath bs) = + handleIOError (\_ -> return False) $ do + bracket (openDirStream bs) + closeDirStream + (\_ -> return ()) + return True + diff --git a/src/HPath/IO.hs-boot b/src/HPath/IO.hs-boot --- a/src/HPath/IO.hs-boot +++ b/src/HPath/IO.hs-boot @@ -6,3 +6,11 @@ canonicalizePath :: Path b -> IO (Path Abs) toAbs :: Path b -> IO (Path Abs) + +doesFileExist :: Path b -> IO Bool + +doesDirectoryExist :: Path b -> IO Bool + +isWritable :: Path b -> IO Bool + +canOpenDirectory :: Path b -> IO Bool diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs --- a/src/HPath/IO/Errors.hs +++ b/src/HPath/IO/Errors.hs @@ -33,10 +33,6 @@ , throwSameFile , sameFile , throwDestinationInSource - , doesFileExist - , doesDirectoryExist - , isWritable - , canOpenDirectory -- * Error handling functions , catchErrno @@ -52,7 +48,7 @@ ( (<$>) ) -import Control.Exception +import Control.Exception.Safe hiding (handleIOError) import Control.Monad ( forM @@ -92,11 +88,14 @@ ( canonicalizePath , toAbs + , doesFileExist + , doesDirectoryExist + , isWritable + , canOpenDirectory ) import System.IO.Error ( alreadyExistsErrorType - , catchIOError , ioeGetErrorType , mkIOError ) @@ -240,42 +239,6 @@ $ PF.getFileStatus sbs when (elem sid dids) (throwIO $ DestinationInSource dbs sbs) - - --- |Checks if the given file exists and is not a directory. --- Does not follow symlinks. -doesFileExist :: Path b -> IO Bool -doesFileExist (MkPath bs) = - handleIOError (\_ -> return False) $ do - fs <- PF.getSymbolicLinkStatus bs - return $ not . PF.isDirectory $ fs - - --- |Checks if the given file exists and is a directory. --- Does not follow symlinks. -doesDirectoryExist :: Path b -> IO Bool -doesDirectoryExist (MkPath bs) = - handleIOError (\_ -> return False) $ do - fs <- PF.getSymbolicLinkStatus bs - return $ PF.isDirectory fs - - --- |Checks whether a file or folder is writable. -isWritable :: Path b -> IO Bool -isWritable (MkPath bs) = - handleIOError (\_ -> return False) $ - fileAccess bs False True False - - --- |Checks whether the directory at the given path exists and can be --- opened. This invokes `openDirStream` which follows symlinks. -canOpenDirectory :: Path b -> IO Bool -canOpenDirectory (MkPath bs) = - handleIOError (\_ -> return False) $ do - bracket (PFD.openDirStream bs) - PFD.closeDirStream - (\_ -> return ()) - return True diff --git a/src/Streamly/ByteString.hs b/src/Streamly/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/Streamly/ByteString.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Streamly.ByteString where + +import Control.Monad.IO.Class +import Data.ByteString hiding (length) +import qualified Data.ByteString as BS +import Data.ByteString.Unsafe +import Data.Word (Word8) +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe +import Foreign.Ptr (castPtr, minusPtr, plusPtr) +import Prelude hiding (length) +import Streamly +import Streamly.Internal.Memory.Array.Types +import Streamly.Memory.Array +import qualified Streamly.Prelude as S + +toByteString :: + forall m. (MonadIO m, MonadAsync m) + => SerialT m (Array Word8) + -> m ByteString +toByteString stream = + let xs = S.mapM arrayToByteString stream + ys = S.foldlM' (\a b -> pure $ a <> b) mempty xs + in ys + +arrayToByteString :: (MonadIO m) => Array Word8 -> m ByteString +arrayToByteString arr + | length arr == 0 = return mempty +arrayToByteString Array {..} = + liftIO $ + withForeignPtr aStart $ \ptr -> + unsafePackCStringFinalizer ptr aLen (return ()) + where + aLen = + let p = unsafeForeignPtrToPtr aStart + in aEnd `minusPtr` p + +byteStringToArray :: (MonadIO m) => ByteString -> m (Array Word8) +byteStringToArray bs = + liftIO $ + unsafeUseAsCStringLen + bs + (\(ptr, _) -> do + let endPtr pr = (castPtr pr `plusPtr` (BS.length bs)) + fptr <- newForeignPtr_ (castPtr ptr) + return $ Array {aStart = fptr, aEnd = endPtr ptr, aBound = endPtr ptr}) + +fromByteString :: + forall m. (MonadIO m) + => ByteString + -> m (Array Word8) +fromByteString bs = byteStringToArray bs diff --git a/test/HPath/IO/ReadFileEOFSpec.hs b/test/HPath/IO/ReadFileEOFSpec.hs deleted file mode 100644 --- a/test/HPath/IO/ReadFileEOFSpec.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.ReadFileEOFSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import Utils - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "ReadFileEOFSpec" - createTmpDir - -setupFiles :: IO () -setupFiles = do - createRegularFile' "fileWithContent" - createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" - createDir' "alreadyExistsD" - createRegularFile' "noPerms" - noPerms "noPerms" - createDir' "noPermsD" - createRegularFile' "noPermsD/inputFile" - noPerms "noPermsD" - writeFile' "fileWithContent" "Blahfaselgagaga" - - -cleanupFiles :: IO () -cleanupFiles = do - deleteFile' "fileWithContent" - deleteFile' "fileWithoutContent" - deleteFile' "inputFileSymL" - deleteDir' "alreadyExistsD" - normalFilePerms "noPerms" - deleteFile' "noPerms" - normalDirPerms "noPermsD" - deleteFile' "noPermsD/inputFile" - deleteDir' "noPermsD" - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.readFileEOF" $ do - - -- successes -- - it "readFileEOF (Strict) file with content, everything clear" $ do - out <- readFileEOF' "fileWithContent" - out `shouldBe` "Blahfaselgagaga" - - it "readFileEOF (Strict) symlink, everything clear" $ do - out <- readFileEOF' "inputFileSymL" - out `shouldBe` "Blahfaselgagaga" - - it "readFileEOF (Strict) empty file, everything clear" $ do - out <- readFileEOF' "fileWithoutContent" - out `shouldBe` "" - - - -- posix failures -- - it "readFileEOF (Strict) directory, wrong file type" $ do - readFileEOF' "alreadyExistsD" - `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - - it "readFileEOF (Strict) file, no permissions" $ do - readFileEOF' "noPerms" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "readFileEOF (Strict) file, no permissions on dir" $ do - readFileEOF' "noPermsD/inputFile" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "readFileEOF (Strict) file, no such file" $ do - readFileEOF' "lalala" - `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/test/Utils.hs b/test/Utils.hs --- a/test/Utils.hs +++ b/test/Utils.hs @@ -27,7 +27,6 @@ , IORef ) import HPath.IO -import HPath.IO.Errors import Prelude hiding (appendFile, readFile, writeFile) import Data.Maybe ( @@ -281,10 +280,5 @@ readFile' :: ByteString -> IO ByteString {-# NOINLINE readFile' #-} -readFile' p = withTmpDir p readFile - - -readFileEOF' :: ByteString -> IO L.ByteString -{-# NOINLINE readFileEOF' #-} -readFileEOF' p = withTmpDir p readFileEOF +readFile' p = withTmpDir p (fmap L.toStrict . readFile)