packages feed

hash-addressed-cli 1.0.0.0 → 2.0.0.0

raw patch · 23 files changed

+651/−255 lines, 23 filesdep +containersdep +hash-addressed-clidep +safe-exceptions

Dependencies added: containers, hash-addressed-cli, safe-exceptions

Files

changelog.md view
@@ -1,3 +1,9 @@+## 2.0.0.0 (2023-01-28)++Added a `--link` option to the `write` command++Add a library to expose the app's internals+ ## 1.0.0.0 (2023-01-27)  Initial release
executable/Main.hs view
@@ -2,258 +2,20 @@  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 HashAddressed.App.Command.Examples.Main (mainCommand)+import Prelude (IO) -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+    action <- Options.execParser mainCommand     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 " -_"))+        Either.Left xs -> do+            traverse_ (IO.hPutStrLn IO.stderr) xs+            Exit.exitFailure
hash-addressed-cli.cabal view
@@ -1,8 +1,8 @@ cabal-version: 3.0  name: hash-addressed-cli-version: 1.0.0.0-synopsis: Hash-addressed file storage+version: 2.0.0.0+synopsis: Hash-addressed file storage app category: Hash, Filesystem  description:@@ -25,10 +25,7 @@     type: git     location: git://github.com/typeclasses/hash-addressed-cli.git -executable hash-addressed-    hs-source-dirs: executable-    main-is: Main.hs-+common base     default-language: GHC2021     ghc-options: -Wall     default-extensions:@@ -38,10 +35,10 @@         LambdaCase         NamedFieldPuns         NoImplicitPrelude-     build-depends:       , base ^>= 4.16 || ^>= 4.17       , bytestring ^>= 0.11.3+      , containers ^>= 0.6.5       , cryptohash-sha256 ^>= 0.11.102       , directory ^>= 1.3.6       , filepath ^>= 1.4.2@@ -50,6 +47,41 @@       , optparse-applicative ^>= 0.16.1 || ^>= 0.17.0       , quaalude ^>= 0.0.0       , resourcet ^>= 1.2.6 || ^>= 1.3.0+      , safe-exceptions ^>= 0.1.7       , text ^>= 1.2.5 || ^>= 2.0.1       , transformers ^>= 0.5.6       , unordered-containers ^>= 0.2.17++library+    import: base+    hs-source-dirs: library+    exposed-modules:+        HashAddressed.App.Command.Type+        HashAddressed.App.Command.Examples+        HashAddressed.App.Command.Examples.Initialize+        HashAddressed.App.Command.Examples.Main+        HashAddressed.App.Command.Examples.Version+        HashAddressed.App.Command.Examples.Write++        HashAddressed.App.HashFunction+        HashAddressed.App.HashFunction.Naming+        HashAddressed.App.HashFunction.Options++        HashAddressed.App.Verbosity+        HashAddressed.App.Verbosity.Type+        HashAddressed.App.Verbosity.Options+        HashAddressed.App.Verbosity.Printing++        HashAddressed.App.Meta+        HashAddressed.App.Meta.Initialization+        HashAddressed.App.Meta.Paths+        HashAddressed.App.Meta.Reading+        HashAddressed.App.Meta.Version++        HashAddressed.App.Version++executable hash-addressed+    import: base+    hs-source-dirs: executable+    main-is: Main.hs+    build-depends: hash-addressed-cli
+ library/HashAddressed/App/Command/Examples.hs view
@@ -0,0 +1,11 @@+module HashAddressed.App.Command.Examples+  (+    {- * Main command -} mainCommand,+    {- * Subcommands -} initializeCommand, writeCommand, versionCommand,+  )+  where++import HashAddressed.App.Command.Examples.Initialize+import HashAddressed.App.Command.Examples.Main+import HashAddressed.App.Command.Examples.Version+import HashAddressed.App.Command.Examples.Write
+ library/HashAddressed/App/Command/Examples/Initialize.hs view
@@ -0,0 +1,31 @@+module HashAddressed.App.Command.Examples.Initialize+  (+    initializeCommand,+  )+  where++import Essentials+import HashAddressed.App.Command.Type+import HashAddressed.App.HashFunction.Options+import HashAddressed.App.Meta.Initialization+import HashAddressed.App.Verbosity.Options++import qualified Options.Applicative as Options++initializeCommand :: Command+initializeCommand =  Options.info (parser <**> Options.helper) $+    Options.progDesc "Initialize a hash-addressed store"+  where+    parser :: Options.Parser (CommandAction ())+    parser = do+        optStoreDirectory <- Options.strOption $ Options.long "directory" <>+            Options.help "Where the hash-addressed files are located"++        optHashFunction <- Options.option hashFunctionRead $+            Options.long "hash-function" <>+            Options.help hashFunctionInstructions++        optVerbosity <- verbosityOption++        pure $ tryInitializeStore CreateNew optVerbosity optHashFunction+            optStoreDirectory
+ library/HashAddressed/App/Command/Examples/Main.hs view
@@ -0,0 +1,23 @@+module HashAddressed.App.Command.Examples.Main+  (+    mainCommand,+  )+  where++import Essentials+import HashAddressed.App.Command.Examples.Initialize+import HashAddressed.App.Command.Examples.Version+import HashAddressed.App.Command.Examples.Write+import HashAddressed.App.Command.Type++import qualified Options.Applicative as Options++mainCommand :: Command+mainCommand = Options.info (parser <**> Options.helper) $+    Options.progDesc "Hash-addressed file storage"+  where+    parser :: Options.Parser (CommandAction ())+    parser = Options.subparser $+        Options.command "version" versionCommand <>+        Options.command "initialize" initializeCommand <>+        Options.command "write" writeCommand
+ library/HashAddressed/App/Command/Examples/Version.hs view
@@ -0,0 +1,22 @@+module HashAddressed.App.Command.Examples.Version+  (+    versionCommand,+  )+  where++import Essentials+import HashAddressed.App.Command.Type++import HashAddressed.App.Version (version)+import Control.Monad.IO.Class (liftIO)++import qualified Options.Applicative as Options+import qualified System.IO as IO++versionCommand :: Command+versionCommand = Options.info (parser <**> Options.helper) $+    Options.progDesc "Print version numbers"+  where+    parser :: Options.Parser (CommandAction ())+    parser = pure do+        liftIO $ IO.putStrLn $ "hash-addressed " <> version
+ library/HashAddressed/App/Command/Examples/Write.hs view
@@ -0,0 +1,129 @@+module HashAddressed.App.Command.Examples.Write+  (+    writeCommand,+  )+  where++import Essentials+import HashAddressed.App.Command.Type+import HashAddressed.App.HashFunction.Naming+import HashAddressed.App.HashFunction.Options+import HashAddressed.App.Meta.Initialization+import HashAddressed.App.Meta.Paths+import HashAddressed.App.Meta.Reading+import HashAddressed.App.Verbosity.Options+import HashAddressed.App.Verbosity.Printing+import HashAddressed.App.Verbosity.Type+import HashAddressed.HashFunction++import Control.Monad.IO.Class (liftIO)+import HashAddressed.Directory (WriteResult (..), WriteType (..))+import Prelude (FilePath, IO)+import Data.Foldable (fold)++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 HashAddressed.Directory+import qualified Options.Applicative as Options+import qualified System.IO as IO+import qualified Data.Sequence as Seq+import qualified Control.Exception.Safe as Exception+import qualified Data.Either as Either+import qualified System.Directory as Directory++writeCommand :: Command+writeCommand = Options.info (parser <**> Options.helper) $ Options.progDesc+    "Copy from the standard input stream (or a file, see --source-file) \+    \to a hash-addressed store (see --target-directory)"+  where+    parser :: Options.Parser (CommandAction ())+    parser = do+        optStoreDirectory :: FilePath <-+            Options.strOption $ Options.long "target-directory" <>+                Options.help "Where the hash-addressed files are located"++        optSourceFile :: Maybe FilePath <-+            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"++        optLinks :: [FilePath] <-+            Options.many $ Options.strOption $ Options.long "link" <>+                Options.help "After writing, create a symbolic link at this path \+                    \that points to the hash-addressed file. \+                    \This option may be given more than once to create multiple links. \+                    \The destination path path must be empty and its parent directory \+                    \must already exist. The process returns a non-zero exit code if \+                    \any of the links cannot be created."++        optInitializeStore :: Bool <-+            Options.switch $ Options.long "initialize" <>+                Options.help "Set up a hash-addressed store if one does not already exist. \+                \If this option is given, --hash-function is required."++        optHashFunction :: Maybe HashFunction <- Options.optional $+            Options.option hashFunctionRead $ Options.long "hash-function" <>+                Options.help ("If --initialize is given, use this flag to specify the hash \+                    \function. If a store exists, fail unless it used this hash function. "+                    <> hashFunctionInstructions)++        optVerbosity :: Verbosity <- verbosityOption++        pure do+            hashFunction <-+                case optInitializeStore of+                    True -> case optHashFunction of+                        Nothing -> Except.throwE $ Seq.singleton $ "--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 $ Seq.singleton $+                                "--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++            putNormalLn optVerbosity contentAddressedFile++            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."++            linkFailures <- fmap fold $ liftIO $ optLinks & traverse \linkToBeCreated ->+                Exception.tryIO (Directory.createFileLink contentAddressedFile linkToBeCreated) <&> \case+                    Either.Left _ -> Seq.singleton $ "Failed to create link " <> linkToBeCreated+                    Either.Right () -> Seq.empty++            Monad.unless (Seq.null linkFailures) $ Except.throwE linkFailures
+ library/HashAddressed/App/Command/Type.hs view
@@ -0,0 +1,16 @@+module HashAddressed.App.Command.Type+  (+    Command,+    CommandAction,+  )+  where++import Prelude (IO, String)+import Data.Sequence (Seq)++import qualified Control.Monad.Trans.Except as Except+import qualified Options.Applicative as Options++type Command = Options.ParserInfo (CommandAction ())++type CommandAction a = Except.ExceptT (Seq String) IO a
+ library/HashAddressed/App/HashFunction.hs view
@@ -0,0 +1,10 @@+module HashAddressed.App.HashFunction+  (+    {- * Naming -} readHashFunctionText, readHashFunctionString,+            showHashFunction, normalizeHashFunction,+    {- * Options -} hashFunctionRead, hashFunctionInstructions,+  )+  where++import HashAddressed.App.HashFunction.Naming+import HashAddressed.App.HashFunction.Options
+ library/HashAddressed/App/HashFunction/Naming.hs view
@@ -0,0 +1,37 @@+module HashAddressed.App.HashFunction.Naming+  (+    readHashFunctionText,+    readHashFunctionString,+    showHashFunction,+    normalizeHashFunction,+    hashFunctions,+  )+  where++import Essentials++import Data.Bool (not)+import HashAddressed.HashFunction (HashFunction (SHA_256))+import Prelude (String)++import qualified Data.Char as Char+import qualified Data.List as List+import qualified Data.Text as Strict+import qualified Data.Text as Strict.Text++hashFunctions :: [(String, HashFunction)]+hashFunctions = [(showHashFunction SHA_256, SHA_256)]++readHashFunctionText :: Strict.Text -> Maybe HashFunction+readHashFunctionText = Strict.Text.unpack >>> readHashFunctionString++readHashFunctionString :: String -> Maybe HashFunction+readHashFunctionString x = List.lookup x hashFunctions++showHashFunction :: HashFunction -> String+showHashFunction = \case+    SHA_256 -> "sha256"++normalizeHashFunction :: String -> String+normalizeHashFunction =+    List.map Char.toLower . List.filter (\x -> not (List.elem x " -_"))
+ library/HashAddressed/App/HashFunction/Options.hs view
@@ -0,0 +1,30 @@+module HashAddressed.App.HashFunction.Options+  (+    hashFunctionRead,+    hashFunctionInstructions,+  )+  where++import Essentials+import HashAddressed.App.HashFunction.Naming++import HashAddressed.HashFunction (HashFunction)+import Prelude (String)++import qualified Control.Monad as Monad+import qualified Data.List as List+import qualified Options.Applicative as Options++hashFunctionRead :: Options.ReadM HashFunction+hashFunctionRead = 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 :: String+choices = "[ SHA-256 ]"++hashFunctionInstructions :: String+hashFunctionInstructions = "Choices: " <> choices <>+    "; space, dash, underscore, and letter case are ignored"
+ library/HashAddressed/App/Meta.hs view
@@ -0,0 +1,14 @@+module HashAddressed.App.Meta+  (+    {- * Initialization -} defaultConfigINI, tryInitializeStore,+            initializeStore, InitializationType (..),+    {- * Paths -} metaDirectory, configFile,+    {- * Reading -} readHashFunctionFromConfig,+    {- * Version -} Version (..),+  )+  where++import HashAddressed.App.Meta.Initialization+import HashAddressed.App.Meta.Paths+import HashAddressed.App.Meta.Reading+import HashAddressed.App.Meta.Version
+ library/HashAddressed/App/Meta/Initialization.hs view
@@ -0,0 +1,47 @@+module HashAddressed.App.Meta.Initialization+  (+    defaultConfigINI, tryInitializeStore, initializeStore,+    InitializationType (..),+  )+  where++import Essentials+import HashAddressed.App.HashFunction.Naming+import HashAddressed.App.Meta.Paths+import HashAddressed.App.Verbosity.Printing+import HashAddressed.App.Verbosity.Type+import HashAddressed.App.Command.Type++import Control.Monad.IO.Class (liftIO)+import HashAddressed.HashFunction (HashFunction)+import Prelude (FilePath)++import qualified Data.ByteString as Strict.ByteString+import qualified Data.Ini as INI+import qualified Data.Text as Strict.Text+import qualified Data.Text.Encoding as Strict.Text+import qualified System.Directory as Directory++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))]++tryInitializeStore :: InitializationType -> Verbosity -> HashFunction -> FilePath -> CommandAction ()+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 -> CommandAction ()+initializeStore optHashFunction optStoreDirectory = do+    liftIO $ Directory.createDirectoryIfMissing True (metaDirectory optStoreDirectory)+    liftIO $ Strict.ByteString.writeFile (configFile optStoreDirectory) $+        Strict.Text.encodeUtf8 (INI.printIni (defaultConfigINI optHashFunction))
+ library/HashAddressed/App/Meta/Paths.hs view
@@ -0,0 +1,14 @@+module HashAddressed.App.Meta.Paths+  (+    metaDirectory, configFile,+  )+  where++import Prelude (FilePath)+import System.FilePath ((</>))++metaDirectory :: FilePath -> FilePath+metaDirectory storeDirectory = storeDirectory </> ".hash-addressed"++configFile :: FilePath -> FilePath+configFile storeDirectory = metaDirectory storeDirectory </> "config"
+ library/HashAddressed/App/Meta/Reading.hs view
@@ -0,0 +1,62 @@+module HashAddressed.App.Meta.Reading+  (+    readHashFunctionFromConfig,+  )+  where++import Essentials+import HashAddressed.App.HashFunction.Naming+import HashAddressed.App.Meta.Paths+import HashAddressed.App.Meta.Version+import HashAddressed.App.Command.Type++import Control.Monad.IO.Class (liftIO)+import HashAddressed.HashFunction (HashFunction)+import Prelude (FilePath)++import qualified Data.Sequence as Seq+import qualified Control.Monad.Trans.Except as Except+import qualified Data.ByteString as Strict.ByteString+import qualified Data.Either as Either+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Ini as INI+import qualified Data.Text as Strict.Text+import qualified Data.Text.Encoding as Strict.Text++readHashFunctionFromConfig :: FilePath -> CommandAction HashFunction+readHashFunctionFromConfig storeDirectory = do++    bs <- liftIO $ Strict.ByteString.readFile (configFile storeDirectory)++    text <- case Strict.Text.decodeUtf8' bs of+        Either.Left _ -> Except.throwE $ Seq.singleton $+            "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 $ Seq.singleton $+            "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 $ Seq.singleton $+            "Missing version in config file " <> configFile storeDirectory+        Just x -> pure x++    _configVersion <- case Strict.Text.unpack versionText of+        "1" -> pure V1+        v -> Except.throwE $ Seq.singleton $+            "Unsupported config version " <> v <> " " <> configFile storeDirectory++    hashFunctionText <- case HashMap.lookup (Strict.Text.pack "hash function") map of+        Nothing -> Except.throwE $ Seq.singleton $+            "Missing hash function in config file " <> configFile storeDirectory+        Just x -> pure x++    case readHashFunctionText hashFunctionText of+        Nothing -> Except.throwE $ Seq.singleton $+            "Unsupported hash function " <> Strict.Text.unpack hashFunctionText+            <> " in config file " <> configFile storeDirectory+        Just x -> pure x
+ library/HashAddressed/App/Meta/Version.hs view
@@ -0,0 +1,7 @@+module HashAddressed.App.Meta.Version+  (+    Version (..),+  )+  where++data Version = V1
+ library/HashAddressed/App/Verbosity.hs view
@@ -0,0 +1,11 @@+module HashAddressed.App.Verbosity+  (+    {- * Type -} Verbosity (..),+    {- * Printing -} putNormalLn, putVerboseLn,+    {- * Options -} verboseOption, quietOption, verbosityOption,+  )+  where++import HashAddressed.App.Verbosity.Options+import HashAddressed.App.Verbosity.Printing+import HashAddressed.App.Verbosity.Type
+ library/HashAddressed/App/Verbosity/Options.hs view
@@ -0,0 +1,24 @@+module HashAddressed.App.Verbosity.Options+  (+    verboseOption, quietOption, verbosityOption,+  )+  where++import Essentials+import HashAddressed.App.Verbosity.Type++import qualified Options.Applicative as Options++verboseOption :: Options.Parser Bool+verboseOption = Options.switch $ Options.long "verbose" <> Options.help+    "Print miscellaneous commentary to the standard error stream"++quietOption :: Options.Parser Bool+quietOption = Options.switch $ Options.long "quiet" <> Options.help+    "Do not print normal output to the standard output stream"++verbosityOption :: Options.Parser Verbosity+verbosityOption = do+    quiet <- quietOption+    verbose <- verboseOption+    pure Verbosity{ quiet, verbose }
+ library/HashAddressed/App/Verbosity/Printing.hs view
@@ -0,0 +1,34 @@+module HashAddressed.App.Verbosity.Printing+  (+    putNormalLn,+    putVerboseLn,+  )+  where++import Essentials+import HashAddressed.App.Verbosity.Type++import Control.Monad.IO.Class (MonadIO, liftIO)+import Prelude (String)++import qualified Control.Monad as Monad+import qualified System.IO as IO++{-| For output that one might want to use programmatically++    Goes to stdout.++    Can be suppressed with the @--quiet@ flag. -}+putNormalLn :: MonadIO m => Verbosity -> String -> m ()+putNormalLn Verbosity{ quiet } x =+    Monad.unless quiet $ liftIO $ IO.hPutStrLn IO.stdout x++{-| For extra chatty messages++    Goes to stderr so that the output that one might want to use+    programmatically can be captured separately.++    Does not print unless the @--verbose@ flag is used. -}+putVerboseLn :: MonadIO m => Verbosity -> String -> m ()+putVerboseLn Verbosity{ verbose } x =+    Monad.when verbose $ liftIO $ IO.hPutStrLn IO.stderr x
+ library/HashAddressed/App/Verbosity/Type.hs view
@@ -0,0 +1,15 @@+module HashAddressed.App.Verbosity.Type+  (+    Verbosity (..),+  )+  where++import Essentials++-- | On non-zero exit code, @stderr@ messages are printed regardless of verbosity+data Verbosity =+    Verbosity+      { quiet :: Bool -- ^ Controls whether normal @stdout@ output is printed+      , verbose :: Bool -- ^ Controls whether chatty @stderr@ output is printed+      }+    deriving stock (Eq, Ord)
+ library/HashAddressed/App/Version.hs view
@@ -0,0 +1,10 @@+module HashAddressed.App.Version+  (+    version,+  )+  where++import Prelude (String)++version :: String+version = "2"
readme.md view
@@ -51,24 +51,73 @@ ```  +Symbolic links+-------------------------------------------------------------------------++A place to put links for demonstration:++```+$ mkdir --parents /tmp/demo-links+```++You can use the `--link` option with the `write` command to create symbolic+links to the hash-addressed content.++```+$ echo "whatever" | hash-addressed write --target-directory /tmp/demo --link /tmp/demo-links/link-1+/tmp/demo/cd293be6cea034bd45a0352775a219ef5dc7825ce55d1f7dae9762d80ce64411+```++Observing that the link was written:++```+$ readlink /tmp/demo-links/link-1+/tmp/demo/cd293be6cea034bd45a0352775a219ef5dc7825ce55d1f7dae9762d80ce64411+```++```+$ cat /tmp/demo-links/link-1+whatever+```++ Verbosity ------------------------------------------------------------------------- -With the `--verbose` flag we get some additional information, including whether-the content was added or already present.+Use the `--verbose` flag to get some additional information, printed to the+standard error stream.  ``` $ 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+One new file was added to the store. ```  ``` $ 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+The file was already present in the store; no change was made.+```++Use the `--quiet` flag to suppress what is normally printed to the standard+output stream.++```+$ echo "Test file 4" | hash-addressed write --target-directory /tmp/demo --quiet+```++Fatal errors resulting in non-zero status code are always printed to the+standard error stream regardless of what command-line options are given. In the+following demonstration, the `--link` instruction succeeds the first time+(printing nothing because we use `--quiet`), but we see an error message the+second time because the link already exists.++```+$ echo "Test file 4" | hash-addressed write --target-directory /tmp/demo --quiet --link /tmp/demo-links/link-2+$ echo "Test file 4" | hash-addressed write --target-directory /tmp/demo --quiet --link /tmp/demo-links/link-2+Failed to create link /tmp/demo-links/link-2 ```