path: root/src/Control/Funflow/ContentHashable.hs
diff options
authornclarke <>2018-06-19 13:12:00 (GMT)
committerhdiff <>2018-06-19 13:12:00 (GMT)
commit1f39d7f795db9c5c259526053806cb0d6e0cbfad (patch)
tree31007fb59833b1505f7bceb8e353731a34ecf916 /src/Control/Funflow/ContentHashable.hs
parent4aade684e6d16c8fcb22b0364de3d79cf9731f45 (diff)
Diffstat (limited to 'src/Control/Funflow/ContentHashable.hs')
1 files changed, 13 insertions, 0 deletions
diff --git a/src/Control/Funflow/ContentHashable.hs b/src/Control/Funflow/ContentHashable.hs
index 44df30a..6fb41fa 100644
--- a/src/Control/Funflow/ContentHashable.hs
+++ b/src/Control/Funflow/ContentHashable.hs
@@ -49,6 +49,7 @@ module Control.Funflow.ContentHashable
) where
+import Control.Exception.Safe (catchJust)
import Control.Funflow.Orphans ()
import Control.Monad (foldM, mzero, (>=>))
import Crypto.Hash (Context, Digest, SHA256,
@@ -109,6 +110,7 @@ import qualified Path.Internal
import qualified Path.IO
import System.IO (IOMode (ReadMode),
+import System.IO.Error (isPermissionError)
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Files (fileSize, getFileStatus)
@@ -515,6 +517,13 @@ instance ContentHashable IO ExternallyAssuredFile where
-- those as we would externally assured files, rather than just relying on the
-- directory path. Doing this traversal is pretty cheap, and it's quite likely
-- for directory contents to be modified without modifying the contents.
+-- If an item in the directory cannot be read due to lacking permissions,
+-- then it will be ignored and not included in the hash. If the flow does not
+-- have permissions to access the contents of a subdirectory, then these
+-- contents cannot influence the outcome of a task and it is okay to exclude
+-- them from the hash. In that case we only hash the name, as that could
+-- influence the outcome of a task.
newtype ExternallyAssuredDirectory = ExternallyAssuredDirectory (Path.Path Path.Abs Path.Dir)
deriving (Generic, Show)
@@ -532,4 +541,8 @@ instance ContentHashable IO ExternallyAssuredDirectory where
foldM hashDir ctx' (sort dirs)
hashFile ctx fp = contentHashUpdate ctx (ExternallyAssuredFile fp)
+ `catchPermissionError` \_ -> contentHashUpdate ctx fp
hashDir ctx dir = contentHashUpdate ctx (ExternallyAssuredDirectory dir)
+ `catchPermissionError` \_ -> contentHashUpdate ctx dir
+ catchPermissionError = catchJust $ \e ->
+ if isPermissionError e then Just e else Nothing