1{- git-annex command
2 -
3 - Copyright 2013-2017 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Command.LookupKey where
9
10import Command
11import Annex.CatFile
12import qualified Git.LsFiles
13
14cmd :: Command
15cmd = notBareRepo $ noCommit $ noMessages $
16	command "lookupkey" SectionPlumbing
17		"looks up key used for file"
18		(paramRepeating paramFile)
19		(batchable run (pure ()))
20
21run :: () -> SeekInput -> String -> Annex Bool
22run _ _ file = seekSingleGitFile file >>= \case
23	Nothing -> return False
24	Just file' -> catKeyFile file' >>= \case
25		Just k  -> do
26			liftIO $ putStrLn $ serializeKey k
27			return True
28		Nothing -> return False
29
30-- To support absolute filenames, pass through git ls-files.
31-- But, this plumbing command does not recurse through directories.
32seekSingleGitFile :: FilePath -> Annex (Maybe RawFilePath)
33seekSingleGitFile file = do
34	(l, cleanup) <- inRepo (Git.LsFiles.inRepo [] [toRawFilePath file])
35	r <- case l of
36		(f:[]) | takeFileName (fromRawFilePath f) == takeFileName file ->
37			return (Just f)
38		_ -> return Nothing
39	void $ liftIO cleanup
40	return r
41