diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +## 0.0.1.0 (2023-01-27) + +Add `HashAddressed.Directory.writeEither` + ## 0.0.0.0 (2023-01-27) Initial release diff --git a/hash-addressed.cabal b/hash-addressed.cabal --- a/hash-addressed.cabal +++ b/hash-addressed.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: hash-addressed -version: 0.0.0.0 +version: 0.0.1.0 synopsis: Hash-addressed file storage category: Hash, Filesystem diff --git a/library/HashAddressed/Directory.hs b/library/HashAddressed/Directory.hs --- a/library/HashAddressed/Directory.hs +++ b/library/HashAddressed/Directory.hs @@ -1,7 +1,8 @@ module HashAddressed.Directory ( {- * Type -} ContentAddressedDirectory, init, - {- * Write operations -} writeStreaming, writeLazy, + {- * Write operations -} + writeLazy, writeStreaming, writeEither, WriteResult (..), WriteType (..), ) where @@ -10,6 +11,7 @@ import HashAddressed.HashFunction import Control.Monad.IO.Class (MonadIO) +import Data.Either (Either) import Data.Function (flip) import Prelude (FilePath, IO) import System.FilePath (()) @@ -25,6 +27,7 @@ import qualified Data.ByteString.Char8 as Strict.ByteString.Char8 import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy as Lazy.ByteString +import qualified Data.Either as Either import qualified System.Directory as Directory import qualified System.IO as IO import qualified System.IO.Temp as Temporary @@ -52,14 +55,16 @@ init SHA_256 = ContentAddressedDirectory {-| Write a stream of strict byte strings to a content-addressed directory -} -writeStreaming :: +writeEither :: ContentAddressedDirectory {- ^ The content-addressed file store to write to; see 'init' -} - -> (forall m. MonadIO m => (Strict.ByteString -> m ()) -> m ()) + -> (forall m. MonadIO m => (Strict.ByteString -> m ()) -> m (Either bad good)) {- ^ Monadic action which is allowed to emit 'Strict.ByteString's - and do I/O -} - -> IO WriteResult -writeStreaming cafs continue = Resource.runResourceT @IO + and do I/O. The action should return 'Either.Right' once the content + has been successfully written. If the action returns 'Either.Left' or + throws an exception, then nothing will be committed to the store. -} + -> IO (Either bad (good, WriteResult)) +writeEither dir stream = Resource.runResourceT @IO do {- Where the system in general keeps its temporary files -} temporaryRoot <- Monad.lift Temporary.getCanonicalTemporaryDirectory @@ -70,7 +75,7 @@ {- We will write the file into this directory and then move it out in an atomic rename operation that will commit the file to the store. -} (_, temporaryDirectory) <- Resource.allocate - (Temporary.createTempDirectory temporaryRoot "cafs") + (Temporary.createTempDirectory temporaryRoot "hash-addressed") Directory.removeDirectoryRecursive {- (🧹) -} {- If the file never gets moved, then when the directory is removed @@ -80,7 +85,7 @@ but the file, which no longer resides within the directory, will remain. -} {- The path of the file we're writing, in its temporary location -} - let temporaryFile = temporaryDirectory "cafs-file" + let temporaryFile = temporaryDirectory "hash-addressed-file" {- Create the file and open a handle to write to it -} (handleRelease, handle) <- Resource.allocate @@ -89,8 +94,8 @@ {- Run the continuation, doing two things at once with the byte string chunks it gives us: -} - hashState :: Hash.Ctx <- Monad.lift $ flip Monad.execStateT Hash.init $ - continue \chunk -> + (badOrGood, hashState :: Hash.Ctx) <- Monad.lift $ flip Monad.runStateT Hash.init $ + stream \chunk -> do {- 1. Write to the file -} Monad.lift $ Strict.ByteString.hPut handle chunk @@ -101,33 +106,54 @@ {- Once we're done writing the file, we no longer need the handle. -} Resource.release handleRelease {- (🍓) -} - {- The final location where the file will reside -} - let contentAddressedFile = directory cafs - Strict.ByteString.Char8.unpack - (Base16.encode (Hash.finalize hashState)) + case badOrGood of + Either.Left bad -> pure $ Either.Left bad + Either.Right good -> do - {- Another file of the same name in the content-addressed directory - might already exist. -} - writeType <- Monad.lift (Directory.doesPathExist contentAddressedFile) - <&> \case{ True -> AlreadyPresent; False -> NewContent } + {- The final location where the file will reside -} + let contentAddressedFile = directory dir + Strict.ByteString.Char8.unpack + (Base16.encode (Hash.finalize hashState)) - case writeType of + {- Another file of the same name in the content-addressed directory + might already exist. -} + writeType <- Monad.lift (Directory.doesPathExist contentAddressedFile) + <&> \case{ True -> AlreadyPresent; False -> NewContent } - {- In one atomic step, this action commits the file to the store - and prevents it from being deleted by the directory cleanup - action (🧹). -} - NewContent -> Monad.lift $ - Directory.renamePath temporaryFile contentAddressedFile + case writeType of - {- Since the store is content-addressed, we assume that two files - with the same name have the same contents. Therefore, if a file - already exists at this path, there is no reason to take any - action. -} - AlreadyPresent -> pure () + {- In one atomic step, this action commits the file to the store + and prevents it from being deleted by the directory cleanup + action (🧹). -} + NewContent -> Monad.lift $ + Directory.renamePath temporaryFile contentAddressedFile - pure WriteResult{ contentAddressedFile, writeType } + {- Since the store is content-addressed, we assume that two files + with the same name have the same contents. Therefore, if a file + already exists at this path, there is no reason to take any + action. -} + AlreadyPresent -> pure () -{-| Write a lazy byte string to a content-addressed directory -} + pure $ Either.Right (good, WriteResult{ contentAddressedFile, writeType }) + +{-| Write a stream of strict byte strings to a content-addressed directory + +This is a simplified variant of 'writeEither'. -} +writeStreaming :: + ContentAddressedDirectory + {- ^ The content-addressed file store to write to; see 'init' -} + -> (forall m. MonadIO m => (Strict.ByteString -> m ()) -> m ()) + {- ^ Monadic action which is allowed to emit 'Strict.ByteString's + and do I/O. If this action throws an exception, nothing will + be written to the store. -} + -> IO WriteResult +writeStreaming dir stream = writeEither dir (fmap Either.Right . stream) <&> \case + Either.Left x -> absurd x + Either.Right ((), result) -> result + +{-| Write a lazy byte string to a content-addressed directory + +This is a simplified variant of 'writeStreaming'. -} writeLazy :: ContentAddressedDirectory {- ^ The content-addressed file store to write to; see 'init' -} @@ -136,5 +162,5 @@ -> IO WriteResult {- ^ The file path where the contents of the lazy byte string now reside. This path includes the store directory. -} -writeLazy cafs lbs = writeStreaming cafs \writeChunk -> +writeLazy dir lbs = writeStreaming dir \writeChunk -> traverse_ writeChunk (Lazy.ByteString.toChunks lbs)