diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,13 @@ +Version format `A.B.C.D`: + +- Raise `A` for any changes that affect the executable behavior +- Raise `B` for breaking changes to the library +- Raise `C` for reverse-compatible changes to the library + +## 2.1.0.0 (2023-01-31) + +Raise `hash-addressed` version to `0.1` + ## 2.0.0.0 (2023-01-28) Added a `--link` option to the `write` command diff --git a/hash-addressed-cli.cabal b/hash-addressed-cli.cabal --- a/hash-addressed-cli.cabal +++ b/hash-addressed-cli.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: hash-addressed-cli -version: 2.0.0.0 +version: 2.1.0.0 synopsis: Hash-addressed file storage app category: Hash, Filesystem @@ -42,9 +42,10 @@ , cryptohash-sha256 ^>= 0.11.102 , directory ^>= 1.3.6 , filepath ^>= 1.4.2 - , hash-addressed ^>= 0.0.0 + , hash-addressed ^>= 0.1.0 , ini ^>= 0.4.2 , optparse-applicative ^>= 0.16.1 || ^>= 0.17.0 + , pipes ^>= 4.3.16 , quaalude ^>= 0.0.0 , resourcet ^>= 1.2.6 || ^>= 1.3.0 , safe-exceptions ^>= 0.1.7 diff --git a/library/HashAddressed/App/Command/Examples/Write.hs b/library/HashAddressed/App/Command/Examples/Write.hs --- a/library/HashAddressed/App/Command/Examples/Write.hs +++ b/library/HashAddressed/App/Command/Examples/Write.hs @@ -14,7 +14,6 @@ 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 (..)) @@ -24,7 +23,6 @@ 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 @@ -33,6 +31,7 @@ import qualified Control.Exception.Safe as Exception import qualified Data.Either as Either import qualified System.Directory as Directory +import qualified Pipes writeCommand :: Command writeCommand = Options.info (parser <**> Options.helper) $ Options.progDesc @@ -64,7 +63,7 @@ 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 $ + optHashFunction :: Maybe HashFunctionName <- 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. " @@ -94,9 +93,9 @@ putVerboseLn optVerbosity $ "The hash function is " <> showHashFunction hashFunction - let store = HashAddressed.Directory.init hashFunction optStoreDirectory + let store = HashAddressed.Directory.Directory optStoreDirectory (resolveHashFunction hashFunction) - WriteResult{ contentAddressedFile, writeType } <- liftIO $ Resource.runResourceT @IO do + ((), WriteResult{ hashAddressedFile, writeType }) <- liftIO $ Resource.runResourceT @IO do input <- case optSourceFile of Nothing -> pure IO.stdin @@ -104,25 +103,22 @@ (_, 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 + liftIO $ HashAddressed.Directory.writeStream store $ + let + loop = do x <- liftIO $ Strict.ByteString.hGetSome input 4096 - case Strict.ByteString.null x of - False -> writeChunk x *> loop - True -> pure () + Monad.unless (Strict.ByteString.null x) (Pipes.yield x *> loop) + in loop - putNormalLn optVerbosity contentAddressedFile + putNormalLn optVerbosity hashAddressedFile 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 + Exception.tryIO (Directory.createFileLink hashAddressedFile linkToBeCreated) <&> \case Either.Left _ -> Seq.singleton $ "Failed to create link " <> linkToBeCreated Either.Right () -> Seq.empty diff --git a/library/HashAddressed/App/HashFunction.hs b/library/HashAddressed/App/HashFunction.hs --- a/library/HashAddressed/App/HashFunction.hs +++ b/library/HashAddressed/App/HashFunction.hs @@ -1,7 +1,7 @@ module HashAddressed.App.HashFunction ( - {- * Naming -} readHashFunctionText, readHashFunctionString, - showHashFunction, normalizeHashFunction, + {- * Naming -} HashFunctionName (..), readHashFunctionText, readHashFunctionString, + showHashFunction, normalizeHashFunction, resolveHashFunction, {- * Options -} hashFunctionRead, hashFunctionInstructions, ) where diff --git a/library/HashAddressed/App/HashFunction/Naming.hs b/library/HashAddressed/App/HashFunction/Naming.hs --- a/library/HashAddressed/App/HashFunction/Naming.hs +++ b/library/HashAddressed/App/HashFunction/Naming.hs @@ -1,34 +1,44 @@ module HashAddressed.App.HashFunction.Naming ( + HashFunctionName (..), readHashFunctionText, readHashFunctionString, showHashFunction, normalizeHashFunction, hashFunctions, + resolveHashFunction, ) where import Essentials import Data.Bool (not) -import HashAddressed.HashFunction (HashFunction (SHA_256)) +import HashAddressed.HashFunction (HashFunction) 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 +import qualified HashAddressed.HashFunction as Hash -hashFunctions :: [(String, HashFunction)] +data HashFunctionName = SHA_256 + deriving Eq + +resolveHashFunction :: HashFunctionName -> HashFunction +resolveHashFunction = \case + SHA_256 -> Hash.sha256 + +hashFunctions :: [(String, HashFunctionName)] hashFunctions = [(showHashFunction SHA_256, SHA_256)] -readHashFunctionText :: Strict.Text -> Maybe HashFunction +readHashFunctionText :: Strict.Text -> Maybe HashFunctionName readHashFunctionText = Strict.Text.unpack >>> readHashFunctionString -readHashFunctionString :: String -> Maybe HashFunction +readHashFunctionString :: String -> Maybe HashFunctionName readHashFunctionString x = List.lookup x hashFunctions -showHashFunction :: HashFunction -> String +showHashFunction :: HashFunctionName -> String showHashFunction = \case SHA_256 -> "sha256" diff --git a/library/HashAddressed/App/HashFunction/Options.hs b/library/HashAddressed/App/HashFunction/Options.hs --- a/library/HashAddressed/App/HashFunction/Options.hs +++ b/library/HashAddressed/App/HashFunction/Options.hs @@ -8,14 +8,13 @@ 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 :: Options.ReadM HashFunctionName hashFunctionRead = do string <- Options.str case List.lookup (normalizeHashFunction string) hashFunctions of diff --git a/library/HashAddressed/App/Meta/Initialization.hs b/library/HashAddressed/App/Meta/Initialization.hs --- a/library/HashAddressed/App/Meta/Initialization.hs +++ b/library/HashAddressed/App/Meta/Initialization.hs @@ -13,7 +13,6 @@ 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 @@ -22,13 +21,13 @@ import qualified Data.Text.Encoding as Strict.Text import qualified System.Directory as Directory -defaultConfigINI :: HashFunction -> INI.Ini +defaultConfigINI :: HashFunctionName -> 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 -> Verbosity -> HashFunctionName -> FilePath -> CommandAction () tryInitializeStore initializationType optVerbosity optHashFunction optStoreDirectory = do liftIO (Directory.doesPathExist (metaDirectory optStoreDirectory)) >>= \case False -> initializeStore optHashFunction optStoreDirectory @@ -40,7 +39,7 @@ data InitializationType = CreateNew | CreateIfNotPresent {-| Assumes a store does not already exist -} -initializeStore :: HashFunction -> FilePath -> CommandAction () +initializeStore :: HashFunctionName -> FilePath -> CommandAction () initializeStore optHashFunction optStoreDirectory = do liftIO $ Directory.createDirectoryIfMissing True (metaDirectory optStoreDirectory) liftIO $ Strict.ByteString.writeFile (configFile optStoreDirectory) $ diff --git a/library/HashAddressed/App/Meta/Reading.hs b/library/HashAddressed/App/Meta/Reading.hs --- a/library/HashAddressed/App/Meta/Reading.hs +++ b/library/HashAddressed/App/Meta/Reading.hs @@ -11,7 +11,6 @@ import HashAddressed.App.Command.Type import Control.Monad.IO.Class (liftIO) -import HashAddressed.HashFunction (HashFunction) import Prelude (FilePath) import qualified Data.Sequence as Seq @@ -23,7 +22,7 @@ import qualified Data.Text as Strict.Text import qualified Data.Text.Encoding as Strict.Text -readHashFunctionFromConfig :: FilePath -> CommandAction HashFunction +readHashFunctionFromConfig :: FilePath -> CommandAction HashFunctionName readHashFunctionFromConfig storeDirectory = do bs <- liftIO $ Strict.ByteString.readFile (configFile storeDirectory)