diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +## 0.0.0.0 (2023-01-27) + +Initial release diff --git a/hash-addressed.cabal b/hash-addressed.cabal new file mode 100644 --- /dev/null +++ b/hash-addressed.cabal @@ -0,0 +1,54 @@ +cabal-version: 3.0 + +name: hash-addressed +version: 0.0.0.0 +synopsis: Hash-addressed file storage +category: Hash, Filesystem + +description: + A simple system for maintaining a directory wherein each file's + name is a hash of its content. + +homepage: https://github.com/typeclasses/hash-addressed +bug-reports: https://github.com/typeclasses/hash-addressed/issues + +author: Chris Martin +maintainer: Chris Martin, Julie Moronuki + +copyright: 2023 Mission Valley Software LLC +license: Apache-2.0 +license-file: license.txt + +extra-source-files: *.md + +source-repository head + type: git + location: git://github.com/typeclasses/hash-addressed.git + +library + hs-source-dirs: library + exposed-modules: + HashAddressed.Directory + HashAddressed.HashFunction + + default-language: GHC2021 + ghc-options: -Wall + default-extensions: + ApplicativeDo + BlockArguments + DerivingVia + LambdaCase + NamedFieldPuns + NoImplicitPrelude + + build-depends: + , base ^>= 4.16 || ^>= 4.17 + , base16-bytestring ^>= 1.0.2 + , bytestring ^>= 0.11.3 + , cryptohash-sha256 ^>= 0.11.102 + , directory ^>= 1.3.6 + , filepath ^>= 1.4.2 + , quaalude ^>= 0.0.0 + , resourcet ^>= 1.2.6 || ^>= 1.3.0 + , temporary ^>= 1.3 + , transformers ^>= 0.5.6 diff --git a/library/HashAddressed/Directory.hs b/library/HashAddressed/Directory.hs new file mode 100644 --- /dev/null +++ b/library/HashAddressed/Directory.hs @@ -0,0 +1,140 @@ +module HashAddressed.Directory + ( + {- * Type -} ContentAddressedDirectory, init, + {- * Write operations -} writeStreaming, writeLazy, + WriteResult (..), WriteType (..), + ) + where + +import Essentials +import HashAddressed.HashFunction + +import Control.Monad.IO.Class (MonadIO) +import Data.Function (flip) +import Prelude (FilePath, IO) +import System.FilePath (()) + +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 System.Directory as Directory +import qualified System.IO as IO +import qualified System.IO.Temp as Temporary + +data ContentAddressedDirectory = + ContentAddressedDirectory + { directory :: FilePath + } + +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 + } + +data WriteType = AlreadyPresent | NewContent + +{-| 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 + +{-| Write a stream of strict byte strings to a content-addressed directory -} +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 -} + -> IO WriteResult +writeStreaming cafs continue = Resource.runResourceT @IO + do + {- Where the system in general keeps its temporary files -} + temporaryRoot <- Monad.lift Temporary.getCanonicalTemporaryDirectory + + {- 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. -} + + {- 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") + Directory.removeDirectoryRecursive {- (๐Ÿงน) -} + + {- If the file never gets moved, then when the directory is removed + recursively (๐Ÿงน), the file will be destroyed along with it. + + If the file does get moved, the directory will be destroyed (๐Ÿงน), + 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" + + {- Create the file and open a handle to write to it -} + (handleRelease, handle) <- Resource.allocate + (IO.openBinaryFile temporaryFile IO.WriteMode) + IO.hClose {- (๐Ÿ“) -} + + {- 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 -> + do + {- 1. Write to the file -} + Monad.lift $ Strict.ByteString.hPut handle chunk + + {- 2. Update the state of the hash function -} + State.modify' \hashState -> Hash.update hashState chunk + + {- 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)) + + {- 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 } + + case writeType of + + {- 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 + + {- 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{ contentAddressedFile, writeType } + +{-| Write a lazy byte string to a content-addressed directory -} +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 cafs lbs = writeStreaming cafs \writeChunk -> + traverse_ writeChunk (Lazy.ByteString.toChunks lbs) diff --git a/library/HashAddressed/HashFunction.hs b/library/HashAddressed/HashFunction.hs new file mode 100644 --- /dev/null +++ b/library/HashAddressed/HashFunction.hs @@ -0,0 +1,12 @@ +module HashAddressed.HashFunction where + +import Essentials + +{-| Hash function supported by the @hash-addressed@ library + + Currently only SHA-256 is supported, but others + may be added in the future. +-} +data HashFunction = + SHA_256 -- ^ SHA-256 + deriving stock (Eq, Ord) diff --git a/license.txt b/license.txt new file mode 100644 --- /dev/null +++ b/license.txt @@ -0,0 +1,13 @@ +Copyright 2023 Mission Valley Software LLC + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/readme.md b/readme.md new file mode 100644 --- /dev/null +++ b/readme.md @@ -0,0 +1,53 @@ +`hash-addressed` is a simple system for maintaining a directory wherein each +file's name is a hash of its content. + +```haskell +import qualified HashAddressed.Directory as Dir +import qualified HashAddressed.HashFunction as Hash +import qualified Data.ByteString.Lazy as Lazy +import qualified Data.ByteString as Strict +``` + +First define a `ContentAddressedDirectory` value by specifying which hash +function to use and the path of the directory in which the files shall be kept. +The directory does not need to already exist. + +```haskell +Dir.init :: Hash.HashFunction -> FilePath + -> Dir.ContentAddressedDirectory +``` + +Presently the only supported hash function is `Hash.SHA_256`. + +You can then write files into the directory using one of the two *write* +functions: + +```haskell +Dir.writeLazy :: Dir.ContentAddressedDirectory + -> Lazy.ByteString -> IO Dir.WriteResult +``` + +```haskell +Dir.writeStreaming :: Dir.ContentAddressedDirectory + -> (forall m. MonadIO m => (Strict.ByteString -> m ()) -> m ()) + -> IO Dir.WriteResult +``` + +The `IO` action returns a `WriteResult`, which gives you the path of the file in +the store, including the path of the store itself. The `WriteType` value +indicates whether the file was actually written by this action or was present in +the store already. + +```haskell +data WriteResult = WriteResult{ contentAddressedFile :: FilePath, + writeType :: Dir.WriteType } +``` + +```haskell +data WriteType = AlreadyPresent | NewContent +``` + +All operations that write into a hash-addressed directory are performed by first +writing the content somewhere within the system temporary directory and then +moving the file to its target location. This ensures that the store never makes +visible the results of a partial write.