{-# 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 {ContentHash -> Digest SHA256
unContentHash :: Digest SHA256}
  deriving (ContentHash -> ContentHash -> Bool
(ContentHash -> ContentHash -> Bool)
-> (ContentHash -> ContentHash -> Bool) -> Eq ContentHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentHash -> ContentHash -> Bool
$c/= :: ContentHash -> ContentHash -> Bool
== :: ContentHash -> ContentHash -> Bool
$c== :: ContentHash -> ContentHash -> Bool
Eq, Eq ContentHash
Eq ContentHash
-> (ContentHash -> ContentHash -> Ordering)
-> (ContentHash -> ContentHash -> Bool)
-> (ContentHash -> ContentHash -> Bool)
-> (ContentHash -> ContentHash -> Bool)
-> (ContentHash -> ContentHash -> Bool)
-> (ContentHash -> ContentHash -> ContentHash)
-> (ContentHash -> ContentHash -> ContentHash)
-> Ord ContentHash
ContentHash -> ContentHash -> Bool
ContentHash -> ContentHash -> Ordering
ContentHash -> ContentHash -> ContentHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContentHash -> ContentHash -> ContentHash
$cmin :: ContentHash -> ContentHash -> ContentHash
max :: ContentHash -> ContentHash -> ContentHash
$cmax :: ContentHash -> ContentHash -> ContentHash
>= :: ContentHash -> ContentHash -> Bool
$c>= :: ContentHash -> ContentHash -> Bool
> :: ContentHash -> ContentHash -> Bool
$c> :: ContentHash -> ContentHash -> Bool
<= :: ContentHash -> ContentHash -> Bool
$c<= :: ContentHash -> ContentHash -> Bool
< :: ContentHash -> ContentHash -> Bool
$c< :: ContentHash -> ContentHash -> Bool
compare :: ContentHash -> ContentHash -> Ordering
$ccompare :: ContentHash -> ContentHash -> Ordering
$cp1Ord :: Eq ContentHash
Ord, (forall x. ContentHash -> Rep ContentHash x)
-> (forall x. Rep ContentHash x -> ContentHash)
-> Generic ContentHash
forall x. Rep ContentHash x -> ContentHash
forall x. ContentHash -> Rep ContentHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentHash x -> ContentHash
$cfrom :: forall x. ContentHash -> Rep ContentHash x
Generic)

instance Aeson.FromJSON ContentHash where
  parseJSON :: Value -> Parser ContentHash
parseJSON (Aeson.String Text
s)
    | Just ContentHash
h <- ByteString -> Maybe ContentHash
decodeHash (Text -> ByteString
TE.encodeUtf8 Text
s) = ContentHash -> Parser ContentHash
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentHash
h
    | Bool
otherwise = String -> Parser ContentHash
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid hash encoding"
  parseJSON Value
invalid =
    String -> Value -> Parser ContentHash
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"ContentHash" Value
invalid

instance Aeson.ToJSON ContentHash where
  toJSON :: ContentHash -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (ContentHash -> Text) -> ContentHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ContentHash -> ByteString) -> ContentHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentHash -> ByteString
encodeHash

instance Data.Hashable.Hashable ContentHash where
  hashWithSalt :: Int -> ContentHash -> Int
hashWithSalt Int
s = Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
Data.Hashable.hashWithSalt Int
s (ByteString -> Int)
-> (ContentHash -> ByteString) -> ContentHash -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentHash -> ByteString
encodeHash

instance Show ContentHash where
  showsPrec :: Int -> ContentHash -> ShowS
showsPrec Int
d ContentHash
h =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ContentHash \""
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> String
C8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ContentHash -> ByteString
encodeHash ContentHash
h)
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\""
    where
      app_prec :: Int
app_prec = Int
10

toBytes :: ContentHash -> BS.ByteString
toBytes :: ContentHash -> ByteString
toBytes = Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA256 -> ByteString)
-> (ContentHash -> Digest SHA256) -> ContentHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentHash -> Digest SHA256
unContentHash

fromBytes :: BS.ByteString -> Maybe ContentHash
fromBytes :: ByteString -> Maybe ContentHash
fromBytes ByteString
bs = Digest SHA256 -> ContentHash
ContentHash (Digest SHA256 -> ContentHash)
-> Maybe (Digest SHA256) -> Maybe ContentHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Digest SHA256)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString ByteString
bs

hashEncoding :: Base
hashEncoding :: Base
hashEncoding = Base
Base16

-- | File path appropriate encoding of a hash
encodeHash :: ContentHash -> BS.ByteString
encodeHash :: ContentHash -> ByteString
encodeHash = Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
hashEncoding (ByteString -> ByteString)
-> (ContentHash -> ByteString) -> ContentHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentHash -> ByteString
toBytes

-- | Inverse of 'encodeHash' if given a valid input.
--
-- prop> decodeHash (encodeHash x) = Just x
decodeHash :: BS.ByteString -> Maybe ContentHash
decodeHash :: ByteString -> Maybe ContentHash
decodeHash ByteString
bs = case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
hashEncoding ByteString
bs of
  Left String
_ -> Maybe ContentHash
forall a. Maybe a
Nothing
  Right ByteString
x -> ByteString -> Maybe ContentHash
fromBytes ByteString
x

-- | File path appropriate encoding of a hash
hashToPath :: ContentHash -> Path.Path Path.Rel Path.Dir
hashToPath :: ContentHash -> Path Rel Dir
hashToPath ContentHash
h =
  case String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
Path.parseRelDir (String -> Maybe (Path Rel Dir)) -> String -> Maybe (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ ByteString -> String
C8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ContentHash -> ByteString
encodeHash ContentHash
h of
    Maybe (Path Rel Dir)
Nothing ->
      String -> Path Rel Dir
forall a. HasCallStack => String -> a
error
        String
"[ContentHashable.hashToPath] \
        \Failed to convert hash to directory name"
    Just Path Rel Dir
dir -> Path Rel Dir
dir

-- | Inverse of 'hashToPath' if given a valid input.
--
-- prop> pathToHash (hashToPath x) = Just x
pathToHash :: FilePath -> Maybe ContentHash
pathToHash :: String -> Maybe ContentHash
pathToHash = ByteString -> Maybe ContentHash
decodeHash (ByteString -> Maybe ContentHash)
-> (String -> ByteString) -> String -> Maybe ContentHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
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 Context SHA256
ctx a
a = Context SHA256 -> Rep a Any -> m (Context SHA256)
forall (m :: * -> *) (f :: * -> *) a.
GContentHashable m f =>
Context SHA256 -> f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
a)

  -- | Generate hash of the given value.
  --
  -- See 'Crypto.Hash.hash'.
  contentHash :: a -> m ContentHash
  contentHash a
x = Digest SHA256 -> ContentHash
ContentHash (Digest SHA256 -> ContentHash)
-> (Context SHA256 -> Digest SHA256)
-> Context SHA256
-> ContentHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context SHA256 -> Digest SHA256
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize (Context SHA256 -> ContentHash)
-> m (Context SHA256) -> m ContentHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context SHA256 -> a -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
forall a. HashAlgorithm a => Context a
hashInit a
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 :: Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_storable Context SHA256
ctx a
a =
  Context SHA256 -> m (Context SHA256)
forall (m :: * -> *) a. Monad m => a -> m a
return (Context SHA256 -> m (Context SHA256))
-> (IO (Context SHA256) -> Context SHA256)
-> IO (Context SHA256)
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Context SHA256) -> Context SHA256
forall a. IO a -> a
unsafePerformIO (IO (Context SHA256) -> m (Context SHA256))
-> IO (Context SHA256) -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ a -> (Ptr a -> IO (Context SHA256)) -> IO (Context SHA256)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
a (\Ptr a
p -> Context SHA256 -> IO (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> IO (Context SHA256))
-> Context SHA256 -> IO (Context SHA256)
forall a b. (a -> b) -> a -> b
$! Context SHA256 -> MemView -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context SHA256
ctx (Ptr Word8 -> Int -> MemView
MemView (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (a -> Int
forall a. Storable a => a -> Int
sizeOf a
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 :: Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Context SHA256
ctx = Context SHA256 -> Fingerprint -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx (Fingerprint -> m (Context SHA256))
-> (a -> Fingerprint) -> a -> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> Fingerprint
typeRepFingerprint (TypeRep -> Fingerprint) -> (a -> TypeRep) -> a -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TypeRep
forall a. Typeable a => a -> TypeRep
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 :: Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive Context SHA256
ctx a
a =
  (Context SHA256 -> a -> m (Context SHA256))
-> a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> a -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint a
a (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> a -> m (Context SHA256))
-> a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> a -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_storable a
a (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

-- | Update hash context based on binary contents of the given file.
contentHashUpdate_binaryFile :: Context SHA256 -> FilePath -> IO (Context SHA256)
contentHashUpdate_binaryFile :: Context SHA256 -> String -> IO (Context SHA256)
contentHashUpdate_binaryFile Context SHA256
ctx0 String
fp = String
-> IOMode -> (Handle -> IO (Context SHA256)) -> IO (Context SHA256)
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fp IOMode
ReadMode ((Handle -> IO (Context SHA256)) -> IO (Context SHA256))
-> (Handle -> IO (Context SHA256)) -> IO (Context SHA256)
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
  let go :: Context a -> IO (Context a)
go Context a
ctx = do
        ByteString
chunk <- Handle -> Int -> IO ByteString
BS.hGetSome Handle
h Int
defaultChunkSize
        if ByteString -> Bool
BS.null ByteString
chunk
          then Context a -> IO (Context a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context a
ctx
          else Context a -> IO (Context a)
go (Context a -> IO (Context a)) -> Context a -> IO (Context a)
forall a b. (a -> b) -> a -> b
$! Context a -> ByteString -> Context a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context a
ctx ByteString
chunk
   in Context SHA256 -> IO (Context SHA256)
forall a. HashAlgorithm a => Context a -> IO (Context a)
go Context SHA256
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# :: ByteArray# -> Int -> Int -> Context SHA256 -> Context SHA256
contentHashUpdate_byteArray# ByteArray#
ba (I# Int#
off) (I# Int#
len) Context SHA256
ctx = Context SHA256 -> Bytes -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context SHA256
ctx (Bytes -> Context SHA256) -> Bytes -> Context SHA256
forall a b. (a -> b) -> a -> b
$
  Int -> (Ptr Any -> IO ()) -> Bytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
allocAndFreeze @Bytes (Int# -> Int
I# Int#
len) ((Ptr Any -> IO ()) -> Bytes) -> (Ptr Any -> IO ()) -> Bytes
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
addr) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    (# ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba Int#
off Addr#
addr Int#
len State# RealWorld
s, () #)

-- | Update hash context based on the contents of a strict 'Data.Text.Text'.
contentHashUpdate_text :: Context SHA256 -> T.Text -> Context SHA256
contentHashUpdate_text :: Context SHA256 -> Text -> Context SHA256
contentHashUpdate_text Context SHA256
ctx (T.Text (TA.ByteArray ByteArray#
arr) Int
off Int
len) =
  ByteArray# -> Int -> Int -> Context SHA256 -> Context SHA256
contentHashUpdate_byteArray# ByteArray#
arr Int
off Int
len Context SHA256
ctx


instance Monad m => ContentHashable m Fingerprint where
  contentHashUpdate :: Context SHA256 -> Fingerprint -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx (Fingerprint Word64
a Word64
b) = (Context SHA256 -> Word64 -> m (Context SHA256))
-> Word64 -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Word64 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_storable Word64
a (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> Word64 -> m (Context SHA256))
-> Word64 -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Word64 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_storable Word64
b (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance Monad m => ContentHashable m Bool where contentHashUpdate :: Context SHA256 -> Bool -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Bool -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Char where contentHashUpdate :: Context SHA256 -> Char -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Char -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Int where contentHashUpdate :: Context SHA256 -> Int -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Int -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Int8 where contentHashUpdate :: Context SHA256 -> Int8 -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Int8 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Int16 where contentHashUpdate :: Context SHA256 -> Int16 -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Int16 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Int32 where contentHashUpdate :: Context SHA256 -> Int32 -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Int32 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Int64 where contentHashUpdate :: Context SHA256 -> Int64 -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Int64 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Word where contentHashUpdate :: Context SHA256 -> Word -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Word -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Word8 where contentHashUpdate :: Context SHA256 -> Word8 -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Word8 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Word16 where contentHashUpdate :: Context SHA256 -> Word16 -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Word16 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Word32 where contentHashUpdate :: Context SHA256 -> Word32 -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Word32 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Word64 where contentHashUpdate :: Context SHA256 -> Word64 -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Word64 -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Float where contentHashUpdate :: Context SHA256 -> Float -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Float -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance Monad m => ContentHashable m Double where contentHashUpdate :: Context SHA256 -> Double -> m (Context SHA256)
contentHashUpdate = Context SHA256 -> Double -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_primitive

instance (ContentHashable m n, Typeable n) => ContentHashable m (Ratio n) where
  contentHashUpdate :: Context SHA256 -> Ratio n -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Ratio n
x =
    (Context SHA256 -> Ratio n -> m (Context SHA256))
-> Ratio n -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Ratio n -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Ratio n
x
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> n -> m (Context SHA256))
-> n -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> n -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (Ratio n -> n
forall a. Ratio a -> a
numerator Ratio n
x)
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> n -> m (Context SHA256))
-> n -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> n -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (Ratio n -> n
forall a. Ratio a -> a
denominator Ratio n
x)
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance Monad m => ContentHashable m Scientific where
  contentHashUpdate :: Context SHA256 -> Scientific -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Scientific
x =
    (Context SHA256 -> Scientific -> m (Context SHA256))
-> Scientific -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Scientific -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Scientific
x
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> Rational -> m (Context SHA256))
-> Rational -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Rational -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (Scientific -> Rational
forall a. Real a => a -> Rational
toRational Scientific
x)
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance Monad m => ContentHashable m Integer where
  contentHashUpdate :: Context SHA256 -> Integer -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Integer
n =
    ((Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx) ((Context SHA256 -> m (Context SHA256)) -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256)) -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$
      (Context SHA256 -> Integer -> m (Context SHA256))
-> Integer -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Integer -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Integer
n (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> case Integer
n of
        S# Int#
i ->
          Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> ByteString -> Context SHA256)
-> ByteString -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate (String -> ByteString
C8.pack String
"S") -- tag constructur
            (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> Int -> m (Context SHA256))
-> Int -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Int -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_storable (Int# -> Int
I# Int#
i) -- hash field
        Jp# (BN# ByteArray#
ba) ->
          Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> ByteString -> Context SHA256)
-> ByteString -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate (String -> ByteString
C8.pack String
"L") -- tag constructur
            (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray# -> Int -> Int -> Context SHA256 -> Context SHA256
contentHashUpdate_byteArray# ByteArray#
ba Int
0 (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba)) -- hash field
        Jn# (BN# ByteArray#
ba) ->
          Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> ByteString -> Context SHA256)
-> ByteString -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate (String -> ByteString
C8.pack String
"N") -- tag constructur
            (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray# -> Int -> Int -> Context SHA256 -> Context SHA256
contentHashUpdate_byteArray# ByteArray#
ba Int
0 (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba)) -- hash field

instance Monad m => ContentHashable m Natural where
  contentHashUpdate :: Context SHA256 -> Natural -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Natural
n =
    ((Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx) ((Context SHA256 -> m (Context SHA256)) -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256)) -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$
      (Context SHA256 -> Natural -> m (Context SHA256))
-> Natural -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Natural -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Natural
n (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> case Natural
n of
        NatS# GmpLimb#
w ->
          Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> ByteString -> Context SHA256)
-> ByteString -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate (String -> ByteString
C8.pack String
"S") -- tag constructur
            (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> Word -> m (Context SHA256))
-> Word -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Word -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_storable (GmpLimb# -> Word
W# GmpLimb#
w) -- hash field
        NatJ# (BN# ByteArray#
ba) ->
          Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> ByteString -> Context SHA256)
-> ByteString -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate (String -> ByteString
C8.pack String
"L") -- tag constructur
            (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray# -> Int -> Int -> Context SHA256 -> Context SHA256
contentHashUpdate_byteArray# ByteArray#
ba Int
0 (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba)) -- hash field

instance Monad m => ContentHashable m BS.ByteString where
  contentHashUpdate :: Context SHA256 -> ByteString -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx ByteString
s =
    (Context SHA256 -> ByteString -> m (Context SHA256))
-> ByteString -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> ByteString -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint ByteString
s
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> ByteString -> Context SHA256)
-> ByteString -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate ByteString
s
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance Monad m => ContentHashable m BSL.ByteString where
  contentHashUpdate :: Context SHA256 -> ByteString -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx ByteString
s =
    (Context SHA256 -> ByteString -> m (Context SHA256))
-> ByteString -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> ByteString -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint ByteString
s
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> ByteString -> Context SHA256)
-> ByteString -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Context SHA256 -> ByteString -> Context SHA256)
-> Context SHA256 -> ByteString -> Context SHA256
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
BSL.foldlChunks Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate) ByteString
s
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance Monad m => ContentHashable m T.Text where
  contentHashUpdate :: Context SHA256 -> Text -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Text
s =
    (Context SHA256 -> Text -> m (Context SHA256))
-> Text -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Text -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Text
s
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> Text -> Context SHA256)
-> Text -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Text -> Context SHA256
contentHashUpdate_text Text
s
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance Monad m => ContentHashable m TL.Text where
  contentHashUpdate :: Context SHA256 -> Text -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Text
s =
    (Context SHA256 -> Text -> m (Context SHA256))
-> Text -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Text -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Text
s
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> Context SHA256)
-> Context SHA256
-> m (Context SHA256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> Text -> Context SHA256)
-> Text -> Context SHA256 -> Context SHA256
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Context SHA256 -> Text -> Context SHA256)
-> Context SHA256 -> Text -> Context SHA256
forall a. (a -> Text -> a) -> a -> Text -> a
TL.foldlChunks Context SHA256 -> Text -> Context SHA256
contentHashUpdate_text) Text
s
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance
  (Typeable k, Typeable v, ContentHashable m k, ContentHashable m v) =>
  ContentHashable m (Map k v)
  where
  contentHashUpdate :: Context SHA256 -> Map k v -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Map k v
m =
    (Context SHA256 -> Map k v -> m (Context SHA256))
-> Map k v -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Map k v -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Map k v
m
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> [(k, v)] -> m (Context SHA256))
-> [(k, v)] -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> [(k, v)] -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m)
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance
  (Typeable k, Typeable v, ContentHashable m k, ContentHashable m v) =>
  ContentHashable m (HashMap.HashMap k v)
  where
  contentHashUpdate :: Context SHA256 -> HashMap k v -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx HashMap k v
m =
    (Context SHA256 -> HashMap k v -> m (Context SHA256))
-> HashMap k v -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> HashMap k v -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint HashMap k v
m
      -- XXX: The order of the list is unspecified.
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> [(k, v)] -> m (Context SHA256))
-> [(k, v)] -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> [(k, v)] -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap k v
m)
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance
  (Typeable v, ContentHashable m v) =>
  ContentHashable m (HashSet.HashSet v)
  where
  contentHashUpdate :: Context SHA256 -> HashSet v -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx HashSet v
s =
    (Context SHA256 -> HashSet v -> m (Context SHA256))
-> HashSet v -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> HashSet v -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint HashSet v
s
      -- XXX: The order of the list is unspecified.
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> [v] -> m (Context SHA256))
-> [v] -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> [v] -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (HashSet v -> [v]
forall a. HashSet a -> [a]
HashSet.toList HashSet v
s)
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance
  (Typeable a, ContentHashable m a) =>
  ContentHashable m [a]
  where
  contentHashUpdate :: Context SHA256 -> [a] -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx [a]
l =
    (Context SHA256 -> [a] -> m (Context SHA256))
-> [a] -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> [a] -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint [a]
l
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> [a] -> m (Context SHA256))
-> [a] -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Context SHA256 -> a -> m (Context SHA256))
-> Context SHA256 -> [a] -> m (Context SHA256)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Context SHA256 -> a -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate) [a]
l
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance
  (Typeable a, ContentHashable m a) =>
  ContentHashable m (NonEmpty a)
  where
  contentHashUpdate :: Context SHA256 -> NonEmpty a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx NonEmpty a
l =
    (Context SHA256 -> NonEmpty a -> m (Context SHA256))
-> NonEmpty a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> NonEmpty a -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint NonEmpty a
l
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> NonEmpty a -> m (Context SHA256))
-> NonEmpty a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Context SHA256 -> a -> m (Context SHA256))
-> Context SHA256 -> NonEmpty a -> m (Context SHA256)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Context SHA256 -> a -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate) NonEmpty a
l
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance
  (Typeable a, ContentHashable m a) =>
  ContentHashable m (V.Vector a)
  where
  contentHashUpdate :: Context SHA256 -> Vector a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Vector a
v =
    (Context SHA256 -> Vector a -> m (Context SHA256))
-> Vector a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Vector a -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Vector a
v
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> Vector a -> m (Context SHA256))
-> Vector a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Context SHA256 -> a -> m (Context SHA256))
-> Context SHA256 -> Vector a -> m (Context SHA256)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
V.foldM' Context SHA256 -> a -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate) Vector a
v
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

-- TODO: Rewrite using MemView
instance
  (Typeable a, Storable a, ContentHashable m a) =>
  ContentHashable m (VS.Vector a)
  where
  contentHashUpdate :: Context SHA256 -> Vector a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Vector a
v =
    (Context SHA256 -> Vector a -> m (Context SHA256))
-> Vector a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Vector a -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Vector a
v
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> Vector a -> m (Context SHA256))
-> Vector a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Context SHA256 -> a -> m (Context SHA256))
-> Context SHA256 -> Vector a -> m (Context SHA256)
forall (m :: * -> *) b a.
(Monad m, Storable b) =>
(a -> b -> m a) -> a -> Vector b -> m a
VS.foldM' Context SHA256 -> a -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate) Vector a
v
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance
  (Typeable a, VU.Unbox a, ContentHashable m a) =>
  ContentHashable m (VU.Vector a)
  where
  contentHashUpdate :: Context SHA256 -> Vector a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Vector a
v =
    (Context SHA256 -> Vector a -> m (Context SHA256))
-> Vector a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Vector a -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Vector a
v
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> Vector a -> m (Context SHA256))
-> Vector a -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Context SHA256 -> a -> m (Context SHA256))
-> Context SHA256 -> Vector a -> m (Context SHA256)
forall (m :: * -> *) b a.
(Monad m, Unbox b) =>
(a -> b -> m a) -> a -> Vector b -> m a
VU.foldM' Context SHA256 -> a -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate) Vector a
v
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
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 :: Context SHA256 -> KeyMap Value -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx KeyMap Value
m = Context SHA256 -> [(Key, Value)] -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
Aeson.toList KeyMap Value
m)

instance Monad m => ContentHashable m Aeson.Key where
  contentHashUpdate :: Context SHA256 -> Key -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Key
k = Context SHA256 -> Text -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx (Key -> Text
Aeson.toText Key
k)

class Monad m => GContentHashable m f where
  gContentHashUpdate :: Context SHA256 -> f a -> m (Context SHA256)

instance Monad m => GContentHashable m V1 where
  gContentHashUpdate :: Context SHA256 -> V1 a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx V1 a
_ = Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context SHA256
ctx

instance Monad m => GContentHashable m U1 where
  gContentHashUpdate :: Context SHA256 -> U1 a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx U1 a
U1 = Context SHA256 -> m (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context SHA256
ctx

instance ContentHashable m c => GContentHashable m (K1 i c) where
  gContentHashUpdate :: Context SHA256 -> K1 i c a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx K1 i c a
x = Context SHA256 -> c -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx (K1 i c a -> c
forall i c k (p :: k). K1 i c p -> c
unK1 K1 i c a
x)

instance (Constructor c, GContentHashable m f) => GContentHashable m (C1 c f) where
  gContentHashUpdate :: Context SHA256 -> C1 c f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx0 C1 c f a
x = Context SHA256
nameCtx Context SHA256 -> m (Context SHA256) -> m (Context SHA256)
`seq` Context SHA256 -> f a -> m (Context SHA256)
forall (m :: * -> *) (f :: * -> *) a.
GContentHashable m f =>
Context SHA256 -> f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
nameCtx (C1 c f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 C1 c f a
x)
    where
      nameCtx :: Context SHA256
nameCtx = Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context SHA256
ctx0 (ByteString -> Context SHA256) -> ByteString -> Context SHA256
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack (C1 c f a -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName C1 c f a
x)

instance (Datatype d, GContentHashable m f) => GContentHashable m (D1 d f) where
  gContentHashUpdate :: Context SHA256 -> D1 d f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx0 D1 d f a
x = Context SHA256
packageCtx Context SHA256 -> m (Context SHA256) -> m (Context SHA256)
`seq` Context SHA256 -> f a -> m (Context SHA256)
forall (m :: * -> *) (f :: * -> *) a.
GContentHashable m f =>
Context SHA256 -> f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
packageCtx (D1 d f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 D1 d f a
x)
    where
      datatypeCtx :: Context SHA256
datatypeCtx = Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context SHA256
ctx0 (ByteString -> Context SHA256) -> ByteString -> Context SHA256
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack (D1 d f a -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName D1 d f a
x)
      moduleCtx :: Context SHA256
moduleCtx = Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context SHA256
datatypeCtx (ByteString -> Context SHA256) -> ByteString -> Context SHA256
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack (D1 d f a -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName D1 d f a
x)
      packageCtx :: Context SHA256
packageCtx = Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context SHA256
moduleCtx (ByteString -> Context SHA256) -> ByteString -> Context SHA256
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack (D1 d f a -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName D1 d f a
x)

instance GContentHashable m f => GContentHashable m (S1 s f) where
  gContentHashUpdate :: Context SHA256 -> S1 s f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx S1 s f a
x = Context SHA256 -> f a -> m (Context SHA256)
forall (m :: * -> *) (f :: * -> *) a.
GContentHashable m f =>
Context SHA256 -> f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx (S1 s f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 S1 s f a
x)

instance (GContentHashable m a, GContentHashable m b) => GContentHashable m (a :*: b) where
  gContentHashUpdate :: Context SHA256 -> (:*:) a b a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx (a a
x :*: b a
y) = Context SHA256 -> a a -> m (Context SHA256)
forall (m :: * -> *) (f :: * -> *) a.
GContentHashable m f =>
Context SHA256 -> f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx a a
x m (Context SHA256)
-> (Context SHA256 -> m (Context SHA256)) -> m (Context SHA256)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Context SHA256
ctx' -> Context SHA256
ctx' Context SHA256 -> m (Context SHA256) -> m (Context SHA256)
`seq` Context SHA256 -> b a -> m (Context SHA256)
forall (m :: * -> *) (f :: * -> *) a.
GContentHashable m f =>
Context SHA256 -> f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx' b a
y

instance (GContentHashable m a, GContentHashable m b) => GContentHashable m (a :+: b) where
  gContentHashUpdate :: Context SHA256 -> (:+:) a b a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx (L1 a a
x) = Context SHA256 -> a a -> m (Context SHA256)
forall (m :: * -> *) (f :: * -> *) a.
GContentHashable m f =>
Context SHA256 -> f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx a a
x
  gContentHashUpdate Context SHA256
ctx (R1 b a
x) = Context SHA256 -> b a -> m (Context SHA256)
forall (m :: * -> *) (f :: * -> *) a.
GContentHashable m f =>
Context SHA256 -> f a -> m (Context SHA256)
gContentHashUpdate Context SHA256
ctx b a
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 :: Context SHA256 -> Path b t -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx p :: Path b t
p@(Path.Internal.Path String
fp) =
    (Context SHA256 -> Path b t -> m (Context SHA256))
-> Path b t -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Path b t -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint Path b t
p
      (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> String -> m (Context SHA256))
-> String -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> String -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate String
fp
      (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
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 :: Context SHA256 -> FileContent -> IO (Context SHA256)
contentHashUpdate Context SHA256
ctx (FileContent Path Abs File
fp) = do
    Bool
exec <- Permissions -> Bool
Path.IO.executable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs File -> IO Permissions
forall (m :: * -> *) b t. MonadIO m => Path b t -> m Permissions
Path.IO.getPermissions Path Abs File
fp
    Context SHA256
ctx' <- if Bool
exec then Context SHA256 -> () -> IO (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx () else Context SHA256 -> IO (Context SHA256)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context SHA256
ctx
    Context SHA256 -> String -> IO (Context SHA256)
contentHashUpdate_binaryFile Context SHA256
ctx' (Path Abs File -> String
Path.fromAbsFile Path Abs File
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 :: Context SHA256 -> DirectoryContent -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx0 (DirectoryContent Path Abs Dir
dir0) = IO (Context SHA256) -> m (Context SHA256)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Context SHA256) -> m (Context SHA256))
-> IO (Context SHA256) -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ do
    ([Path Abs Dir]
dirs, [Path Abs File]
files) <- Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
Path.IO.listDir Path Abs Dir
dir0
    Context SHA256
ctx' <- (Context SHA256 -> Path Abs File -> IO (Context SHA256))
-> Context SHA256 -> [Path Abs File] -> IO (Context SHA256)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Context SHA256 -> Path Abs File -> IO (Context SHA256)
forall (m :: * -> *).
ContentHashable m FileContent =>
Context SHA256 -> Path Abs File -> m (Context SHA256)
hashFile Context SHA256
ctx0 ([Path Abs File] -> [Path Abs File]
forall a. Ord a => [a] -> [a]
sort [Path Abs File]
files)
    (Context SHA256 -> Path Abs Dir -> IO (Context SHA256))
-> Context SHA256 -> [Path Abs Dir] -> IO (Context SHA256)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Context SHA256 -> Path Abs Dir -> IO (Context SHA256)
forall (m :: * -> *).
MonadIO m =>
Context SHA256 -> Path Abs Dir -> m (Context SHA256)
hashDir Context SHA256
ctx' ([Path Abs Dir] -> [Path Abs Dir]
forall a. Ord a => [a] -> [a]
sort [Path Abs Dir]
dirs)
    where
      hashFile :: Context SHA256 -> Path Abs File -> m (Context SHA256)
hashFile Context SHA256
ctx Path Abs File
fp =
        -- XXX: Do we need to treat symbolic links specially?
        (Context SHA256 -> Path Rel File -> m (Context SHA256))
-> Path Rel File -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Path Rel File -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
Path.filename Path Abs File
fp)
          (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> FileContent -> m (Context SHA256))
-> FileContent -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> FileContent -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (Path Abs File -> FileContent
FileContent Path Abs File
fp)
          (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx
      hashDir :: Context SHA256 -> Path Abs Dir -> m (Context SHA256)
hashDir Context SHA256
ctx Path Abs Dir
dir =
        (Context SHA256 -> Path Rel Dir -> m (Context SHA256))
-> Path Rel Dir -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Path Rel Dir -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
Path.dirname Path Abs Dir
dir)
          (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> DirectoryContent -> m (Context SHA256))
-> DirectoryContent -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> DirectoryContent -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate (Path Abs Dir -> DirectoryContent
DirectoryContent Path Abs Dir
dir)
          (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
ctx

instance Monad m => ContentHashable m UTCTime where
  contentHashUpdate :: Context SHA256 -> UTCTime -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx UTCTime
utcTime =
    let secondsSinceEpoch :: Int
secondsSinceEpoch = POSIXTime -> Int
forall a. Enum a => a -> Int
fromEnum (POSIXTime -> Int) -> (UTCTime -> POSIXTime) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> Int) -> UTCTime -> Int
forall a b. (a -> b) -> a -> b
$ UTCTime
utcTime
     in (Context SHA256 -> UTCTime -> m (Context SHA256))
-> UTCTime -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> UTCTime -> m (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Typeable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_fingerprint UTCTime
utcTime
          (Context SHA256 -> m (Context SHA256))
-> (Context SHA256 -> m (Context SHA256))
-> Context SHA256
-> m (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> Int -> m (Context SHA256))
-> Int -> Context SHA256 -> m (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Int -> m (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Int
secondsSinceEpoch
          (Context SHA256 -> m (Context SHA256))
-> Context SHA256 -> m (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
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 ((forall x. ExternallyAssuredFile -> Rep ExternallyAssuredFile x)
-> (forall x. Rep ExternallyAssuredFile x -> ExternallyAssuredFile)
-> Generic ExternallyAssuredFile
forall x. Rep ExternallyAssuredFile x -> ExternallyAssuredFile
forall x. ExternallyAssuredFile -> Rep ExternallyAssuredFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExternallyAssuredFile x -> ExternallyAssuredFile
$cfrom :: forall x. ExternallyAssuredFile -> Rep ExternallyAssuredFile x
Generic, Int -> ExternallyAssuredFile -> ShowS
[ExternallyAssuredFile] -> ShowS
ExternallyAssuredFile -> String
(Int -> ExternallyAssuredFile -> ShowS)
-> (ExternallyAssuredFile -> String)
-> ([ExternallyAssuredFile] -> ShowS)
-> Show ExternallyAssuredFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternallyAssuredFile] -> ShowS
$cshowList :: [ExternallyAssuredFile] -> ShowS
show :: ExternallyAssuredFile -> String
$cshow :: ExternallyAssuredFile -> String
showsPrec :: Int -> ExternallyAssuredFile -> ShowS
$cshowsPrec :: Int -> ExternallyAssuredFile -> ShowS
Show)

instance Aeson.FromJSON ExternallyAssuredFile

instance Aeson.ToJSON ExternallyAssuredFile

instance ContentHashable IO ExternallyAssuredFile where
  contentHashUpdate :: Context SHA256 -> ExternallyAssuredFile -> IO (Context SHA256)
contentHashUpdate Context SHA256
ctx (ExternallyAssuredFile Path Abs File
fp) = do
    UTCTime
modTime <- Path Abs File -> IO UTCTime
forall (m :: * -> *) b t. MonadIO m => Path b t -> m UTCTime
Path.IO.getModificationTime Path Abs File
fp
    FileOffset
fSize <- FileStatus -> FileOffset
fileSize (FileStatus -> FileOffset) -> IO FileStatus -> IO FileOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus (Path Abs File -> String
forall b t. Path b t -> String
Path.toFilePath Path Abs File
fp)
    (Context SHA256 -> Path Abs File -> IO (Context SHA256))
-> Path Abs File -> Context SHA256 -> IO (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> Path Abs File -> IO (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Path Abs File
fp
      (Context SHA256 -> IO (Context SHA256))
-> (Context SHA256 -> IO (Context SHA256))
-> Context SHA256
-> IO (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> UTCTime -> IO (Context SHA256))
-> UTCTime -> Context SHA256 -> IO (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> UTCTime -> IO (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate UTCTime
modTime
      (Context SHA256 -> IO (Context SHA256))
-> (Context SHA256 -> IO (Context SHA256))
-> Context SHA256
-> IO (Context SHA256)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Context SHA256 -> FileOffset -> IO (Context SHA256))
-> FileOffset -> Context SHA256 -> IO (Context SHA256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Context SHA256 -> FileOffset -> IO (Context SHA256)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate_storable FileOffset
fSize
      (Context SHA256 -> IO (Context SHA256))
-> Context SHA256 -> IO (Context SHA256)
forall a b. (a -> b) -> a -> b
$ Context SHA256
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 ((forall x.
 ExternallyAssuredDirectory -> Rep ExternallyAssuredDirectory x)
-> (forall x.
    Rep ExternallyAssuredDirectory x -> ExternallyAssuredDirectory)
-> Generic ExternallyAssuredDirectory
forall x.
Rep ExternallyAssuredDirectory x -> ExternallyAssuredDirectory
forall x.
ExternallyAssuredDirectory -> Rep ExternallyAssuredDirectory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExternallyAssuredDirectory x -> ExternallyAssuredDirectory
$cfrom :: forall x.
ExternallyAssuredDirectory -> Rep ExternallyAssuredDirectory x
Generic, Int -> ExternallyAssuredDirectory -> ShowS
[ExternallyAssuredDirectory] -> ShowS
ExternallyAssuredDirectory -> String
(Int -> ExternallyAssuredDirectory -> ShowS)
-> (ExternallyAssuredDirectory -> String)
-> ([ExternallyAssuredDirectory] -> ShowS)
-> Show ExternallyAssuredDirectory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternallyAssuredDirectory] -> ShowS
$cshowList :: [ExternallyAssuredDirectory] -> ShowS
show :: ExternallyAssuredDirectory -> String
$cshow :: ExternallyAssuredDirectory -> String
showsPrec :: Int -> ExternallyAssuredDirectory -> ShowS
$cshowsPrec :: Int -> ExternallyAssuredDirectory -> ShowS
Show)

instance Aeson.FromJSON ExternallyAssuredDirectory

instance Aeson.ToJSON ExternallyAssuredDirectory

instance ContentHashable IO ExternallyAssuredDirectory where
  contentHashUpdate :: Context SHA256 -> ExternallyAssuredDirectory -> IO (Context SHA256)
contentHashUpdate Context SHA256
ctx0 (ExternallyAssuredDirectory Path Abs Dir
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.
    ([Path Abs Dir]
dirs, [Path Abs File]
files) <- Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
Path.IO.listDir Path Abs Dir
dir0
    Context SHA256
ctx' <- (Context SHA256 -> Path Abs File -> IO (Context SHA256))
-> Context SHA256 -> [Path Abs File] -> IO (Context SHA256)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Context SHA256 -> Path Abs File -> IO (Context SHA256)
hashFile Context SHA256
ctx0 ([Path Abs File] -> [Path Abs File]
forall a. Ord a => [a] -> [a]
sort [Path Abs File]
files)
    (Context SHA256 -> Path Abs Dir -> IO (Context SHA256))
-> Context SHA256 -> [Path Abs Dir] -> IO (Context SHA256)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Context SHA256 -> Path Abs Dir -> IO (Context SHA256)
hashDir Context SHA256
ctx' ([Path Abs Dir] -> [Path Abs Dir]
forall a. Ord a => [a] -> [a]
sort [Path Abs Dir]
dirs)
    where
      hashFile :: Context SHA256 -> Path Abs File -> IO (Context SHA256)
hashFile Context SHA256
ctx Path Abs File
fp =
        Context SHA256 -> ExternallyAssuredFile -> IO (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx (Path Abs File -> ExternallyAssuredFile
ExternallyAssuredFile Path Abs File
fp)
          IO (Context SHA256)
-> (IOError -> IO (Context SHA256)) -> IO (Context SHA256)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchPermissionError` \IOError
_ -> Context SHA256 -> Path Abs File -> IO (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Path Abs File
fp
      hashDir :: Context SHA256 -> Path Abs Dir -> IO (Context SHA256)
hashDir Context SHA256
ctx Path Abs Dir
dir =
        Context SHA256 -> ExternallyAssuredDirectory -> IO (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx (Path Abs Dir -> ExternallyAssuredDirectory
ExternallyAssuredDirectory Path Abs Dir
dir)
          IO (Context SHA256)
-> (IOError -> IO (Context SHA256)) -> IO (Context SHA256)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchPermissionError` \IOError
_ -> Context SHA256 -> Path Abs Dir -> IO (Context SHA256)
forall (m :: * -> *) a.
ContentHashable m a =>
Context SHA256 -> a -> m (Context SHA256)
contentHashUpdate Context SHA256
ctx Path Abs Dir
dir
      catchPermissionError :: IO a -> (IOError -> IO a) -> IO a
catchPermissionError = (IOError -> Maybe IOError) -> IO a -> (IOError -> IO a) -> IO a
forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust ((IOError -> Maybe IOError) -> IO a -> (IOError -> IO a) -> IO a)
-> (IOError -> Maybe IOError) -> IO a -> (IOError -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \IOError
e ->
        if IOError -> Bool
isPermissionError IOError
e then IOError -> Maybe IOError
forall a. a -> Maybe a
Just IOError
e else Maybe IOError
forall a. Maybe a
Nothing