diff --git a/LICENSE b/LICENSE index 90ee70c..a322840 100644 --- a/LICENSE +++ b/LICENSE @@ -1,25 +1,340 @@ -Copyright (c) 2015–2016, FP Complete -Copyright (c) 2016, Julian Ospald -All rights reserved. + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 -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 paths nor the - names of its contributors may be used to endorse or promote products - derived from this software without specific prior written permission. + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. -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 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. diff --git a/hpath.cabal b/hpath.cabal index cba21dc..a0b5501 100644 --- a/hpath.cabal +++ b/hpath.cabal @@ -2,7 +2,7 @@ name: hpath version: 0.5.8 synopsis: Support for well-typed paths description: Support for will-typed paths. -license: BSD3 +license: GPL-2 license-file: LICENSE author: Julian Ospald maintainer: Julian Ospald @@ -23,6 +23,8 @@ library c-sources: cbits/dirutils.c exposed-modules: HPath, HPath.IO, + HPath.IO.Errors, + HPath.IO.Utils, HPath.Internal, System.Posix.Directory.Foreign, System.Posix.Directory.Traversals, @@ -33,6 +35,7 @@ library , exceptions , hspec , unix >= 2.5 + , unix-bytestring , utf8-string , word8 @@ -61,6 +64,39 @@ test-suite doctests-posix HUnit, QuickCheck +test-suite spec + Type: exitcode-stdio-1.0 + Default-Language: Haskell2010 + Hs-Source-Dirs: test + Main-Is: Main.hs + other-modules: + Spec + HPath.IO.CopyDirRecursiveSpec + HPath.IO.CopyDirRecursiveOverwriteSpec + HPath.IO.CopyFileSpec + HPath.IO.CopyFileOverwriteSpec + HPath.IO.CreateDirSpec + HPath.IO.CreateRegularFileSpec + HPath.IO.DeleteDirRecursiveSpec + HPath.IO.DeleteDirSpec + HPath.IO.DeleteFileSpec + HPath.IO.GetDirsFilesSpec + HPath.IO.GetFileTypeSpec + HPath.IO.MoveFileSpec + HPath.IO.MoveFileOverwriteSpec + HPath.IO.RecreateSymlinkSpec + HPath.IO.RenameFileSpec + Utils + GHC-Options: -Wall + Build-Depends: base + , HUnit + , bytestring + , hpath + , hspec >= 1.3 + , process + , unix + , utf8-string + benchmark bench.hs default-language: Haskell2010 type: exitcode-stdio-1.0 diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs index e1d761f..1db067e 100644 --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -1,28 +1,778 @@ -- | -- Module : HPath.IO -- Copyright : © 2016 Julian Ospald --- License : BSD 3 clause +-- License : GPL-2 -- -- Maintainer : Julian Ospald -- Stability : experimental -- Portability : portable -- --- IO operations on HPath. +-- This module provides high-level IO related file operations like +-- copy, delete, move and so on. It only operates on `Path Abs` which +-- guarantees us well-typed paths which are absolute. +-- +-- Some functions are just path-safe wrappers around +-- unix functions, others have stricter exception handling +-- and some implement functionality that doesn't have a unix +-- counterpart (like `copyDirRecursive`). +-- +-- Some of these operations are due to their nature not _atomic_, which +-- means they may do multiple syscalls which form one context. Some +-- of them also have to examine the filetypes explicitly before the +-- syscalls, so a reasonable decision can be made. That means +-- the result is undefined if another process changes that context +-- while the non-atomic operation is still happening. However, where +-- possible, as few syscalls as possible are used and the underlying +-- exception handling is kept. +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK ignore-exports #-} -module HPath.IO +module HPath.IO where + + + +import Control.Exception + ( + bracket + , bracketOnError + , throwIO + ) +import Control.Monad + ( + void + , when + ) +import Data.ByteString + ( + ByteString + ) +import Data.Foldable + ( + for_ + ) +import Data.Maybe + ( + catMaybes + ) +import Data.Word + ( + Word8 + ) +import Foreign.C.Error + ( + eEXIST + , eNOTEMPTY + , eXDEV + ) +import Foreign.C.Types + ( + CSize + ) +import Foreign.Marshal.Alloc + ( + allocaBytes + ) +import Foreign.Ptr + ( + Ptr + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import HPath +import HPath.Internal +import HPath.IO.Errors +import HPath.IO.Utils +import Prelude hiding (readFile) +import System.IO.Error + ( + catchIOError + , ioeGetErrorType + ) +import System.Posix.ByteString + ( + exclusive + ) +import System.Posix.Directory.ByteString + ( + createDirectory + , removeDirectory + ) +import System.Posix.Directory.Traversals + ( + getDirectoryContents' + ) +import System.Posix.Files.ByteString + ( + createSymbolicLink + , fileMode + , getFdStatus + , groupExecuteMode + , groupReadMode + , groupWriteMode + , otherExecuteMode + , otherReadMode + , otherWriteMode + , ownerModes + , ownerReadMode + , ownerWriteMode + , readSymbolicLink + , removeLink + , rename + , setFileMode + , unionFileModes + ) +import qualified System.Posix.Files.ByteString as PF +import qualified "unix" System.Posix.IO.ByteString as SPI +import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB +import qualified System.Posix.Directory.Traversals as SPDT +import qualified System.Posix.Directory.Foreign as SPDF +import qualified System.Posix.Process.ByteString as SPP +import System.Posix.Types + ( + FileMode + , ProcessID + , Fd + ) + + + + + +data FileType = Directory + | RegularFile + | SymbolicLink + | BlockDevice + | CharacterDevice + | NamedPipe + | Socket + deriving (Eq, Show) + + + + + + -------------------- + --[ File Copying ]-- + -------------------- + + + +-- |Copies a directory recursively to the given destination. +-- Does not follow symbolic links. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * examines filetypes explicitly +-- * an explicit check `throwDestinationInSource` is carried out for the +-- top directory for basic sanity, because otherwise we might end up +-- with an infinite copy loop... however, this operation is not +-- carried out recursively (because it's slow) +-- +-- Throws: +-- +-- - `NoSuchThing` if source directory does not exist +-- - `PermissionDenied` if output directory is not writable +-- - `PermissionDenied` if source directory can't be opened +-- - `InvalidArgument` if source directory is wrong type (symlink) +-- - `InvalidArgument` if source directory is wrong type (regular file) +-- - `SameFile` if source and destination are the same file (`HPathIOException`) +-- - `AlreadyExists` if destination already exists +-- - `DestinationInSource` if destination is contained in source (`HPathIOException`) +copyDirRecursive :: Path Abs -- ^ source dir + -> Path Abs -- ^ full destination + -> IO () +copyDirRecursive fromp destdirp + = do + -- for performance, sanity checks are only done for the top dir + throwSameFile fromp destdirp + throwDestinationInSource fromp destdirp + go fromp destdirp where + go :: Path Abs -> Path Abs -> IO () + go fromp' destdirp' = do + -- order is important here, so we don't get empty directories + -- on failure + contents <- getDirsFiles fromp' + + fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp') + createDirectory (fromAbs destdirp') fmode' + + for_ contents $ \f -> do + ftype <- getFileType f + newdest <- (destdirp' ) <$> basename f + case ftype of + SymbolicLink -> recreateSymlink f newdest + Directory -> go f newdest + RegularFile -> copyFile f newdest + _ -> ioError $ userError $ "No idea what to do with the" ++ + "given filetype: " ++ show ftype -import HPath -import HPath.Internal -import System.Posix.Directory.Traversals (realpath) +-- |Like `copyDirRecursive` except it overwrites contents of directories +-- if any. +-- +-- Throws: +-- +-- - `NoSuchThing` if source directory does not exist +-- - `PermissionDenied` if output directory is not writable +-- - `PermissionDenied` if source directory can't be opened +-- - `InvalidArgument` if source directory is wrong type (symlink) +-- - `InvalidArgument` if source directory is wrong type (regular file) +-- - `SameFile` if source and destination are the same file (`HPathIOException`) +-- - `DestinationInSource` if destination is contained in source (`HPathIOException`) +copyDirRecursiveOverwrite :: Path Abs -- ^ source dir + -> Path Abs -- ^ full destination + -> IO () +copyDirRecursiveOverwrite fromp destdirp + = do + -- for performance, sanity checks are only done for the top dir + throwSameFile fromp destdirp + throwDestinationInSource fromp destdirp + go fromp destdirp + where + go :: Path Abs -> Path Abs -> IO () + go fromp' destdirp' = do + -- order is important here, so we don't get empty directories + -- on failure + contents <- getDirsFiles fromp' + + fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp') + catchIOError (createDirectory (fromAbs destdirp') fmode') $ \e -> + case ioeGetErrorType e of + AlreadyExists -> setFileMode (fromAbs destdirp') fmode' + _ -> ioError e + + for_ contents $ \f -> do + ftype <- getFileType f + newdest <- (destdirp' ) <$> basename f + case ftype of + SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest) + >> recreateSymlink f newdest + Directory -> go f newdest + RegularFile -> copyFileOverwrite f newdest + _ -> ioError $ userError $ "No idea what to do with the" ++ + "given filetype: " ++ show ftype + + +-- |Recreate a symlink. +-- +-- Throws: +-- +-- - `InvalidArgument` if symlink file is wrong type (file) +-- - `InvalidArgument` if symlink file is wrong type (directory) +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `AlreadyExists` if destination file already exists +-- - `SameFile` if source and destination are the same file (`HPathIOException`) +-- +-- Note: calls `symlink` +recreateSymlink :: Path Abs -- ^ the old symlink file + -> Path Abs -- ^ destination file + -> IO () +recreateSymlink symsource newsym + = do + throwSameFile symsource newsym + sympoint <- readSymbolicLink (fromAbs symsource) + createSymbolicLink sympoint (fromAbs newsym) + + +-- |Copies the given regular file to the given destination. +-- Neither follows symbolic links, nor accepts them. +-- For "copying" symbolic links, use `recreateSymlink` instead. +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory is not writable +-- - `PermissionDenied` if source directory can't be opened +-- - `InvalidArgument` if source file is wrong type (symlink) +-- - `InvalidArgument` if source file is wrong type (directory) +-- - `SameFile` if source and destination are the same file (`HPathIOException`) +-- - `AlreadyExists` if destination already exists +-- +-- Note: calls `sendfile` +copyFile :: Path Abs -- ^ source file + -> Path Abs -- ^ destination file + -> IO () +copyFile from to = do + throwSameFile from to + _copyFile [SPDF.oNofollow] + [SPDF.oNofollow, SPDF.oExcl] + from to + + +-- |Like `copyFile` except it overwrites the destination if it already +-- exists. +-- This also works if source and destination are the same file. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * falls back to delete-copy method with explicit checks +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory is not writable +-- - `PermissionDenied` if source directory can't be opened +-- - `InvalidArgument` if source file is wrong type (symlink) +-- - `InvalidArgument` if source file is wrong type (directory) +-- - `SameFile` if source and destination are the same file (`HPathIOException`) +-- +-- Note: calls `sendfile` +copyFileOverwrite :: Path Abs -- ^ source file + -> Path Abs -- ^ destination file + -> IO () +copyFileOverwrite from to = do + throwSameFile from to + catchIOError (_copyFile [SPDF.oNofollow] + [SPDF.oNofollow, SPDF.oTrunc] + from to) $ \e -> + case ioeGetErrorType e of + -- if the destination file is not writable, we need to + -- figure out if we can still copy by deleting it first + PermissionDenied -> do + exists <- doesFileExist to + writable <- isWritable (dirname to) + if exists && writable + then deleteFile to >> copyFile from to + else ioError e + _ -> ioError e + + +_copyFile :: [SPDF.Flags] + -> [SPDF.Flags] + -> Path Abs -- ^ source file + -> Path Abs -- ^ destination file + -> IO () +_copyFile sflags dflags from to + = + -- from sendfile(2) manpage: + -- Applications may wish to fall back to read(2)/write(2) in the case + -- where sendfile() fails with EINVAL or ENOSYS. + withAbsPath to $ \to' -> withAbsPath from $ \from' -> + void $ fallbackCopy from' to' + where + -- low-level copy operation utilizing read(2)/write(2) + -- in case `sendFileCopy` fails/is unsupported + fallbackCopy source dest = + bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing) + SPI.closeFd + $ \sfd -> do + fileM <- System.Posix.Files.ByteString.fileMode + <$> getFdStatus sfd + bracketeer (SPDT.openFd dest SPI.WriteOnly + dflags $ Just fileM) + SPI.closeFd + (\fd -> SPI.closeFd fd >> deleteFile to) + $ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf -> + write' sfd dfd buf 0 + where + bufSize :: CSize + bufSize = 8192 + write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int + write' sfd dfd buf totalsize = do + size <- SPB.fdReadBuf sfd buf bufSize + if size == 0 + then return $ fromIntegral totalsize + else do rsize <- SPB.fdWriteBuf dfd buf size + when (rsize /= size) (throwIO . CopyFailed $ "wrong size!") + write' sfd dfd buf (totalsize + fromIntegral size) + + +-- |Copies anything. In case of a symlink, +-- it is just recreated, even if it points to a directory. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `copyDirRecursive` for directories +easyCopy :: Path Abs + -> Path Abs + -> IO () +easyCopy from to = do + ftype <- getFileType from + case ftype of + SymbolicLink -> recreateSymlink from to + RegularFile -> copyFile from to + Directory -> copyDirRecursive from to + _ -> ioError $ userError $ "No idea what to do with the" ++ + "given filetype: " ++ show ftype + + +-- |Like `easyCopy` except it overwrites the destination if it already exists. +-- For directories, this overwrites contents without pruning them, so the resulting +-- directory may have more files than have been copied. +easyCopyOverwrite :: Path Abs + -> Path Abs + -> IO () +easyCopyOverwrite from to = do + ftype <- getFileType from + case ftype of + SymbolicLink -> whenM (doesFileExist to) (deleteFile to) + >> recreateSymlink from to + RegularFile -> copyFileOverwrite from to + Directory -> copyDirRecursiveOverwrite from to + _ -> ioError $ userError $ "No idea what to do with the" ++ + "given filetype: " ++ show ftype --- | May fail on `realpath`. + + + + --------------------- + --[ File Deletion ]-- + --------------------- + + +-- |Deletes the given file, does not follow symlinks. Raises `eISDIR` +-- if run on a directory. Does not follow symbolic links. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (directory) +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if the directory cannot be read +deleteFile :: Path Abs -> IO () +deleteFile p = withAbsPath p removeLink + + +-- |Deletes the given directory, which must be empty, never symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `UnsatisfiedConstraints` if directory is not empty +-- - `PermissionDenied` if we can't open or write to parent directory +-- +-- Notes: calls `rmdir` +deleteDir :: Path Abs -> IO () +deleteDir p = withAbsPath p removeDirectory + + +-- |Deletes the given directory recursively. Does not follow symbolic +-- links. Tries `deleteDir` first before attemtping a recursive +-- deletion. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * examines filetypes explicitly +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `PermissionDenied` if we can't open or write to parent directory +deleteDirRecursive :: Path Abs -> IO () +deleteDirRecursive p = + catchErrno [eNOTEMPTY, eEXIST] + (deleteDir p) + $ do + files <- getDirsFiles p + for_ files $ \file -> do + ftype <- getFileType file + case ftype of + SymbolicLink -> deleteFile file + Directory -> deleteDirRecursive file + RegularFile -> deleteFile file + _ -> ioError $ userError $ "No idea what to do with the" ++ + "given filetype: " ++ show ftype + removeDirectory . toFilePath $ p + + +-- |Deletes a file, directory or symlink, whatever it may be. +-- In case of directory, performs recursive deletion. In case of +-- a symlink, the symlink file is deleted. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `deleteDirRecursive` for directories +easyDelete :: Path Abs -> IO () +easyDelete p = do + ftype <- getFileType p + case ftype of + SymbolicLink -> deleteFile p + Directory -> deleteDirRecursive p + RegularFile -> deleteFile p + _ -> ioError $ userError $ "No idea what to do with the" ++ + "given filetype: " ++ show ftype + + + + + -------------------- + --[ File Opening ]-- + -------------------- + + +-- |Opens a file appropriately by invoking xdg-open. The file type +-- is not checked. +openFile :: Path Abs + -> IO ProcessID +openFile p = + withAbsPath p $ \fp -> + SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing + + +-- |Executes a program with the given arguments. +executeFile :: Path Abs -- ^ program + -> [ByteString] -- ^ arguments + -> IO ProcessID +executeFile fp args + = withAbsPath fp $ \fpb -> + SPP.forkProcess + $ SPP.executeFile fpb True args Nothing + + + + + --------------------- + --[ File Creation ]-- + --------------------- + + +-- |Create an empty regular file at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination file already exists +createRegularFile :: Path Abs -> IO () +createRegularFile dest = + bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just newFilePerms) + (SPI.defaultFileFlags { exclusive = True })) + SPI.closeFd + (\_ -> return ()) + + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination directory already exists +createDir :: Path Abs -> IO () +createDir dest = createDirectory (fromAbs dest) newDirPerms + + + + + ---------------------------- + --[ File Renaming/Moving ]-- + ---------------------------- + + +-- |Rename a given file with the provided filename. Destination and source +-- must be on the same device, otherwise `eXDEV` will be raised. +-- +-- Does not follow symbolic links, but renames the symbolic link file. +-- +-- Safety/reliability concerns: +-- +-- * has a separate set of exception handling, apart from the syscall +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `UnsupportedOperation` if source and destination are on different devices +-- - `FileDoesExist` if destination file already exists +-- - `DirDoesExist` if destination directory already exists +-- - `SameFile` if destination and source are the same file (`HPathIOException`) +-- +-- Note: calls `rename` (but does not allow to rename over existing files) +renameFile :: Path Abs -> Path Abs -> IO () +renameFile fromf tof = do + throwSameFile fromf tof + throwFileDoesExist tof + throwDirDoesExist tof + rename (fromAbs fromf) (fromAbs tof) + + +-- |Move a file. This also works across devices by copy-delete fallback. +-- And also works on directories. +-- +-- Does not follow symbolic links, but renames the symbolic link file. +-- +-- Safety/reliability concerns: +-- +-- * copy-delete fallback is inherently non-atomic +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `FileDoesExist` if destination file already exists +-- - `DirDoesExist` if destination directory already exists +-- - `SameFile` if destination and source are the same file (`HPathIOException`) +-- +-- Note: calls `rename` (but does not allow to rename over existing files) +moveFile :: Path Abs -- ^ file to move + -> Path Abs -- ^ destination + -> IO () +moveFile from to = do + throwSameFile from to + catchErrno [eXDEV] (renameFile from to) $ do + easyCopy from to + easyDelete from + + +-- |Like `moveFile`, but overwrites the destination if it exists. +-- +-- Does not follow symbolic links, but renames the symbolic link file. +-- +-- Safety/reliability concerns: +-- +-- * copy-delete fallback is inherently non-atomic +-- * checks for file types and destination file existence explicitly +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `SameFile` if destination and source are the same file (`HPathIOException`) +-- +-- Note: calls `rename` (but does not allow to rename over existing files) +moveFileOverwrite :: Path Abs -- ^ file to move + -> Path Abs -- ^ destination + -> IO () +moveFileOverwrite from to = do + throwSameFile from to + ft <- getFileType from + writable <- isWritable $ dirname to + case ft of + RegularFile -> do + exists <- doesFileExist to + when (exists && writable) (deleteFile to) + SymbolicLink -> do + exists <- doesFileExist to + when (exists && writable) (deleteFile to) + Directory -> do + exists <- doesDirectoryExist to + when (exists && writable) (deleteDir to) + _ -> ioError $ userError $ "Don't know how to handle filetype " ++ + show ft + moveFile from to + + + + + ----------------------- + --[ File Permissions]-- + ----------------------- + + +-- |Default permissions for a new file. +newFilePerms :: FileMode +newFilePerms + = ownerWriteMode + `unionFileModes` ownerReadMode + `unionFileModes` groupWriteMode + `unionFileModes` groupReadMode + `unionFileModes` otherWriteMode + `unionFileModes` otherReadMode + + +-- |Default permissions for a new directory. +newDirPerms :: FileMode +newDirPerms + = ownerModes + `unionFileModes` groupExecuteMode + `unionFileModes` groupReadMode + `unionFileModes` otherExecuteMode + `unionFileModes` otherReadMode + + + + ------------------------- + --[ Directory reading ]-- + ------------------------- + + +-- |Gets all filenames of the given directory. This excludes "." and "..". +-- This version does not follow symbolic links. +-- +-- Throws: +-- +-- - `NoSuchThing` if directory does not exist +-- - `InappropriateType` if file type is wrong (file) +-- - `InappropriateType` if file type is wrong (symlink to file) +-- - `InappropriateType` if file type is wrong (symlink to dir) +-- - `PermissionDenied` if directory cannot be opened +getDirsFiles :: Path Abs -- ^ dir to read + -> IO [Path Abs] +getDirsFiles p = + withAbsPath p $ \fp -> + bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing) + SPI.closeFd + $ \fd -> + return + . catMaybes + . fmap (\x -> () p <$> (parseMaybe . snd $ x)) + =<< getDirectoryContents' fd + where + parseMaybe :: ByteString -> Maybe (Path Fn) + parseMaybe = parseFn + + + + + --------------------------- + --[ FileType operations ]-- + --------------------------- + + +-- |Get the file type of the file located at the given path. Does +-- not follow symbolic links. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if any part of the path is not accessible +getFileType :: Path Abs -> IO FileType +getFileType p = do + fs <- PF.getSymbolicLinkStatus (fromAbs p) + decide fs + where + decide fs + | PF.isDirectory fs = return Directory + | PF.isRegularFile fs = return RegularFile + | PF.isSymbolicLink fs = return SymbolicLink + | PF.isBlockDevice fs = return BlockDevice + | PF.isCharacterDevice fs = return CharacterDevice + | PF.isNamedPipe fs = return NamedPipe + | PF.isSocket fs = return Socket + | otherwise = ioError $ userError "No filetype?!" + + + + -------------- + --[ Others ]-- + -------------- + + + +-- |Applies `realpath` on the given absolute path. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file at the given path does not exist +-- - `NoSuchThing` if the symlink is broken canonicalizePath :: Path Abs -> IO (Path Abs) canonicalizePath (MkPath l) = do - nl <- realpath l + nl <- SPDT.realpath l return $ MkPath nl diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs new file mode 100644 index 0000000..6517029 --- /dev/null +++ b/src/HPath/IO/Errors.hs @@ -0,0 +1,331 @@ +-- | +-- Module : HPath.IO.Errors +-- Copyright : © 2016 Julian Ospald +-- License : GPL-2 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- Provides error handling. + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_HADDOCK ignore-exports #-} + +module HPath.IO.Errors where + + +import Control.Exception +import Control.Monad + ( + forM + , when + ) +import Data.ByteString + ( + ByteString + ) +import Data.Data + ( + Data(..) + ) +import Data.Typeable +import Foreign.C.Error + ( + getErrno + , Errno + ) +import GHC.IO.Exception + ( + IOErrorType + ) +import HPath +import HPath.IO.Utils +{- import HPath.IO -} + {- ( -} + {- canonicalizePath -} + {- ) -} +import System.IO.Error + ( + catchIOError + , ioeGetErrorType + ) + +import qualified System.Posix.Directory.ByteString as PFD +import System.Posix.Files.ByteString + ( + fileAccess + , getFileStatus + ) +import qualified System.Posix.Files.ByteString as PF + + +data HPathIOException = FileDoesNotExist ByteString + | DirDoesNotExist ByteString + | PathNotAbsolute ByteString + | FileNotExecutable ByteString + | SameFile ByteString ByteString + | NotAFile ByteString + | NotADir ByteString + | DestinationInSource ByteString ByteString + | FileDoesExist ByteString + | DirDoesExist ByteString + | IsSymlink ByteString + | InvalidOperation String + | InvalidFileName + | Can'tOpenDirectory ByteString + | CopyFailed String + | MoveFailed String + deriving (Typeable, Eq, Data) + + +instance Show HPathIOException where + show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp + show (DirDoesNotExist fp) = "Directory does not exist: " + ++ fpToString fp + show (PathNotAbsolute fp) = "Path not absolute: " ++ fpToString fp + show (FileNotExecutable fp) = "File not executable: " + ++ fpToString fp + show (SameFile fp1 fp2) = fpToString fp1 + ++ " and " ++ fpToString fp2 + ++ " are the same file!" + show (NotAFile fp) = "Not a file: " ++ fpToString fp + show (NotADir fp) = "Not a directory: " ++ fpToString fp + show (DestinationInSource fp1 fp2) = fpToString fp1 + ++ " is contained in " + ++ fpToString fp2 + show (FileDoesExist fp) = "File does exist: " ++ fpToString fp + show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp + show (IsSymlink fp) = "Is a symlink: " ++ fpToString fp + show (InvalidOperation str) = "Invalid operation: " ++ str + show InvalidFileName = "Invalid file name!" + show (Can'tOpenDirectory fp) = "Can't open directory: " + ++ fpToString fp + show (CopyFailed str) = "Copying failed: " ++ str + show (MoveFailed str) = "Moving failed: " ++ str + + + +instance Exception HPathIOException + + + +isDestinationInSource :: HPathIOException -> Bool +isDestinationInSource (DestinationInSource _ _) = True +isDestinationInSource _ = False + + +isSameFile :: HPathIOException -> Bool +isSameFile (SameFile _ _) = True +isSameFile _ = False + + +isFileDoesExist :: HPathIOException -> Bool +isFileDoesExist (FileDoesExist _) = True +isFileDoesExist _ = False + + +isDirDoesExist :: HPathIOException -> Bool +isDirDoesExist (DirDoesExist _) = True +isDirDoesExist _ = False + + + + ---------------------------- + --[ Path based functions ]-- + ---------------------------- + + +throwFileDoesExist :: Path Abs -> IO () +throwFileDoesExist fp = + whenM (doesFileExist fp) (throwIO . FileDoesExist + . fromAbs $ fp) + + +throwDirDoesExist :: Path Abs -> IO () +throwDirDoesExist fp = + whenM (doesDirectoryExist fp) (throwIO . DirDoesExist + . fromAbs $ fp) + + +throwFileDoesNotExist :: Path Abs -> IO () +throwFileDoesNotExist fp = + unlessM (doesFileExist fp) (throwIO . FileDoesNotExist + . fromAbs $ fp) + + +throwDirDoesNotExist :: Path Abs -> IO () +throwDirDoesNotExist fp = + unlessM (doesDirectoryExist fp) (throwIO . DirDoesNotExist + . fromAbs $ fp) + + +-- |Uses `isSameFile` and throws `SameFile` if it returns True. +throwSameFile :: Path Abs + -> Path Abs + -> IO () +throwSameFile fp1 fp2 = + whenM (sameFile fp1 fp2) + (throwIO $ SameFile (fromAbs fp1) (fromAbs fp2)) + + +-- |Check if the files are the same by examining device and file id. +-- This follows symbolic links. +sameFile :: Path Abs -> Path Abs -> IO Bool +sameFile fp1 fp2 = + withAbsPath fp1 $ \fp1' -> withAbsPath fp2 $ \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 + + +-- |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 :: Path Abs -- ^ source dir + -> Path Abs -- ^ full destination, `dirname dest` + -- must exist + -> IO () +throwDestinationInSource source dest = do + dest' <- (\x -> maybe x (\y -> x y) $ basename dest) + {- <$> (canonicalizePath $ P.dirname dest) -} + <$> (return $ dirname dest) + dids <- forM (getAllParents dest') $ \p -> do + fs <- PF.getSymbolicLinkStatus (fromAbs p) + return (PF.deviceID fs, PF.fileID fs) + sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) + $ PF.getFileStatus (fromAbs source) + when (elem sid dids) + (throwIO $ DestinationInSource (fromAbs dest) + (fromAbs source)) + + +-- |Checks if the given file exists and is not a directory. +-- Does not follow symlinks. +doesFileExist :: Path Abs -> IO Bool +doesFileExist fp = + handleIOError (\_ -> return False) $ do + fs <- PF.getSymbolicLinkStatus (fromAbs fp) + return $ not . PF.isDirectory $ fs + + +-- |Checks if the given file exists and is a directory. +-- Does not follow symlinks. +doesDirectoryExist :: Path Abs -> IO Bool +doesDirectoryExist fp = + handleIOError (\_ -> return False) $ do + fs <- PF.getSymbolicLinkStatus (fromAbs fp) + return $ PF.isDirectory fs + + +-- |Checks whether a file or folder is writable. +isWritable :: Path Abs -> IO Bool +isWritable fp = + handleIOError (\_ -> return False) $ + fileAccess (fromAbs fp) False True False + + +-- |Checks whether the directory at the given path exists and can be +-- opened. This invokes `openDirStream` which follows symlinks. +canOpenDirectory :: Path Abs -> IO Bool +canOpenDirectory fp = + handleIOError (\_ -> return False) $ do + bracket (PFD.openDirStream . fromAbs $ fp) + PFD.closeDirStream + (\_ -> return ()) + return True + + +-- |Throws a `Can'tOpenDirectory` FmIOException if the directory at the given +-- path cannot be opened. +throwCantOpenDirectory :: Path Abs -> IO () +throwCantOpenDirectory fp = + unlessM (canOpenDirectory fp) + (throwIO . Can'tOpenDirectory . fromAbs $ fp) + + + + -------------------------------- + --[ 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 + + +-- |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 FmIOException + -> 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 diff --git a/src/HPath/IO/Utils.hs b/src/HPath/IO/Utils.hs new file mode 100644 index 0000000..d49259d --- /dev/null +++ b/src/HPath/IO/Utils.hs @@ -0,0 +1,34 @@ +-- | +-- Module : HPath.IO.Utils +-- Copyright : © 2016 Julian Ospald +-- License : GPL-2 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- Random and general IO/monad utilities. + +{-# OPTIONS_HADDOCK ignore-exports #-} + + +module HPath.IO.Utils where + + +import Control.Monad + ( + when + , unless + ) + + +-- |If the value of the first argument is True, then execute the action +-- provided in the second argument, otherwise do nothing. +whenM :: Monad m => m Bool -> m () -> m () +whenM mb a = mb >>= (`when` a) + + +-- |If the value of the first argument is False, then execute the action +-- provided in the second argument, otherwise do nothing. +unlessM :: Monad m => m Bool -> m () -> m () +unlessM mb a = mb >>= (`unless` a) diff --git a/test/HPath/IO/CanonicalizePathSpec.hs b/test/HPath/IO/CanonicalizePathSpec.hs new file mode 100644 index 0000000..7e00269 --- /dev/null +++ b/test/HPath/IO/CanonicalizePathSpec.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.CanonicalizePathSpec where + + +import Test.Hspec +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/canonicalizePathSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.canonicalizePath" $ do + + -- successes -- + it "canonicalizePath, all fine" $ do + path <- withPwd (specDir `ba` "file") return + canonicalizePath' (specDir `ba` "file") + `shouldReturn` path + + it "canonicalizePath, all fine" $ do + path <- withPwd (specDir `ba` "dir") return + canonicalizePath' (specDir `ba` "dir") + `shouldReturn` path + + it "canonicalizePath, all fine" $ do + path <- withPwd (specDir `ba` "file") return + canonicalizePath' (specDir `ba` "fileSym") + `shouldReturn` path + + it "canonicalizePath, all fine" $ do + path <- withPwd (specDir `ba` "dir") return + canonicalizePath' (specDir `ba` "dirSym") + `shouldReturn` path + + + -- posix failures -- + it "canonicalizePath, broken symlink" $ + canonicalizePath' (specDir `ba` "brokenSym") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "canonicalizePath, file does not exist" $ + canonicalizePath' (specDir `ba` "nothingBlah") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + diff --git a/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs b/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs new file mode 100644 index 0000000..bc178ad --- /dev/null +++ b/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.CopyDirRecursiveOverwriteSpec where + + +import Test.Hspec +import HPath.IO.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) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/copyDirRecursiveOverwriteSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.copyDirRecursiveOverwrite" $ do + + -- successes -- + it "copyDirRecursiveOverwrite, all fine" $ do + copyDirRecursiveOverwrite' (specDir `ba` "inputDir") + (specDir `ba` "outputDir") + removeDirIfExists $ specDir `ba` "outputDir" + + it "copyDirRecursiveOverwrite, all fine and compare" $ do + copyDirRecursiveOverwrite' (specDir `ba` "inputDir") + (specDir `ba` "outputDir") + (system $ "diff -r --no-dereference " + ++ specDir' ++ "inputDir" ++ " " + ++ specDir' ++ "outputDir") + `shouldReturn` ExitSuccess + removeDirIfExists $ specDir `ba` "outputDir" + + it "copyDirRecursiveOverwrite, destination dir already exists" $ + copyDirRecursiveOverwrite' (specDir `ba` "inputDir") + (specDir `ba` "alreadyExistsD") + + -- posix failures -- + it "copyDirRecursiveOverwrite, source directory does not exist" $ + copyDirRecursiveOverwrite' (specDir `ba` "doesNotExist") + (specDir `ba` "outputDir") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "copyDirRecursiveOverwrite, no write permission on output dir" $ + copyDirRecursiveOverwrite' (specDir `ba` "inputDir") + (specDir `ba` "noWritePerm/foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyDirRecursiveOverwrite, cannot open output dir" $ + copyDirRecursiveOverwrite' (specDir `ba` "inputDir") + (specDir `ba` "noPerms/foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyDirRecursiveOverwrite, cannot open source dir" $ + copyDirRecursiveOverwrite' (specDir `ba` "noPerms/inputDir") + (specDir `ba` "foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyDirRecursiveOverwrite, destination already exists and is a file" $ + copyDirRecursiveOverwrite' (specDir `ba` "inputDir") + (specDir `ba` "alreadyExists") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "copyDirRecursiveOverwrite, wrong input (regular file)" $ + copyDirRecursiveOverwrite' (specDir `ba` "wrongInput") + (specDir `ba` "outputDir") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $ + copyDirRecursiveOverwrite' (specDir `ba` "wrongInputSymL") + (specDir `ba` "outputDir") + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + -- custom failures + it "copyDirRecursiveOverwrite, destination in source" $ + copyDirRecursiveOverwrite' (specDir `ba` "inputDir") + (specDir `ba` "inputDir/foo") + `shouldThrow` + isDestinationInSource + + it "copyDirRecursiveOverwrite, destination and source same directory" $ + copyDirRecursiveOverwrite' (specDir `ba` "inputDir") + (specDir `ba` "inputDir") + `shouldThrow` + isSameFile diff --git a/test/HPath/IO/CopyDirRecursiveSpec.hs b/test/HPath/IO/CopyDirRecursiveSpec.hs new file mode 100644 index 0000000..0bdee58 --- /dev/null +++ b/test/HPath/IO/CopyDirRecursiveSpec.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.CopyDirRecursiveSpec where + + +import Test.Hspec +import HPath.IO.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) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/copyDirRecursiveSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.copyDirRecursive" $ do + + -- successes -- + it "copyDirRecursive, all fine" $ do + copyDirRecursive' (specDir `ba` "inputDir") + (specDir `ba` "outputDir") + removeDirIfExists (specDir `ba` "outputDir") + + it "copyDirRecursive, all fine and compare" $ do + copyDirRecursive' (specDir `ba` "inputDir") + (specDir `ba` "outputDir") + (system $ "diff -r --no-dereference " + ++ specDir' ++ "inputDir" ++ " " + ++ specDir' ++ "outputDir") + `shouldReturn` ExitSuccess + removeDirIfExists (specDir `ba` "outputDir") + + -- posix failures -- + it "copyDirRecursive, source directory does not exist" $ + copyDirRecursive' (specDir `ba` "doesNotExist") + (specDir `ba` "outputDir") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "copyDirRecursive, no write permission on output dir" $ + copyDirRecursive' (specDir `ba` "inputDir") + (specDir `ba` "noWritePerm/foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyDirRecursive, cannot open output dir" $ + copyDirRecursive' (specDir `ba` "inputDir") + (specDir `ba` "noPerms/foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyDirRecursive, cannot open source dir" $ + copyDirRecursive' (specDir `ba` "noPerms/inputDir") + (specDir `ba` "foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyDirRecursive, destination dir already exists" $ + copyDirRecursive' (specDir `ba` "inputDir") + (specDir `ba` "alreadyExistsD") + `shouldThrow` + (\e -> ioeGetErrorType e == AlreadyExists) + + it "copyDirRecursive, destination already exists and is a file" $ + copyDirRecursive' (specDir `ba` "inputDir") + (specDir `ba` "alreadyExists") + `shouldThrow` + (\e -> ioeGetErrorType e == AlreadyExists) + + it "copyDirRecursive, wrong input (regular file)" $ + copyDirRecursive' (specDir `ba` "wrongInput") + (specDir `ba` "outputDir") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "copyDirRecursive, wrong input (symlink to directory)" $ + copyDirRecursive' (specDir `ba` "wrongInputSymL") + (specDir `ba` "outputDir") + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + -- custom failures + it "copyDirRecursive, destination in source" $ + copyDirRecursive' (specDir `ba` "inputDir") + (specDir `ba` "inputDir/foo") + `shouldThrow` + isDestinationInSource + + it "copyDirRecursive, destination and source same directory" $ + copyDirRecursive' (specDir `ba` "inputDir") + (specDir `ba` "inputDir") + `shouldThrow` + isSameFile diff --git a/test/HPath/IO/CopyFileOverwriteSpec.hs b/test/HPath/IO/CopyFileOverwriteSpec.hs new file mode 100644 index 0000000..8639500 --- /dev/null +++ b/test/HPath/IO/CopyFileOverwriteSpec.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.CopyFileOverwriteSpec where + + +import Test.Hspec +import HPath.IO.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) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/copyFileOverwriteSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.copyFileOverwrite" $ do + + -- successes -- + it "copyFileOverwrite, everything clear" $ do + copyFileOverwrite' (specDir `ba` "inputFile") + (specDir `ba` "outputFile") + removeFileIfExists (specDir `ba` "outputFile") + + it "copyFileOverwrite, output file already exists, all clear" $ do + copyFile' (specDir `ba` "alreadyExists") (specDir `ba` "alreadyExists.bak") + copyFileOverwrite' (specDir `ba` "inputFile") + (specDir `ba` "alreadyExists") + (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " " + ++ specDir' ++ "alreadyExists") + `shouldReturn` ExitSuccess + removeFileIfExists (specDir `ba` "alreadyExists") + copyFile' (specDir `ba` "alreadyExists.bak") (specDir `ba` "alreadyExists") + removeFileIfExists (specDir `ba` "alreadyExists.bak") + + it "copyFileOverwrite, and compare" $ do + copyFileOverwrite' (specDir `ba` "inputFile") + (specDir `ba` "outputFile") + (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " " + ++ specDir' ++ "outputFile") + `shouldReturn` ExitSuccess + removeFileIfExists (specDir `ba` "outputFile") + + -- posix failures -- + it "copyFileOverwrite, input file does not exist" $ + copyFileOverwrite' (specDir `ba` "noSuchFile") + (specDir `ba` "outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "copyFileOverwrite, no permission to write to output directory" $ + copyFileOverwrite' (specDir `ba` "inputFile") + (specDir `ba` "outputDirNoWrite/outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyFileOverwrite, cannot open output directory" $ + copyFileOverwrite' (specDir `ba` "inputFile") + (specDir `ba` "noPerms/outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyFileOverwrite, cannot open source directory" $ + copyFileOverwrite' (specDir `ba` "noPerms/inputFile") + (specDir `ba` "outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyFileOverwrite, wrong input type (symlink)" $ + copyFileOverwrite' (specDir `ba` "inputFileSymL") + (specDir `ba` "outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + it "copyFileOverwrite, wrong input type (directory)" $ + copyFileOverwrite' (specDir `ba` "wrongInput") + (specDir `ba` "outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "copyFileOverwrite, output file already exists and is a dir" $ + copyFileOverwrite' (specDir `ba` "inputFile") + (specDir `ba` "alreadyExistsD") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + -- custom failures -- + it "copyFileOverwrite, output and input are same file" $ + copyFileOverwrite' (specDir `ba` "inputFile") + (specDir `ba` "inputFile") + `shouldThrow` isSameFile diff --git a/test/HPath/IO/CopyFileSpec.hs b/test/HPath/IO/CopyFileSpec.hs new file mode 100644 index 0000000..cffbde3 --- /dev/null +++ b/test/HPath/IO/CopyFileSpec.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.CopyFileSpec where + + +import Test.Hspec +import HPath.IO.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) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/copyFileSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.copyFile" $ do + + -- successes -- + it "copyFile, everything clear" $ do + copyFile' (specDir `ba` "inputFile") + (specDir `ba` "outputFile") + removeFileIfExists (specDir `ba` "outputFile") + + it "copyFile, and compare" $ do + copyFile' (specDir `ba` "inputFile") + (specDir `ba` "outputFile") + (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " " + ++ specDir' ++ "outputFile") + `shouldReturn` ExitSuccess + removeFileIfExists (specDir `ba` "outputFile") + + -- posix failures -- + it "copyFile, input file does not exist" $ + copyFile' (specDir `ba` "noSuchFile") + (specDir `ba` "outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "copyFile, no permission to write to output directory" $ + copyFile' (specDir `ba` "inputFile") + (specDir `ba` "outputDirNoWrite/outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyFile, cannot open output directory" $ + copyFile' (specDir `ba` "inputFile") + (specDir `ba` "noPerms/outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyFile, cannot open source directory" $ + copyFile' (specDir `ba` "noPerms/inputFile") + (specDir `ba` "outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "copyFile, wrong input type (symlink)" $ + copyFile' (specDir `ba` "inputFileSymL") + (specDir `ba` "outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + it "copyFile, wrong input type (directory)" $ + copyFile' (specDir `ba` "wrongInput") + (specDir `ba` "outputFile") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "copyFile, output file already exists" $ + copyFile' (specDir `ba` "inputFile") + (specDir `ba` "alreadyExists") + `shouldThrow` + (\e -> ioeGetErrorType e == AlreadyExists) + + it "copyFile, output file already exists and is a dir" $ + copyFile' (specDir `ba` "inputFile") + (specDir `ba` "alreadyExistsD") + `shouldThrow` + (\e -> ioeGetErrorType e == AlreadyExists) + + -- custom failures -- + it "copyFile, output and input are same file" $ + copyFile' (specDir `ba` "inputFile") + (specDir `ba` "inputFile") + `shouldThrow` + isSameFile diff --git a/test/HPath/IO/CreateDirSpec.hs b/test/HPath/IO/CreateDirSpec.hs new file mode 100644 index 0000000..da58b4f --- /dev/null +++ b/test/HPath/IO/CreateDirSpec.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.CreateDirSpec where + + +import Test.Hspec +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/createDirSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.createDir" $ do + + -- successes -- + it "createDir, all fine" $ do + createDir' (specDir `ba` "newDir") + removeDirIfExists (specDir `ba` "newDir") + + -- posix failures -- + it "createDir, can't write to output directory" $ + createDir' (specDir `ba` "noWritePerms/newDir") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "createDir, can't open output directory" $ + createDir' (specDir `ba` "noPerms/newDir") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "createDir, destination directory already exists" $ + createDir' (specDir `ba` "alreadyExists") + `shouldThrow` + (\e -> ioeGetErrorType e == AlreadyExists) + diff --git a/test/HPath/IO/CreateRegularFileSpec.hs b/test/HPath/IO/CreateRegularFileSpec.hs new file mode 100644 index 0000000..3901e5a --- /dev/null +++ b/test/HPath/IO/CreateRegularFileSpec.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.CreateRegularFileSpec where + + +import Test.Hspec +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/createRegularFileSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.createRegularFile" $ do + + -- successes -- + it "createRegularFile, all fine" $ do + createRegularFile' (specDir `ba` "newDir") + removeFileIfExists (specDir `ba` "newDir") + + -- posix failures -- + it "createRegularFile, can't write to destination directory" $ + createRegularFile' (specDir `ba` "noWritePerms/newDir") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "createRegularFile, can't write to destination directory" $ + createRegularFile' (specDir `ba` "noPerms/newDir") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "createRegularFile, destination file already exists" $ + createRegularFile' (specDir `ba` "alreadyExists") + `shouldThrow` + (\e -> ioeGetErrorType e == AlreadyExists) + diff --git a/test/HPath/IO/DeleteDirRecursiveSpec.hs b/test/HPath/IO/DeleteDirRecursiveSpec.hs new file mode 100644 index 0000000..bd8dd71 --- /dev/null +++ b/test/HPath/IO/DeleteDirRecursiveSpec.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.DeleteDirRecursiveSpec where + + +import Test.Hspec +import System.IO.Error + ( + ioeGetErrorType + ) +import System.Posix.Files.ByteString + ( + getSymbolicLinkStatus + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/deleteDirRecursiveSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.deleteDirRecursive" $ do + + -- successes -- + it "deleteDirRecursive, empty directory, all fine" $ do + createDir' (specDir `ba` "testDir") + deleteDirRecursive' (specDir `ba` "testDir") + getSymbolicLinkStatus (specDir `ba` "testDir") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "deleteDirRecursive, empty directory with null permissions, all fine" $ do + createDir' (specDir `ba` "noPerms/testDir") + noPerms (specDir `ba` "noPerms/testDir") + deleteDirRecursive' (specDir `ba` "noPerms/testDir") + + it "deleteDirRecursive, non-empty directory, all fine" $ do + createDir' (specDir `ba` "nonEmpty") + createDir' (specDir `ba` "nonEmpty/dir1") + createDir' (specDir `ba` "nonEmpty/dir2") + createDir' (specDir `ba` "nonEmpty/dir2/dir3") + createRegularFile' (specDir `ba` "nonEmpty/file1") + createRegularFile' (specDir `ba` "nonEmpty/dir1/file2") + deleteDirRecursive' (specDir `ba` "nonEmpty") + getSymbolicLinkStatus (specDir `ba` "nonEmpty") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + -- posix failures -- + it "deleteDirRecursive, can't open parent directory" $ do + createDir' (specDir `ba` "noPerms/foo") + noPerms (specDir `ba` "noPerms") + (deleteDirRecursive' (specDir `ba` "noPerms/foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied)) + >> normalDirPerms (specDir `ba` "noPerms") + >> deleteDir' (specDir `ba` "noPerms/foo") + + it "deleteDirRecursive, can't write to parent directory" $ do + createDir' (specDir `ba` "noWritable/foo") + noWritableDirPerms (specDir `ba` "noWritable") + (deleteDirRecursive' (specDir `ba` "noWritable/foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied)) + normalDirPerms (specDir `ba` "noWritable") + deleteDir' (specDir `ba` "noWritable/foo") + + it "deleteDirRecursive, wrong file type (symlink to directory)" $ + deleteDirRecursive' (specDir `ba` "dirSym") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "deleteDirRecursive, wrong file type (regular file)" $ + deleteDirRecursive' (specDir `ba` "file") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "deleteDirRecursive, directory does not exist" $ + deleteDirRecursive' (specDir `ba` "doesNotExist") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + diff --git a/test/HPath/IO/DeleteDirSpec.hs b/test/HPath/IO/DeleteDirSpec.hs new file mode 100644 index 0000000..dd98bae --- /dev/null +++ b/test/HPath/IO/DeleteDirSpec.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.DeleteDirSpec where + + +import Test.Hspec +import System.IO.Error + ( + ioeGetErrorType + ) +import System.Posix.Files.ByteString + ( + getSymbolicLinkStatus + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/deleteDirSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.deleteDir" $ do + + -- successes -- + it "deleteDir, empty directory, all fine" $ do + createDir' (specDir `ba` "testDir") + deleteDir' (specDir `ba` "testDir") + getSymbolicLinkStatus (specDir `ba` "testDir") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "deleteDir, directory with null permissions, all fine" $ do + createDir' (specDir `ba` "noPerms/testDir") + noPerms (specDir `ba` "noPerms/testDir") + deleteDir' (specDir `ba` "noPerms/testDir") + getSymbolicLinkStatus (specDir `ba` "testDir") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + -- posix failures -- + it "deleteDir, wrong file type (symlink to directory)" $ + deleteDir' (specDir `ba` "dirSym") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "deleteDir, wrong file type (regular file)" $ + deleteDir' (specDir `ba` "file") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "deleteDir, directory does not exist" $ + deleteDir' (specDir `ba` "doesNotExist") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "deleteDir, directory not empty" $ + deleteDir' (specDir `ba` "dir") + `shouldThrow` + (\e -> ioeGetErrorType e == UnsatisfiedConstraints) + + it "deleteDir, can't open parent directory" $ do + createDir' (specDir `ba` "noPerms/foo") + noPerms (specDir `ba` "noPerms") + (deleteDir' (specDir `ba` "noPerms/foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied)) + >> normalDirPerms (specDir `ba` "noPerms") + >> deleteDir' (specDir `ba` "noPerms/foo") + + it "deleteDir, can't write to parent directory, still fine" $ do + createDir' (specDir `ba` "noWritable/foo") + noWritableDirPerms (specDir `ba` "noWritable") + (deleteDir' (specDir `ba` "noWritable/foo") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied)) + normalDirPerms (specDir `ba` "noWritable") + deleteDir' (specDir `ba` "noWritable/foo") + + + diff --git a/test/HPath/IO/DeleteFileSpec.hs b/test/HPath/IO/DeleteFileSpec.hs new file mode 100644 index 0000000..6eb43e4 --- /dev/null +++ b/test/HPath/IO/DeleteFileSpec.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.DeleteFileSpec where + + +import Test.Hspec +import System.IO.Error + ( + ioeGetErrorType + ) +import System.Posix.Files.ByteString + ( + getSymbolicLinkStatus + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/deleteFileSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.deleteFile" $ do + + -- successes -- + it "deleteFile, regular file, all fine" $ do + createRegularFile' (specDir `ba` "testFile") + deleteFile' (specDir `ba` "testFile") + getSymbolicLinkStatus (specDir `ba` "testFile") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "deleteFile, symlink, all fine" $ do + recreateSymlink' (specDir `ba` "syml") + (specDir `ba` "testFile") + deleteFile' (specDir `ba` "testFile") + getSymbolicLinkStatus (specDir `ba` "testFile") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + -- posix failures -- + it "deleteFile, wrong file type (directory)" $ + deleteFile' (specDir `ba` "dir") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "deleteFile, file does not exist" $ + deleteFile' (specDir `ba` "doesNotExist") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "deleteFile, can't read directory" $ + deleteFile' (specDir `ba` "noPerms/blah") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + diff --git a/test/HPath/IO/GetDirsFilesSpec.hs b/test/HPath/IO/GetDirsFilesSpec.hs new file mode 100644 index 0000000..f43098d --- /dev/null +++ b/test/HPath/IO/GetDirsFilesSpec.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.GetDirsFilesSpec where + + +import Data.List + ( + sort + ) +import Data.Maybe + ( + fromJust + ) +import qualified HPath as P +import Test.Hspec +import System.IO.Error + ( + ioeGetErrorType + ) +import System.Posix.Env.ByteString + ( + getEnv + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/getDirsFilesSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.getDirsFiles" $ do + + -- successes -- + it "getDirsFiles, all fine" $ do + pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs + expectedFiles <- mapM P.parseRel [(specDir `ba ` ".hidden") + ,(specDir `ba ` "Lala") + ,(specDir `ba ` "dir") + ,(specDir `ba ` "dirsym") + ,(specDir `ba ` "file") + ,(specDir `ba ` "noPerms") + ,(specDir `ba ` "syml")] + (fmap sort $ getDirsFiles' specDir) + `shouldReturn` fmap (pwd P.) expectedFiles + + -- posix failures -- + it "getDirsFiles, nonexistent directory" $ + getDirsFiles' (specDir `ba ` "nothingHere") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "getDirsFiles, wrong file type (file)" $ + getDirsFiles' (specDir `ba ` "file") + `shouldThrow` + (\e -> ioeGetErrorType e == InappropriateType) + + it "getDirsFiles, wrong file type (symlink to file)" $ + getDirsFiles' (specDir `ba ` "syml") + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + it "getDirsFiles, wrong file type (symlink to dir)" $ + getDirsFiles' (specDir `ba ` "dirsym") + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + it "getDirsFiles, can't open directory" $ + getDirsFiles' (specDir `ba ` "noPerms") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + + + diff --git a/test/HPath/IO/GetFileTypeSpec.hs b/test/HPath/IO/GetFileTypeSpec.hs new file mode 100644 index 0000000..2ca2074 --- /dev/null +++ b/test/HPath/IO/GetFileTypeSpec.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.GetFileTypeSpec where + + +import HPath.IO +import Test.Hspec +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/getFileTypeSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.getFileType" $ do + + -- successes -- + it "getFileType, regular file" $ + getFileType' (specDir `ba` "regularfile") + `shouldReturn` RegularFile + + it "getFileType, directory" $ + getFileType' (specDir `ba` "directory") + `shouldReturn` Directory + + it "getFileType, directory with null permissions" $ + getFileType' (specDir `ba` "noPerms") + `shouldReturn` Directory + + it "getFileType, symlink to file" $ + getFileType' (specDir `ba` "symlink") + `shouldReturn` SymbolicLink + + it "getFileType, symlink to directory" $ + getFileType' (specDir `ba` "symlinkD") + `shouldReturn` SymbolicLink + + it "getFileType, broken symlink" $ + getFileType' (specDir `ba` "brokenSymlink") + `shouldReturn` SymbolicLink + + -- posix failures -- + it "getFileType, file does not exist" $ + getFileType' (specDir `ba` "nothingHere") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "getFileType, can't open directory" $ + getFileType' (specDir `ba` "noPerms/forz") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + diff --git a/test/HPath/IO/MoveFileOverwriteSpec.hs b/test/HPath/IO/MoveFileOverwriteSpec.hs new file mode 100644 index 0000000..bbaaa80 --- /dev/null +++ b/test/HPath/IO/MoveFileOverwriteSpec.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.MoveFileOverwriteSpec where + + +import Test.Hspec +import HPath.IO.Errors +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/moveFileOverwriteSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.moveFileOverwrite" $ do + + -- successes -- + it "moveFileOverwrite, all fine" $ + moveFileOverwrite' (specDir `ba` "myFile") + (specDir `ba` "movedFile") + + it "moveFileOverwrite, all fine" $ + moveFileOverwrite' (specDir `ba` "myFile") + (specDir `ba` "dir/movedFile") + + it "moveFileOverwrite, all fine on symlink" $ + moveFileOverwrite' (specDir `ba` "myFileL") + (specDir `ba` "movedFile") + + it "moveFileOverwrite, all fine on directory" $ + moveFileOverwrite' (specDir `ba` "dir") + (specDir `ba` "movedFile") + + it "moveFileOverwrite, destination file already exists" $ + moveFileOverwrite' (specDir `ba` "myFile") + (specDir `ba` "alreadyExists") + + -- posix failures -- + it "moveFileOverwrite, source file does not exist" $ + moveFileOverwrite' (specDir `ba` "fileDoesNotExist") + (specDir `ba` "movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "moveFileOverwrite, can't write to destination directory" $ + moveFileOverwrite' (specDir `ba` "myFile") + (specDir `ba` "noWritePerm/movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "moveFileOverwrite, can't open destination directory" $ + moveFileOverwrite' (specDir `ba` "myFile") + (specDir `ba` "noPerms/movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "moveFileOverwrite, can't open source directory" $ + moveFileOverwrite' (specDir `ba` "noPerms/myFile") + (specDir `ba` "movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + -- custom failures -- + it "moveFileOverwrite, move from file to dir" $ + moveFileOverwrite' (specDir `ba` "myFile") + (specDir `ba` "alreadyExistsD") + `shouldThrow` + isDirDoesExist + + it "moveFileOverwrite, source and dest are same file" $ + moveFileOverwrite' (specDir `ba` "myFile") + (specDir `ba` "myFile") + `shouldThrow` + isSameFile + diff --git a/test/HPath/IO/MoveFileSpec.hs b/test/HPath/IO/MoveFileSpec.hs new file mode 100644 index 0000000..95923a9 --- /dev/null +++ b/test/HPath/IO/MoveFileSpec.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.MoveFileSpec where + + +import Test.Hspec +import HPath.IO.Errors +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/moveFileSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.moveFile" $ do + + -- successes -- + it "moveFile, all fine" $ + moveFile' (specDir `ba` "myFile") + (specDir `ba` "movedFile") + + it "moveFile, all fine" $ + moveFile' (specDir `ba` "myFile") + (specDir `ba` "dir/movedFile") + + it "moveFile, all fine on symlink" $ + moveFile' (specDir `ba` "myFileL") + (specDir `ba` "movedFile") + + it "moveFile, all fine on directory" $ + moveFile' (specDir `ba` "dir") + (specDir `ba` "movedFile") + + -- posix failures -- + it "moveFile, source file does not exist" $ + moveFile' (specDir `ba` "fileDoesNotExist") + (specDir `ba` "movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "moveFile, can't write to destination directory" $ + moveFile' (specDir `ba` "myFile") + (specDir `ba` "noWritePerm/movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "moveFile, can't open destination directory" $ + moveFile' (specDir `ba` "myFile") + (specDir `ba` "noPerms/movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "moveFile, can't open source directory" $ + moveFile' (specDir `ba` "noPerms/myFile") + (specDir `ba` "movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + -- custom failures -- + it "moveFile, destination file already exists" $ + moveFile' (specDir `ba` "myFile") + (specDir `ba` "alreadyExists") + `shouldThrow` + isFileDoesExist + + it "moveFile, move from file to dir" $ + moveFile' (specDir `ba` "myFile") + (specDir `ba` "alreadyExistsD") + `shouldThrow` + isDirDoesExist + + it "moveFile, source and dest are same file" $ + moveFile' (specDir `ba` "myFile") + (specDir `ba` "myFile") + `shouldThrow` + isSameFile + diff --git a/test/HPath/IO/RecreateSymlinkSpec.hs b/test/HPath/IO/RecreateSymlinkSpec.hs new file mode 100644 index 0000000..2ea8351 --- /dev/null +++ b/test/HPath/IO/RecreateSymlinkSpec.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.RecreateSymlinkSpec where + + +import Test.Hspec +import HPath.IO.Errors +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/recreateSymlinkSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.recreateSymlink" $ do + + -- successes -- + it "recreateSymLink, all fine" $ do + recreateSymlink' (specDir `ba` "myFileL") + (specDir `ba` "movedFile") + removeFileIfExists (specDir `ba` "movedFile") + + it "recreateSymLink, all fine" $ do + recreateSymlink' (specDir `ba` "myFileL") + (specDir `ba` "dir/movedFile") + removeFileIfExists (specDir `ba` "dir/movedFile") + + -- posix failures -- + it "recreateSymLink, wrong input type (file)" $ + recreateSymlink' (specDir `ba` "myFile") + (specDir `ba` "movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + it "recreateSymLink, wrong input type (directory)" $ + recreateSymlink' (specDir `ba` "dir") + (specDir `ba` "movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + it "recreateSymLink, can't write to destination directory" $ + recreateSymlink' (specDir `ba` "myFileL") + (specDir `ba` "noWritePerm/movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "recreateSymLink, can't open destination directory" $ + recreateSymlink' (specDir `ba` "myFileL") + (specDir `ba` "noPerms/movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "recreateSymLink, can't open source directory" $ + recreateSymlink' (specDir `ba` "noPerms/myFileL") + (specDir `ba` "movedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "recreateSymLink, destination file already exists" $ + recreateSymlink' (specDir `ba` "myFileL") + (specDir `ba` "alreadyExists") + `shouldThrow` + (\e -> ioeGetErrorType e == AlreadyExists) + + it "recreateSymLink, destination already exists and is a dir" $ + recreateSymlink' (specDir `ba` "myFileL") + (specDir `ba` "alreadyExistsD") + `shouldThrow` + (\e -> ioeGetErrorType e == AlreadyExists) + + -- custom failures -- + it "recreateSymLink, source and destination are the same file" $ + recreateSymlink' (specDir `ba` "myFileL") + (specDir `ba` "myFileL") + `shouldThrow` + isSameFile + diff --git a/test/HPath/IO/RenameFileSpec.hs b/test/HPath/IO/RenameFileSpec.hs new file mode 100644 index 0000000..1580ad7 --- /dev/null +++ b/test/HPath/IO/RenameFileSpec.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.RenameFileSpec where + + +import Test.Hspec +import HPath.IO.Errors +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + +ba :: BS.ByteString -> BS.ByteString -> BS.ByteString +ba = BS.append + +specDir :: BS.ByteString +specDir = "test/HPath/IO/renameFileSpec/" + +specDir' :: String +specDir' = toString specDir + + +spec :: Spec +spec = + describe "HPath.IO.renameFile" $ do + + -- successes -- + it "renameFile, all fine" $ + renameFile' (specDir `ba` "myFile") + (specDir `ba` "renamedFile") + + it "renameFile, all fine" $ + renameFile' (specDir `ba` "myFile") + (specDir `ba` "dir/renamedFile") + + it "renameFile, all fine on symlink" $ + renameFile' (specDir `ba` "myFileL") + (specDir `ba` "renamedFile") + + it "renameFile, all fine on directory" $ + renameFile' (specDir `ba` "dir") + (specDir `ba` "renamedFile") + + -- posix failures -- + it "renameFile, source file does not exist" $ + renameFile' (specDir `ba` "fileDoesNotExist") + (specDir `ba` "renamedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "renameFile, can't write to output directory" $ + renameFile' (specDir `ba` "myFile") + (specDir `ba` "noWritePerm/renamedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "renameFile, can't open output directory" $ + renameFile' (specDir `ba` "myFile") + (specDir `ba` "noPerms/renamedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "renameFile, can't open source directory" $ + renameFile' (specDir `ba` "noPerms/myFile") + (specDir `ba` "renamedFile") + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + -- custom failures -- + it "renameFile, destination file already exists" $ + renameFile' (specDir `ba` "myFile") + (specDir `ba` "alreadyExists") + `shouldThrow` + isFileDoesExist + + it "renameFile, move from file to dir" $ + renameFile' (specDir `ba` "myFile") + (specDir `ba` "alreadyExistsD") + `shouldThrow` + isDirDoesExist + + it "renameFile, source and dest are same file" $ + renameFile' (specDir `ba` "myFile") + (specDir `ba` "myFile") + `shouldThrow` + isSameFile + diff --git a/test/HPath/IO/canonicalizePathSpec/brokenSym b/test/HPath/IO/canonicalizePathSpec/brokenSym new file mode 120000 index 0000000..97896a0 --- /dev/null +++ b/test/HPath/IO/canonicalizePathSpec/brokenSym @@ -0,0 +1 @@ +nothing \ No newline at end of file diff --git a/test/HPath/IO/canonicalizePathSpec/dir/.keep b/test/HPath/IO/canonicalizePathSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/canonicalizePathSpec/dirSym b/test/HPath/IO/canonicalizePathSpec/dirSym new file mode 120000 index 0000000..8724519 --- /dev/null +++ b/test/HPath/IO/canonicalizePathSpec/dirSym @@ -0,0 +1 @@ +dir \ No newline at end of file diff --git a/test/HPath/IO/canonicalizePathSpec/file b/test/HPath/IO/canonicalizePathSpec/file new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/canonicalizePathSpec/fileSym b/test/HPath/IO/canonicalizePathSpec/fileSym new file mode 120000 index 0000000..1a010b1 --- /dev/null +++ b/test/HPath/IO/canonicalizePathSpec/fileSym @@ -0,0 +1 @@ +file \ No newline at end of file diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExists b/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExists new file mode 100755 index 0000000..e69de29 diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/.keep b/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/bar/inputFile3 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/bar/inputFile3 new file mode 100644 index 0000000..8b2f378 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/bar/inputFile3 @@ -0,0 +1,8 @@ +dadasasddas +sda + +!!1 +sda + + +11 diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/foo/inputFile1 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/foo/inputFile1 new file mode 100644 index 0000000..31c5074 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/foo/inputFile1 @@ -0,0 +1 @@ +dadasasddas diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/inputFile2 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/inputFile2 new file mode 100644 index 0000000..1eed72f --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/alreadyExistsD/inputFile2 @@ -0,0 +1,4 @@ +dadasasddas +das +sda +sda diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/bar/inputFile3 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/bar/inputFile3 new file mode 100644 index 0000000..8b2f378 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/bar/inputFile3 @@ -0,0 +1,8 @@ +dadasasddas +sda + +!!1 +sda + + +11 diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/foo/inputFile1 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/foo/inputFile1 new file mode 100644 index 0000000..31c5074 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/foo/inputFile1 @@ -0,0 +1 @@ +dadasasddas diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/inputFile2 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/inputFile2 new file mode 100644 index 0000000..1eed72f --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/inputDir/inputFile2 @@ -0,0 +1,4 @@ +dadasasddas +das +sda +sda diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/bar/inputFile3 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/bar/inputFile3 new file mode 100644 index 0000000..8b2f378 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/bar/inputFile3 @@ -0,0 +1,8 @@ +dadasasddas +sda + +!!1 +sda + + +11 diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/foo/inputFile1 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/foo/inputFile1 new file mode 100644 index 0000000..31c5074 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/foo/inputFile1 @@ -0,0 +1 @@ +dadasasddas diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/inputFile2 b/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/inputFile2 new file mode 100644 index 0000000..1eed72f --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms/inputDir/inputFile2 @@ -0,0 +1,4 @@ +dadasasddas +das +sda +sda diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/noWritePerm/.keep b/test/HPath/IO/copyDirRecursiveOverwriteSpec/noWritePerm/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/wrongInput b/test/HPath/IO/copyDirRecursiveOverwriteSpec/wrongInput new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyDirRecursiveOverwriteSpec/wrongInputSymL b/test/HPath/IO/copyDirRecursiveOverwriteSpec/wrongInputSymL new file mode 120000 index 0000000..e722311 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveOverwriteSpec/wrongInputSymL @@ -0,0 +1 @@ +inputDir/ \ No newline at end of file diff --git a/test/HPath/IO/copyDirRecursiveSpec/alreadyExists b/test/HPath/IO/copyDirRecursiveSpec/alreadyExists new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyDirRecursiveSpec/alreadyExistsD/.keep b/test/HPath/IO/copyDirRecursiveSpec/alreadyExistsD/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyDirRecursiveSpec/inputDir/bar/inputFile3 b/test/HPath/IO/copyDirRecursiveSpec/inputDir/bar/inputFile3 new file mode 100644 index 0000000..8b2f378 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveSpec/inputDir/bar/inputFile3 @@ -0,0 +1,8 @@ +dadasasddas +sda + +!!1 +sda + + +11 diff --git a/test/HPath/IO/copyDirRecursiveSpec/inputDir/foo/inputFile1 b/test/HPath/IO/copyDirRecursiveSpec/inputDir/foo/inputFile1 new file mode 100644 index 0000000..31c5074 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveSpec/inputDir/foo/inputFile1 @@ -0,0 +1 @@ +dadasasddas diff --git a/test/HPath/IO/copyDirRecursiveSpec/inputDir/inputFile2 b/test/HPath/IO/copyDirRecursiveSpec/inputDir/inputFile2 new file mode 100644 index 0000000..1eed72f --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveSpec/inputDir/inputFile2 @@ -0,0 +1,4 @@ +dadasasddas +das +sda +sda diff --git a/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/bar/inputFile3 b/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/bar/inputFile3 new file mode 100644 index 0000000..8b2f378 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/bar/inputFile3 @@ -0,0 +1,8 @@ +dadasasddas +sda + +!!1 +sda + + +11 diff --git a/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/foo/inputFile1 b/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/foo/inputFile1 new file mode 100644 index 0000000..31c5074 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/foo/inputFile1 @@ -0,0 +1 @@ +dadasasddas diff --git a/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/inputFile2 b/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/inputFile2 new file mode 100644 index 0000000..1eed72f --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveSpec/noPerms/inputDir/inputFile2 @@ -0,0 +1,4 @@ +dadasasddas +das +sda +sda diff --git a/test/HPath/IO/copyDirRecursiveSpec/noWritePerm/.keep b/test/HPath/IO/copyDirRecursiveSpec/noWritePerm/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyDirRecursiveSpec/wrongInput b/test/HPath/IO/copyDirRecursiveSpec/wrongInput new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyDirRecursiveSpec/wrongInputSymL b/test/HPath/IO/copyDirRecursiveSpec/wrongInputSymL new file mode 120000 index 0000000..e722311 --- /dev/null +++ b/test/HPath/IO/copyDirRecursiveSpec/wrongInputSymL @@ -0,0 +1 @@ +inputDir/ \ No newline at end of file diff --git a/test/HPath/IO/copyFileOverwriteSpec/alreadyExists b/test/HPath/IO/copyFileOverwriteSpec/alreadyExists new file mode 100644 index 0000000..d7d35c0 --- /dev/null +++ b/test/HPath/IO/copyFileOverwriteSpec/alreadyExists @@ -0,0 +1,16 @@ +adaöölsdaöl +dsalö +ölsda +ääödsf +äsdfä +öä453 +öä +435 +ä45343 +5 +453 +453453453 +das +asd +das + diff --git a/test/HPath/IO/copyFileOverwriteSpec/alreadyExistsD/.keep b/test/HPath/IO/copyFileOverwriteSpec/alreadyExistsD/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyFileOverwriteSpec/inputFile b/test/HPath/IO/copyFileOverwriteSpec/inputFile new file mode 100644 index 0000000..87bf7bc --- /dev/null +++ b/test/HPath/IO/copyFileOverwriteSpec/inputFile @@ -0,0 +1,4 @@ +abc +def + +dsadasdsa diff --git a/test/HPath/IO/copyFileOverwriteSpec/inputFileSymL b/test/HPath/IO/copyFileOverwriteSpec/inputFileSymL new file mode 120000 index 0000000..55529d2 --- /dev/null +++ b/test/HPath/IO/copyFileOverwriteSpec/inputFileSymL @@ -0,0 +1 @@ +inputFile \ No newline at end of file diff --git a/test/HPath/IO/copyFileOverwriteSpec/noPerms/inputFile b/test/HPath/IO/copyFileOverwriteSpec/noPerms/inputFile new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyFileOverwriteSpec/outputDirNoWrite/.keep b/test/HPath/IO/copyFileOverwriteSpec/outputDirNoWrite/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyFileOverwriteSpec/wrongInput/.keep b/test/HPath/IO/copyFileOverwriteSpec/wrongInput/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyFileSpec/alreadyExists b/test/HPath/IO/copyFileSpec/alreadyExists new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyFileSpec/alreadyExistsD/.keep b/test/HPath/IO/copyFileSpec/alreadyExistsD/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyFileSpec/inputFile b/test/HPath/IO/copyFileSpec/inputFile new file mode 100644 index 0000000..5f5521f --- /dev/null +++ b/test/HPath/IO/copyFileSpec/inputFile @@ -0,0 +1,2 @@ +abc +def diff --git a/test/HPath/IO/copyFileSpec/inputFileSymL b/test/HPath/IO/copyFileSpec/inputFileSymL new file mode 120000 index 0000000..55529d2 --- /dev/null +++ b/test/HPath/IO/copyFileSpec/inputFileSymL @@ -0,0 +1 @@ +inputFile \ No newline at end of file diff --git a/test/HPath/IO/copyFileSpec/noPerms/inputFile b/test/HPath/IO/copyFileSpec/noPerms/inputFile new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyFileSpec/outputDirNoWrite/.keep b/test/HPath/IO/copyFileSpec/outputDirNoWrite/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/copyFileSpec/wrongInput/.keep b/test/HPath/IO/copyFileSpec/wrongInput/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/createDirSpec/.keep b/test/HPath/IO/createDirSpec/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/createDirSpec/alreadyExists/.keep b/test/HPath/IO/createDirSpec/alreadyExists/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/createDirSpec/noPerms/.keep b/test/HPath/IO/createDirSpec/noPerms/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/createDirSpec/noWritePerms/.keep b/test/HPath/IO/createDirSpec/noWritePerms/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/createRegularFileSpec/alreadyExists b/test/HPath/IO/createRegularFileSpec/alreadyExists new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/createRegularFileSpec/noPerms/.keep b/test/HPath/IO/createRegularFileSpec/noPerms/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/createRegularFileSpec/noWritePerms/.keep b/test/HPath/IO/createRegularFileSpec/noWritePerms/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirRecursiveSpec/.keep b/test/HPath/IO/deleteDirRecursiveSpec/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirRecursiveSpec/dir/.keep b/test/HPath/IO/deleteDirRecursiveSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirRecursiveSpec/dirSym b/test/HPath/IO/deleteDirRecursiveSpec/dirSym new file mode 120000 index 0000000..8724519 --- /dev/null +++ b/test/HPath/IO/deleteDirRecursiveSpec/dirSym @@ -0,0 +1 @@ +dir \ No newline at end of file diff --git a/test/HPath/IO/deleteDirRecursiveSpec/file b/test/HPath/IO/deleteDirRecursiveSpec/file new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirRecursiveSpec/noPerms/.keep b/test/HPath/IO/deleteDirRecursiveSpec/noPerms/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirRecursiveSpec/noWritable/.keep b/test/HPath/IO/deleteDirRecursiveSpec/noWritable/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirSpec/.keep b/test/HPath/IO/deleteDirSpec/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirSpec/dir/.keep b/test/HPath/IO/deleteDirSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirSpec/dirSym b/test/HPath/IO/deleteDirSpec/dirSym new file mode 120000 index 0000000..8724519 --- /dev/null +++ b/test/HPath/IO/deleteDirSpec/dirSym @@ -0,0 +1 @@ +dir \ No newline at end of file diff --git a/test/HPath/IO/deleteDirSpec/file b/test/HPath/IO/deleteDirSpec/file new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirSpec/noPerms/.keep b/test/HPath/IO/deleteDirSpec/noPerms/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteDirSpec/noWritable/.keep b/test/HPath/IO/deleteDirSpec/noWritable/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteFileSpec/dir/.keep b/test/HPath/IO/deleteFileSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteFileSpec/foo b/test/HPath/IO/deleteFileSpec/foo new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteFileSpec/noPerms/blah b/test/HPath/IO/deleteFileSpec/noPerms/blah new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/deleteFileSpec/syml b/test/HPath/IO/deleteFileSpec/syml new file mode 120000 index 0000000..1910281 --- /dev/null +++ b/test/HPath/IO/deleteFileSpec/syml @@ -0,0 +1 @@ +foo \ No newline at end of file diff --git a/test/HPath/IO/getDirsFilesSpec/.hidden b/test/HPath/IO/getDirsFilesSpec/.hidden new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/getDirsFilesSpec/Lala b/test/HPath/IO/getDirsFilesSpec/Lala new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/getDirsFilesSpec/dir/.keep b/test/HPath/IO/getDirsFilesSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/getDirsFilesSpec/dirsym b/test/HPath/IO/getDirsFilesSpec/dirsym new file mode 120000 index 0000000..8724519 --- /dev/null +++ b/test/HPath/IO/getDirsFilesSpec/dirsym @@ -0,0 +1 @@ +dir \ No newline at end of file diff --git a/test/HPath/IO/getDirsFilesSpec/file b/test/HPath/IO/getDirsFilesSpec/file new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/getDirsFilesSpec/noPerms/.keep b/test/HPath/IO/getDirsFilesSpec/noPerms/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/getDirsFilesSpec/syml b/test/HPath/IO/getDirsFilesSpec/syml new file mode 120000 index 0000000..bbfbf8c --- /dev/null +++ b/test/HPath/IO/getDirsFilesSpec/syml @@ -0,0 +1 @@ +Lala \ No newline at end of file diff --git a/test/HPath/IO/getFileTypeSpec/brokenSymlink b/test/HPath/IO/getFileTypeSpec/brokenSymlink new file mode 120000 index 0000000..86a410d --- /dev/null +++ b/test/HPath/IO/getFileTypeSpec/brokenSymlink @@ -0,0 +1 @@ +broken \ No newline at end of file diff --git a/test/HPath/IO/getFileTypeSpec/directory/.keep b/test/HPath/IO/getFileTypeSpec/directory/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/getFileTypeSpec/noPerms/.keep b/test/HPath/IO/getFileTypeSpec/noPerms/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/getFileTypeSpec/regularfile b/test/HPath/IO/getFileTypeSpec/regularfile new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/getFileTypeSpec/symlink b/test/HPath/IO/getFileTypeSpec/symlink new file mode 120000 index 0000000..6a33ade --- /dev/null +++ b/test/HPath/IO/getFileTypeSpec/symlink @@ -0,0 +1 @@ +regularfile \ No newline at end of file diff --git a/test/HPath/IO/getFileTypeSpec/symlinkD b/test/HPath/IO/getFileTypeSpec/symlinkD new file mode 120000 index 0000000..6d0450c --- /dev/null +++ b/test/HPath/IO/getFileTypeSpec/symlinkD @@ -0,0 +1 @@ +directory \ No newline at end of file diff --git a/test/HPath/IO/moveFileOverwriteSpec/alreadyExistsD/.keep b/test/HPath/IO/moveFileOverwriteSpec/alreadyExistsD/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/moveFileOverwriteSpec/dir/.keep b/test/HPath/IO/moveFileOverwriteSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/moveFileOverwriteSpec/myFile b/test/HPath/IO/moveFileOverwriteSpec/myFile new file mode 100644 index 0000000..1f62e72 --- /dev/null +++ b/test/HPath/IO/moveFileOverwriteSpec/myFile @@ -0,0 +1,4 @@ +asd +sda + +sda diff --git a/test/HPath/IO/moveFileOverwriteSpec/myFileL b/test/HPath/IO/moveFileOverwriteSpec/myFileL new file mode 120000 index 0000000..c97626f --- /dev/null +++ b/test/HPath/IO/moveFileOverwriteSpec/myFileL @@ -0,0 +1 @@ +myFile \ No newline at end of file diff --git a/test/HPath/IO/moveFileOverwriteSpec/noPerms/myFile b/test/HPath/IO/moveFileOverwriteSpec/noPerms/myFile new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/moveFileOverwriteSpec/noWritePerm/.keep b/test/HPath/IO/moveFileOverwriteSpec/noWritePerm/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/moveFileSpec/alreadyExists b/test/HPath/IO/moveFileSpec/alreadyExists new file mode 100644 index 0000000..82a6fbd --- /dev/null +++ b/test/HPath/IO/moveFileSpec/alreadyExists @@ -0,0 +1,2 @@ +dasklaksd +sda diff --git a/test/HPath/IO/moveFileSpec/alreadyExistsD/.keep b/test/HPath/IO/moveFileSpec/alreadyExistsD/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/moveFileSpec/dir/.keep b/test/HPath/IO/moveFileSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/moveFileSpec/myFile b/test/HPath/IO/moveFileSpec/myFile new file mode 100644 index 0000000..1f62e72 --- /dev/null +++ b/test/HPath/IO/moveFileSpec/myFile @@ -0,0 +1,4 @@ +asd +sda + +sda diff --git a/test/HPath/IO/moveFileSpec/myFileL b/test/HPath/IO/moveFileSpec/myFileL new file mode 120000 index 0000000..c97626f --- /dev/null +++ b/test/HPath/IO/moveFileSpec/myFileL @@ -0,0 +1 @@ +myFile \ No newline at end of file diff --git a/test/HPath/IO/moveFileSpec/noPerms/myFile b/test/HPath/IO/moveFileSpec/noPerms/myFile new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/moveFileSpec/noWritePerm/.keep b/test/HPath/IO/moveFileSpec/noWritePerm/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/recreateSymlinkSpec/alreadyExists b/test/HPath/IO/recreateSymlinkSpec/alreadyExists new file mode 100644 index 0000000..f9c6694 --- /dev/null +++ b/test/HPath/IO/recreateSymlinkSpec/alreadyExists @@ -0,0 +1,3 @@ +asdl +dsa +sd diff --git a/test/HPath/IO/recreateSymlinkSpec/alreadyExistsD/.keep b/test/HPath/IO/recreateSymlinkSpec/alreadyExistsD/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/recreateSymlinkSpec/dir/.keep b/test/HPath/IO/recreateSymlinkSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/recreateSymlinkSpec/myFile b/test/HPath/IO/recreateSymlinkSpec/myFile new file mode 100644 index 0000000..ee838ea --- /dev/null +++ b/test/HPath/IO/recreateSymlinkSpec/myFile @@ -0,0 +1,4 @@ +ads +sad +das +sda diff --git a/test/HPath/IO/recreateSymlinkSpec/myFileL b/test/HPath/IO/recreateSymlinkSpec/myFileL new file mode 120000 index 0000000..c97626f --- /dev/null +++ b/test/HPath/IO/recreateSymlinkSpec/myFileL @@ -0,0 +1 @@ +myFile \ No newline at end of file diff --git a/test/HPath/IO/recreateSymlinkSpec/noPerms/myFile b/test/HPath/IO/recreateSymlinkSpec/noPerms/myFile new file mode 100644 index 0000000..ee838ea --- /dev/null +++ b/test/HPath/IO/recreateSymlinkSpec/noPerms/myFile @@ -0,0 +1,4 @@ +ads +sad +das +sda diff --git a/test/HPath/IO/recreateSymlinkSpec/noPerms/myFileL b/test/HPath/IO/recreateSymlinkSpec/noPerms/myFileL new file mode 120000 index 0000000..c97626f --- /dev/null +++ b/test/HPath/IO/recreateSymlinkSpec/noPerms/myFileL @@ -0,0 +1 @@ +myFile \ No newline at end of file diff --git a/test/HPath/IO/recreateSymlinkSpec/noWritePerm/.keep b/test/HPath/IO/recreateSymlinkSpec/noWritePerm/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/renameFileSpec/alreadyExists b/test/HPath/IO/renameFileSpec/alreadyExists new file mode 100644 index 0000000..f9c6694 --- /dev/null +++ b/test/HPath/IO/renameFileSpec/alreadyExists @@ -0,0 +1,3 @@ +asdl +dsa +sd diff --git a/test/HPath/IO/renameFileSpec/alreadyExistsD/.keep b/test/HPath/IO/renameFileSpec/alreadyExistsD/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/renameFileSpec/dir/.keep b/test/HPath/IO/renameFileSpec/dir/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/renameFileSpec/myFile b/test/HPath/IO/renameFileSpec/myFile new file mode 100644 index 0000000..ee838ea --- /dev/null +++ b/test/HPath/IO/renameFileSpec/myFile @@ -0,0 +1,4 @@ +ads +sad +das +sda diff --git a/test/HPath/IO/renameFileSpec/myFileL b/test/HPath/IO/renameFileSpec/myFileL new file mode 120000 index 0000000..c97626f --- /dev/null +++ b/test/HPath/IO/renameFileSpec/myFileL @@ -0,0 +1 @@ +myFile \ No newline at end of file diff --git a/test/HPath/IO/renameFileSpec/noPerms/myFile b/test/HPath/IO/renameFileSpec/noPerms/myFile new file mode 100644 index 0000000..e69de29 diff --git a/test/HPath/IO/renameFileSpec/noWritePerm/.keep b/test/HPath/IO/renameFileSpec/noWritePerm/.keep new file mode 100644 index 0000000..e69de29 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..2d78dcf --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Test.Hspec +import Test.Hspec.Runner +import Test.Hspec.Formatters +import qualified Spec +import Utils + + +-- TODO: chardev, blockdev, namedpipe, socket + + +main :: IO () +main = + hspecWith + defaultConfig { configFormatter = Just progress } + $ before_ fixPermissions + $ after_ revertPermissions + $ Spec.spec >> Spec.spec + where + noWriteDirs = ["test/HPath/IO/copyFileSpec/outputDirNoWrite" + ,"test/HPath/IO/copyFileOverwriteSpec/outputDirNoWrite" + ,"test/HPath/IO/copyDirRecursiveSpec/noWritePerm" + ,"test/HPath/IO/copyDirRecursiveOverwriteSpec/noWritePerm" + ,"test/HPath/IO/createDirSpec/noWritePerms" + ,"test/HPath/IO/createRegularFileSpec/noWritePerms" + ,"test/HPath/IO/renameFileSpec/noWritePerm" + ,"test/HPath/IO/moveFileSpec/noWritePerm" + ,"test/HPath/IO/moveFileOverwriteSpec/noWritePerm" + ,"test/HPath/IO/recreateSymlinkSpec/noWritePerm" + ] + noPermsDirs = ["test/HPath/IO/copyFileSpec/noPerms" + ,"test/HPath/IO/copyFileOverwriteSpec/noPerms" + ,"test/HPath/IO/copyDirRecursiveSpec/noPerms" + ,"test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms" + ,"test/HPath/IO/createDirSpec/noPerms" + ,"test/HPath/IO/createRegularFileSpec/noPerms" + ,"test/HPath/IO/renameFileSpec/noPerms" + ,"test/HPath/IO/moveFileSpec/noPerms" + ,"test/HPath/IO/moveFileOverwriteSpec/noPerms" + ,"test/HPath/IO/recreateSymlinkSpec/noPerms" + ,"test/HPath/IO/getFileTypeSpec/noPerms" + ,"test/HPath/IO/getDirsFilesSpec/noPerms" + ,"test/HPath/IO/deleteFileSpec/noPerms" + ] + fixPermissions = do + sequence_ $ fmap noWritableDirPerms noWriteDirs + sequence_ $ fmap noPerms noPermsDirs + revertPermissions = do + sequence_ $ fmap normalDirPerms noWriteDirs + sequence_ $ fmap normalDirPerms noPermsDirs + + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..939c0ff --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +-- file test/Spec.hs +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/test/Utils.hs b/test/Utils.hs new file mode 100644 index 0000000..074dada --- /dev/null +++ b/test/Utils.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Utils where + + +import HPath.IO +import HPath.IO.Errors +import HPath.IO.Utils +import Data.Maybe + ( + fromJust + ) +import qualified HPath as P +import System.Posix.Env.ByteString + ( + getEnv + ) +import Data.ByteString + ( + ByteString + ) +import System.Posix.Files.ByteString + ( + groupExecuteMode + , groupReadMode + , nullFileMode + , otherExecuteMode + , otherReadMode + , ownerExecuteMode + , ownerReadMode + , setFileMode + , unionFileModes + ) + + + + ----------------- + --[ Utilities ]-- + ----------------- + + +withPwd :: ByteString -> (P.Path P.Abs -> IO a) -> IO a +withPwd ip f = do + pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs + p <- (pwd P.) <$> P.parseRel ip + f p + + +withPwd' :: ByteString + -> ByteString + -> (P.Path P.Abs -> P.Path P.Abs -> IO a) + -> IO a +withPwd' ip1 ip2 f = do + pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs + p1 <- (pwd P.) <$> P.parseRel ip1 + p2 <- (pwd P.) <$> P.parseRel ip2 + f p1 p2 + + +removeFileIfExists :: ByteString -> IO () +removeFileIfExists bs = + withPwd bs $ \p -> whenM (doesFileExist p) (deleteFile p) + + +removeDirIfExists :: ByteString -> IO () +removeDirIfExists bs = + withPwd bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) + + +copyFile' :: ByteString -> ByteString -> IO () +copyFile' inputFileP outputFileP = + withPwd' inputFileP outputFileP copyFile + + +copyFileOverwrite' :: ByteString -> ByteString -> IO () +copyFileOverwrite' inputFileP outputFileP = + withPwd' inputFileP outputFileP copyFileOverwrite + + +copyDirRecursive' :: ByteString -> ByteString -> IO () +copyDirRecursive' inputDirP outputDirP = + withPwd' inputDirP outputDirP copyDirRecursive + + +copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO () +copyDirRecursiveOverwrite' inputDirP outputDirP = + withPwd' inputDirP outputDirP copyDirRecursiveOverwrite + + +createDir' :: ByteString -> IO () +createDir' dest = withPwd dest createDir + + +createRegularFile' :: ByteString -> IO () +createRegularFile' dest = withPwd dest createRegularFile + + +renameFile' :: ByteString -> ByteString -> IO () +renameFile' inputFileP outputFileP = + withPwd' inputFileP outputFileP $ \i o -> do + renameFile i o + renameFile o i + + +moveFile' :: ByteString -> ByteString -> IO () +moveFile' inputFileP outputFileP = + withPwd' inputFileP outputFileP $ \i o -> do + moveFile i o + moveFile o i + + +moveFileOverwrite' :: ByteString -> ByteString -> IO () +moveFileOverwrite' inputFileP outputFileP = + withPwd' inputFileP outputFileP $ \i o -> do + moveFileOverwrite i o + moveFile o i + + +recreateSymlink' :: ByteString -> ByteString -> IO () +recreateSymlink' inputFileP outputFileP = + withPwd' inputFileP outputFileP recreateSymlink + + +noWritableDirPerms :: ByteString -> IO () +noWritableDirPerms path = withPwd path $ \p -> + setFileMode (P.fromAbs p) perms + where + perms = ownerReadMode + `unionFileModes` ownerExecuteMode + `unionFileModes` groupReadMode + `unionFileModes` groupExecuteMode + `unionFileModes` otherReadMode + `unionFileModes` otherExecuteMode + + +noPerms :: ByteString -> IO () +noPerms path = withPwd path $ \p -> setFileMode (P.fromAbs p) nullFileMode + + +normalDirPerms :: ByteString -> IO () +normalDirPerms path = + withPwd path $ \p -> setFileMode (P.fromAbs p) newDirPerms + + +getFileType' :: ByteString -> IO FileType +getFileType' path = withPwd path getFileType + + +getDirsFiles' :: ByteString -> IO [P.Path P.Abs] +getDirsFiles' path = withPwd path getDirsFiles + + +deleteFile' :: ByteString -> IO () +deleteFile' p = withPwd p deleteFile + + +deleteDir' :: ByteString -> IO () +deleteDir' p = withPwd p deleteDir + + +deleteDirRecursive' :: ByteString -> IO () +deleteDirRecursive' p = withPwd p deleteDirRecursive + + +canonicalizePath' :: ByteString -> IO (P.Path P.Abs) +canonicalizePath' p = withPwd p canonicalizePath +