hash-addressed 0.0.1.0 → 0.1.0.0

raw patch · 4 files changed

+242/−141 lines, 4 filesdep +gamblerdep +mtldep +pipesdep −transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: gambler, mtl, pipes

Dependencies removed: transformers

API changes (from Hackage documentation)

Files

• changelog.md +62/−2
• hash-addressed.cabal +4/−3
• library/HashAddressed/Directory.hs +155/−128
• library/HashAddressed/HashFunction.hs +21/−8

@@ -1,7 +1,67 @@-## 0.0.1.0 (2023-01-27)+0.1.0.0 (2023-01-31)+---------------------------------------------------------------- +### HashFunction++`HashFunction` type is no longer opaque; any hash function can be supported.+The type is now a newtype for `Fold` from the `gambler` library.++### Directory++Renamed `ContentAddressedDirectory` to `Directory`++`Directory` constructor is now exported++Removed `init` function, which is redundant to `Directory` constructor++### Pipes++Now using the `pipes` library to express streams.++Removed:++```haskell+writeStreaming :: ContentAddressedDirectory+    -> (forall m. MonadIO m => (ByteString -> m ()) -> m ())+    -> IO WriteResult+```++Added:++```haskell+writeStream :: MonadIO m =>+    Directory -> Producer ByteString IO a -> m (a, WriteResult)+```++Removed:++```haskell+writeEither :: ContentAddressedDirectory+    -> (forall m. MonadIO m => (ByteString -> m ()) -> m (Either bad good))+    -> IO (Either bad (good, WriteResult))+```++Added:++```haskell+writeExcept :: (MonadIO m, MonadError abort m) =>+    Directory+    -> Producer ByteString (ExceptT abort IO) commit+    -> m (commit, WriteResult)+```++### WriteResult++Renamed field from `contentAddressedFile` to `hashAddressedFile`+++0.0.1.0 (2023-01-27)+----------------------------------------------------------------+ Add `HashAddressed.Directory.writeEither` -## 0.0.0.0 (2023-01-27)++0.0.0.0 (2023-01-27)+----------------------------------------------------------------  Initial release

@@ -1,7 +1,7 @@ cabal-version: 3.0  name: hash-addressed-version: 0.0.1.0+version: 0.1.0.0 synopsis: Hash-addressed file storage category: Hash, Filesystem @@ -34,7 +34,6 @@     default-language: GHC2021     ghc-options: -Wall     default-extensions:-        ApplicativeDo         BlockArguments         DerivingVia         LambdaCase@@ -48,7 +47,9 @@       , cryptohash-sha256 ^>= 0.11.102       , directory ^>= 1.3.6       , filepath ^>= 1.4.2+      , gambler ^>= 0.0.0       , quaalude ^>= 0.0.0+      , mtl ^>= 2.2.2+      , pipes ^>= 4.3.16       , resourcet ^>= 1.2.6 || ^>= 1.3.0       , temporary ^>= 1.3-      , transformers ^>= 0.5.6

@@ -1,8 +1,8 @@ module HashAddressed.Directory   (-    {- * Type -} ContentAddressedDirectory, init,+    {- * Type -} Directory (..),     {- * Write operations -}-            writeLazy, writeStreaming, writeEither,+            writeLazy, writeStream, writeExcept,             WriteResult (..), WriteType (..),   )   where@@ -10,157 +10,184 @@ import Essentials import HashAddressed.HashFunction -import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Except (ExceptT, MonadError)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans (lift)+import Control.Monad.Trans.Resource (ResourceT) import Data.Either (Either)-import Data.Function (flip)-import Prelude (FilePath, IO)+import Pipes (Producer) import System.FilePath ((</>))+import System.IO (IO, FilePath, Handle) -import qualified Control.Monad.Trans.Class as Monad-import qualified Control.Monad.Trans.Resource as Resource-import qualified Control.Monad.Trans.State as Monad-import qualified Control.Monad.Trans.State as State-import qualified Crypto.Hash.SHA256 as Hash-import qualified Data.ByteString as Strict-import qualified Data.ByteString as Strict.ByteString-import qualified Data.ByteString.Base16 as Base16-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+import qualified Control.Monad.Except as Except (liftEither, runExceptT)+import qualified Control.Monad.Trans.Resource as Resource (runResourceT, allocate, release)+import qualified Data.ByteString as Strict (ByteString)+import qualified Data.ByteString as Strict.ByteString (hPut)+import qualified Data.ByteString.Lazy as Lazy (ByteString, toChunks)+import qualified Data.Either as Either (Either (Left, Right))+import qualified Fold.Effectful as Fold (EffectfulFold (..), effect, fold)+import qualified Pipes (hoist, each)+import qualified Pipes.Prelude as Pipes (foldM')+import qualified System.Directory as Directory (removeDirectoryRecursive, doesPathExist, renamePath)+import qualified System.IO as IO (openBinaryFile, IOMode (..), hClose)+import qualified System.IO.Temp as Temporary (getCanonicalTemporaryDirectory, createTempDirectory) -data ContentAddressedDirectory =-  ContentAddressedDirectory-    { directory :: FilePath-    }+{-| Specification of a hash-addressed directory -data WriteResult =-  WriteResult-    { contentAddressedFile :: FilePath-        {- ^ The file path where the contents written by the action-             now reside. This path includes the store directory. -}-    , writeType :: WriteType-    }+Note that the utilities in "HashAddressed.Directory" do not create the+directory; ensure that it already exists before attempting to write. -data WriteType = AlreadyPresent | NewContent+See "HashAddressed.HashFunction" for examples of hash functions. -}+data Directory = Directory+  { directoryPath :: FilePath+      {- ^ Directory where hash-addressed files are stored -}+  , hashFunction :: HashFunction+      {- ^ Hash function to use for generating file names -}+  } -{-| Specification of a content-addressed directory -}-init ::-    HashFunction {- ^ Which hash function to use -}-    -> FilePath {- ^ Directory where content-addressed files are stored -}-    -> ContentAddressedDirectory-init SHA_256 = ContentAddressedDirectory+data WriteResult = WriteResult+  { hashAddressedFile :: FilePath+      {- ^ The file path where the contents written by the+           action now reside, including the store directory -}+  , writeType :: WriteType+  } -{-| Write a stream of strict byte strings to a content-addressed directory -}-writeEither ::-    ContentAddressedDirectory-        {- ^ The content-addressed file store to write to; see 'init' -}-    -> (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. 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+data WriteType =+    AlreadyPresent -- ^ No action was taken because the content+                   --   is already present in the directory+  | NewContent     -- ^ A new file was written into the directory -    {-  We do not yet know what the final file path will be, because that is-        determined by the hash of the contents, which we have not computed yet. -}+{-| Path of a file that we write to before moving it into the+    hash-addressed directory -}+newtype TemporaryFile = TemporaryFile{ temporaryFilePath :: FilePath } -    {-  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 "hash-addressed")-        Directory.removeDirectoryRecursive {- (🧹) -}+{-| File path within a hash-addressed directory -    {-  If the file never gets moved, then when the directory is removed-        recursively (🧹), the file will be destroyed along with it.+This does no include the directory part, just the file name. -}+newtype HashName = HashName FilePath -        If the file does get moved, the directory will be destroyed (🧹),-        but the file, which no longer resides within the directory, will remain. -}+{-| Write a stream of strict ByteStrings to a hash-addressed directory,+    possibly aborting mid-stream with an error value instead -    {-  The path of the file we're writing, in its temporary location  -}-    let temporaryFile = temporaryDirectory </> "hash-addressed-file"+If the producer throws @abort@ or an 'IO' exception, nothing will be written.+An @abort@ thrown via 'Except.ExceptT' will be re-thrown via 'Except.MonadError',+and an exception thrown via 'IO' will be re-thrown via 'IO'. -}+writeExcept :: forall abort commit m. (MonadIO m, MonadError abort m) =>+    Directory -- ^ Where to write+    -> Pipes.Producer Strict.ByteString (ExceptT abort IO) commit+        -- ^ What to write+    -> m (commit, WriteResult)+writeExcept dir stream = run action+  where+    run = Resource.runResourceT >>> liftIO >>> (>>= Except.liftEither) -    {-  Create the file and open a handle to write to it  -}-    (handleRelease, handle) <- Resource.allocate-        (IO.openBinaryFile temporaryFile IO.WriteMode)-        IO.hClose {- (🍓) -}+    action :: ResourceT IO (Either abort (commit, WriteResult))+    action = do+        {-  Where the system in general keeps its temporary files  -}+        temporaryRoot <- liftIO Temporary.getCanonicalTemporaryDirectory -    {-  Run the continuation, doing two things at once with the byte string-        chunks it gives us:  -}-    (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+        {-  We do not yet know what the final file path will be, because that is+            determined by the hash of the contents, which we have not computed yet. -} -            {-  2. Update the state of the hash function  -}-            State.modify' \hashState -> Hash.update hashState chunk+        {-  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 "hash-addressed")+            Directory.removeDirectoryRecursive {- (🧹) -} -    {-  Once we're done writing the file, we no longer need the handle.  -}-    Resource.release handleRelease {- (🍓) -}+        {-  If the file never gets moved, then when the directory is removed+            recursively (🧹), the file will be destroyed along with it. -    case badOrGood of-        Either.Left bad -> pure $ Either.Left bad-        Either.Right good -> do+            If the file does get moved, the directory will be destroyed (🧹),+            but the file, which no longer resides within the directory, will remain. -} -            {-  The final location where the file will reside  -}-            let contentAddressedFile = directory dir </>-                    Strict.ByteString.Char8.unpack-                        (Base16.encode (Hash.finalize hashState))+        {-  The path of the file we're writing, in its temporary location  -}+        let temporaryFile = TemporaryFile (temporaryDirectory </> "hash-addressed-file") -            {-  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 }+        {-  Create the file and open a handle to write to it  -}+        (handleRelease, handle) <- Resource.allocate+            (IO.openBinaryFile (temporaryFilePath temporaryFile) IO.WriteMode)+            IO.hClose {- (🍓) -} -            case writeType of+        {-  Run the continuation, doing two things at once with the ByteString+            chunks it gives us: write the file, and update a hash context -}+        abortOrCommit :: Either abort (HashName, commit) <-+            lift $ runStream (hashFunction dir) handle stream -                {-  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+        {-  Once we're done writing the file, we no longer need the handle.  -}+        Resource.release handleRelease {- (🍓) -} -                {-  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 ()+        case abortOrCommit of+            Either.Left abort -> pure (Either.Left abort)+            Either.Right (name, commit) -> do+                result <- finalize dir temporaryFile name+                pure $ Either.Right (commit, result) -            pure $ Either.Right (good, WriteResult{ contentAddressedFile, writeType })+finalize :: MonadIO m => Directory -> TemporaryFile -> HashName -> m WriteResult+finalize dir temporaryFile (HashName name) = do -{-| Write a stream of strict byte strings to a content-addressed directory+    let hashAddressedFile = directoryPath dir </> name -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+    -- Another file of the same name in the content-addressed directory might already exist.+    writeType <- liftIO $+          Directory.doesPathExist hashAddressedFile+          <&> \case{ True -> AlreadyPresent; False -> NewContent } -{-| Write a lazy byte string to a content-addressed directory+    case writeType of -This is a simplified variant of 'writeStreaming'. -}-writeLazy ::-    ContentAddressedDirectory-        {- ^ The content-addressed file store to write to; see 'init' -}-    -> Lazy.ByteString-        {- ^ The content to write to the store -}-    -> IO WriteResult-        {- ^ The file path where the contents of the lazy byte string-             now reside. This path includes the store directory. -}-writeLazy dir lbs = writeStreaming dir \writeChunk ->-    traverse_ writeChunk (Lazy.ByteString.toChunks lbs)+        -- In one atomic step, this action commits the file to the store and prevents it+        -- from being deleted by the directory cleanup action (🧹).+        NewContent -> liftIO $+            Directory.renamePath (temporaryFilePath temporaryFile) hashAddressedFile++        -- 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 ()++    pure WriteResult{ hashAddressedFile, writeType }++runStream :: forall abort commit. HashFunction -> Handle+    -> Pipes.Producer Strict.ByteString (ExceptT abort IO) commit+    -> IO (Either abort (HashName, commit))+runStream hash handle stream =+    case writeAndHash hash handle of+        Fold.EffectfulFold{ Fold.initial, Fold.step, Fold.extract } ->+            Except.runExceptT $+                Pipes.foldM' step initial extract stream++writeAndHash :: HashFunction -> Handle+    -> Fold.EffectfulFold (ExceptT abort IO) Strict.ByteString HashName+writeAndHash (HashFunction hash) handle =+    (Fold.effect \chunk -> liftIO (Strict.ByteString.hPut handle chunk))+    *> (HashName <$> Fold.fold hash)++{-| Write a stream of strict ByteStrings to a hash-addressed directory++If the producer throws an exception, nothing will be written and the+exception will be re-thrown.++This is a simplified variant of 'writeExcept'. -}+writeStream :: forall commit m. MonadIO m =>+    Directory -- ^ Where to write+    -> Pipes.Producer Strict.ByteString IO commit -- ^ What to write+    -> m (commit, WriteResult)+writeStream dir source = voidExcept $ writeExcept dir $ Pipes.hoist lift source++voidLeft :: Either Void a -> a+voidLeft = \case{ Either.Left x -> absurd x; Either.Right x -> x }++voidExcept :: Functor m => ExceptT Void m a -> m a+voidExcept = Except.runExceptT >>> fmap voidLeft++{-| Write a lazy ByteString to a hash-addressed directory++This is a simplified variant of 'writeStream'. -}+writeLazy :: forall m. MonadIO m =>+    Directory -- ^ Where to write+    -> Lazy.ByteString -- ^ What to write+    -> m WriteResult+writeLazy dir lbs = writeStream dir (lbsProducer lbs) <&> (\((), x) -> x)++lbsProducer :: Lazy.ByteString -> Pipes.Producer Strict.ByteString IO ()+lbsProducer = Lazy.toChunks >>> Pipes.each

@@ -1,12 +1,25 @@-module HashAddressed.HashFunction where+module HashAddressed.HashFunction+  (+    {- * Type -} HashFunction (..),+    {- * Examples -} sha256,+  )+  where  import Essentials -{-| Hash function supported by the @hash-addressed@ library+import Fold.Pure (Fold (..))+import System.IO (FilePath) -    Currently only SHA-256 is supported, but others-    may be added in the future.--}-data HashFunction =-    SHA_256 -- ^ SHA-256-  deriving stock (Eq, Ord)+import qualified Crypto.Hash.SHA256 as Hash+import qualified Data.ByteString as Strict+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Char8 as Strict.ByteString.Char8++newtype HashFunction = HashFunction (Fold Strict.ByteString FilePath)++sha256 :: HashFunction+sha256 = HashFunction Fold+  { initial = Hash.init+  , step = Hash.update+  , extract = Strict.ByteString.Char8.unpack . Base16.encode . Hash.finalize+  }