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