diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +## 1.0.0.0 (2023-01-27) + +Initial release diff --git a/executable/Main.hs b/executable/Main.hs new file mode 100644 --- /dev/null +++ b/executable/Main.hs @@ -0,0 +1,259 @@ +module Main (main) where + +import Essentials + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bool (not, (||)) +import HashAddressed.Directory (WriteResult (..), WriteType (..)) +import HashAddressed.HashFunction (HashFunction (SHA_256)) +import Prelude (IO, FilePath, String) +import System.FilePath (()) + +import qualified Control.Monad as Monad +import qualified Control.Monad.Trans.Except as Except +import qualified Control.Monad.Trans.Resource as Resource +import qualified Data.ByteString as Strict +import qualified Data.ByteString as Strict.ByteString +import qualified Data.Char as Char +import qualified Data.Either as Either +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Ini as INI +import qualified Data.List as List +import qualified Data.Text as Strict +import qualified Data.Text as Strict.Text +import qualified Data.Text.Encoding as Strict.Text +import qualified HashAddressed.Directory +import qualified Options.Applicative as Options +import qualified System.Directory as Directory +import qualified System.Exit as Exit +import qualified System.IO as IO + +main :: IO () +main = do + action <- Options.execParser command + Except.runExceptT action >>= \case + Either.Left x -> Exit.die x + Either.Right () -> pure () + +type Command = Options.ParserInfo (Except.ExceptT String IO ()) + +command :: Command +command = Options.info (parser <**> Options.helper) $ + Options.progDesc "Hash-addressed file storage" + where + parser = Options.subparser $ + Options.command "version" versionCommand <> + Options.command "initialize" initializeCommand <> + Options.command "write" writeCommand + + +--- The 'version' command --- + +versionCommand :: Command +versionCommand = Options.info (parser <**> Options.helper) $ + Options.progDesc "Print version numbers" + where + parser = pure do + liftIO $ IO.putStrLn $ "hash-addressed 1" + + +--- The meta directory --- + +metaDirectory :: FilePath -> FilePath +metaDirectory storeDirectory = storeDirectory ".hash-addressed" + +configFile :: FilePath -> FilePath +configFile storeDirectory = metaDirectory storeDirectory "config" + +defaultConfigINI :: HashFunction -> INI.Ini +defaultConfigINI optHashFunction = INI.Ini mempty + [ (Strict.Text.pack "version", Strict.Text.pack "1") + , (Strict.Text.pack "hash function", + Strict.Text.pack (showHashFunction optHashFunction))] + +data Version = V1 + +readHashFunctionFromConfig :: FilePath -> Except.ExceptT String IO HashFunction +readHashFunctionFromConfig storeDirectory = do + bs <- liftIO $ Strict.ByteString.readFile (configFile storeDirectory) + text <- case Strict.Text.decodeUtf8' bs of + Either.Left _ -> Except.throwE $ "Invalid UTF-8 in config file " <> configFile storeDirectory + Either.Right x -> pure x + INI.Ini _ iniGlobals <- case INI.parseIni text of + Either.Left _ -> Except.throwE $ "Invalid config file " <> configFile storeDirectory + Either.Right ini -> pure ini + let map = HashMap.fromList iniGlobals + versionText <- case HashMap.lookup (Strict.Text.pack "version") map of + Nothing -> Except.throwE $ "Missing version in config file " <> configFile storeDirectory + Just x -> pure x + _configVersion <- case Strict.Text.unpack versionText of + "1" -> pure V1 + v -> Except.throwE $ "Unsupported config version " <> v <> " " <> configFile storeDirectory + hashFunctionText <- case HashMap.lookup (Strict.Text.pack "hash function") map of + Nothing -> Except.throwE $ "Missing hash function in config file " <> configFile storeDirectory + Just x -> pure x + case readHashFunctionText hashFunctionText of + Nothing -> Except.throwE $ "Unsupported hash function " <> Strict.Text.unpack hashFunctionText + <> " in config file " <> configFile storeDirectory + Just x -> pure x + + +--- The 'initialize' command --- + +initializeCommand :: Command +initializeCommand = Options.info (parser <**> Options.helper) $ + Options.progDesc "Initialize a hash-addressed store" + where + parser = do + optVerbosity <- verbosityOption + optHashFunction <- hashFunctionOption + optStoreDirectory <- Options.strOption $ Options.long "directory" <> + Options.help "Where the hash-addressed files are located" + pure do + tryInitializeStore CreateNew optVerbosity + optHashFunction optStoreDirectory + +tryInitializeStore :: InitializationType -> Verbosity -> HashFunction -> FilePath + -> Except.ExceptT String IO () +tryInitializeStore initializationType optVerbosity optHashFunction optStoreDirectory = do + liftIO (Directory.doesPathExist (metaDirectory optStoreDirectory)) >>= \case + False -> initializeStore optHashFunction optStoreDirectory + True -> case initializationType of + CreateNew -> initializeStore optHashFunction optStoreDirectory + CreateIfNotPresent -> + putVerboseLn optVerbosity "Store is already initialized." + +data InitializationType = CreateNew | CreateIfNotPresent + +{-| Assumes a store does not already exist -} +initializeStore :: HashFunction -> FilePath -> Except.ExceptT String IO () +initializeStore optHashFunction optStoreDirectory = do + liftIO $ Directory.createDirectoryIfMissing True (metaDirectory optStoreDirectory) + liftIO $ Strict.ByteString.writeFile (configFile optStoreDirectory) $ + Strict.Text.encodeUtf8 (INI.printIni (defaultConfigINI optHashFunction)) + + +--- The 'write' command --- + +writeCommand :: Command +writeCommand = Options.info (parser <**> Options.helper) $ Options.progDesc + "Copy from the standard input stream to a hash-addressed store" + where + parser = do + optVerbosity <- verbosityOption + optHashFunction <- Options.optional hashFunctionOption + optStoreDirectory <- Options.strOption $ Options.long "target-directory" <> + Options.help "Where the hash-addressed files are located" + optInitializeStore <- Options.switch $ Options.long "initialize" <> + Options.help "Set up a hash-addressed store if one does not already exist" + optSourceFile <- Options.optional $ Options.strOption $ Options.long "source-file" <> + Options.help "Path of file to copy to the store; if this option is not given, \ + \will read from standard input stream instead" + pure do + hashFunction <- + case optInitializeStore of + True -> case optHashFunction of + Nothing -> Except.throwE $ "--initialize requires --hash-function" + Just hf -> do + Monad.when optInitializeStore $ tryInitializeStore CreateIfNotPresent + optVerbosity hf optStoreDirectory + pure hf + False -> do + configHashFunction <- readHashFunctionFromConfig optStoreDirectory + case optHashFunction of + Just hf | hf /= configHashFunction -> Except.throwE $ + "--hash-function " <> showHashFunction hf <> + " does not match hash function " <> showHashFunction configHashFunction + <> " in " <> configFile optStoreDirectory + _ -> pure () + pure configHashFunction + + putVerboseLn optVerbosity $ "The hash function is " + <> showHashFunction hashFunction + + let store = HashAddressed.Directory.init hashFunction optStoreDirectory + + WriteResult{ contentAddressedFile, writeType } <- liftIO $ Resource.runResourceT @IO do + + input <- case optSourceFile of + Nothing -> pure IO.stdin + Just inputFile -> do + (_, h) <- Resource.allocate (IO.openBinaryFile inputFile IO.ReadMode) IO.hClose + pure h + + liftIO $ HashAddressed.Directory.writeStreaming store \(writeChunk :: Strict.ByteString -> m ()) -> do + let + loop :: m () + loop = do + x <- liftIO $ Strict.ByteString.hGetSome input 4096 + case Strict.ByteString.null x of + False -> writeChunk x *> loop + True -> pure () + loop + + putVerboseLn optVerbosity case writeType of + AlreadyPresent -> "The file was already present in the \ + \store; no change was made." + NewContent -> "One new file was added to the store." + + putNormalLn optVerbosity contentAddressedFile + + +--- Verbosity options --- + +data Verbosity = Verbosity{ quiet :: Bool, verbose :: Bool } + deriving stock (Eq, Ord) + +verboseOption :: Options.Parser Bool +verboseOption = Options.switch $ Options.long "verbose" <> Options.help + "Print miscellaneous commentary to stderr" + +quietOption :: Options.Parser Bool +quietOption = Options.switch $ Options.long "quiet" <> Options.help + "Print nothing but fatal errors" + +verbosityOption :: Options.Parser Verbosity +verbosityOption = do + quiet <- quietOption + verbose <- verboseOption + pure Verbosity{ quiet, verbose } + +putNormalLn :: MonadIO m => Verbosity -> String -> m () +putNormalLn Verbosity{ quiet } x = + if quiet then pure () else liftIO $ IO.hPutStrLn IO.stdout x + +putVerboseLn :: MonadIO m => Verbosity -> String -> m () +putVerboseLn Verbosity{ quiet, verbose } x = + if quiet || not verbose then pure () else liftIO $ IO.hPutStrLn IO.stderr x + + +--- Hash options --- + +hashFunctionOption :: Options.Parser HashFunction +hashFunctionOption = + Options.option read $ Options.long "hash-function" <> Options.help + ("Choices: " <> choices <> "; space, dash, underscore, and letter case are ignored") + where + read = do + string <- Options.str + case List.lookup (normalizeHashFunction string) hashFunctions of + Just x -> pure x + Nothing -> Monad.fail $ "Unsupported hash function. Choices are: " <> choices + choices = "[ SHA-256 ]" + +showHashFunction :: HashFunction -> String +showHashFunction = \case + SHA_256 -> "sha256" + +readHashFunctionText :: Strict.Text -> Maybe HashFunction +readHashFunctionText = Strict.Text.unpack >>> readHashFunctionString + +readHashFunctionString :: String -> Maybe HashFunction +readHashFunctionString x = List.lookup x hashFunctions + +hashFunctions :: [(String, HashFunction)] +hashFunctions = [(showHashFunction SHA_256, SHA_256)] + +normalizeHashFunction :: String -> String +normalizeHashFunction = + List.map Char.toLower . List.filter (\x -> not (List.elem x " -_")) diff --git a/hash-addressed-cli.cabal b/hash-addressed-cli.cabal new file mode 100644 --- /dev/null +++ b/hash-addressed-cli.cabal @@ -0,0 +1,55 @@ +cabal-version: 3.0 + +name: hash-addressed-cli +version: 1.0.0.0 +synopsis: Hash-addressed file storage +category: Hash, Filesystem + +description: + A command-line interface for maintaining a directory wherein each file's + name is a hash of its content. + +homepage: https://github.com/typeclasses/hash-addressed-cli +bug-reports: https://github.com/typeclasses/hash-addressed-cli/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-cli.git + +executable hash-addressed + hs-source-dirs: executable + main-is: Main.hs + + default-language: GHC2021 + ghc-options: -Wall + default-extensions: + ApplicativeDo + BlockArguments + DerivingVia + LambdaCase + NamedFieldPuns + NoImplicitPrelude + + build-depends: + , base ^>= 4.16 || ^>= 4.17 + , bytestring ^>= 0.11.3 + , cryptohash-sha256 ^>= 0.11.102 + , directory ^>= 1.3.6 + , filepath ^>= 1.4.2 + , hash-addressed ^>= 0.0.0 + , ini ^>= 0.4.2 + , optparse-applicative ^>= 0.16.1 || ^>= 0.17.0 + , quaalude ^>= 0.0.0 + , resourcet ^>= 1.2.6 || ^>= 1.3.0 + , text ^>= 1.2.5 || ^>= 2.0.1 + , transformers ^>= 0.5.6 + , unordered-containers ^>= 0.2.17 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,93 @@ +The `hash-addressed` executable is a command-line interface for maintaining a +directory wherein each file's name is a hash of its content. + + +Initialization +------------------------------------------------------------------------- + +In this demonstration, we initialize a SHA-256 hash-addressed directory at +`/tmp/demo`. + +``` +$ hash-addressed initialize --directory /tmp/demo --hash-function sha256 +``` + +This created a configuration file: + +``` +$ cat /tmp/demo/.hash-addressed/config +version: 1 +hash function: sha256 +``` + + +Writing +------------------------------------------------------------------------- + +We can now use the `hash-addressed write` command to write files into this +directory. In the output we see the path to which the content was written. + +``` +$ echo "Test file 1" | hash-addressed write --target-directory /tmp/demo +/tmp/demo/ad7a409054a68314812ba3ad0e523a66593ab3404c81700d6f5c3601f0da830e +``` + +``` +$ echo "Test file 2" | hash-addressed write --target-directory /tmp/demo +/tmp/demo/20b39ca6ca85b53be73920532fd6f9cc164317646995839e2e54a6871dc13bf7 +``` + +We can verify that the file was written and that indeed its name matches its +SHA-256 checksum: + +``` +$ cat /tmp/demo/20b39ca6ca85b53be73920532fd6f9cc164317646995839e2e54a6871dc13bf7 +Test file 2 +``` + +``` +$ sha256sum /tmp/demo/20b39ca6ca85b53be73920532fd6f9cc164317646995839e2e54a6871dc13bf7 +20b39ca6ca85b53be73920532fd6f9cc164317646995839e2e54a6871dc13bf7 +``` + + +Verbosity +------------------------------------------------------------------------- + +With the `--verbose` flag we get some additional information, including whether +the content was added or already present. + +``` +$ echo "Test file 3" | hash-addressed write --target-directory /tmp/demo --verbose +The hash function is sha256 +One new file was added to the store. +/tmp/demo/efdbe264574c7440b80a2c4aaf15c18787a125b6223d05300841f32f46361e7f +``` + +``` +$ echo "Test file 3" | hash-addressed write --target-directory /tmp/demo --verbose +The hash function is sha256 +The file was already present in the store; no change was made. +/tmp/demo/efdbe264574c7440b80a2c4aaf15c18787a125b6223d05300841f32f46361e7f +``` + + +File copying +------------------------------------------------------------------------- + +Instead of reading from the standard input stream, `hash-addressed` can also +copy a file into the store using the `--source-file` option. + +``` +$ echo "file content" > /tmp/demo-file +``` + +``` +$ hash-addressed write --source-file /tmp/demo-file --target-directory /tmp/demo +/tmp/demo/694b27f021c4861b3373cd5ddbc42695c056d0a4297d2d85e2dae040a84e61df +``` + +``` +$ cat /tmp/demo/694b27f021c4861b3373cd5ddbc42695c056d0a4297d2d85e2dae040a84e61df +file content +```