git-annex/Command/CalcKey.hs

{- git-annex command
 -
 - Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module Command.CalcKey where

import Command
import Backend (genKey)
import Types.KeySource
import Utility.Metered

cmd :: Command
cmd = noCommit $ noMessages $ dontCheck repoExists $
	command "calckey" SectionPlumbing 
		"calulate key for a file"
		(paramRepeating paramFile)
		(batchable run (pure ()))

run :: () -> SeekInput -> String -> Annex Bool
run _ _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case
	Right (k, _) -> do
		liftIO $ putStrLn $ serializeKey k
		return True
	Left _err -> return False
  where
	ks = KeySource file' file' Nothing
	file' = toRawFilePath file
calckey: New plumbing command, calculates the key that would be used to refer to a file 2016-04-20 17:49:42 +00:00			`{- git-annex command`
			`-`
			`- Copyright 2016 Joey Hess <id@joeyh.name>`
			`-`
update licenses from GPL to AGPL This does not change the overall license of the git-annex program, which was already AGPL due to a number of sources files being AGPL already. Legally speaking, I'm adding a new license under which these files are now available; I already released their current contents under the GPL license. Now they're dual licensed GPL and AGPL. However, I intend for all my future changes to these files to only be released under the AGPL license, and I won't be tracking the dual licensing status, so I'm simply changing the license statement to say it's AGPL. (In some cases, others wrote parts of the code of a file and released it under the GPL; but in all cases I have contributed a significant portion of the code in each file and it's that code that is getting the AGPL license; the GPL license of other contributors allows combining with AGPL code.) 2019-03-13 19:48:14 +00:00			`- Licensed under the GNU AGPL version 3 or higher.`
calckey: New plumbing command, calculates the key that would be used to refer to a file 2016-04-20 17:49:42 +00:00			`-}`

			`module Command.CalcKey where`

			`import Command`
			`import Backend (genKey)`
			`import Types.KeySource`
plumb MeterUpdate into getKey No behavior changes, but this shows everywhere that a progress meter could be displayed when hashing a file to add to the annex. Many of the places don't make sense to display a progress meter though, eg when importing the copy of the file probably swamps the hashing of the file. 2019-06-25 15:37:52 +00:00			`import Utility.Metered`
calckey: New plumbing command, calculates the key that would be used to refer to a file 2016-04-20 17:49:42 +00:00
			`cmd :: Command`
			`cmd = noCommit $ noMessages $ dontCheck repoExists $`
			`command "calckey" SectionPlumbing`
shorten some too-long descriptions 2019-01-16 18:16:10 +00:00			`"calulate key for a file"`
calckey: New plumbing command, calculates the key that would be used to refer to a file 2016-04-20 17:49:42 +00:00			`(paramRepeating paramFile)`
			`(batchable run (pure ()))`

add SeekInput (not yet used) No behavior changes (hopefully), just adding SeekInput and plumbing it through to the JSON display code for later use. Over the course of 2 grueling days. withFilesNotInGit reimplemented in terms of seekHelper should be the only possible behavior change. It seems to test as behaving the same. Note that seekHelper dummies up the SeekInput in the case where segmentPaths' gives up on sorting the expanded paths because there are too many input paths. When SeekInput later gets exposed as a json field, that will result in it being a little bit wrong in the case where 100 or more paths are passed to a git-annex command. I think this is a subtle enough problem to not matter. If it does turn out to be a problem, fixing it would require splitting up the input parameters into groups of < 100, which would make git ls-files run perhaps more than is necessary. May want to revisit this, because that fix seems fairly low-impact. 2020-09-14 20:49:33 +00:00			`run :: () -> SeekInput -> String -> Annex Bool`
			`run _ _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case`
change retrieveExport and getKey to throw exception retrieveExport is part of ongoing transition to make remote methods throw exceptions, rather than silently hide them. getKey very rarely fails, and when it does it's always for the same reason (user configured annex.backend to url for some reason). So, this will avoid dealing with Nothing everywhere it's used. This commit was sponsored by Ilya Shlyakhter on Patreon. 2020-05-15 16:51:09 +00:00			`Right (k, _) -> do`
rename key2file and file2key What these generate is not really suitable to be used as a filename, which is why keyFile and fileKey further escape it. These are just serializing Keys. Also removed a quickcheck test that was very unlikely to test anything useful, since it relied on random chance creating something that looks like a serialized key. The other test is sufficient for testing what that was intended to test anyway. 2019-01-14 17:03:35 +00:00			`liftIO $ putStrLn $ serializeKey k`
more lambda-case conversion 2017-12-05 19:00:50 +00:00			`return True`
change retrieveExport and getKey to throw exception retrieveExport is part of ongoing transition to make remote methods throw exceptions, rather than silently hide them. getKey very rarely fails, and when it does it's always for the same reason (user configured annex.backend to url for some reason). So, this will avoid dealing with Nothing everywhere it's used. This commit was sponsored by Ilya Shlyakhter on Patreon. 2020-05-15 16:51:09 +00:00			`Left _err -> return False`
convert KeySource to RawFilePath 2020-02-21 13:34:59 +00:00			`where`
			`ks = KeySource file' file' Nothing`
			`file' = toRawFilePath file`