hash-addressed-cli (empty) → 1.0.0.0
raw patch · 5 files changed
+423/−0 lines, 5 filesdep +basedep +bytestringdep +cryptohash-sha256
Dependencies added: base, bytestring, cryptohash-sha256, directory, filepath, hash-addressed, ini, optparse-applicative, quaalude, resourcet, text, transformers, unordered-containers
Files
- changelog.md +3/−0
- executable/Main.hs +259/−0
- hash-addressed-cli.cabal +55/−0
- license.txt +13/−0
- readme.md +93/−0
+ changelog.md view
@@ -0,0 +1,3 @@+## 1.0.0.0 (2023-01-27)++Initial release
+ executable/Main.hs view
@@ -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 " -_"))
+ hash-addressed-cli.cabal view
@@ -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
+ license.txt view
@@ -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.
+ readme.md view
@@ -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+```