cas-hashable-1.0.1: A hashing class for content-addressed storage

Safe HaskellNone
LanguageHaskell2010

Data.CAS.ContentHashable

Description

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.

Synopsis

Documentation

data ContentHash Source #

Instances
Eq ContentHash Source # 
Instance details

Defined in Data.CAS.ContentHashable

Ord ContentHash Source # 
Instance details

Defined in Data.CAS.ContentHashable

Show ContentHash Source # 
Instance details

Defined in Data.CAS.ContentHashable

Generic ContentHash Source # 
Instance details

Defined in Data.CAS.ContentHashable

Associated Types

type Rep ContentHash :: Type -> Type #

Hashable ContentHash Source # 
Instance details

Defined in Data.CAS.ContentHashable

ToJSON ContentHash Source # 
Instance details

Defined in Data.CAS.ContentHashable

FromJSON ContentHash Source # 
Instance details

Defined in Data.CAS.ContentHashable

type Rep ContentHash Source # 
Instance details

Defined in Data.CAS.ContentHashable

type Rep ContentHash = D1 (MetaData "ContentHash" "Data.CAS.ContentHashable" "cas-hashable-1.0.1-tAl3eFUihc4CCrYPnFOue" True) (C1 (MetaCons "ContentHash" PrefixI True) (S1 (MetaSel (Just "unContentHash") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Digest SHA256))))

class Monad m => ContentHashable m a where Source #

Minimal complete definition

Nothing

Methods

contentHashUpdate :: Context SHA256 -> a -> m (Context SHA256) Source #

Update a hash context based on the given value.

See hashUpdate.

XXX: Consider swapping the arguments.

contentHashUpdate :: (Generic a, GContentHashable m (Rep a)) => Context SHA256 -> a -> m (Context SHA256) Source #

Update a hash context based on the given value.

See hashUpdate.

XXX: Consider swapping the arguments.

contentHash :: a -> m ContentHash Source #

Generate hash of the given value.

See hash.

Instances
ContentHashable IO ExternallyAssuredDirectory Source # 
Instance details

Defined in Data.CAS.ContentHashable

ContentHashable IO ExternallyAssuredFile Source # 
Instance details

Defined in Data.CAS.ContentHashable

ContentHashable IO FileContent Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m UTCTime Source # 
Instance details

Defined in Data.CAS.ContentHashable

MonadIO m => ContentHashable m DirectoryContent Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Value Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m () Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Text Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Text Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m ByteString Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m ByteString Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Natural Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Integer Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Scientific Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Double Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Float Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Word64 Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Word32 Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Word16 Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Word8 Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Word Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Int64 Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Int32 Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Int16 Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Int8 Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Int Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Char Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Bool Source # 
Instance details

Defined in Data.CAS.ContentHashable

Monad m => ContentHashable m Fingerprint Source # 
Instance details

Defined in Data.CAS.ContentHashable

ContentHashable m a => ContentHashable m (Maybe a) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(Typeable a, ContentHashable m a) => ContentHashable m (Vector a) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(Typeable a, ContentHashable m a) => ContentHashable m (NonEmpty a) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(Typeable a, ContentHashable m a) => ContentHashable m [a] Source # 
Instance details

Defined in Data.CAS.ContentHashable

(Typeable v, ContentHashable m v) => ContentHashable m (HashSet v) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(ContentHashable m n, Typeable n) => ContentHashable m (Ratio n) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(Monad m, Typeable b, Typeable t) => ContentHashable m (Path b t) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(ContentHashable m a, ContentHashable m b) => ContentHashable m (Either a b) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(ContentHashable m a, ContentHashable m b) => ContentHashable m (a, b) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(Typeable k, Typeable v, ContentHashable m k, ContentHashable m v) => ContentHashable m (HashMap k v) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(Typeable k, Typeable v, ContentHashable m k, ContentHashable m v) => ContentHashable m (Map k v) Source # 
Instance details

Defined in Data.CAS.ContentHashable

(ContentHashable m a, ContentHashable m b, ContentHashable m c) => ContentHashable m (a, b, c) Source # 
Instance details

Defined in Data.CAS.ContentHashable

Methods

contentHashUpdate :: Context SHA256 -> (a, b, c) -> m (Context SHA256) Source #

contentHash :: (a, b, c) -> m ContentHash Source #

(ContentHashable m a, ContentHashable m b, ContentHashable m c, ContentHashable m d) => ContentHashable m (a, b, c, d) Source # 
Instance details

Defined in Data.CAS.ContentHashable

Methods

contentHashUpdate :: Context SHA256 -> (a, b, c, d) -> m (Context SHA256) Source #

contentHash :: (a, b, c, d) -> m ContentHash Source #

(ContentHashable m a, ContentHashable m b, ContentHashable m c, ContentHashable m d, ContentHashable m e) => ContentHashable m (a, b, c, d, e) Source # 
Instance details

Defined in Data.CAS.ContentHashable

Methods

contentHashUpdate :: Context SHA256 -> (a, b, c, d, e) -> m (Context SHA256) Source #

contentHash :: (a, b, c, d, e) -> m ContentHash Source #

(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) Source # 
Instance details

Defined in Data.CAS.ContentHashable

Methods

contentHashUpdate :: Context SHA256 -> (a, b, c, d, e, f) -> m (Context SHA256) Source #

contentHash :: (a, b, c, d, e, f) -> m ContentHash Source #

(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) Source # 
Instance details

Defined in Data.CAS.ContentHashable

Methods

contentHashUpdate :: Context SHA256 -> (a, b, c, d, e, f, g) -> m (Context SHA256) Source #

contentHash :: (a, b, c, d, e, f, g) -> m ContentHash Source #

contentHashUpdate_binaryFile :: Context SHA256 -> FilePath -> IO (Context SHA256) Source #

Update hash context based on binary contents of the given file.

contentHashUpdate_byteArray# :: ByteArray# -> Int -> Int -> Context SHA256 -> Context SHA256 Source #

Update hash context based on ByteArray# by copying into a newly allocated Bytes and updating the hash context from there.

XXX: byteArrayContents# :: ByteArray# -> Addr# could be used together with MemView instead. However, byteArrayContents# explicitly says, that it is only safe to use on a pinned ByteArray#.

contentHashUpdate_fingerprint :: (Monad m, Typeable a) => Context SHA256 -> a -> m (Context SHA256) Source #

Update hash context based on a type's Fingerprint.

The fingerprint is constructed from the library-name, module-name, and name of the type itself.

contentHashUpdate_primitive :: (Monad m, Typeable a, Storable a) => Context SHA256 -> a -> m (Context SHA256) Source #

Update hash context by combining contentHashUpdate_fingerprint and contentHashUpdate_storable. Intended for primitive types like Int.

contentHashUpdate_storable :: (Monad m, Storable a) => Context SHA256 -> a -> m (Context SHA256) Source #

Update hash context based on binary in memory representation due to Storable.

XXX: Do we need to worry about endianness?

newtype FileContent Source #

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.

Constructors

FileContent (Path Abs File) 

newtype DirectoryContent Source #

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.

Constructors

DirectoryContent (Path Abs Dir) 

newtype ExternallyAssuredFile Source #

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 Control.Funflow.AWS.S3, where we exploit the fact that S3 is already content hashed to avoid performing any hashing.

Instances
Show ExternallyAssuredFile Source # 
Instance details

Defined in Data.CAS.ContentHashable

Generic ExternallyAssuredFile Source # 
Instance details

Defined in Data.CAS.ContentHashable

Associated Types

type Rep ExternallyAssuredFile :: Type -> Type #

ToJSON ExternallyAssuredFile Source # 
Instance details

Defined in Data.CAS.ContentHashable

FromJSON ExternallyAssuredFile Source # 
Instance details

Defined in Data.CAS.ContentHashable

ContentHashable IO ExternallyAssuredFile Source # 
Instance details

Defined in Data.CAS.ContentHashable

type Rep ExternallyAssuredFile Source # 
Instance details

Defined in Data.CAS.ContentHashable

type Rep ExternallyAssuredFile = D1 (MetaData "ExternallyAssuredFile" "Data.CAS.ContentHashable" "cas-hashable-1.0.1-tAl3eFUihc4CCrYPnFOue" True) (C1 (MetaCons "ExternallyAssuredFile" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Path Abs File))))

newtype ExternallyAssuredDirectory Source #

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.

Instances
Show ExternallyAssuredDirectory Source # 
Instance details

Defined in Data.CAS.ContentHashable

Generic ExternallyAssuredDirectory Source # 
Instance details

Defined in Data.CAS.ContentHashable

Associated Types

type Rep ExternallyAssuredDirectory :: Type -> Type #

ToJSON ExternallyAssuredDirectory Source # 
Instance details

Defined in Data.CAS.ContentHashable

FromJSON ExternallyAssuredDirectory Source # 
Instance details

Defined in Data.CAS.ContentHashable

ContentHashable IO ExternallyAssuredDirectory Source # 
Instance details

Defined in Data.CAS.ContentHashable

type Rep ExternallyAssuredDirectory Source # 
Instance details

Defined in Data.CAS.ContentHashable

type Rep ExternallyAssuredDirectory = D1 (MetaData "ExternallyAssuredDirectory" "Data.CAS.ContentHashable" "cas-hashable-1.0.1-tAl3eFUihc4CCrYPnFOue" True) (C1 (MetaCons "ExternallyAssuredDirectory" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Path Abs Dir))))

encodeHash :: ContentHash -> ByteString Source #

File path appropriate encoding of a hash

decodeHash :: ByteString -> Maybe ContentHash Source #

Inverse of encodeHash if given a valid input.

decodeHash (encodeHash x) = Just x

hashToPath :: ContentHash -> Path Rel Dir Source #

File path appropriate encoding of a hash

pathToHash :: FilePath -> Maybe ContentHash Source #

Inverse of hashToPath if given a valid input.

pathToHash (hashToPath x) = Just x

data SHA256 #

SHA256 cryptographic hash algorithm

Instances
Data SHA256 
Instance details

Defined in Crypto.Hash.SHA256

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA256 -> c SHA256 #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA256 #

toConstr :: SHA256 -> Constr #

dataTypeOf :: SHA256 -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c SHA256) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA256) #

gmapT :: (forall b. Data b => b -> b) -> SHA256 -> SHA256 #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r #

gmapQ :: (forall d. Data d => d -> u) -> SHA256 -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA256 -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA256 -> m SHA256 #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA256 -> m SHA256 #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA256 -> m SHA256 #

Show SHA256 
Instance details

Defined in Crypto.Hash.SHA256

HashAlgorithm SHA256 
Instance details

Defined in Crypto.Hash.SHA256

type HashInternalContextSize SHA256 
Instance details

Defined in Crypto.Hash.SHA256

type HashDigestSize SHA256 
Instance details

Defined in Crypto.Hash.SHA256

type HashBlockSize SHA256 
Instance details

Defined in Crypto.Hash.SHA256

data Context a #

Represent a context for a given hash algorithm.

Instances
NFData (Context a) 
Instance details

Defined in Crypto.Hash.Types

Methods

rnf :: Context a -> () #

ByteArrayAccess (Context a) 
Instance details

Defined in Crypto.Hash.Types

Methods

length :: Context a -> Int #

withByteArray :: Context a -> (Ptr p -> IO a0) -> IO a0 #

copyByteArrayToPtr :: Context a -> Ptr p -> IO () #

data Digest a #

Represent a digest for a given hash algorithm.

This type is an instance of ByteArrayAccess from package memory. Module Data.ByteArray provides many primitives to work with those values including conversion to other types.

Creating a digest from a bytearray is also possible with function digestFromByteString.

Instances
Eq (Digest a) 
Instance details

Defined in Crypto.Hash.Types

Methods

(==) :: Digest a -> Digest a -> Bool #

(/=) :: Digest a -> Digest a -> Bool #

Data a => Data (Digest a) 
Instance details

Defined in Crypto.Hash.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Digest a -> c (Digest a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Digest a) #

toConstr :: Digest a -> Constr #

dataTypeOf :: Digest a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Digest a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Digest a)) #

gmapT :: (forall b. Data b => b -> b) -> Digest a -> Digest a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Digest a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Digest a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Digest a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Digest a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Digest a -> m (Digest a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Digest a -> m (Digest a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Digest a -> m (Digest a) #

Ord (Digest a) 
Instance details

Defined in Crypto.Hash.Types

Methods

compare :: Digest a -> Digest a -> Ordering #

(<) :: Digest a -> Digest a -> Bool #

(<=) :: Digest a -> Digest a -> Bool #

(>) :: Digest a -> Digest a -> Bool #

(>=) :: Digest a -> Digest a -> Bool #

max :: Digest a -> Digest a -> Digest a #

min :: Digest a -> Digest a -> Digest a #

HashAlgorithm a => Read (Digest a) 
Instance details

Defined in Crypto.Hash.Types

Show (Digest a) 
Instance details

Defined in Crypto.Hash.Types

Methods

showsPrec :: Int -> Digest a -> ShowS #

show :: Digest a -> String #

showList :: [Digest a] -> ShowS #

NFData (Digest a) 
Instance details

Defined in Crypto.Hash.Types

Methods

rnf :: Digest a -> () #

ByteArrayAccess (Digest a) 
Instance details

Defined in Crypto.Hash.Types

Methods

length :: Digest a -> Int #

withByteArray :: Digest a -> (Ptr p -> IO a0) -> IO a0 #

copyByteArrayToPtr :: Digest a -> Ptr p -> IO () #