@@ -1,25 +1,340 @@ | |||
Copyright (c) 2015–2016, FP Complete | |||
Copyright (c) 2016, Julian Ospald | |||
All rights reserved. | |||
Redistribution and use in source and binary forms, with or without | |||
modification, are permitted provided that the following conditions are met: | |||
* Redistributions of source code must retain the above copyright | |||
notice, this list of conditions and the following disclaimer. | |||
* Redistributions in binary form must reproduce the above copyright | |||
notice, this list of conditions and the following disclaimer in the | |||
documentation and/or other materials provided with the distribution. | |||
* Neither the name of paths nor the | |||
names of its contributors may be used to endorse or promote products | |||
derived from this software without specific prior written permission. | |||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND | |||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED | |||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE | |||
DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> 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. | |||
GNU GENERAL PUBLIC LICENSE | |||
Version 2, June 1991 | |||
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. | |||
<one line to give the program's name and a brief idea of what it does.> | |||
Copyright (C) <year> <name of author> | |||
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. | |||
<signature of Ty Coon>, 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. | |||
@@ -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 <hasufell@posteo.de> | |||
maintainer: Julian Ospald <hasufell@posteo.de> | |||
@@ -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 | |||
@@ -1,28 +1,778 @@ | |||
-- | | |||
-- Module : HPath.IO | |||
-- Copyright : © 2016 Julian Ospald | |||
-- License : GPL-2 | |||
-- | |||
-- Maintainer : Julian Ospald <hasufell@posteo.de> | |||
-- Stability : experimental | |||
-- Portability : portable | |||
-- | |||
-- 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 | |||
-- |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 | |||
--------------------- | |||
--[ 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 | |||
import HPath | |||
import HPath.Internal | |||
import System.Posix.Directory.Traversals (realpath) | |||
--------------------------- | |||
--[ 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 |
@@ -0,0 +1,331 @@ | |||
-- | | |||
-- Module : HPath.IO.Errors | |||
-- Copyright : © 2016 Julian Ospald | |||
-- License : GPL-2 | |||
-- | |||
-- Maintainer : Julian Ospald <hasufell@posteo.de> | |||
-- 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 |
@@ -0,0 +1,34 @@ | |||
-- | | |||
-- Module : HPath.IO.Utils | |||
-- Copyright : © 2016 Julian Ospald | |||
-- License : GPL-2 | |||
-- | |||
-- Maintainer : Julian Ospald <hasufell@posteo.de> | |||
-- 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) |
@@ -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) | |||
@@ -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 |
@@ -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 |
@@ -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 |
@@ -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 |
@@ -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) | |||
@@ -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) | |||
@@ -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) | |||
@@ -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") | |||
@@ -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) | |||
@@ -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) | |||
@@ -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) | |||
@@ -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 | |||
@@ -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 | |||
@@ -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 | |||
@@ -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 | |||
@@ -0,0 +1 @@ | |||
nothing |
@@ -0,0 +1 @@ | |||
dir |
@@ -0,0 +1 @@ | |||
file |
@@ -0,0 +1,8 @@ | |||
dadasasddas | |||
sda | |||
!!1 | |||
sda | |||
11 |
@@ -0,0 +1 @@ | |||
dadasasddas |
@@ -0,0 +1,4 @@ | |||
dadasasddas | |||
das | |||
sda | |||
sda |
@@ -0,0 +1,8 @@ | |||
dadasasddas | |||
sda | |||
!!1 | |||
sda | |||
11 |
@@ -0,0 +1 @@ | |||
dadasasddas |
@@ -0,0 +1,4 @@ | |||
dadasasddas | |||
das | |||
sda | |||
sda |
@@ -0,0 +1,8 @@ | |||
dadasasddas | |||
sda | |||
!!1 | |||
sda | |||
11 |
@@ -0,0 +1 @@ | |||
dadasasddas |
@@ -0,0 +1,4 @@ | |||
dadasasddas | |||
das | |||
sda | |||
sda |
@@ -0,0 +1 @@ | |||
inputDir/ |
@@ -0,0 +1,8 @@ | |||
dadasasddas | |||
sda | |||
!!1 | |||
sda | |||
11 |
@@ -0,0 +1 @@ | |||
dadasasddas |
@@ -0,0 +1,4 @@ | |||
dadasasddas | |||
das | |||
sda | |||
sda |
@@ -0,0 +1,8 @@ | |||
dadasasddas | |||
sda | |||
!!1 | |||
sda | |||
11 |
@@ -0,0 +1 @@ | |||
dadasasddas |
@@ -0,0 +1,4 @@ | |||
dadasasddas | |||
das | |||
sda | |||
sda |
@@ -0,0 +1 @@ | |||
inputDir/ |
@@ -0,0 +1,16 @@ | |||
adaöölsdaöl | |||
dsalö | |||
ölsda | |||
ääödsf | |||
äsdfä | |||
öä453 | |||
öä | |||
435 | |||
ä45343 | |||
5 | |||
453 | |||
453453453 | |||
das | |||
asd | |||
das | |||
@@ -0,0 +1,4 @@ | |||
abc | |||
def | |||
dsadasdsa |
@@ -0,0 +1 @@ | |||
inputFile |
@@ -0,0 +1,2 @@ | |||
abc | |||
def |
@@ -0,0 +1 @@ | |||
inputFile |
@@ -0,0 +1 @@ | |||
dir |
@@ -0,0 +1 @@ | |||
dir |
@@ -0,0 +1 @@ | |||
foo |
@@ -0,0 +1 @@ | |||
dir |
@@ -0,0 +1 @@ | |||
Lala |
@@ -0,0 +1 @@ | |||
broken |
@@ -0,0 +1 @@ | |||
regularfile |