Browse Source

Add hpath-directory

travis
Julian Ospald 4 years ago
parent
commit
f3f232e4c9
No known key found for this signature in database GPG Key ID: 511B62C09D50CD28
42 changed files with 5412 additions and 0 deletions
  1. +1
    -0
      cabal.project
  2. +5
    -0
      hpath-directory/CHANGELOG.md
  3. +30
    -0
      hpath-directory/LICENSE
  4. +2
    -0
      hpath-directory/Setup.hs
  5. +7
    -0
      hpath-directory/cbits/dirutils.c
  6. +13
    -0
      hpath-directory/cbits/dirutils.h
  7. +113
    -0
      hpath-directory/hpath-directory.cabal
  8. +75
    -0
      hpath-directory/src/System/Posix/FD.hs
  9. +55
    -0
      hpath-directory/src/System/Posix/Foreign.hsc
  10. +1246
    -0
      hpath-directory/src/System/Posix/RawFilePath/Directory.hs
  11. +15
    -0
      hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot
  12. +327
    -0
      hpath-directory/src/System/Posix/RawFilePath/Directory/Errors.hs
  13. +263
    -0
      hpath-directory/src/System/Posix/RawFilePath/Directory/Traversals.hs
  14. +24
    -0
      hpath-directory/test/Main.hs
  15. +2
    -0
      hpath-directory/test/Spec.hs
  16. +108
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/AppendFileSpec.hs
  17. +78
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CanonicalizePathSpec.hs
  18. +248
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs
  19. +205
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs
  20. +181
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveSpec.hs
  21. +148
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileOverwriteSpec.hs
  22. +143
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileSpec.hs
  23. +69
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirIfMissingSpec.hs
  24. +78
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirRecursiveSpec.hs
  25. +72
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirSpec.hs
  26. +70
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CreateRegularFileSpec.hs
  27. +71
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/CreateSymlinkSpec.hs
  28. +116
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirRecursiveSpec.hs
  29. +114
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirSpec.hs
  30. +84
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteFileSpec.hs
  31. +100
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/GetDirsFilesSpec.hs
  32. +88
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/GetFileTypeSpec.hs
  33. +126
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileOverwriteSpec.hs
  34. +129
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileSpec.hs
  35. +85
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/ReadFileSpec.hs
  36. +139
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkOverwriteSpec.hs
  37. +130
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkSpec.hs
  38. +117
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/RenameFileSpec.hs
  39. +26
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/ToAbsSpec.hs
  40. +108
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileLSpec.hs
  41. +108
    -0
      hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileSpec.hs
  42. +293
    -0
      hpath-directory/test/Utils.hs

+ 1
- 0
cabal.project View File

@@ -1,4 +1,5 @@
packages: ./hpath
./hpath-directory
./hpath-filepath
./hpath-io



+ 5
- 0
hpath-directory/CHANGELOG.md View File

@@ -0,0 +1,5 @@
# Revision history for hpath-directory

## 0.1.0.0 -- 2020-01-26

* First version. Released on an unsuspecting world.

+ 30
- 0
hpath-directory/LICENSE View File

@@ -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.

+ 2
- 0
hpath-directory/Setup.hs View File

@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

+ 7
- 0
hpath-directory/cbits/dirutils.c View File

@@ -0,0 +1,7 @@
#include "dirutils.h"
unsigned int
__posixdir_d_type(struct dirent* d)
{
return(d -> d_type);
}


+ 13
- 0
hpath-directory/cbits/dirutils.h View File

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

+ 113
- 0
hpath-directory/hpath-directory.cabal View File

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

+ 75
- 0
hpath-directory/src/System/Posix/FD.hs View File

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


+ 55
- 0
hpath-directory/src/System/Posix/Foreign.hsc View File

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

+ 1246
- 0
hpath-directory/src/System/Posix/RawFilePath/Directory.hs
File diff suppressed because it is too large
View File


+ 15
- 0
hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot View File

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

+ 327
- 0
hpath-directory/src/System/Posix/RawFilePath/Directory/Errors.hs View File

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



+ 263
- 0
hpath-directory/src/System/Posix/RawFilePath/Directory/Traversals.hs View File

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

+ 24
- 0
hpath-directory/test/Main.hs View File

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

+ 2
- 0
hpath-directory/test/Spec.hs View File

@@ -0,0 +1,2 @@
-- file test/Spec.hs
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

+ 108
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/AppendFileSpec.hs View File

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

+ 78
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CanonicalizePathSpec.hs View File

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


+ 248
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs View File

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



+ 205
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs View File

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

+ 181
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveSpec.hs View File

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



+ 148
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileOverwriteSpec.hs View File

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

+ 143
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileSpec.hs View File

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

+ 69
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirIfMissingSpec.hs View File

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

+ 78
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirRecursiveSpec.hs View File

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




+ 72
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirSpec.hs View File

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


+ 70
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CreateRegularFileSpec.hs View File

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


+ 71
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/CreateSymlinkSpec.hs View File

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


+ 116
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirRecursiveSpec.hs View File

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



+ 114
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirSpec.hs View File

@@ -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"




+ 84
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteFileSpec.hs View File

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


+ 100
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/GetDirsFilesSpec.hs View File

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





+ 88
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/GetFileTypeSpec.hs View File

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


+ 126
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileOverwriteSpec.hs View File

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

+ 129
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileSpec.hs View File

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

+ 85
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/ReadFileSpec.hs View File

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

+ 139
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkOverwriteSpec.hs View File

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


+ 130
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkSpec.hs View File

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


+ 117
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/RenameFileSpec.hs View File

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


+ 26
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/ToAbsSpec.hs View File

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



+ 108
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileLSpec.hs View File

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

+ 108
- 0
hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileSpec.hs View File

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

+ 293
- 0
hpath-directory/test/Utils.hs View File

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


Loading…
Cancel
Save