cas-store-1.0.1: A content-addressed storage

Safe HaskellNone
LanguageHaskell2010

Data.CAS.ContentStore

Contents

Description

Hash addressed store in file system.

Associates a key (ContentHash) with an item in the store. An item can either be Missing, Pending, or Complete. The state is persisted in the file system.

Items are stored under a path derived from their hash. Therefore, there can be no two copies of the same item in the store. If two keys are associated with the same item, then there will be only one copy of that item in the store.

The store is thread-safe and multi-process safe.

It is assumed that the user that the process is running under is the owner of the store root, or has permission to create it if missing.

It is assumed that the store root and its immediate contents are not modified externally. The contents of pending items may be modified externally.

Implementation notes:

The hash of an item can only be determined once it is completed. If that hash already exists in the store, then the new item is discarded.

Store state is persisted in the file-system:

  • Pending items are stored writable under the path pending-<key>.
  • Complete items are stored read-only under the path item-<hash>, with a link under complete-<key> pointing to that directory.
Synopsis

Open/Close

withStore :: (MonadIO m, MonadMask m) => Path Abs Dir -> (ContentStore -> m a) -> m a Source #

Open the store under the given root and perform the given action. Closes the store once the action is complete

See also: open

open :: Path Abs Dir -> IO ContentStore Source #

open root opens a store under the given root directory.

The root directory is created if necessary.

It is not safe to have multiple store objects refer to the same root directory.

close :: ContentStore -> IO () Source #

Free the resources associated with the given store object.

The store object may not be used afterwards.

High-level API

data CacherM m i o Source #

A cacher is responsible for controlling how steps are cached.

Constructors

NoCache

This step cannot be cached (default).

Cache 

Fields

defaultCacherWithIdent Source #

Arguments

:: (ContentHashable m i, Store o) 
=> Int

Seed for the cacher

-> CacherM m i o 

Constructs a Cacher that will use hashability of input and serializability of output to make a step cacheable

defaultIOCacherWithIdent Source #

Arguments

:: (MonadIO m, ContentHashable IO i, Store o) 
=> Int

Seed for the cacher

-> CacherM m i o 

Looks for a CacherM IO, then lifts it

cacheKleisliIO Source #

Arguments

:: (MonadIO m, MonadBaseControl IO m, MonadMask m, Cacher m remoteCache) 
=> Maybe Int

This can be used to disambiguate the same program run in multiple configurations. If Nothing, then it means this program has no identity, this implies that steps will be executed without cache, even if Cache has been given.

-> CacherM m i o 
-> ContentStore 
-> remoteCache 
-> (i -> m o) 
-> i 
-> m o 

Caches a Kleisli of some MonadIO action in the store given the required properties

putInStore Source #

Arguments

:: (MonadIO m, MonadMask m, MonadBaseControl IO m, Cacher m remoteCacher, ContentHashable IO t) 
=> ContentStore 
-> remoteCacher 
-> (ContentHash -> m ())

In case an exception occurs

-> (Path Abs Dir -> t -> m ())

The action that writes to the new store directory

-> t 
-> m Item

The Item in the store to which t has been written

Caches an action that writes content-addressed data to the store. Returns the Item of the written content.

contentPath :: ContentStore -> Content t -> Path Abs t Source #

The absolute path to content within the store.

List Contents

listAll :: MonadIO m => ContentStore -> m ([ContentHash], [ContentHash], [Item]) Source #

List all elements in the store (pending keys, completed keys, completed items).

listPending :: MonadIO m => ContentStore -> m [ContentHash] Source #

List all pending keys in the store.

listComplete :: MonadIO m => ContentStore -> m [ContentHash] Source #

List all completed keys in the store.

listItems :: MonadIO m => ContentStore -> m [Item] Source #

List all completed items in the store.

Query/Lookup

query :: MonadIO m => ContentStore -> ContentHash -> m (Status () () ()) Source #

Query the state of the item under the given key.

isMissing :: MonadIO m => ContentStore -> ContentHash -> m Bool Source #

Check if there is no complete or pending item under the given key.

isPending :: MonadIO m => ContentStore -> ContentHash -> m Bool Source #

Check if there is a pending item under the given key.

isComplete :: MonadIO m => ContentStore -> ContentHash -> m Bool Source #

Check if there is a completed item under the given key.

lookup :: MonadIO m => ContentStore -> ContentHash -> m (Status () () Item) Source #

Query the state under the given key and return the item if completed. Doesn't block if the item is pending.

lookupOrWait :: MonadIO m => ContentStore -> ContentHash -> m (Status () (Async Update) Item) Source #

Query the state under the given key and return the item if completed. Return an Async to await an update, if pending.

waitUntilComplete :: MonadIO m => ContentStore -> ContentHash -> m (Maybe Item) Source #

Query the state under the given key and return the item once completed. Blocks if the item is pending. Returns Nothing if the item is missing, or failed to be completed.

Construct Items

constructOrAsync :: forall m remoteCache. (MonadIO m, MonadBaseControl IO m, MonadMask m, Cacher m remoteCache) => ContentStore -> remoteCache -> ContentHash -> m (Status (Path Abs Dir) (Async Update) Item) Source #

Atomically query the state under the given key and mark pending if missing.

Returns Complete item if the item is complete. Returns Pending async if the item is pending, where async is an Async to await updates on. Returns Missing buildDir if the item was missing, and is now pending. It should be constructed in the given buildDir, and then marked as complete using markComplete.

constructOrWait :: (MonadIO m, MonadMask m, MonadBaseControl IO m, Cacher m remoteCache) => ContentStore -> remoteCache -> ContentHash -> m (Status (Path Abs Dir) Void Item) Source #

Atomically query the state under the given key and mark pending if missing. Wait for the item to be completed, if already pending. Throws a FailedToConstruct error if construction fails.

Returns Complete item if the item is complete. Returns Missing buildDir if the item was missing, and is now pending. It should be constructed in the given buildDir, and then marked as complete using markComplete.

constructIfMissing :: (MonadIO m, MonadBaseControl IO m, MonadMask m, Cacher m remoteCache) => ContentStore -> remoteCache -> ContentHash -> m (Status (Path Abs Dir) () Item) Source #

Atomically query the state under the given key and mark pending if missing.

withConstructIfMissing :: (MonadIO m, MonadBaseControl IO m, MonadMask m, Cacher m remoteCache) => ContentStore -> remoteCache -> ContentHash -> (Path Abs Dir -> m (Either e a)) -> m (Status e () (Maybe a, Item)) Source #

Atomically query the state under the given key and mark pending if missing. Execute the given function to construct the item, mark as complete on success and remove on failure. Forcibly removes if an uncaught exception occurs during item construction.

markPending :: MonadIO m => ContentStore -> ContentHash -> m (Path Abs Dir) Source #

Mark a non-existent item as pending.

Creates the build directory and returns its path.

See also: constructIfMissing.

markComplete :: MonadIO m => ContentStore -> ContentHash -> m Item Source #

Mark a pending item as complete.

Remove Contents

removeFailed :: MonadIO m => ContentStore -> ContentHash -> m () Source #

Remove a pending item.

It is the callers responsibility to ensure that no other threads or processes will attempt to access the item's contents afterwards.

removeForcibly :: MonadIO m => ContentStore -> ContentHash -> m () Source #

Remove a key association independent of the corresponding item state. Do nothing if no item exists under the given key.

It is the callers responsibility to ensure that no other threads or processes will attempt to access the contents afterwards.

Note, this will leave an orphan item behind if no other keys point to it. There is no garbage collection mechanism in place at the moment.

removeItemForcibly :: MonadIO m => ContentStore -> Item -> m () Source #

Remove a completed item in the store. Do nothing if not completed.

It is the callers responsibility to ensure that no other threads or processes will attempt to access the contents afterwards.

Note, this will leave keys pointing to that item dangling. There is no garbage collection mechanism in place at the moment.

Aliases

assignAlias :: MonadIO m => ContentStore -> Alias -> Item -> m () Source #

Link the given alias to the given item. If the alias existed before it is overwritten.

lookupAlias :: MonadIO m => ContentStore -> Alias -> m (Maybe Item) Source #

Lookup an item under the given alias. Returns Nothing if the alias does not exist.

removeAlias :: MonadIO m => ContentStore -> Alias -> m () Source #

Remove the given alias.

listAliases :: MonadIO m => ContentStore -> m [(Alias, Item)] Source #

List all aliases and the respective items.

Metadata

getBackReferences :: MonadIO m => ContentStore -> Item -> m [ContentHash] Source #

Get all hashes that resulted in the given item.

setInputs :: MonadIO m => ContentStore -> ContentHash -> [Item] -> m () Source #

Define the input items to a subtree.

getInputs :: MonadIO m => ContentStore -> ContentHash -> m [Item] Source #

Get the input items to a subtree if any were defined.

setMetadata :: (ToField k, ToField v, MonadIO m) => ContentStore -> ContentHash -> k -> v -> m () Source #

Set a metadata entry on an item.

getMetadata :: (ToField k, FromField v, MonadIO m) => ContentStore -> ContentHash -> k -> m (Maybe v) Source #

Retrieve a metadata entry on an item, or Nothing if missing.

createMetadataFile :: MonadIO m => ContentStore -> ContentHash -> Path Rel File -> m (Path Abs File, Handle) Source #

Create and open a new metadata file on a pending item in write mode.

getMetadataFile :: MonadIO m => ContentStore -> ContentHash -> Path Rel File -> m (Maybe (Path Abs File)) Source #

Return the path to a metadata file if it exists.

Accessors

itemPath :: ContentStore -> Item -> Path Abs Dir Source #

The store path of a completed item.

itemRelPath :: Item -> Path Rel Dir Source #

The scoped path to a content item within the store.

contentItem :: Content t -> Item Source #

Store item containing the given content.

root :: ContentStore -> Path Abs Dir Source #

The root directory of the store.

Types

data ContentStore Source #

A hash addressed store on the file system.

data Item Source #

A completed item in the ContentStore.

Instances
Eq Item Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

(==) :: Item -> Item -> Bool #

(/=) :: Item -> Item -> Bool #

Ord Item Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

compare :: Item -> Item -> Ordering #

(<) :: Item -> Item -> Bool #

(<=) :: Item -> Item -> Bool #

(>) :: Item -> Item -> Bool #

(>=) :: Item -> Item -> Bool #

max :: Item -> Item -> Item #

min :: Item -> Item -> Item #

Show Item Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

showsPrec :: Int -> Item -> ShowS #

show :: Item -> String #

showList :: [Item] -> ShowS #

Generic Item Source # 
Instance details

Defined in Data.CAS.ContentStore

Associated Types

type Rep Item :: Type -> Type #

Methods

from :: Item -> Rep Item x #

to :: Rep Item x -> Item #

Hashable Item Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

hashWithSalt :: Int -> Item -> Int #

hash :: Item -> Int #

ToJSON Item Source # 
Instance details

Defined in Data.CAS.ContentStore

FromJSON Item Source # 
Instance details

Defined in Data.CAS.ContentStore

Store Item Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

size :: Size Item #

poke :: Item -> Poke () #

peek :: Peek Item #

Monad m => ContentHashable m Item Source # 
Instance details

Defined in Data.CAS.ContentStore

type Rep Item Source # 
Instance details

Defined in Data.CAS.ContentStore

type Rep Item = D1 (MetaData "Item" "Data.CAS.ContentStore" "cas-store-1.0.1-IWFoJP6wUfI4DwQAF7BUsH" False) (C1 (MetaCons "Item" PrefixI True) (S1 (MetaSel (Just "itemHash") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ContentHash)))

data Content t where Source #

File or directory within a content store Item.

Constructors

All :: Item -> Content Dir 
(:</>) :: Item -> Path Rel t -> Content t infixr 5 
Instances
Monad m => ContentHashable m (Content File) Source # 
Instance details

Defined in Data.CAS.ContentStore

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

Defined in Data.CAS.ContentStore

Eq (Content t) Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

(==) :: Content t -> Content t -> Bool #

(/=) :: Content t -> Content t -> Bool #

Show (Content t) Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

showsPrec :: Int -> Content t -> ShowS #

show :: Content t -> String #

showList :: [Content t] -> ShowS #

(^</>) :: Content Dir -> Path Rel t -> Content t infixl 4 Source #

Append to the path within a store item.

newtype Alias Source #

Constructors

Alias 

Fields

Instances
Eq Alias Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

(==) :: Alias -> Alias -> Bool #

(/=) :: Alias -> Alias -> Bool #

Ord Alias Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

compare :: Alias -> Alias -> Ordering #

(<) :: Alias -> Alias -> Bool #

(<=) :: Alias -> Alias -> Bool #

(>) :: Alias -> Alias -> Bool #

(>=) :: Alias -> Alias -> Bool #

max :: Alias -> Alias -> Alias #

min :: Alias -> Alias -> Alias #

Show Alias Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

showsPrec :: Int -> Alias -> ShowS #

show :: Alias -> String #

showList :: [Alias] -> ShowS #

FromField Alias Source # 
Instance details

Defined in Data.CAS.ContentStore

ToField Alias Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

toField :: Alias -> SQLData #

Store Alias Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

size :: Size Alias #

poke :: Alias -> Poke () #

peek :: Peek Alias #

ContentHashable IO Alias Source # 
Instance details

Defined in Data.CAS.ContentStore

data Status missing pending complete Source #

Status of an item in the store.

Constructors

Missing missing

The item does not exist, yet.

Pending pending

The item is under construction and not ready for consumption.

Complete complete

The item is complete and ready for consumption.

Instances
(Eq missing, Eq pending, Eq complete) => Eq (Status missing pending complete) Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

(==) :: Status missing pending complete -> Status missing pending complete -> Bool #

(/=) :: Status missing pending complete -> Status missing pending complete -> Bool #

(Show missing, Show pending, Show complete) => Show (Status missing pending complete) Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

showsPrec :: Int -> Status missing pending complete -> ShowS #

show :: Status missing pending complete -> String #

showList :: [Status missing pending complete] -> ShowS #

type Status_ = Status () () () Source #

data Update Source #

Update about the status of a pending item.

Constructors

Completed Item

The item is now completed and ready for consumption.

Failed

Constructing the item failed.

Instances
Eq Update Source # 
Instance details

Defined in Data.CAS.ContentStore

Methods

(==) :: Update -> Update -> Bool #

(/=) :: Update -> Update -> Bool #

Show Update Source # 
Instance details

Defined in Data.CAS.ContentStore

data StoreError Source #

Errors that can occur when interacting with the store.

Constructors

NotPending ContentHash

An item is not under construction when it should be.

AlreadyPending ContentHash

An item is already under construction when it should be missing.

AlreadyComplete ContentHash

An item is already complete when it shouldn't be.

CorruptedLink ContentHash FilePath

The link under the given hash points to an invalid path.

FailedToConstruct ContentHash

A failure occurred while waiting for the item to be constructed.

IncompatibleStoreVersion (Path Abs Dir) Int Int

IncompatibleStoreVersion storeDir actual expected The given store has a version number that is incompatible.

MalformedMetadataEntry ContentHash SQLData

MalformedMetadataEntry hash key The metadata entry for the give hash, key pair is malformed.

Orphan instances

FromField ContentHash Source # 
Instance details

ToField ContentHash Source # 
Instance details