hash-addressed 0.0.0.0 → 0.0.1.0

raw patch · 3 files changed

+63/−33 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +4/−0
• hash-addressed.cabal +1/−1
• library/HashAddressed/Directory.hs +58/−32

@@ -1,3 +1,7 @@+## 0.0.1.0 (2023-01-27)++Add `HashAddressed.Directory.writeEither`+ ## 0.0.0.0 (2023-01-27)  Initial release

@@ -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 

@@ -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)