content: {-# LANGUAGE DefaultSignatures #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE TypeSynonymInstances #-}
  {-# LANGUAGE UnboxedTuples #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  {-# HLINT ignore "Use camelCase" #-}
  
  -- | 'ContentHashable' provides a hashing function suitable for use in the
  --   Funflow content store.
  --
  --   This behaves as does a normal hashing function on Haskell types. However,
  --   on path types, this instead calculates a hash based on the contents of the
  --   file or directory referenced.
  --
  --   We also export the 'ExternallyAssuredFile' and 'ExternallyAssuredDirectory'
  --   types. These instead use the path, file size and modification time to control
  --   the hash.
  module Data.CAS.ContentHashable
    ( ContentHash,
      toBytes,
      fromBytes,
      ContentHashable (..),
      contentHashUpdate_binaryFile,
      contentHashUpdate_byteArray#,
      contentHashUpdate_fingerprint,
      contentHashUpdate_primitive,
      contentHashUpdate_storable,
      FileContent (..),
      DirectoryContent (..),
      ExternallyAssuredFile (..),
      ExternallyAssuredDirectory (..),
      encodeHash,
      decodeHash,
      hashToPath,
      pathToHash,
      SHA256,
      Context,
      Digest,
    )
  where
  
  import Control.Exception.Safe (catchJust)
  import Control.Monad (foldM, (>=>))
  import Control.Monad.IO.Class (MonadIO, liftIO)
  import Crypto.Hash
    ( Context,
      Digest,
      SHA256,
      digestFromByteString,
      hashFinalize,
      hashInit,
      hashUpdate,
    )
  import qualified Data.Aeson as Aeson
  import qualified Data.Aeson.Types as Aeson
  import qualified Data.Aeson.KeyMap as Aeson
  import qualified Data.Aeson.Key as Aeson
  import Data.ByteArray
    ( Bytes,
      MemView (MemView),
      allocAndFreeze,
      convert,
    )
  import Data.ByteArray.Encoding
    ( Base (Base16),
      convertFromBase,
      convertToBase,
    )
  import qualified Data.ByteString as BS
  import Data.ByteString.Builder.Extra (defaultChunkSize)
  import qualified Data.ByteString.Char8 as C8
  import qualified Data.ByteString.Lazy as BSL
  import Data.Foldable (foldlM)
  import qualified Data.HashMap.Lazy as HashMap
  import qualified Data.HashSet as HashSet
  import qualified Data.Hashable
  import Data.Int
  import Data.List (sort)
  import Data.List.NonEmpty (NonEmpty)
  import Data.Map (Map)
  import qualified Data.Map as Map
  import Data.Ratio
  import Data.Scientific
  import qualified Data.Text as T
  import qualified Data.Text.Array as TA
  import qualified Data.Text.Encoding as TE
  import qualified Data.Text.Internal as T
  import qualified Data.Text.Lazy as TL
  import Data.Time.Clock (UTCTime)
  import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
  import Data.Typeable
  import qualified Data.Vector as V
  import qualified Data.Vector.Storable as VS
  import qualified Data.Vector.Unboxed as VU
  import Data.Word
  import Foreign.Marshal.Utils (with)
  import Foreign.Ptr (castPtr)
  import Foreign.Storable (Storable, sizeOf)
  import GHC.Fingerprint
  import GHC.Generics
  import GHC.Integer.GMP.Internals (BigNat (..), Integer (..))
  import GHC.Natural (Natural (..))
  import GHC.Prim
    ( ByteArray#,
      copyByteArrayToAddr#,
      sizeofByteArray#,
    )
  import GHC.Ptr (Ptr (Ptr))
  import GHC.Types (IO (IO), Int (I#), Word (W#))
  import qualified Path
  import qualified Path.IO
  import qualified Path.Internal
  import System.IO
    ( IOMode (ReadMode),
      withBinaryFile,
    )
  import System.IO.Error (isPermissionError)
  import System.IO.Unsafe (unsafePerformIO)
  import System.Posix.Files (fileSize, getFileStatus)
  
  newtype ContentHash = ContentHash {unContentHash :: Digest SHA256}
    deriving (Eq, Ord, Generic)
  
  instance Aeson.FromJSON ContentHash where
    parseJSON (Aeson.String s)
      | Just h <- decodeHash (TE.encodeUtf8 s) = pure h
      | otherwise = fail "Invalid hash encoding"
    parseJSON invalid =
      Aeson.typeMismatch "ContentHash" invalid
  
  instance Aeson.ToJSON ContentHash where
    toJSON = Aeson.String . TE.decodeUtf8 . encodeHash
  
  instance Data.Hashable.Hashable ContentHash where
    hashWithSalt s = Data.Hashable.hashWithSalt s . encodeHash
  
  instance Show ContentHash where
    showsPrec d h =
      showParen (d > app_prec) $
        showString "ContentHash \""
          . (showString $ C8.unpack $ encodeHash h)
          . showString "\""
      where
        app_prec = 10
  
  toBytes :: ContentHash -> BS.ByteString
  toBytes = convert . unContentHash
  
  fromBytes :: BS.ByteString -> Maybe ContentHash
  fromBytes bs = ContentHash <$> digestFromByteString bs
  
  hashEncoding :: Base
  hashEncoding = Base16
  
  -- | File path appropriate encoding of a hash
  encodeHash :: ContentHash -> BS.ByteString
  encodeHash = convertToBase hashEncoding . toBytes
  
  -- | Inverse of 'encodeHash' if given a valid input.
  --
  -- prop> decodeHash (encodeHash x) = Just x
  decodeHash :: BS.ByteString -> Maybe ContentHash
  decodeHash bs = case convertFromBase hashEncoding bs of
    Left _ -> Nothing
    Right x -> fromBytes x
  
  -- | File path appropriate encoding of a hash
  hashToPath :: ContentHash -> Path.Path Path.Rel Path.Dir
  hashToPath h =
    case Path.parseRelDir $ C8.unpack $ encodeHash h of
      Nothing ->
        error
          "[ContentHashable.hashToPath] \
          \Failed to convert hash to directory name"
      Just dir -> dir
  
  -- | Inverse of 'hashToPath' if given a valid input.
  --
  -- prop> pathToHash (hashToPath x) = Just x
  pathToHash :: FilePath -> Maybe ContentHash
  pathToHash = decodeHash . C8.pack
  
  class Monad m => ContentHashable m a where
    -- | Update a hash context based on the given value.
    --
    -- See 'Crypto.Hash.hashUpdate'.
    --
    -- XXX: Consider swapping the arguments.
    contentHashUpdate :: Context SHA256 -> a -> m (Context SHA256)
    default contentHashUpdate ::
      (Generic a, GContentHashable m (Rep a)) =>
      Context SHA256 ->
      a ->
      m (Context SHA256)
    contentHashUpdate ctx a = gContentHashUpdate ctx (from a)
  
    -- | Generate hash of the given value.
    --
    -- See 'Crypto.Hash.hash'.
    contentHash :: a -> m ContentHash
    contentHash x = ContentHash . hashFinalize <$> contentHashUpdate hashInit x
  
  -- | Update hash context based on binary in memory representation due to 'Foreign.Storable.Storable'.
  --
  -- XXX: Do we need to worry about endianness?
  contentHashUpdate_storable :: (Monad m, Storable a) => Context SHA256 -> a -> m (Context SHA256)
  contentHashUpdate_storable ctx a =
    return . unsafePerformIO $ with a (\p -> pure $! hashUpdate ctx (MemView (castPtr p) (sizeOf a)))
  
  -- | Update hash context based on a type's 'GHC.Fingerprint.Type.Fingerprint'.
  --
  -- The fingerprint is constructed from the library-name, module-name, and name of the type itself.
  contentHashUpdate_fingerprint :: (Monad m, Typeable a) => Context SHA256 -> a -> m (Context SHA256)
  contentHashUpdate_fingerprint ctx = contentHashUpdate ctx . typeRepFingerprint . typeOf
  
  -- | Update hash context by combining 'contentHashUpdate_fingerprint' and 'contentHashUpdate_storable'.
  -- Intended for primitive types like 'Int'.
  contentHashUpdate_primitive :: (Monad m, Typeable a, Storable a) => Context SHA256 -> a -> m (Context SHA256)
  contentHashUpdate_primitive ctx a =
    flip contentHashUpdate_fingerprint a >=> flip contentHashUpdate_storable a $ ctx
  
  -- | Update hash context based on binary contents of the given file.
  contentHashUpdate_binaryFile :: Context SHA256 -> FilePath -> IO (Context SHA256)
  contentHashUpdate_binaryFile ctx0 fp = withBinaryFile fp ReadMode $ \h ->
    let go ctx = do
          chunk <- BS.hGetSome h defaultChunkSize
          if BS.null chunk
            then pure ctx
            else go $! hashUpdate ctx chunk
     in go ctx0
  
  -- | Update hash context based on 'GHC.Prim.ByteArray#'
  -- by copying into a newly allocated 'Data.ByteArray.Bytes'
  -- and updating the hash context from there.
  --
  -- XXX: @'GHC.Prim.byteArrayContents#' :: 'GHC.Prim.ByteArray#' -> 'GHC.Prim.Addr#'@
  -- could be used together with 'Data.ByteArray.MemView' instead.
  -- However, 'GHC.Prim.byteArrayContents#' explicitly says, that it is only safe to use
  -- on a pinned 'GHC.Prim.ByteArray#'.
  contentHashUpdate_byteArray# :: ByteArray# -> Int -> Int -> Context SHA256 -> Context SHA256
  contentHashUpdate_byteArray# ba (I# off) (I# len) ctx = hashUpdate ctx $
    allocAndFreeze @Bytes (I# len) $ \(Ptr addr) -> IO $ \s ->
      (# copyByteArrayToAddr# ba off addr len s, () #)
  
  -- | Update hash context based on the contents of a strict 'Data.Text.Text'.
  contentHashUpdate_text :: Context SHA256 -> T.Text -> Context SHA256
  contentHashUpdate_text ctx (T.Text (TA.ByteArray arr) off len) =
    contentHashUpdate_byteArray# arr off len ctx
  
  
  instance Monad m => ContentHashable m Fingerprint where
    contentHashUpdate ctx (Fingerprint a b) = flip contentHashUpdate_storable a >=> flip contentHashUpdate_storable b $ ctx
  
  instance Monad m => ContentHashable m Bool where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Char where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Int where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Int8 where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Int16 where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Int32 where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Int64 where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Word where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Word8 where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Word16 where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Word32 where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Word64 where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Float where contentHashUpdate = contentHashUpdate_primitive
  
  instance Monad m => ContentHashable m Double where contentHashUpdate = contentHashUpdate_primitive
  
  instance (ContentHashable m n, Typeable n) => ContentHashable m (Ratio n) where
    contentHashUpdate ctx x =
      flip contentHashUpdate_fingerprint x
        >=> flip contentHashUpdate (numerator x)
        >=> flip contentHashUpdate (denominator x)
        $ ctx
  
  instance Monad m => ContentHashable m Scientific where
    contentHashUpdate ctx x =
      flip contentHashUpdate_fingerprint x
        >=> flip contentHashUpdate (toRational x)
        $ ctx
  
  instance Monad m => ContentHashable m Integer where
    contentHashUpdate ctx n =
      ($ ctx) $
        flip contentHashUpdate_fingerprint n >=> case n of
          S# i ->
            pure . flip hashUpdate (C8.pack "S") -- tag constructur
              >=> flip contentHashUpdate_storable (I# i) -- hash field
          Jp# (BN# ba) ->
            pure . flip hashUpdate (C8.pack "L") -- tag constructur
              >=> pure . contentHashUpdate_byteArray# ba 0 (I# (sizeofByteArray# ba)) -- hash field
          Jn# (BN# ba) ->
            pure . flip hashUpdate (C8.pack "N") -- tag constructur
              >=> pure . contentHashUpdate_byteArray# ba 0 (I# (sizeofByteArray# ba)) -- hash field
  
  instance Monad m => ContentHashable m Natural where
    contentHashUpdate ctx n =
      ($ ctx) $
        flip contentHashUpdate_fingerprint n >=> case n of
          NatS# w ->
            pure . flip hashUpdate (C8.pack "S") -- tag constructur
              >=> flip contentHashUpdate_storable (W# w) -- hash field
          NatJ# (BN# ba) ->
            pure . flip hashUpdate (C8.pack "L") -- tag constructur
              >=> pure . contentHashUpdate_byteArray# ba 0 (I# (sizeofByteArray# ba)) -- hash field
  
  instance Monad m => ContentHashable m BS.ByteString where
    contentHashUpdate ctx s =
      flip contentHashUpdate_fingerprint s
        >=> pure . flip hashUpdate s
        $ ctx
  
  instance Monad m => ContentHashable m BSL.ByteString where
    contentHashUpdate ctx s =
      flip contentHashUpdate_fingerprint s
        >=> pure . flip (BSL.foldlChunks hashUpdate) s
        $ ctx
  
  instance Monad m => ContentHashable m T.Text where
    contentHashUpdate ctx s =
      flip contentHashUpdate_fingerprint s
        >=> pure . flip contentHashUpdate_text s
        $ ctx
  
  instance Monad m => ContentHashable m TL.Text where
    contentHashUpdate ctx s =
      flip contentHashUpdate_fingerprint s
        >=> pure . flip (TL.foldlChunks contentHashUpdate_text) s
        $ ctx
  
  instance
    (Typeable k, Typeable v, ContentHashable m k, ContentHashable m v) =>
    ContentHashable m (Map k v)
    where
    contentHashUpdate ctx m =
      flip contentHashUpdate_fingerprint m
        >=> flip contentHashUpdate (Map.toList m)
        $ ctx
  
  instance
    (Typeable k, Typeable v, ContentHashable m k, ContentHashable m v) =>
    ContentHashable m (HashMap.HashMap k v)
    where
    contentHashUpdate ctx m =
      flip contentHashUpdate_fingerprint m
        -- XXX: The order of the list is unspecified.
        >=> flip contentHashUpdate (HashMap.toList m)
        $ ctx
  
  instance
    (Typeable v, ContentHashable m v) =>
    ContentHashable m (HashSet.HashSet v)
    where
    contentHashUpdate ctx s =
      flip contentHashUpdate_fingerprint s
        -- XXX: The order of the list is unspecified.
        >=> flip contentHashUpdate (HashSet.toList s)
        $ ctx
  
  instance
    (Typeable a, ContentHashable m a) =>
    ContentHashable m [a]
    where
    contentHashUpdate ctx l =
      flip contentHashUpdate_fingerprint l
        >=> flip (foldM contentHashUpdate) l
        $ ctx
  
  instance
    (Typeable a, ContentHashable m a) =>
    ContentHashable m (NonEmpty a)
    where
    contentHashUpdate ctx l =
      flip contentHashUpdate_fingerprint l
        >=> flip (foldlM contentHashUpdate) l
        $ ctx
  
  instance
    (Typeable a, ContentHashable m a) =>
    ContentHashable m (V.Vector a)
    where
    contentHashUpdate ctx v =
      flip contentHashUpdate_fingerprint v
        >=> flip (V.foldM' contentHashUpdate) v
        $ ctx
  
  -- TODO: Rewrite using MemView
  instance
    (Typeable a, Storable a, ContentHashable m a) =>
    ContentHashable m (VS.Vector a)
    where
    contentHashUpdate ctx v =
      flip contentHashUpdate_fingerprint v
        >=> flip (VS.foldM' contentHashUpdate) v
        $ ctx
  
  instance
    (Typeable a, VU.Unbox a, ContentHashable m a) =>
    ContentHashable m (VU.Vector a)
    where
    contentHashUpdate ctx v =
      flip contentHashUpdate_fingerprint v
        >=> flip (VU.foldM' contentHashUpdate) v
        $ ctx
  
  instance Monad m => ContentHashable m ()
  
  instance (ContentHashable m a, ContentHashable m b) => ContentHashable m (a, b)
  
  instance (ContentHashable m a, ContentHashable m b, ContentHashable m c) => ContentHashable m (a, b, c)
  
  instance (ContentHashable m a, ContentHashable m b, ContentHashable m c, ContentHashable m d) => ContentHashable m (a, b, c, d)
  
  instance (ContentHashable m a, ContentHashable m b, ContentHashable m c, ContentHashable m d, ContentHashable m e) => ContentHashable m (a, b, c, d, e)
  
  instance (Monad m, ContentHashable m a, ContentHashable m b, ContentHashable m c, ContentHashable m d, ContentHashable m e, ContentHashable m f) => ContentHashable m (a, b, c, d, e, f)
  
  instance (Monad m, ContentHashable m a, ContentHashable m b, ContentHashable m c, ContentHashable m d, ContentHashable m e, ContentHashable m f, ContentHashable m g) => ContentHashable m (a, b, c, d, e, f, g)
  
  instance ContentHashable m a => ContentHashable m (Maybe a)
  
  instance (ContentHashable m a, ContentHashable m b) => ContentHashable m (Either a b)
  
  instance Monad m => ContentHashable m Aeson.Value
  
  instance Monad m => ContentHashable m (Aeson.KeyMap Aeson.Value) where
    contentHashUpdate ctx m = contentHashUpdate ctx (Aeson.toList m)
  
  instance Monad m => ContentHashable m Aeson.Key where
    contentHashUpdate ctx k = contentHashUpdate ctx (Aeson.toText k)
  
  class Monad m => GContentHashable m f where
    gContentHashUpdate :: Context SHA256 -> f a -> m (Context SHA256)
  
  instance Monad m => GContentHashable m V1 where
    gContentHashUpdate ctx _ = pure ctx
  
  instance Monad m => GContentHashable m U1 where
    gContentHashUpdate ctx U1 = pure ctx
  
  instance ContentHashable m c => GContentHashable m (K1 i c) where
    gContentHashUpdate ctx x = contentHashUpdate ctx (unK1 x)
  
  instance (Constructor c, GContentHashable m f) => GContentHashable m (C1 c f) where
    gContentHashUpdate ctx0 x = nameCtx `seq` gContentHashUpdate nameCtx (unM1 x)
      where
        nameCtx = hashUpdate ctx0 $ C8.pack (conName x)
  
  instance (Datatype d, GContentHashable m f) => GContentHashable m (D1 d f) where
    gContentHashUpdate ctx0 x = packageCtx `seq` gContentHashUpdate packageCtx (unM1 x)
      where
        datatypeCtx = hashUpdate ctx0 $ C8.pack (datatypeName x)
        moduleCtx = hashUpdate datatypeCtx $ C8.pack (datatypeName x)
        packageCtx = hashUpdate moduleCtx $ C8.pack (datatypeName x)
  
  instance GContentHashable m f => GContentHashable m (S1 s f) where
    gContentHashUpdate ctx x = gContentHashUpdate ctx (unM1 x)
  
  instance (GContentHashable m a, GContentHashable m b) => GContentHashable m (a :*: b) where
    gContentHashUpdate ctx (x :*: y) = gContentHashUpdate ctx x >>= \ctx' -> ctx' `seq` gContentHashUpdate ctx' y
  
  instance (GContentHashable m a, GContentHashable m b) => GContentHashable m (a :+: b) where
    gContentHashUpdate ctx (L1 x) = gContentHashUpdate ctx x
    gContentHashUpdate ctx (R1 x) = gContentHashUpdate ctx x
  
  -- XXX: Do we need this?
  -- instance GContentHashable (a :.: b) where
  --   gContentHashUpdate ctx x = _ (unComp1 x)
  
  instance (Monad m, Typeable b, Typeable t) => ContentHashable m (Path.Path b t) where
    contentHashUpdate ctx p@(Path.Internal.Path fp) =
      flip contentHashUpdate_fingerprint p
        >=> flip contentHashUpdate fp
        $ ctx
  
  -- | Path to a regular file
  --
  -- Only the file's content and its executable permission is taken into account
  -- when generating the content hash. The path itself is ignored.
  newtype FileContent = FileContent (Path.Path Path.Abs Path.File)
  
  instance ContentHashable IO FileContent where
    contentHashUpdate ctx (FileContent fp) = do
      exec <- Path.IO.executable <$> Path.IO.getPermissions fp
      ctx' <- if exec then contentHashUpdate ctx () else pure ctx
      contentHashUpdate_binaryFile ctx' (Path.fromAbsFile fp)
  
  -- | Path to a directory
  --
  -- Only the contents of the directory and their path relative to the directory
  -- are taken into account when generating the content hash.
  -- The path to the directory is ignored.
  newtype DirectoryContent = DirectoryContent (Path.Path Path.Abs Path.Dir)
  
  instance MonadIO m => ContentHashable m DirectoryContent where
    contentHashUpdate ctx0 (DirectoryContent dir0) = liftIO $ do
      (dirs, files) <- Path.IO.listDir dir0
      ctx' <- foldM hashFile ctx0 (sort files)
      foldM hashDir ctx' (sort dirs)
      where
        hashFile ctx fp =
          -- XXX: Do we need to treat symbolic links specially?
          flip contentHashUpdate (Path.filename fp)
            >=> flip contentHashUpdate (FileContent fp)
            $ ctx
        hashDir ctx dir =
          flip contentHashUpdate (Path.dirname dir)
            >=> flip contentHashUpdate (DirectoryContent dir)
            $ ctx
  
  instance Monad m => ContentHashable m UTCTime where
    contentHashUpdate ctx utcTime =
      let secondsSinceEpoch = fromEnum . utcTimeToPOSIXSeconds $ utcTime
       in flip contentHashUpdate_fingerprint utcTime
            >=> flip contentHashUpdate secondsSinceEpoch
            $ ctx
  
  -- | Path to a file to be treated as _externally assured_.
  --
  --   An externally assured file is handled in a somewhat 'cheating' way by
  --   funflow. The 'ContentHashable' instance for such assumes that some external
  --   agent guarantees the integrity of the file being referenced. Thus, rather
  --   than hashing the file contents, we only consider its (absolute) path, size and
  --   modification time, which can be rapidly looked up from filesystem metadata.
  --
  --   For a similar approach, see the instance for 'ObjectInBucket' in
  --   Data.CAS.ContentHashable.S3 (in `cas-hashable-s3` package), where we
  --   exploit the fact that S3 is already content hashed to avoid performing any
  --   hashing.
  newtype ExternallyAssuredFile = ExternallyAssuredFile (Path.Path Path.Abs Path.File)
    deriving (Generic, Show)
  
  instance Aeson.FromJSON ExternallyAssuredFile
  
  instance Aeson.ToJSON ExternallyAssuredFile
  
  instance ContentHashable IO ExternallyAssuredFile where
    contentHashUpdate ctx (ExternallyAssuredFile fp) = do
      modTime <- Path.IO.getModificationTime fp
      fSize <- fileSize <$> getFileStatus (Path.toFilePath fp)
      flip contentHashUpdate fp
        >=> flip contentHashUpdate modTime
        >=> flip contentHashUpdate_storable fSize
        $ ctx
  
  -- | Path to a directory to be treated as _externally assured_.
  --
  --   For an externally assured directory, we _do_ traverse its contents and verify
  --   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)
  
  instance Aeson.FromJSON ExternallyAssuredDirectory
  
  instance Aeson.ToJSON ExternallyAssuredDirectory
  
  instance ContentHashable IO ExternallyAssuredDirectory where
    contentHashUpdate ctx0 (ExternallyAssuredDirectory dir0) = do
      -- Note that we don't bother looking at the relative directory paths and
      -- including these in the hash. This is because the absolute hash gets
      -- included every time we hash a file.
      (dirs, files) <- Path.IO.listDir dir0
      ctx' <- foldM hashFile ctx0 (sort files)
      foldM hashDir ctx' (sort dirs)
      where
        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
  