@@ -1,4 +1,5 @@ | |||
packages: ./hpath | |||
./hpath-directory | |||
./hpath-filepath | |||
./hpath-io | |||
@@ -0,0 +1,5 @@ | |||
# Revision history for hpath-directory | |||
## 0.1.0.0 -- 2020-01-26 | |||
* First version. Released on an unsuspecting world. |
@@ -0,0 +1,30 @@ | |||
Copyright (c) 2020, Julian Ospald | |||
All rights reserved. | |||
Redistribution and use in source and binary forms, with or without | |||
modification, are permitted provided that the following conditions are met: | |||
* Redistributions of source code must retain the above copyright | |||
notice, this list of conditions and the following disclaimer. | |||
* Redistributions in binary form must reproduce the above | |||
copyright notice, this list of conditions and the following | |||
disclaimer in the documentation and/or other materials provided | |||
with the distribution. | |||
* Neither the name of Julian Ospald nor the names of other | |||
contributors may be used to endorse or promote products derived | |||
from this software without specific prior written permission. | |||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
@@ -0,0 +1,2 @@ | |||
import Distribution.Simple | |||
main = defaultMain |
@@ -0,0 +1,7 @@ | |||
#include "dirutils.h" | |||
unsigned int | |||
__posixdir_d_type(struct dirent* d) | |||
{ | |||
return(d -> d_type); | |||
} | |||
@@ -0,0 +1,13 @@ | |||
#ifndef POSIXPATHS_CBITS_DIRUTILS_H | |||
#define POSIXPATHS_CBITS_DIRUTILS_H | |||
#include <stdlib.h> | |||
#include <dirent.h> | |||
#include <sys/types.h> | |||
#include <sys/stat.h> | |||
#include <fcntl.h> | |||
extern unsigned int | |||
__posixdir_d_type(struct dirent* d) | |||
; | |||
#endif |
@@ -0,0 +1,113 @@ | |||
cabal-version: >=1.10 | |||
name: hpath-directory | |||
version: 0.1.0.0 | |||
synopsis: Alternative to 'directory' package with ByteString based filepaths | |||
description: This provides a safer alternative to the 'directory' | |||
package. FilePaths are ByteString based, so this | |||
package only works on POSIX systems. | |||
For a more high-level version of this with | |||
proper Path type, use 'hpath-io', which makes | |||
use of this package. | |||
homepage: https://github.com/hasufell/hpath | |||
bug-reports: https://github.com/hasufell/hpath/issues | |||
license: BSD3 | |||
license-file: LICENSE | |||
author: Julian Ospald <hasufell@posteo.de> | |||
maintainer: Julian Ospald <hasufell@posteo.de> | |||
copyright: Julian Ospald <hasufell@posteo.de> 2020 | |||
category: Filesystem | |||
build-type: Simple | |||
extra-source-files: CHANGELOG.md | |||
cbits/dirutils.h | |||
tested-with: GHC==7.10.3 | |||
, GHC==8.0.2 | |||
, GHC==8.2.2 | |||
, GHC==8.4.4 | |||
, GHC==8.6.5 | |||
, GHC==8.8.1 | |||
library | |||
if os(windows) | |||
build-depends: unbuildable<0 | |||
buildable: False | |||
exposed-modules: System.Posix.RawFilePath.Directory | |||
System.Posix.RawFilePath.Directory.Errors | |||
System.Posix.RawFilePath.Directory.Traversals | |||
System.Posix.Foreign, | |||
System.Posix.FD | |||
-- other-modules: | |||
-- other-extensions: | |||
c-sources: cbits/dirutils.c | |||
build-depends: base >= 4.8 && <5 | |||
, IfElse | |||
, bytestring >= 0.10 | |||
, exceptions >= 0.10 | |||
, hpath-filepath >= 0.10.3 | |||
, safe-exceptions >= 0.1 | |||
, streamly >= 0.7 | |||
, streamly-bytestring >= 0.1 | |||
, time >= 1.8 | |||
, unix >= 2.5 | |||
, unix-bytestring >= 0.3 | |||
, utf8-string | |||
hs-source-dirs: src | |||
default-language: Haskell2010 | |||
default-extensions: PackageImports | |||
test-suite spec | |||
if os(windows) | |||
build-depends: unbuildable<0 | |||
buildable: False | |||
Type: exitcode-stdio-1.0 | |||
Default-Language: Haskell2010 | |||
Hs-Source-Dirs: test | |||
Main-Is: Main.hs | |||
other-modules: | |||
System.Posix.RawFilePath.Directory.AppendFileSpec | |||
System.Posix.RawFilePath.Directory.CanonicalizePathSpec | |||
System.Posix.RawFilePath.Directory.CopyDirRecursiveCollectFailuresSpec | |||
System.Posix.RawFilePath.Directory.CopyDirRecursiveOverwriteSpec | |||
System.Posix.RawFilePath.Directory.CopyDirRecursiveSpec | |||
System.Posix.RawFilePath.Directory.CopyFileOverwriteSpec | |||
System.Posix.RawFilePath.Directory.CopyFileSpec | |||
System.Posix.RawFilePath.Directory.CreateDirIfMissingSpec | |||
System.Posix.RawFilePath.Directory.CreateDirRecursiveSpec | |||
System.Posix.RawFilePath.Directory.CreateDirSpec | |||
System.Posix.RawFilePath.Directory.CreateRegularFileSpec | |||
System.Posix.RawFilePath.Directory.CreateSymlinkSpec | |||
System.Posix.RawFilePath.Directory.DeleteDirRecursiveSpec | |||
System.Posix.RawFilePath.Directory.DeleteDirSpec | |||
System.Posix.RawFilePath.Directory.DeleteFileSpec | |||
System.Posix.RawFilePath.Directory.GetDirsFilesSpec | |||
System.Posix.RawFilePath.Directory.GetFileTypeSpec | |||
System.Posix.RawFilePath.Directory.MoveFileOverwriteSpec | |||
System.Posix.RawFilePath.Directory.MoveFileSpec | |||
System.Posix.RawFilePath.Directory.ReadFileSpec | |||
System.Posix.RawFilePath.Directory.RecreateSymlinkOverwriteSpec | |||
System.Posix.RawFilePath.Directory.RecreateSymlinkSpec | |||
System.Posix.RawFilePath.Directory.RenameFileSpec | |||
System.Posix.RawFilePath.Directory.ToAbsSpec | |||
System.Posix.RawFilePath.Directory.WriteFileLSpec | |||
System.Posix.RawFilePath.Directory.WriteFileSpec | |||
Spec | |||
Utils | |||
GHC-Options: -Wall | |||
Build-Depends: base | |||
, HUnit | |||
, IfElse | |||
, bytestring >= 0.10.0.0 | |||
, hpath-directory | |||
, hpath-filepath >= 0.10 | |||
, hspec >= 1.3 | |||
, process | |||
, time >= 1.8 | |||
, unix | |||
, unix-bytestring | |||
, utf8-string | |||
default-extensions: PackageImports | |||
source-repository head | |||
type: git | |||
location: https://github.com/hasufell/hpath |
@@ -0,0 +1,75 @@ | |||
-- | | |||
-- Module : System.Posix.FD | |||
-- Copyright : © 2016 Julian Ospald | |||
-- License : BSD3 | |||
-- | |||
-- Maintainer : Julian Ospald <hasufell@posteo.de> | |||
-- Stability : experimental | |||
-- Portability : portable | |||
-- | |||
-- Provides an alternative for `System.Posix.IO.ByteString.openFd` | |||
-- which gives us more control on what status flags to pass to the | |||
-- low-level @open(2)@ call, in contrast to the unix package. | |||
{-# LANGUAGE ForeignFunctionInterface #-} | |||
{-# LANGUAGE OverloadedStrings #-} | |||
{-# LANGUAGE TupleSections #-} | |||
{-# OPTIONS_GHC -Wall #-} | |||
module System.Posix.FD ( | |||
openFd | |||
) where | |||
import Foreign.C.String | |||
import Foreign.C.Types | |||
import System.Posix.Foreign | |||
import qualified System.Posix as Posix | |||
import System.Posix.ByteString.FilePath | |||
foreign import ccall unsafe "open" | |||
c_open :: CString -> CInt -> Posix.CMode -> IO CInt | |||
open_ :: CString | |||
-> Posix.OpenMode | |||
-> [Flags] | |||
-> Maybe Posix.FileMode | |||
-> IO Posix.Fd | |||
open_ str how optional_flags maybe_mode = do | |||
fd <- c_open str all_flags mode_w | |||
return (Posix.Fd fd) | |||
where | |||
all_flags = unionFlags $ optional_flags ++ [open_mode] ++ creat | |||
(creat, mode_w) = case maybe_mode of | |||
Nothing -> ([],0) | |||
Just x -> ([oCreat], x) | |||
open_mode = case how of | |||
Posix.ReadOnly -> oRdonly | |||
Posix.WriteOnly -> oWronly | |||
Posix.ReadWrite -> oRdwr | |||
-- |Open and optionally create this file. See 'System.Posix.Files' | |||
-- for information on how to use the 'FileMode' type. | |||
-- | |||
-- Note that passing @Just x@ as the 4th argument triggers the | |||
-- `oCreat` status flag, which must be set when you pass in `oExcl` | |||
-- to the status flags. Also see the manpage for @open(2)@. | |||
openFd :: RawFilePath | |||
-> Posix.OpenMode | |||
-> [Flags] -- ^ status flags of @open(2)@ | |||
-> Maybe Posix.FileMode -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist. | |||
-> IO Posix.Fd | |||
openFd name how optional_flags maybe_mode = | |||
withFilePath name $ \str -> | |||
throwErrnoPathIfMinus1Retry "openFd" name $ | |||
open_ str how optional_flags maybe_mode | |||
@@ -0,0 +1,55 @@ | |||
module System.Posix.Foreign where | |||
import Data.Bits | |||
import Data.List (foldl') | |||
import Foreign.C.Types | |||
#include <limits.h> | |||
#include <stdlib.h> | |||
#include <dirent.h> | |||
#include <sys/types.h> | |||
#include <sys/stat.h> | |||
#include <fcntl.h> | |||
newtype DirType = DirType Int deriving (Eq, Show) | |||
data Flags = Flags Int | UnsupportedFlag String deriving (Eq, Show) | |||
unFlags :: Flags -> Int | |||
unFlags (Flags i) = i | |||
unFlags (UnsupportedFlag name) = error (name ++ " is not supported on this platform") | |||
-- |Returns @True@ if posix-paths was compiled with support for the provided | |||
-- flag. (As of this writing, the only flag for which this check may be | |||
-- necessary is 'oCloexec'; all other flags will always yield @True@.) | |||
isSupported :: Flags -> Bool | |||
isSupported (Flags _) = True | |||
isSupported _ = False | |||
-- |@O_CLOEXEC@ is not supported on every POSIX platform. Use | |||
-- @'isSupported' oCloexec@ to determine if support for @O_CLOEXEC@ was | |||
-- compiled into your version of posix-paths. (If not, using @oCloexec@ will | |||
-- throw an exception.) | |||
oCloexec :: Flags | |||
#ifdef O_CLOEXEC | |||
oCloexec = Flags #{const O_CLOEXEC} | |||
#else | |||
{-# WARNING oCloexec | |||
"This version of posix-paths was compiled without @O_CLOEXEC@ support." #-} | |||
oCloexec = UnsupportedFlag "O_CLOEXEC" | |||
#endif | |||
-- If these enum declarations occur earlier in the file, haddock | |||
-- gets royally confused about the above doc comments. | |||
-- Probably http://trac.haskell.org/haddock/ticket/138 | |||
#{enum DirType, DirType, DT_BLK, DT_CHR, DT_DIR, DT_FIFO, DT_LNK, DT_REG, DT_SOCK, DT_UNKNOWN} | |||
#{enum Flags, Flags, O_APPEND, O_ASYNC, O_CREAT, O_DIRECTORY, O_EXCL, O_NOCTTY, O_NOFOLLOW, O_NONBLOCK, O_RDONLY, O_WRONLY, O_RDWR, O_SYNC, O_TRUNC} | |||
pathMax :: Int | |||
pathMax = #{const PATH_MAX} | |||
unionFlags :: [Flags] -> CInt | |||
unionFlags = fromIntegral . foldl' ((. unFlags) . (.|.)) 0 |
@@ -0,0 +1,15 @@ | |||
module System.Posix.RawFilePath.Directory where | |||
import System.Posix.ByteString.FilePath (RawFilePath) | |||
canonicalizePath :: RawFilePath -> IO RawFilePath | |||
toAbs :: RawFilePath -> IO RawFilePath | |||
doesFileExist :: RawFilePath -> IO Bool | |||
doesDirectoryExist :: RawFilePath -> IO Bool | |||
isWritable :: RawFilePath -> IO Bool | |||
canOpenDirectory :: RawFilePath -> IO Bool |
@@ -0,0 +1,327 @@ | |||
-- | | |||
-- Module : System.Posix.RawFilePath.Directory.Errors | |||
-- Copyright : © 2016 Julian Ospald | |||
-- License : BSD3 | |||
-- | |||
-- Maintainer : Julian Ospald <hasufell@posteo.de> | |||
-- Stability : experimental | |||
-- Portability : portable | |||
-- | |||
-- Provides error handling. | |||
{-# LANGUAGE DeriveDataTypeable #-} | |||
{-# LANGUAGE ScopedTypeVariables #-} | |||
module System.Posix.RawFilePath.Directory.Errors | |||
( | |||
-- * Types | |||
HPathIOException(..) | |||
, RecursiveFailureHint(..) | |||
-- * Exception identifiers | |||
, isSameFile | |||
, isDestinationInSource | |||
, isRecursiveFailure | |||
, isReadContentsFailed | |||
, isCreateDirFailed | |||
, isCopyFileFailed | |||
, isRecreateSymlinkFailed | |||
-- * Path based functions | |||
, throwFileDoesExist | |||
, throwDirDoesExist | |||
, throwSameFile | |||
, sameFile | |||
, throwDestinationInSource | |||
-- * Error handling functions | |||
, catchErrno | |||
, rethrowErrnoAs | |||
, handleIOError | |||
, hideError | |||
, bracketeer | |||
, reactOnError | |||
) | |||
where | |||
import Control.Applicative | |||
( | |||
(<$>) | |||
) | |||
import Control.Exception.Safe hiding (handleIOError) | |||
import Control.Monad | |||
( | |||
forM | |||
, when | |||
) | |||
import Control.Monad.IfElse | |||
( | |||
whenM | |||
) | |||
import Data.ByteString | |||
( | |||
ByteString | |||
) | |||
import qualified Data.ByteString as BS | |||
import Data.ByteString.UTF8 | |||
( | |||
toString | |||
) | |||
import Data.Typeable | |||
( | |||
Typeable | |||
) | |||
import Foreign.C.Error | |||
( | |||
getErrno | |||
, Errno | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType | |||
) | |||
import {-# SOURCE #-} System.Posix.RawFilePath.Directory | |||
( | |||
canonicalizePath | |||
, toAbs | |||
, doesFileExist | |||
, doesDirectoryExist | |||
, isWritable | |||
, canOpenDirectory | |||
) | |||
import System.IO.Error | |||
( | |||
alreadyExistsErrorType | |||
, ioeGetErrorType | |||
, mkIOError | |||
) | |||
import System.Posix.FilePath | |||
import qualified System.Posix.Directory.ByteString as PFD | |||
import System.Posix.Files.ByteString | |||
( | |||
fileAccess | |||
, getFileStatus | |||
) | |||
import qualified System.Posix.Files.ByteString as PF | |||
-- |Additional generic IO exceptions that the posix functions | |||
-- do not provide. | |||
data HPathIOException = SameFile ByteString ByteString | |||
| DestinationInSource ByteString ByteString | |||
| RecursiveFailure [(RecursiveFailureHint, IOException)] | |||
deriving (Eq, Show, Typeable) | |||
-- |A type for giving failure hints on recursive failure, which allows | |||
-- to programmatically make choices without examining | |||
-- the weakly typed I/O error attributes (like `ioeGetFileName`). | |||
-- | |||
-- The first argument to the data constructor is always the | |||
-- source and the second the destination. | |||
data RecursiveFailureHint = ReadContentsFailed ByteString ByteString | |||
| CreateDirFailed ByteString ByteString | |||
| CopyFileFailed ByteString ByteString | |||
| RecreateSymlinkFailed ByteString ByteString | |||
deriving (Eq, Show) | |||
instance Exception HPathIOException | |||
toConstr :: HPathIOException -> String | |||
toConstr SameFile {} = "SameFile" | |||
toConstr DestinationInSource {} = "DestinationInSource" | |||
toConstr RecursiveFailure {} = "RecursiveFailure" | |||
----------------------------- | |||
--[ Exception identifiers ]-- | |||
----------------------------- | |||
isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool | |||
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty) | |||
isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) | |||
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) | |||
isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool | |||
isReadContentsFailed ReadContentsFailed{} = True | |||
isReadContentsFailed _ = False | |||
isCreateDirFailed CreateDirFailed{} = True | |||
isCreateDirFailed _ = False | |||
isCopyFileFailed CopyFileFailed{} = True | |||
isCopyFileFailed _ = False | |||
isRecreateSymlinkFailed RecreateSymlinkFailed{} = True | |||
isRecreateSymlinkFailed _ = False | |||
---------------------------- | |||
--[ Path based functions ]-- | |||
---------------------------- | |||
-- |Throws `AlreadyExists` `IOError` if file exists. | |||
throwFileDoesExist :: RawFilePath -> IO () | |||
throwFileDoesExist bs = | |||
whenM (doesFileExist bs) | |||
(ioError . mkIOError | |||
alreadyExistsErrorType | |||
"File already exists" | |||
Nothing | |||
$ (Just (toString $ bs)) | |||
) | |||
-- |Throws `AlreadyExists` `IOError` if directory exists. | |||
throwDirDoesExist :: RawFilePath -> IO () | |||
throwDirDoesExist bs = | |||
whenM (doesDirectoryExist bs) | |||
(ioError . mkIOError | |||
alreadyExistsErrorType | |||
"Directory already exists" | |||
Nothing | |||
$ (Just (toString $ bs)) | |||
) | |||
-- |Uses `isSameFile` and throws `SameFile` if it returns True. | |||
throwSameFile :: RawFilePath | |||
-> RawFilePath | |||
-> IO () | |||
throwSameFile bs1 bs2 = | |||
whenM (sameFile bs1 bs2) | |||
(throwIO $ SameFile bs1 bs2) | |||
-- |Check if the files are the same by examining device and file id. | |||
-- This follows symbolic links. | |||
sameFile :: RawFilePath -> RawFilePath -> IO Bool | |||
sameFile fp1 fp2 = | |||
handleIOError (\_ -> return False) $ do | |||
fs1 <- getFileStatus fp1 | |||
fs2 <- getFileStatus fp2 | |||
if ((PF.deviceID fs1, PF.fileID fs1) == | |||
(PF.deviceID fs2, PF.fileID fs2)) | |||
then return True | |||
else return False | |||
-- TODO: make this more robust when destination does not exist | |||
-- |Checks whether the destination directory is contained | |||
-- within the source directory by comparing the device+file ID of the | |||
-- source directory with all device+file IDs of the parent directories | |||
-- of the destination. | |||
throwDestinationInSource :: RawFilePath -- ^ source dir | |||
-> RawFilePath -- ^ full destination, @dirname dest@ | |||
-- must exist | |||
-> IO () | |||
throwDestinationInSource sbs dbs = do | |||
destAbs <- toAbs dbs | |||
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dbs) | |||
<$> (canonicalizePath $ takeDirectory destAbs) | |||
dids <- forM (takeAllParents dest') $ \p -> do | |||
fs <- PF.getSymbolicLinkStatus p | |||
return (PF.deviceID fs, PF.fileID fs) | |||
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) | |||
$ PF.getFileStatus sbs | |||
when (elem sid dids) | |||
(throwIO $ DestinationInSource dbs sbs) | |||
where | |||
basename x = let b = takeBaseName x | |||
in if BS.null b then Nothing else Just b | |||
-------------------------------- | |||
--[ Error handling functions ]-- | |||
-------------------------------- | |||
-- |Carries out an action, then checks if there is an IOException and | |||
-- a specific errno. If so, then it carries out another action, otherwise | |||
-- it rethrows the error. | |||
catchErrno :: [Errno] -- ^ errno to catch | |||
-> IO a -- ^ action to try, which can raise an IOException | |||
-> IO a -- ^ action to carry out in case of an IOException and | |||
-- if errno matches | |||
-> IO a | |||
catchErrno en a1 a2 = | |||
catchIOError a1 $ \e -> do | |||
errno <- getErrno | |||
if errno `elem` en | |||
then a2 | |||
else ioError e | |||
-- |Execute the given action and retrow IO exceptions as a new Exception | |||
-- that have the given errno. If errno does not match the exception is rethrown | |||
-- as is. | |||
rethrowErrnoAs :: Exception e | |||
=> [Errno] -- ^ errno to catch | |||
-> e -- ^ rethrow as if errno matches | |||
-> IO a -- ^ action to try | |||
-> IO a | |||
rethrowErrnoAs en fmex action = catchErrno en action (throwIO fmex) | |||
-- |Like `catchIOError`, with arguments swapped. | |||
handleIOError :: (IOError -> IO a) -> IO a -> IO a | |||
handleIOError = flip catchIOError | |||
hideError :: IOErrorType -> IO () -> IO () | |||
hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e) | |||
-- |Like `bracket`, but allows to have different clean-up | |||
-- actions depending on whether the in-between computation | |||
-- has raised an exception or not. | |||
bracketeer :: IO a -- ^ computation to run first | |||
-> (a -> IO b) -- ^ computation to run last, when | |||
-- no exception was raised | |||
-> (a -> IO b) -- ^ computation to run last, | |||
-- when an exception was raised | |||
-> (a -> IO c) -- ^ computation to run in-between | |||
-> IO c | |||
bracketeer before after afterEx thing = | |||
mask $ \restore -> do | |||
a <- before | |||
r <- restore (thing a) `onException` afterEx a | |||
_ <- after a | |||
return r | |||
reactOnError :: IO a | |||
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors | |||
-> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException | |||
-> IO a | |||
reactOnError a ios fmios = | |||
a `catches` [iohandler, fmiohandler] | |||
where | |||
iohandler = Handler $ | |||
\(ex :: IOException) -> | |||
foldr (\(t, a') y -> if ioeGetErrorType ex == t | |||
then a' | |||
else y) | |||
(throwIO ex) | |||
ios | |||
fmiohandler = Handler $ | |||
\(ex :: HPathIOException) -> | |||
foldr (\(t, a') y -> if toConstr ex == toConstr t | |||
then a' | |||
else y) | |||
(throwIO ex) | |||
fmios | |||
@@ -0,0 +1,263 @@ | |||
-- | | |||
-- Module : System.Posix.RawFilePath.Directory.Traversals | |||
-- Copyright : © 2016 Julian Ospald | |||
-- License : BSD3 | |||
-- | |||
-- Maintainer : Julian Ospald <hasufell@posteo.de> | |||
-- Stability : experimental | |||
-- Portability : portable | |||
-- | |||
-- Traversal and read operations on directories. | |||
{-# LANGUAGE CPP #-} | |||
{-# LANGUAGE ForeignFunctionInterface #-} | |||
{-# LANGUAGE OverloadedStrings #-} | |||
{-# LANGUAGE TupleSections #-} | |||
{-# LANGUAGE ViewPatterns #-} | |||
{-# OPTIONS_GHC -Wall #-} | |||
module System.Posix.RawFilePath.Directory.Traversals ( | |||
getDirectoryContents | |||
, getDirectoryContents' | |||
, allDirectoryContents | |||
, allDirectoryContents' | |||
, traverseDirectory | |||
-- lower-level stuff | |||
, readDirEnt | |||
, packDirStream | |||
, unpackDirStream | |||
, fdOpendir | |||
, realpath | |||
) where | |||
#if __GLASGOW_HASKELL__ < 710 | |||
import Control.Applicative ((<$>)) | |||
#endif | |||
import Control.Monad | |||
import System.Posix.FilePath ((</>)) | |||
import System.Posix.Foreign | |||
import qualified System.Posix as Posix | |||
import System.IO.Error | |||
import Control.Exception | |||
import qualified Data.ByteString.Char8 as BS | |||
import System.Posix.ByteString.FilePath | |||
import System.Posix.Directory.ByteString as PosixBS | |||
import System.Posix.Files.ByteString | |||
import System.IO.Unsafe | |||
import "unix" System.Posix.IO.ByteString (closeFd) | |||
import Unsafe.Coerce (unsafeCoerce) | |||
import Foreign.C.Error | |||
import Foreign.C.String | |||
import Foreign.C.Types | |||
import Foreign.Marshal.Alloc (alloca,allocaBytes) | |||
import Foreign.Ptr | |||
import Foreign.Storable | |||
---------------------------------------------------------- | |||
-- | Get all files from a directory and its subdirectories. | |||
-- | |||
-- Upon entering a directory, 'allDirectoryContents' will get all entries | |||
-- strictly. However the returned list is lazy in that directories will only | |||
-- be accessed on demand. | |||
-- | |||
-- Follows symbolic links for the input dir. | |||
allDirectoryContents :: RawFilePath -> IO [RawFilePath] | |||
allDirectoryContents topdir = do | |||
namesAndTypes <- getDirectoryContents topdir | |||
let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes | |||
paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do | |||
let path = topdir </> name | |||
case () of | |||
() | typ == dtDir -> allDirectoryContents path | |||
| typ == dtUnknown -> do | |||
isDir <- isDirectory <$> getFileStatus path | |||
if isDir | |||
then allDirectoryContents path | |||
else return [path] | |||
| otherwise -> return [path] | |||
return (topdir : concat paths) | |||
-- | Get all files from a directory and its subdirectories strictly. | |||
-- | |||
-- Follows symbolic links for the input dir. | |||
allDirectoryContents' :: RawFilePath -> IO [RawFilePath] | |||
allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] | |||
-- this uses traverseDirectory because it's more efficient than forcing the | |||
-- lazy version. | |||
-- | Recursively apply the 'action' to the parent directory and all | |||
-- files/subdirectories. | |||
-- | |||
-- This function allows for memory-efficient traversals. | |||
-- | |||
-- Follows symbolic links for the input dir. | |||
traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s | |||
traverseDirectory act s0 topdir = toploop | |||
where | |||
toploop = do | |||
isDir <- isDirectory <$> getFileStatus topdir | |||
s' <- act s0 topdir | |||
if isDir then actOnDirContents topdir s' loop | |||
else return s' | |||
loop typ path acc = do | |||
isDir <- case () of | |||
() | typ == dtDir -> return True | |||
| typ == dtUnknown -> isDirectory <$> getFileStatus path | |||
| otherwise -> return False | |||
if isDir | |||
then act acc path >>= \acc' -> actOnDirContents path acc' loop | |||
else act acc path | |||
actOnDirContents :: RawFilePath | |||
-> b | |||
-> (DirType -> RawFilePath -> b -> IO b) | |||
-> IO b | |||
actOnDirContents pathRelToTop b f = | |||
modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) . | |||
(`ioeSetLocation` "findBSTypRel")) $ | |||
bracket | |||
(openDirStream pathRelToTop) | |||
Posix.closeDirStream | |||
(\dirp -> loop dirp b) | |||
where | |||
loop dirp b' = do | |||
(typ,e) <- readDirEnt dirp | |||
if (e == "") | |||
then return b' | |||
else | |||
if (e == "." || e == "..") | |||
then loop dirp b' | |||
else f typ (pathRelToTop </> e) b' >>= loop dirp | |||
---------------------------------------------------------- | |||
-- dodgy stuff | |||
type CDir = () | |||
type CDirent = () | |||
-- Posix doesn't export DirStream, so to re-use that type we need to use | |||
-- unsafeCoerce. It's just a newtype, so this is a legitimate usage. | |||
-- ugly trick. | |||
unpackDirStream :: DirStream -> Ptr CDir | |||
unpackDirStream = unsafeCoerce | |||
packDirStream :: Ptr CDir -> DirStream | |||
packDirStream = unsafeCoerce | |||
-- the __hscore_* functions are defined in the unix package. We can import them and let | |||
-- the linker figure it out. | |||
foreign import ccall unsafe "__hscore_readdir" | |||
c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt | |||
foreign import ccall unsafe "__hscore_free_dirent" | |||
c_freeDirEnt :: Ptr CDirent -> IO () | |||
foreign import ccall unsafe "__hscore_d_name" | |||
c_name :: Ptr CDirent -> IO CString | |||
foreign import ccall unsafe "__posixdir_d_type" | |||
c_type :: Ptr CDirent -> IO DirType | |||
foreign import ccall "realpath" | |||
c_realpath :: CString -> CString -> IO CString | |||
foreign import ccall unsafe "fdopendir" | |||
c_fdopendir :: Posix.Fd -> IO (Ptr ()) | |||
---------------------------------------------------------- | |||
-- less dodgy but still lower-level | |||
readDirEnt :: DirStream -> IO (DirType, RawFilePath) | |||
readDirEnt (unpackDirStream -> dirp) = | |||
alloca $ \ptr_dEnt -> loop ptr_dEnt | |||
where | |||
loop ptr_dEnt = do | |||
resetErrno | |||
r <- c_readdir dirp ptr_dEnt | |||
if (r == 0) | |||
then do | |||
dEnt <- peek ptr_dEnt | |||
if (dEnt == nullPtr) | |||
then return (dtUnknown,BS.empty) | |||
else do | |||
dName <- c_name dEnt >>= peekFilePath | |||
dType <- c_type dEnt | |||
c_freeDirEnt dEnt | |||
return (dType, dName) | |||
else do | |||
errno <- getErrno | |||
if (errno == eINTR) | |||
then loop ptr_dEnt | |||
else do | |||
let (Errno eo) = errno | |||
if (eo == 0) | |||
then return (dtUnknown,BS.empty) | |||
else throwErrno "readDirEnt" | |||
-- |Gets all directory contents (not recursively). | |||
getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] | |||
getDirectoryContents path = | |||
modifyIOError ((`ioeSetFileName` (BS.unpack path)) . | |||
(`ioeSetLocation` "System.Posix.RawFilePath.Directory.Traversals.getDirectoryContents")) $ | |||
bracket | |||
(PosixBS.openDirStream path) | |||
PosixBS.closeDirStream | |||
_dirloop | |||
-- |Binding to @fdopendir(3)@. | |||
fdOpendir :: Posix.Fd -> IO DirStream | |||
fdOpendir fd = | |||
packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd) | |||
-- |Like `getDirectoryContents` except for a file descriptor. | |||
-- | |||
-- To avoid complicated error checks, the file descriptor is | |||
-- __always__ closed, even if `fdOpendir` fails. Usually, this | |||
-- only happens on successful `fdOpendir` and after the directory | |||
-- stream is closed. Also see the manpage of @fdopendir(3)@ for | |||
-- more details. | |||
getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)] | |||
getDirectoryContents' fd = do | |||
dirstream <- fdOpendir fd `catchIOError` \e -> do | |||
closeFd fd | |||
ioError e | |||
-- closeDirStream closes the filedescriptor | |||
finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream) | |||
_dirloop :: DirStream -> IO [(DirType, RawFilePath)] | |||
{-# INLINE _dirloop #-} | |||
_dirloop dirp = do | |||
t@(_typ,e) <- readDirEnt dirp | |||
if BS.null e then return [] else do | |||
es <- _dirloop dirp | |||
return (t:es) | |||
-- | return the canonicalized absolute pathname | |||
-- | |||
-- like canonicalizePath, but uses @realpath(3)@ | |||
realpath :: RawFilePath -> IO RawFilePath | |||
realpath inp = | |||
allocaBytes pathMax $ \tmp -> do | |||
void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp | |||
BS.packCString tmp |
@@ -0,0 +1,24 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
import qualified Data.ByteString as BS | |||
import Data.IORef | |||
import Test.Hspec | |||
import Test.Hspec.Runner | |||
import Test.Hspec.Formatters | |||
import qualified Spec | |||
import Utils | |||
import System.Posix.Temp.ByteString (mkdtemp) | |||
-- TODO: chardev, blockdev, namedpipe, socket | |||
main :: IO () | |||
main = do | |||
tmpBase <- mkdtemp "/tmp/" | |||
writeIORef baseTmpDir (Just (tmpBase `BS.append` "/")) | |||
putStrLn $ ("Temporary test directory at: " ++ show tmpBase) | |||
hspecWith | |||
defaultConfig { configFormatter = Just progress } | |||
$ afterAll_ deleteBaseTmpDir | |||
$ Spec.spec |
@@ -0,0 +1,2 @@ | |||
-- file test/Spec.hs | |||
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} |
@@ -0,0 +1,108 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.AppendFileSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "AppendFileSpec" | |||
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" "BLKASL" | |||
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 "System.Posix.RawFilePath.Directory.appendFile" $ do | |||
-- successes -- | |||
it "appendFile file with content, everything clear" $ do | |||
appendFile' "fileWithContent" "blahfaselllll" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "BLKASLblahfaselllll" | |||
it "appendFile file with content, everything clear" $ do | |||
appendFile' "fileWithContent" "gagagaga" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "BLKASLblahfaselllllgagagaga" | |||
it "appendFile file with content, everything clear" $ do | |||
appendFile' "fileWithContent" "" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "BLKASLblahfaselllllgagagaga" | |||
it "appendFile file without content, everything clear" $ do | |||
appendFile' "fileWithoutContent" "blahfaselllll" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "appendFile, everything clear" $ do | |||
appendFile' "fileWithoutContent" "gagagaga" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "blahfaselllllgagagaga" | |||
it "appendFile symlink, everything clear" $ do | |||
appendFile' "inputFileSymL" "blahfaselllll" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll" | |||
it "appendFile symlink, everything clear" $ do | |||
appendFile' "inputFileSymL" "gagagaga" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga" | |||
-- posix failures -- | |||
it "appendFile to dir, inappropriate type" $ do | |||
appendFile' "alreadyExistsD" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) | |||
it "appendFile, no permissions to file" $ do | |||
appendFile' "noPerms" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "appendFile, no permissions to file" $ do | |||
appendFile' "noPermsD/inputFile" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "appendFile, file does not exist" $ do | |||
appendFile' "gaga" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) |
@@ -0,0 +1,78 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CanonicalizePathSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CanonicalizePathSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "file" | |||
createDir' "dir" | |||
createSymlink' "dirSym" "dir/" | |||
createSymlink' "brokenSym" "nothing" | |||
createSymlink' "fileSym" "file" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "file" | |||
deleteDir' "dir" | |||
deleteFile' "dirSym" | |||
deleteFile' "brokenSym" | |||
deleteFile' "fileSym" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.canonicalizePath" $ do | |||
-- successes -- | |||
it "canonicalizePath, all fine" $ do | |||
path <- withTmpDir "file" return | |||
canonicalizePath' "file" | |||
`shouldReturn` path | |||
it "canonicalizePath, all fine" $ do | |||
path <- withTmpDir "dir" return | |||
canonicalizePath' "dir" | |||
`shouldReturn` path | |||
it "canonicalizePath, all fine" $ do | |||
path <- withTmpDir "file" return | |||
canonicalizePath' "fileSym" | |||
`shouldReturn` path | |||
it "canonicalizePath, all fine" $ do | |||
path <- withTmpDir "dir" return | |||
canonicalizePath' "dirSym" | |||
`shouldReturn` path | |||
-- posix failures -- | |||
it "canonicalizePath, broken symlink" $ | |||
canonicalizePath' "brokenSym" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "canonicalizePath, file does not exist" $ | |||
canonicalizePath' "nothingBlah" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
@@ -0,0 +1,248 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CopyDirRecursiveCollectFailuresSpec where | |||
import Test.Hspec | |||
import Data.List (sort) | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import qualified Data.ByteString as BS | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyDirRecursiveCollectFailuresSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createRegularFile' "wrongInput" | |||
createSymlink' "wrongInputSymL" "inputDir/" | |||
createDir' "alreadyExistsD" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
createDir' "inputDir" | |||
createDir' "inputDir/bar" | |||
createDir' "inputDir/foo" | |||
createRegularFile' "inputDir/foo/inputFile1" | |||
createRegularFile' "inputDir/inputFile2" | |||
createRegularFile' "inputDir/bar/inputFile3" | |||
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" | |||
writeFile' "inputDir/inputFile2" "Blahfaselgagaga" | |||
writeFile' "inputDir/bar/inputFile3" | |||
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" | |||
createDir' "inputDir1" | |||
createDir' "inputDir1/foo2" | |||
createDir' "inputDir1/foo2/foo3" | |||
createDir' "inputDir1/foo2/foo4" | |||
createRegularFile' "inputDir1/foo2/inputFile1" | |||
createRegularFile' "inputDir1/foo2/inputFile2" | |||
createRegularFile' "inputDir1/foo2/inputFile3" | |||
createRegularFile' "inputDir1/foo2/foo4/inputFile4" | |||
createRegularFile' "inputDir1/foo2/foo4/inputFile6" | |||
createRegularFile' "inputDir1/foo2/foo3/inputFile5" | |||
noPerms "inputDir1/foo2/foo3" | |||
createDir' "outputDir1" | |||
createDir' "outputDir1/foo2" | |||
createDir' "outputDir1/foo2/foo4" | |||
createDir' "outputDir1/foo2/foo4/inputFile4" | |||
createRegularFile' "outputDir1/foo2/foo4/inputFile6" | |||
noPerms "outputDir1/foo2/foo4/inputFile4" | |||
noPerms "outputDir1/foo2/foo4" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
normalDirPerms "inputDir1/foo2/foo3" | |||
deleteFile' "inputDir1/foo2/foo4/inputFile4" | |||
deleteFile' "inputDir1/foo2/foo4/inputFile6" | |||
deleteFile' "inputDir1/foo2/inputFile1" | |||
deleteFile' "inputDir1/foo2/inputFile2" | |||
deleteFile' "inputDir1/foo2/inputFile3" | |||
deleteFile' "inputDir1/foo2/foo3/inputFile5" | |||
deleteDir' "inputDir1/foo2/foo3" | |||
deleteDir' "inputDir1/foo2/foo4" | |||
deleteDir' "inputDir1/foo2" | |||
deleteDir' "inputDir1" | |||
normalDirPerms "outputDir1/foo2/foo4" | |||
normalDirPerms "outputDir1/foo2/foo4/inputFile4" | |||
deleteFile' "outputDir1/foo2/foo4/inputFile6" | |||
deleteDir' "outputDir1/foo2/foo4/inputFile4" | |||
deleteDir' "outputDir1/foo2/foo4" | |||
deleteDir' "outputDir1/foo2" | |||
deleteDir' "outputDir1" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "wrongInput" | |||
deleteFile' "wrongInputSymL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
deleteFile' "inputDir/foo/inputFile1" | |||
deleteFile' "inputDir/inputFile2" | |||
deleteFile' "inputDir/bar/inputFile3" | |||
deleteDir' "inputDir/foo" | |||
deleteDir' "inputDir/bar" | |||
deleteDir' "inputDir" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do | |||
-- successes -- | |||
it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Strict | |||
CollectFailures | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "outputDir" | |||
++ " >/dev/null") | |||
`shouldReturn` ExitSuccess | |||
removeDirIfExists "outputDir" | |||
-- posix failures -- | |||
it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $ | |||
copyDirRecursive' "doesNotExist" | |||
"outputDir" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $ | |||
copyDirRecursive' "noPerms/inputDir" | |||
"foo" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures | |||
it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do | |||
copyDirRecursive' "inputDir1/foo2" | |||
"outputDir1/foo2" | |||
Overwrite | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure ex@[_, _]) -> | |||
any (\(h, e) -> ioeGetErrorType e == InappropriateType | |||
&& isCopyFileFailed h) ex && | |||
any (\(h, e) -> ioeGetErrorType e == PermissionDenied | |||
&& isReadContentsFailed h) ex) | |||
normalDirPerms "outputDir1/foo2/foo4" | |||
normalDirPerms "outputDir1/foo2/foo4/inputFile4" | |||
c <- allDirectoryContents' "outputDir1" | |||
tmpDir' <- getRawTmpDir | |||
let shouldC = (fmap (\x -> tmpDir' `BS.append` x) | |||
["outputDir1" | |||
,"outputDir1/foo2" | |||
,"outputDir1/foo2/inputFile1" | |||
,"outputDir1/foo2/inputFile2" | |||
,"outputDir1/foo2/inputFile3" | |||
,"outputDir1/foo2/foo4" | |||
,"outputDir1/foo2/foo4/inputFile6" | |||
,"outputDir1/foo2/foo4/inputFile4"]) | |||
deleteFile' "outputDir1/foo2/inputFile1" | |||
deleteFile' "outputDir1/foo2/inputFile2" | |||
deleteFile' "outputDir1/foo2/inputFile3" | |||
sort c `shouldBe` sort shouldC | |||
it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noWritePerm/foo" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noPerms/foo" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
isRecursiveFailure | |||
it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExistsD" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists) | |||
it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExists" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
isRecursiveFailure | |||
it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $ | |||
copyDirRecursive' "wrongInput" | |||
"outputDir" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $ | |||
copyDirRecursive' "wrongInputSymL" | |||
"outputDir" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument) | |||
it "copyDirRecursive (Strict, CollectFailures), destination in source" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir/foo" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
isDestinationInSource | |||
it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
isSameFile | |||
@@ -0,0 +1,205 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CopyDirRecursiveOverwriteSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyDirRecursiveOverwriteSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createRegularFile' "wrongInput" | |||
createSymlink' "wrongInputSymL" "inputDir/" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
createDir' "inputDir" | |||
createDir' "inputDir/bar" | |||
createDir' "inputDir/foo" | |||
createRegularFile' "inputDir/foo/inputFile1" | |||
createRegularFile' "inputDir/inputFile2" | |||
createRegularFile' "inputDir/bar/inputFile3" | |||
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" | |||
writeFile' "inputDir/inputFile2" "Blahfaselgagaga" | |||
writeFile' "inputDir/bar/inputFile3" | |||
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" | |||
createDir' "alreadyExistsD" | |||
createDir' "alreadyExistsD/bar" | |||
createDir' "alreadyExistsD/foo" | |||
createRegularFile' "alreadyExistsD/foo/inputFile1" | |||
createRegularFile' "alreadyExistsD/inputFile2" | |||
createRegularFile' "alreadyExistsD/bar/inputFile3" | |||
writeFile' "alreadyExistsD/foo/inputFile1" "DAAsada" | |||
writeFile' "alreadyExistsD/inputFile2" "ahfaagaga" | |||
writeFile' "alreadyExistsD/bar/inputFile3" | |||
"f3223sasdasdaasdasdasasd4" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "wrongInput" | |||
deleteFile' "wrongInputSymL" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
deleteFile' "inputDir/foo/inputFile1" | |||
deleteFile' "inputDir/inputFile2" | |||
deleteFile' "inputDir/bar/inputFile3" | |||
deleteDir' "inputDir/foo" | |||
deleteDir' "inputDir/bar" | |||
deleteDir' "inputDir" | |||
deleteFile' "alreadyExistsD/foo/inputFile1" | |||
deleteFile' "alreadyExistsD/inputFile2" | |||
deleteFile' "alreadyExistsD/bar/inputFile3" | |||
deleteDir' "alreadyExistsD/foo" | |||
deleteDir' "alreadyExistsD/bar" | |||
deleteDir' "alreadyExistsD" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do | |||
-- successes -- | |||
it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
removeDirIfExists "outputDir" | |||
it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "outputDir" | |||
++ " >/dev/null") | |||
`shouldReturn` ExitSuccess | |||
removeDirIfExists "outputDir" | |||
it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do | |||
tmpDir' <- getRawTmpDir | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "alreadyExistsD" | |||
++ " >/dev/null") | |||
`shouldReturn` (ExitFailure 1) | |||
copyDirRecursive' "inputDir" | |||
"alreadyExistsD" | |||
Overwrite | |||
FailEarly | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "alreadyExistsD" | |||
++ " >/dev/null") | |||
`shouldReturn` ExitSuccess | |||
removeDirIfExists "outputDir" | |||
-- posix failures -- | |||
it "copyDirRecursive, source directory does not exist" $ | |||
copyDirRecursive' "doesNotExist" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyDirRecursive, no write permission on output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noWritePerm/foo" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive, cannot open output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noPerms/foo" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive, cannot open source dir" $ | |||
copyDirRecursive' "noPerms/inputDir" | |||
"foo" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive, destination already exists and is a file" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExists" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive, wrong input (regular file)" $ | |||
copyDirRecursive' "wrongInput" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive, wrong input (symlink to directory)" $ | |||
copyDirRecursive' "wrongInputSymL" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
-- custom failures | |||
it "copyDirRecursive (Overwrite, FailEarly), destination in source" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir/foo" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
isDestinationInSource | |||
it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
isSameFile |
@@ -0,0 +1,181 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CopyDirRecursiveSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyDirRecursiveSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createRegularFile' "wrongInput" | |||
createSymlink' "wrongInputSymL" "inputDir/" | |||
createDir' "alreadyExistsD" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
createDir' "inputDir" | |||
createDir' "inputDir/bar" | |||
createDir' "inputDir/foo" | |||
createRegularFile' "inputDir/foo/inputFile1" | |||
createRegularFile' "inputDir/inputFile2" | |||
createRegularFile' "inputDir/bar/inputFile3" | |||
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" | |||
writeFile' "inputDir/inputFile2" "Blahfaselgagaga" | |||
writeFile' "inputDir/bar/inputFile3" | |||
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "wrongInput" | |||
deleteFile' "wrongInputSymL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
deleteFile' "inputDir/foo/inputFile1" | |||
deleteFile' "inputDir/inputFile2" | |||
deleteFile' "inputDir/bar/inputFile3" | |||
deleteDir' "inputDir/foo" | |||
deleteDir' "inputDir/bar" | |||
deleteDir' "inputDir" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do | |||
-- successes -- | |||
it "copyDirRecursive (Strict, FailEarly), all fine" $ do | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
removeDirIfExists "outputDir" | |||
it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "outputDir" | |||
++ " >/dev/null") | |||
`shouldReturn` ExitSuccess | |||
removeDirIfExists "outputDir" | |||
-- posix failures -- | |||
it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $ | |||
copyDirRecursive' "doesNotExist" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noWritePerm/foo" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noPerms/foo" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $ | |||
copyDirRecursive' "noPerms/inputDir" | |||
"foo" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExistsD" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExists" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $ | |||
copyDirRecursive' "wrongInput" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $ | |||
copyDirRecursive' "wrongInputSymL" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
-- custom failures | |||
it "copyDirRecursive (Strict, FailEarly), destination in source" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir/foo" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
isDestinationInSource | |||
it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
isSameFile | |||
@@ -0,0 +1,148 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CopyFileOverwriteSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyFileOverwriteSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "inputFile" | |||
createRegularFile' "alreadyExists" | |||
createSymlink' "inputFileSymL" "inputFile" | |||
createDir' "alreadyExistsD" | |||
createDir' "noPerms" | |||
createRegularFile' "noPerms/inputFile" | |||
createDir' "outputDirNoWrite" | |||
createDir' "wrongInput" | |||
noPerms "noPerms" | |||
noWritableDirPerms "outputDirNoWrite" | |||
writeFile' "inputFile" "Blahfaselgagaga" | |||
writeFile' "alreadyExists" "dsaldsalkaklsdlkasksdadasl" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "outputDirNoWrite" | |||
deleteFile' "noPerms/inputFile" | |||
deleteFile' "inputFile" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "inputFileSymL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "noPerms" | |||
deleteDir' "outputDirNoWrite" | |||
deleteDir' "wrongInput" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.copyFile" $ do | |||
-- successes -- | |||
it "copyFile (Overwrite), everything clear" $ do | |||
copyFile' "inputFile" | |||
"outputFile" | |||
Overwrite | |||
removeFileIfExists "outputFile" | |||
it "copyFile (Overwrite), output file already exists, all clear" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyFile' "alreadyExists" "alreadyExists.bak" Strict | |||
copyFile' "inputFile" "alreadyExists" Overwrite | |||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " | |||
++ toString tmpDir' ++ "alreadyExists") | |||
`shouldReturn` ExitSuccess | |||
removeFileIfExists "alreadyExists" | |||
copyFile' "alreadyExists.bak" "alreadyExists" Strict | |||
removeFileIfExists "alreadyExists.bak" | |||
it "copyFile (Overwrite), and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyFile' "inputFile" | |||
"outputFile" | |||
Overwrite | |||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " | |||
++ toString tmpDir' ++ "outputFile") | |||
`shouldReturn` ExitSuccess | |||
removeFileIfExists "outputFile" | |||
-- posix failures -- | |||
it "copyFile (Overwrite), input file does not exist" $ | |||
copyFile' "noSuchFile" | |||
"outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyFile (Overwrite), no permission to write to output directory" $ | |||
copyFile' "inputFile" | |||
"outputDirNoWrite/outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Overwrite), cannot open output directory" $ | |||
copyFile' "inputFile" | |||
"noPerms/outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Overwrite), cannot open source directory" $ | |||
copyFile' "noPerms/inputFile" | |||
"outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Overwrite), wrong input type (symlink)" $ | |||
copyFile' "inputFileSymL" | |||
"outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "copyFile (Overwrite), wrong input type (directory)" $ | |||
copyFile' "wrongInput" | |||
"outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyFile (Overwrite), output file already exists and is a dir" $ | |||
copyFile' "inputFile" | |||
"alreadyExistsD" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
-- custom failures -- | |||
it "copyFile (Overwrite), output and input are same file" $ | |||
copyFile' "inputFile" | |||
"inputFile" | |||
Overwrite | |||
`shouldThrow` isSameFile |
@@ -0,0 +1,143 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CopyFileSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "inputFile" | |||
createRegularFile' "alreadyExists" | |||
createSymlink' "inputFileSymL" "inputFile" | |||
createDir' "alreadyExistsD" | |||
createDir' "noPerms" | |||
createRegularFile' "noPerms/inputFile" | |||
createDir' "outputDirNoWrite" | |||
createDir' "wrongInput" | |||
noPerms "noPerms" | |||
noWritableDirPerms "outputDirNoWrite" | |||
writeFile' "inputFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "outputDirNoWrite" | |||
deleteFile' "noPerms/inputFile" | |||
deleteFile' "inputFile" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "inputFileSymL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "noPerms" | |||
deleteDir' "outputDirNoWrite" | |||
deleteDir' "wrongInput" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.copyFile" $ do | |||
-- successes -- | |||
it "copyFile (Strict), everything clear" $ do | |||
copyFile' "inputFile" | |||
"outputFile" | |||
Strict | |||
removeFileIfExists "outputFile" | |||
it "copyFile (Strict), and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyFile' "inputFile" | |||
"outputFile" | |||
Strict | |||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " | |||
++ toString tmpDir' ++ "outputFile") | |||
`shouldReturn` ExitSuccess | |||
removeFileIfExists "outputFile" | |||
-- posix failures -- | |||
it "copyFile (Strict), input file does not exist" $ | |||
copyFile' "noSuchFile" | |||
"outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyFile (Strict), no permission to write to output directory" $ | |||
copyFile' "inputFile" | |||
"outputDirNoWrite/outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Strict), cannot open output directory" $ | |||
copyFile' "inputFile" | |||
"noPerms/outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Strict), cannot open source directory" $ | |||
copyFile' "noPerms/inputFile" | |||
"outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Strict), wrong input type (symlink)" $ | |||
copyFile' "inputFileSymL" | |||
"outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "copyFile (Strict), wrong input type (directory)" $ | |||
copyFile' "wrongInput" | |||
"outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyFile (Strict), output file already exists" $ | |||
copyFile' "inputFile" | |||
"alreadyExists" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "copyFile (Strict), output file already exists and is a dir" $ | |||
copyFile' "inputFile" | |||
"alreadyExistsD" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
-- custom failures -- | |||
it "copyFile (Strict), output and input are same file" $ | |||
copyFile' "inputFile" | |||
"inputFile" | |||
Strict | |||
`shouldThrow` | |||
isSameFile |
@@ -0,0 +1,69 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CreateDirIfMissingSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateDirIfMissingSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createDir' "alreadyExists" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteDir' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.CreateDirIfMissing" $ do | |||
-- successes -- | |||
it "createDirIfMissing, all fine" $ do | |||
createDirIfMissing' "newDir" | |||
removeDirIfExists "newDir" | |||
it "createDirIfMissing, destination directory already exists" $ | |||
createDirIfMissing' "alreadyExists" | |||
-- posix failures -- | |||
it "createDirIfMissing, parent directories do not exist" $ | |||
createDirIfMissing' "some/thing/dada" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "createDirIfMissing, can't write to output directory" $ | |||
createDirIfMissing' "noWritePerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createDirIfMissing, can't open output directory" $ | |||
createDirIfMissing' "noPerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) |
@@ -0,0 +1,78 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CreateDirRecursiveSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateDirRecursiveSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createDir' "alreadyExists" | |||
createRegularFile' "alreadyExistsF" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteDir' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
deleteFile' "alreadyExistsF" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.createDirRecursive" $ do | |||
-- successes -- | |||
it "createDirRecursive, all fine" $ do | |||
createDirRecursive' "newDir" | |||
deleteDir' "newDir" | |||
it "createDirRecursive, parent directories do not exist" $ do | |||
createDirRecursive' "some/thing/dada" | |||
deleteDir' "some/thing/dada" | |||
deleteDir' "some/thing" | |||
deleteDir' "some" | |||
it "createDirRecursive, destination directory already exists" $ | |||
createDirRecursive' "alreadyExists" | |||
-- posix failures -- | |||
it "createDirRecursive, destination already exists and is a file" $ | |||
createDirRecursive' "alreadyExistsF" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "createDirRecursive, can't write to output directory" $ | |||
createDirRecursive' "noWritePerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createDirRecursive, can't open output directory" $ | |||
createDirRecursive' "noPerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
@@ -0,0 +1,72 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CreateDirSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateDirSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createDir' "alreadyExists" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteDir' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.createDir" $ do | |||
-- successes -- | |||
it "createDir, all fine" $ do | |||
createDir' "newDir" | |||
removeDirIfExists "newDir" | |||
-- posix failures -- | |||
it "createDir, parent directories do not exist" $ | |||
createDir' "some/thing/dada" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "createDir, can't write to output directory" $ | |||
createDir' "noWritePerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createDir, can't open output directory" $ | |||
createDir' "noPerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createDir, destination directory already exists" $ | |||
createDir' "alreadyExists" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
@@ -0,0 +1,70 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CreateRegularFileSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateRegularFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.createRegularFile" $ do | |||
-- successes -- | |||
it "createRegularFile, all fine" $ do | |||
createRegularFile' "newDir" | |||
removeFileIfExists "newDir" | |||
-- posix failures -- | |||
it "createRegularFile, parent directories do not exist" $ | |||
createRegularFile' "some/thing/dada" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "createRegularFile, can't write to destination directory" $ | |||
createRegularFile' "noWritePerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createRegularFile, can't write to destination directory" $ | |||
createRegularFile' "noPerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createRegularFile, destination file already exists" $ | |||
createRegularFile' "alreadyExists" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
@@ -0,0 +1,71 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.CreateSymlinkSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateSymlinkSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.createSymlink" $ do | |||
-- successes -- | |||
it "createSymlink, all fine" $ do | |||
createSymlink' "newSymL" "alreadyExists/" | |||
removeFileIfExists "newSymL" | |||
-- posix failures -- | |||
it "createSymlink, parent directories do not exist" $ | |||
createSymlink' "some/thing/dada" "lala" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "createSymlink, can't write to destination directory" $ | |||
createSymlink' "noWritePerms/newDir" "lala" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createSymlink, can't write to destination directory" $ | |||
createSymlink' "noPerms/newDir" "lala" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createSymlink, destination file already exists" $ | |||
createSymlink' "alreadyExists" "lala" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
@@ -0,0 +1,116 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.DeleteDirRecursiveSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import System.Posix.Files.ByteString | |||
( | |||
getSymbolicLinkStatus | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "DeleteDirRecursiveSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "file" | |||
createDir' "dir" | |||
createRegularFile' "dir/.keep" | |||
createSymlink' "dirSym" "dir/" | |||
createDir' "noPerms" | |||
createRegularFile' "noPerms/.keep" | |||
createDir' "noWritable" | |||
createRegularFile' "noWritable/.keep" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "file" | |||
deleteFile' "dir/.keep" | |||
deleteDir' "dir" | |||
deleteFile' "dirSym" | |||
deleteFile' "noPerms/.keep" | |||
deleteDir' "noPerms" | |||
deleteFile' "noWritable/.keep" | |||
deleteDir' "noWritable" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.deleteDirRecursive" $ do | |||
-- successes -- | |||
it "deleteDirRecursive, empty directory, all fine" $ do | |||
createDir' "testDir" | |||
deleteDirRecursive' "testDir" | |||
getSymbolicLinkStatus "testDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do | |||
createDir' "noPerms/testDir" | |||
noPerms "noPerms/testDir" | |||
deleteDirRecursive' "noPerms/testDir" | |||
it "deleteDirRecursive, non-empty directory, all fine" $ do | |||
createDir' "nonEmpty" | |||
createDir' "nonEmpty/dir1" | |||
createDir' "nonEmpty/dir2" | |||
createDir' "nonEmpty/dir2/dir3" | |||
createRegularFile' "nonEmpty/file1" | |||
createRegularFile' "nonEmpty/dir1/file2" | |||
deleteDirRecursive' "nonEmpty" | |||
getSymbolicLinkStatus "nonEmpty" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
-- posix failures -- | |||
it "deleteDirRecursive, can't open parent directory" $ do | |||
createDir' "noPerms/foo" | |||
noPerms "noPerms" | |||
(deleteDirRecursive' "noPerms/foo") | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
normalDirPerms "noPerms" | |||
deleteDir' "noPerms/foo" | |||
it "deleteDirRecursive, can't write to parent directory" $ do | |||
createDir' "noWritable/foo" | |||
noWritableDirPerms "noWritable" | |||
(deleteDirRecursive' "noWritable/foo") | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
normalDirPerms "noWritable" | |||
deleteDir' "noWritable/foo" | |||
it "deleteDirRecursive, wrong file type (symlink to directory)" $ | |||
deleteDirRecursive' "dirSym" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteDirRecursive, wrong file type (regular file)" $ | |||
deleteDirRecursive' "file" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteDirRecursive, directory does not exist" $ | |||
deleteDirRecursive' "doesNotExist" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
@@ -0,0 +1,114 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.DeleteDirSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import System.Posix.Files.ByteString | |||
( | |||
getSymbolicLinkStatus | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "DeleteDirSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "file" | |||
createDir' "dir" | |||
createRegularFile' "dir/.keep" | |||
createSymlink' "dirSym" "dir/" | |||
createDir' "noPerms" | |||
createRegularFile' "noPerms/.keep" | |||
createDir' "noWritable" | |||
createRegularFile' "noWritable/.keep" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "file" | |||
deleteFile' "dir/.keep" | |||
deleteDir' "dir" | |||
deleteFile' "dirSym" | |||
deleteFile' "noPerms/.keep" | |||
deleteDir' "noPerms" | |||
deleteFile' "noWritable/.keep" | |||
deleteDir' "noWritable" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.deleteDir" $ do | |||
-- successes -- | |||
it "deleteDir, empty directory, all fine" $ do | |||
createDir' "testDir" | |||
deleteDir' "testDir" | |||
getSymbolicLinkStatus "testDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteDir, directory with null permissions, all fine" $ do | |||
createDir' "noPerms/testDir" | |||
noPerms "noPerms/testDir" | |||
deleteDir' "noPerms/testDir" | |||
getSymbolicLinkStatus "testDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
-- posix failures -- | |||
it "deleteDir, wrong file type (symlink to directory)" $ | |||
deleteDir' "dirSym" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteDir, wrong file type (regular file)" $ | |||
deleteDir' "file" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteDir, directory does not exist" $ | |||
deleteDir' "doesNotExist" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteDir, directory not empty" $ | |||
deleteDir' "dir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == UnsatisfiedConstraints) | |||
it "deleteDir, can't open parent directory" $ do | |||
createDir' "noPerms/foo" | |||
noPerms "noPerms" | |||
(deleteDir' "noPerms/foo") | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
normalDirPerms "noPerms" | |||
deleteDir' "noPerms/foo" | |||
it "deleteDir, can't write to parent directory, still fine" $ do | |||
createDir' "noWritable/foo" | |||
noWritableDirPerms "noWritable" | |||
(deleteDir' "noWritable/foo") | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
normalDirPerms "noWritable" | |||
deleteDir' "noWritable/foo" | |||
@@ -0,0 +1,84 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.DeleteFileSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import System.Posix.Files.ByteString | |||
( | |||
getSymbolicLinkStatus | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "DeleteFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "foo" | |||
createSymlink' "syml" "foo" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
noPerms "noPerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
deleteFile' "foo" | |||
deleteFile' "syml" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.deleteFile" $ do | |||
-- successes -- | |||
it "deleteFile, regular file, all fine" $ do | |||
createRegularFile' "testFile" | |||
deleteFile' "testFile" | |||
getSymbolicLinkStatus "testFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteFile, symlink, all fine" $ do | |||
recreateSymlink' "syml" | |||
"testFile" | |||
Strict | |||
deleteFile' "testFile" | |||
getSymbolicLinkStatus "testFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
-- posix failures -- | |||
it "deleteFile, wrong file type (directory)" $ | |||
deleteFile' "dir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteFile, file does not exist" $ | |||
deleteFile' "doesNotExist" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteFile, can't read directory" $ | |||
deleteFile' "noPerms/blah" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
@@ -0,0 +1,100 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.GetDirsFilesSpec where | |||
import Data.List | |||
( | |||
sort | |||
) | |||
import "hpath-directory" System.Posix.RawFilePath.Directory hiding (getDirsFiles') | |||
import System.Posix.FilePath | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "GetDirsFilesSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "file" | |||
createRegularFile' "Lala" | |||
createRegularFile' ".hidden" | |||
createSymlink' "syml" "Lala" | |||
createDir' "dir" | |||
createSymlink' "dirsym" "dir" | |||
createDir' "noPerms" | |||
noPerms "noPerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
deleteFile' "file" | |||
deleteFile' "Lala" | |||
deleteFile' ".hidden" | |||
deleteFile' "syml" | |||
deleteDir' "dir" | |||
deleteFile' "dirsym" | |||
deleteDir' "noPerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.getDirsFiles" $ do | |||
-- successes -- | |||
it "getDirsFiles, all fine" $ | |||
withRawTmpDir $ \p -> do | |||
let expectedFiles = [".hidden" | |||
,"Lala" | |||
,"dir" | |||
,"dirsym" | |||
,"file" | |||
,"noPerms" | |||
,"syml"] | |||
(fmap sort $ getDirsFiles p) | |||
`shouldReturn` fmap (p </>) expectedFiles | |||
-- posix failures -- | |||
it "getDirsFiles, nonexistent directory" $ | |||
getDirsFiles' "nothingHere" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "getDirsFiles, wrong file type (file)" $ | |||
getDirsFiles' "file" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "getDirsFiles, wrong file type (symlink to file)" $ | |||
getDirsFiles' "syml" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "getDirsFiles, wrong file type (symlink to dir)" $ | |||
getDirsFiles' "dirsym" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "getDirsFiles, can't open directory" $ | |||
getDirsFiles' "noPerms" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
@@ -0,0 +1,88 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.GetFileTypeSpec where | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "GetFileTypeSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "regularfile" | |||
createSymlink' "symlink" "regularfile" | |||
createSymlink' "brokenSymlink" "broken" | |||
createDir' "directory" | |||
createSymlink' "symlinkD" "directory" | |||
createDir' "noPerms" | |||
noPerms "noPerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
deleteFile' "regularfile" | |||
deleteFile' "symlink" | |||
deleteFile' "brokenSymlink" | |||
deleteDir' "directory" | |||
deleteFile' "symlinkD" | |||
deleteDir' "noPerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.getFileType" $ do | |||
-- successes -- | |||
it "getFileType, regular file" $ | |||
getFileType' "regularfile" | |||
`shouldReturn` RegularFile | |||
it "getFileType, directory" $ | |||
getFileType' "directory" | |||
`shouldReturn` Directory | |||
it "getFileType, directory with null permissions" $ | |||
getFileType' "noPerms" | |||
`shouldReturn` Directory | |||
it "getFileType, symlink to file" $ | |||
getFileType' "symlink" | |||
`shouldReturn` SymbolicLink | |||
it "getFileType, symlink to directory" $ | |||
getFileType' "symlinkD" | |||
`shouldReturn` SymbolicLink | |||
it "getFileType, broken symlink" $ | |||
getFileType' "brokenSymlink" | |||
`shouldReturn` SymbolicLink | |||
-- posix failures -- | |||
it "getFileType, file does not exist" $ | |||
getFileType' "nothingHere" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "getFileType, can't open directory" $ | |||
getFileType' "noPerms/forz" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
@@ -0,0 +1,126 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.MoveFileOverwriteSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "MoveFileOverwriteSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.moveFile" $ do | |||
-- successes -- | |||
it "moveFile (Overwrite), all fine" $ | |||
moveFile' "myFile" | |||
"movedFile" | |||
Overwrite | |||
it "moveFile (Overwrite), all fine" $ | |||
moveFile' "myFile" | |||
"dir/movedFile" | |||
Overwrite | |||
it "moveFile (Overwrite), all fine on symlink" $ | |||
moveFile' "myFileL" | |||
"movedFile" | |||
Overwrite | |||
it "moveFile (Overwrite), all fine on directory" $ | |||
moveFile' "dir" | |||
"movedFile" | |||
Overwrite | |||
it "moveFile (Overwrite), destination file already exists" $ | |||
moveFile' "myFile" | |||
"alreadyExists" | |||
Overwrite | |||
-- posix failures -- | |||
it "moveFile (Overwrite), source file does not exist" $ | |||
moveFile' "fileDoesNotExist" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "moveFile (Overwrite), can't write to destination directory" $ | |||
moveFile' "myFile" | |||
"noWritePerm/movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "moveFile (Overwrite), can't open destination directory" $ | |||
moveFile' "myFile" | |||
"noPerms/movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "moveFile (Overwrite), can't open source directory" $ | |||
moveFile' "noPerms/myFile" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures -- | |||
it "moveFile (Overwrite), move from file to dir" $ | |||
moveFile' "myFile" | |||
"alreadyExistsD" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Overwrite), source and dest are same file" $ | |||
moveFile' "myFile" | |||
"myFile" | |||
Overwrite | |||
`shouldThrow` | |||
isSameFile |
@@ -0,0 +1,129 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.MoveFileSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "MoveFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createRegularFile' "alreadyExists" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.moveFile" $ do | |||
-- successes -- | |||
it "moveFile (Strict), all fine" $ | |||
moveFile' "myFile" | |||
"movedFile" | |||
Strict | |||
it "moveFile (Strict), all fine" $ | |||
moveFile' "myFile" | |||
"dir/movedFile" | |||
Strict | |||
it "moveFile (Strict), all fine on symlink" $ | |||
moveFile' "myFileL" | |||
"movedFile" | |||
Strict | |||
it "moveFile (Strict), all fine on directory" $ | |||
moveFile' "dir" | |||
"movedFile" | |||
Strict | |||
-- posix failures -- | |||
it "moveFile (Strict), source file does not exist" $ | |||
moveFile' "fileDoesNotExist" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "moveFile (Strict), can't write to destination directory" $ | |||
moveFile' "myFile" | |||
"noWritePerm/movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "moveFile (Strict), can't open destination directory" $ | |||
moveFile' "myFile" | |||
"noPerms/movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "moveFile (Strict), can't open source directory" $ | |||
moveFile' "noPerms/myFile" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures -- | |||
it "moveFile (Strict), destination file already exists" $ | |||
moveFile' "myFile" | |||
"alreadyExists" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Strict), move from file to dir" $ | |||
moveFile' "myFile" | |||
"alreadyExistsD" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Strict), source and dest are same file" $ | |||
moveFile' "myFile" | |||
"myFile" | |||
Strict | |||
`shouldThrow` | |||
isSameFile |
@@ -0,0 +1,85 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.ReadFileSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "ReadFileSpec" | |||
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 "System.Posix.RawFilePath.Directory.readFile" $ do | |||
-- successes -- | |||
it "readFile (Strict) file with content, everything clear" $ do | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "Blahfaselgagaga" | |||
it "readFile (Strict) symlink, everything clear" $ do | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "Blahfaselgagaga" | |||
it "readFile (Strict) empty file, everything clear" $ do | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "" | |||
-- posix failures -- | |||
it "readFile (Strict) directory, wrong file type" $ do | |||
readFile' "alreadyExistsD" | |||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) | |||
it "readFile (Strict) file, no permissions" $ do | |||
readFile' "noPerms" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "readFile (Strict) file, no permissions on dir" $ do | |||
readFile' "noPermsD/inputFile" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "readFile (Strict) file, no such file" $ do | |||
readFile' "lalala" | |||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) |
@@ -0,0 +1,139 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.RecreateSymlinkOverwriteSpec where | |||
-- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "RecreateSymlinkOverwriteSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createRegularFile' "alreadyExists" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
createDir' "alreadyExistsD2" | |||
createRegularFile' "alreadyExistsD2/lala" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "alreadyExistsD2/lala" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "alreadyExistsD2" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.recreateSymlink" $ do | |||
-- successes -- | |||
it "recreateSymLink (Overwrite), all fine" $ do | |||
recreateSymlink' "myFileL" | |||
"movedFile" | |||
Overwrite | |||
removeFileIfExists "movedFile" | |||
it "recreateSymLink (Overwrite), all fine" $ do | |||
recreateSymlink' "myFileL" | |||
"dir/movedFile" | |||
Overwrite | |||
removeFileIfExists "dir/movedFile" | |||
it "recreateSymLink (Overwrite), destination file already exists" $ | |||
recreateSymlink' "myFileL" | |||
"alreadyExists" | |||
Overwrite | |||
it "recreateSymLink (Overwrite), destination already exists and is an empty dir" $ do | |||
recreateSymlink' "myFileL" | |||
"alreadyExistsD" | |||
Overwrite | |||
deleteFile' "alreadyExistsD" | |||
createDir' "alreadyExistsD" | |||
-- posix failures -- | |||
it "recreateSymLink (Overwrite), destination already exists and is a non-empty dir" $ | |||
recreateSymlink' "myFileL" | |||
"alreadyExistsD2" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == UnsatisfiedConstraints) | |||
it "recreateSymLink (Overwrite), wrong input type (file)" $ | |||
recreateSymlink' "myFile" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "recreateSymLink (Overwrite), wrong input type (directory)" $ | |||
recreateSymlink' "dir" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "recreateSymLink (Overwrite), can't write to destination directory" $ | |||
recreateSymlink' "myFileL" | |||
"noWritePerm/movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Overwrite), can't open destination directory" $ | |||
recreateSymlink' "myFileL" | |||
"noPerms/movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Overwrite), can't open source directory" $ | |||
recreateSymlink' "noPerms/myFileL" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures -- | |||
it "recreateSymLink (Overwrite), source and destination are the same file" $ | |||
recreateSymlink' "myFileL" | |||
"myFileL" | |||
Overwrite | |||
`shouldThrow` | |||
isSameFile | |||
@@ -0,0 +1,130 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.RecreateSymlinkSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "RecreateSymlinkSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createRegularFile' "alreadyExists" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.recreateSymlink" $ do | |||
-- successes -- | |||
it "recreateSymLink (Strict), all fine" $ do | |||
recreateSymlink' "myFileL" | |||
"movedFile" | |||
Strict | |||
removeFileIfExists "movedFile" | |||
it "recreateSymLink (Strict), all fine" $ do | |||
recreateSymlink' "myFileL" | |||
"dir/movedFile" | |||
Strict | |||
removeFileIfExists "dir/movedFile" | |||
-- posix failures -- | |||
it "recreateSymLink (Strict), wrong input type (file)" $ | |||
recreateSymlink' "myFile" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "recreateSymLink (Strict), wrong input type (directory)" $ | |||
recreateSymlink' "dir" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "recreateSymLink (Strict), can't write to destination directory" $ | |||
recreateSymlink' "myFileL" | |||
"noWritePerm/movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Strict), can't open destination directory" $ | |||
recreateSymlink' "myFileL" | |||
"noPerms/movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Strict), can't open source directory" $ | |||
recreateSymlink' "noPerms/myFileL" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Strict), destination file already exists" $ | |||
recreateSymlink' "myFileL" | |||
"alreadyExists" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "recreateSymLink (Strict), destination already exists and is a dir" $ | |||
recreateSymlink' "myFileL" | |||
"alreadyExistsD" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
-- custom failures -- | |||
it "recreateSymLink (Strict), source and destination are the same file" $ | |||
recreateSymlink' "myFileL" | |||
"myFileL" | |||
Strict | |||
`shouldThrow` | |||
isSameFile | |||
@@ -0,0 +1,117 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.RenameFileSpec where | |||
import Test.Hspec | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "RenameFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createRegularFile' "alreadyExists" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "System.Posix.RawFilePath.Directory.renameFile" $ do | |||
-- successes -- | |||
it "renameFile, all fine" $ | |||
renameFile' "myFile" | |||
"renamedFile" | |||
it "renameFile, all fine" $ | |||
renameFile' "myFile" | |||
"dir/renamedFile" | |||
it "renameFile, all fine on symlink" $ | |||
renameFile' "myFileL" | |||
"renamedFile" | |||
it "renameFile, all fine on directory" $ | |||
renameFile' "dir" | |||
"renamedFile" | |||
-- posix failures -- | |||
it "renameFile, source file does not exist" $ | |||
renameFile' "fileDoesNotExist" | |||
"renamedFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "renameFile, can't write to output directory" $ | |||
renameFile' "myFile" | |||
"noWritePerm/renamedFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "renameFile, can't open output directory" $ | |||
renameFile' "myFile" | |||
"noPerms/renamedFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "renameFile, can't open source directory" $ | |||
renameFile' "noPerms/myFile" | |||
"renamedFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures -- | |||
it "renameFile, destination file already exists" $ | |||
renameFile' "myFile" | |||
"alreadyExists" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "renameFile, move from file to dir" $ | |||
renameFile' "myFile" | |||
"alreadyExistsD" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "renameFile, source and dest are same file" $ | |||
renameFile' "myFile" | |||
"myFile" | |||
`shouldThrow` | |||
isSameFile | |||
@@ -0,0 +1,26 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.ToAbsSpec where | |||
import Test.Hspec | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
spec :: Spec | |||
spec = describe "System.Posix.RawFilePath.Directory.toAbs" $ do | |||
-- successes -- | |||
it "toAbs returns absolute paths unchanged" $ do | |||
let p1 = "/a/b/c/d" | |||
to <- toAbs p1 | |||
p1 `shouldBe` to | |||
it "toAbs returns even existing absolute paths unchanged" $ do | |||
let p1 = "/home" | |||
to <- toAbs p1 | |||
p1 `shouldBe` to | |||
@@ -0,0 +1,108 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.WriteFileLSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "WriteFileLSpec" | |||
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" "BLKASL" | |||
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 "System.Posix.RawFilePath.Directory.WriteFileL" $ do | |||
-- successes -- | |||
it "WriteFileL file with content, everything clear" $ do | |||
writeFileL' "fileWithContent" "blahfaselllll" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "WriteFileL file with content, everything clear" $ do | |||
writeFileL' "fileWithContent" "gagagaga" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "gagagaga" | |||
it "WriteFileL file with content, everything clear" $ do | |||
writeFileL' "fileWithContent" "" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "" | |||
it "WriteFileL file without content, everything clear" $ do | |||
writeFileL' "fileWithoutContent" "blahfaselllll" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "WriteFileL, everything clear" $ do | |||
writeFileL' "fileWithoutContent" "gagagaga" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "gagagaga" | |||
it "WriteFileL symlink, everything clear" $ do | |||
writeFileL' "inputFileSymL" "blahfaselllll" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "blahfaselllll" | |||
it "WriteFileL symlink, everything clear" $ do | |||
writeFileL' "inputFileSymL" "gagagaga" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "gagagaga" | |||
-- posix failures -- | |||
it "WriteFileL to dir, inappropriate type" $ do | |||
writeFileL' "alreadyExistsD" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) | |||
it "WriteFileL, no permissions to file" $ do | |||
writeFileL' "noPerms" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "WriteFileL, no permissions to file" $ do | |||
writeFileL' "noPermsD/inputFile" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "WriteFileL, file does not exist" $ do | |||
writeFileL' "gaga" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) |
@@ -0,0 +1,108 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module System.Posix.RawFilePath.Directory.WriteFileSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "WriteFileSpec" | |||
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" "BLKASL" | |||
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 "System.Posix.RawFilePath.Directory.writeFile" $ do | |||
-- successes -- | |||
it "writeFile file with content, everything clear" $ do | |||
writeFile' "fileWithContent" "blahfaselllll" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "writeFile file with content, everything clear" $ do | |||
writeFile' "fileWithContent" "gagagaga" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "gagagaga" | |||
it "writeFile file with content, everything clear" $ do | |||
writeFile' "fileWithContent" "" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "" | |||
it "writeFile file without content, everything clear" $ do | |||
writeFile' "fileWithoutContent" "blahfaselllll" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "writeFile, everything clear" $ do | |||
writeFile' "fileWithoutContent" "gagagaga" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "gagagaga" | |||
it "writeFile symlink, everything clear" $ do | |||
writeFile' "inputFileSymL" "blahfaselllll" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "blahfaselllll" | |||
it "writeFile symlink, everything clear" $ do | |||
writeFile' "inputFileSymL" "gagagaga" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "gagagaga" | |||
-- posix failures -- | |||
it "writeFile to dir, inappropriate type" $ do | |||
writeFile' "alreadyExistsD" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) | |||
it "writeFile, no permissions to file" $ do | |||
writeFile' "noPerms" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "writeFile, no permissions to file" $ do | |||
writeFile' "noPermsD/inputFile" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "writeFile, file does not exist" $ do | |||
writeFile' "gaga" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) |
@@ -0,0 +1,293 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module Utils where | |||
import Control.Applicative | |||
( | |||
(<$>) | |||
) | |||
import Control.Monad | |||
( | |||
forM_ | |||
, void | |||
) | |||
import Control.Monad.IfElse | |||
( | |||
whenM | |||
) | |||
import qualified Data.ByteString as BS | |||
import qualified Data.ByteString.Lazy as BSL | |||
import Data.IORef | |||
( | |||
newIORef | |||
, readIORef | |||
, writeIORef | |||
, IORef | |||
) | |||
import "hpath-directory" System.Posix.RawFilePath.Directory | |||
import Prelude hiding (appendFile, readFile, writeFile) | |||
import Data.Maybe | |||
( | |||
fromJust | |||
) | |||
import System.IO.Unsafe | |||
( | |||
unsafePerformIO | |||
) | |||
import qualified System.Posix.RawFilePath.Directory.Traversals as DT | |||
import Data.ByteString | |||
( | |||
ByteString | |||
) | |||
import qualified Data.ByteString.Lazy as L | |||
import System.Posix.FilePath | |||
import System.Posix.Files.ByteString | |||
( | |||
groupExecuteMode | |||
, groupReadMode | |||
, nullFileMode | |||
, otherExecuteMode | |||
, otherReadMode | |||
, ownerExecuteMode | |||
, ownerReadMode | |||
, setFileMode | |||
, unionFileModes | |||
) | |||
baseTmpDir :: IORef (Maybe ByteString) | |||
{-# NOINLINE baseTmpDir #-} | |||
baseTmpDir = unsafePerformIO (newIORef Nothing) | |||
tmpDir :: IORef (Maybe ByteString) | |||
{-# NOINLINE tmpDir #-} | |||
tmpDir = unsafePerformIO (newIORef Nothing) | |||
----------------- | |||
--[ Utilities ]-- | |||
----------------- | |||
setTmpDir :: ByteString -> IO () | |||
{-# NOINLINE setTmpDir #-} | |||
setTmpDir bs = do | |||
tmp <- fromJust <$> readIORef baseTmpDir | |||
writeIORef tmpDir (Just (tmp `BS.append` bs)) | |||
createTmpDir :: IO () | |||
{-# NOINLINE createTmpDir #-} | |||
createTmpDir = do | |||
tmp <- fromJust <$> readIORef tmpDir | |||
void $ createDir newDirPerms tmp | |||
deleteTmpDir :: IO () | |||
{-# NOINLINE deleteTmpDir #-} | |||
deleteTmpDir = do | |||
tmp <- fromJust <$> readIORef tmpDir | |||
void $ deleteDir tmp | |||
deleteBaseTmpDir :: IO () | |||
{-# NOINLINE deleteBaseTmpDir #-} | |||
deleteBaseTmpDir = do | |||
tmp <- fromJust <$> readIORef baseTmpDir | |||
contents <- getDirsFiles tmp | |||
forM_ contents deleteDir | |||
void $ deleteDir tmp | |||
withRawTmpDir :: (ByteString -> IO a) -> IO a | |||
{-# NOINLINE withRawTmpDir #-} | |||
withRawTmpDir f = do | |||
tmp <- fromJust <$> readIORef tmpDir | |||
f tmp | |||
getRawTmpDir :: IO ByteString | |||
{-# NOINLINE getRawTmpDir #-} | |||
getRawTmpDir = withRawTmpDir (return . flip BS.append "/") | |||
withTmpDir :: ByteString -> (ByteString -> IO a) -> IO a | |||
{-# NOINLINE withTmpDir #-} | |||
withTmpDir ip f = do | |||
tmp <- fromJust <$> readIORef tmpDir | |||
let p = tmp </> ip | |||
f p | |||
withTmpDir' :: ByteString | |||
-> ByteString | |||
-> (ByteString -> ByteString -> IO a) | |||
-> IO a | |||
{-# NOINLINE withTmpDir' #-} | |||
withTmpDir' ip1 ip2 f = do | |||
tmp <- fromJust <$> readIORef tmpDir | |||
let p1 = tmp </> ip1 | |||
let p2 = tmp </> ip2 | |||
f p1 p2 | |||
removeFileIfExists :: ByteString -> IO () | |||
{-# NOINLINE removeFileIfExists #-} | |||
removeFileIfExists bs = | |||
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) | |||
removeDirIfExists :: ByteString -> IO () | |||
{-# NOINLINE removeDirIfExists #-} | |||
removeDirIfExists bs = | |||
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) | |||
copyFile' :: ByteString -> ByteString -> CopyMode -> IO () | |||
{-# NOINLINE copyFile' #-} | |||
copyFile' inputFileP outputFileP cm = | |||
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) | |||
copyDirRecursive' :: ByteString -> ByteString | |||
-> CopyMode -> RecursiveErrorMode -> IO () | |||
{-# NOINLINE copyDirRecursive' #-} | |||
copyDirRecursive' inputDirP outputDirP cm rm = | |||
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) | |||
createDir' :: ByteString -> IO () | |||
{-# NOINLINE createDir' #-} | |||
createDir' dest = withTmpDir dest (createDir newDirPerms) | |||
createDirIfMissing' :: ByteString -> IO () | |||
{-# NOINLINE createDirIfMissing' #-} | |||
createDirIfMissing' dest = withTmpDir dest (createDirIfMissing newDirPerms) | |||
createDirRecursive' :: ByteString -> IO () | |||
{-# NOINLINE createDirRecursive' #-} | |||
createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms) | |||
createRegularFile' :: ByteString -> IO () | |||
{-# NOINLINE createRegularFile' #-} | |||
createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms) | |||
createSymlink' :: ByteString -> ByteString -> IO () | |||
{-# NOINLINE createSymlink' #-} | |||
createSymlink' dest sympoint = withTmpDir dest | |||
(\x -> createSymlink x sympoint) | |||
renameFile' :: ByteString -> ByteString -> IO () | |||
{-# NOINLINE renameFile' #-} | |||
renameFile' inputFileP outputFileP = | |||
withTmpDir' inputFileP outputFileP $ \i o -> do | |||
renameFile i o | |||
renameFile o i | |||
moveFile' :: ByteString -> ByteString -> CopyMode -> IO () | |||
{-# NOINLINE moveFile' #-} | |||
moveFile' inputFileP outputFileP cm = | |||
withTmpDir' inputFileP outputFileP $ \i o -> do | |||
moveFile i o cm | |||
moveFile o i Strict | |||
recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () | |||
{-# NOINLINE recreateSymlink' #-} | |||
recreateSymlink' inputFileP outputFileP cm = | |||
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) | |||
noWritableDirPerms :: ByteString -> IO () | |||
{-# NOINLINE noWritableDirPerms #-} | |||
noWritableDirPerms path = withTmpDir path $ \p -> | |||
setFileMode p perms | |||
where | |||
perms = ownerReadMode | |||
`unionFileModes` ownerExecuteMode | |||
`unionFileModes` groupReadMode | |||
`unionFileModes` groupExecuteMode | |||
`unionFileModes` otherReadMode | |||
`unionFileModes` otherExecuteMode | |||
noPerms :: ByteString -> IO () | |||
{-# NOINLINE noPerms #-} | |||
noPerms path = withTmpDir path $ \p -> setFileMode p nullFileMode | |||
normalDirPerms :: ByteString -> IO () | |||
{-# NOINLINE normalDirPerms #-} | |||
normalDirPerms path = | |||
withTmpDir path $ \p -> setFileMode p newDirPerms | |||
normalFilePerms :: ByteString -> IO () | |||
{-# NOINLINE normalFilePerms #-} | |||
normalFilePerms path = | |||
withTmpDir path $ \p -> setFileMode p newFilePerms | |||
getFileType' :: ByteString -> IO FileType | |||
{-# NOINLINE getFileType' #-} | |||
getFileType' path = withTmpDir path getFileType | |||
getDirsFiles' :: ByteString -> IO [ByteString] | |||
{-# NOINLINE getDirsFiles' #-} | |||
getDirsFiles' path = withTmpDir path getDirsFiles | |||
deleteFile' :: ByteString -> IO () | |||
{-# NOINLINE deleteFile' #-} | |||
deleteFile' p = withTmpDir p deleteFile | |||
deleteDir' :: ByteString -> IO () | |||
{-# NOINLINE deleteDir' #-} | |||
deleteDir' p = withTmpDir p deleteDir | |||
deleteDirRecursive' :: ByteString -> IO () | |||
{-# NOINLINE deleteDirRecursive' #-} | |||
deleteDirRecursive' p = withTmpDir p deleteDirRecursive | |||
canonicalizePath' :: ByteString -> IO ByteString | |||
{-# NOINLINE canonicalizePath' #-} | |||
canonicalizePath' p = withTmpDir p canonicalizePath | |||
writeFile' :: ByteString -> ByteString -> IO () | |||
{-# NOINLINE writeFile' #-} | |||
writeFile' ip bs = | |||
withTmpDir ip $ \p -> writeFile p Nothing bs | |||
writeFileL' :: ByteString -> BSL.ByteString -> IO () | |||
{-# NOINLINE writeFileL' #-} | |||
writeFileL' ip bs = | |||
withTmpDir ip $ \p -> writeFileL p Nothing bs | |||
appendFile' :: ByteString -> ByteString -> IO () | |||
{-# NOINLINE appendFile' #-} | |||
appendFile' ip bs = | |||
withTmpDir ip $ \p -> appendFile p bs | |||
allDirectoryContents' :: ByteString -> IO [ByteString] | |||
{-# NOINLINE allDirectoryContents' #-} | |||
allDirectoryContents' ip = | |||
withTmpDir ip $ \p -> DT.allDirectoryContents' p | |||
readFile' :: ByteString -> IO ByteString | |||
{-# NOINLINE readFile' #-} | |||
readFile' p = withTmpDir p (fmap L.toStrict . readFile) | |||