From fcf5d11c6381b0fa0d7eddf73fef5d7a6aa862a0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 15 Sep 2020 16:22:44 -0400 Subject: [PATCH] add "input" field to json output The use case of this field is mostly to support -J combined with --json. When that is implemented, a user will be able to look at the field to determine which of the requests they have sent it corresponds to. The field typically has a single value in its list, but in some cases mutliple values (eg 2 command-line params) are combined together and the list will have more. Note that json parsing was already non-strict, so old git-annex metadata --json --batch can be fed json produced by the new git-annex and will not stumble over the new field. --- Assistant/Threads/Committer.hs | 3 ++- CHANGELOG | 2 +- Command/Config.hs | 2 +- Command/FuzzTest.hs | 2 +- Command/ImportFeed.hs | 6 ++--- Command/Info.hs | 46 +++++++++++++++++----------------- Command/List.hs | 2 +- Command/Map.hs | 2 +- Messages.hs | 46 +++++++++++++++++----------------- Messages/JSON.hs | 13 +++++++--- Types/Command.hs | 2 +- 11 files changed, 66 insertions(+), 60 deletions(-) diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index e88a6529ef..c25dbe5aec 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -24,6 +24,7 @@ import Utility.ThreadScheduler import qualified Utility.Lsof as Lsof import qualified Utility.DirWatcher as DirWatcher import Types.KeySource +import Types.Command import Config import Annex.Content import Annex.Ingest @@ -286,7 +287,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do ks = keySource ld doadd = sanitycheck ks $ do (mkey, _mcache) <- liftAnnex $ do - showStart "add" $ keyFilename ks + showStart "add" (keyFilename ks) (SeekInput []) ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing maybe (failedingest change) (done change $ fromRawFilePath $ keyFilename ks) mkey add _ _ = return Nothing diff --git a/CHANGELOG b/CHANGELOG index dd4cacbd33..b3bd319f1b 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,7 +1,7 @@ git-annex (8.20200909) UNRELEASED; urgency=medium * --json output now includes a new field "input" which is the input - (filename, url, etc) that caused that json to be output. + value (filename, url, etc) that caused a json object to be output. -- Joey Hess Mon, 14 Sep 2020 13:13:10 -0400 diff --git a/Command/Config.hs b/Command/Config.hs index f7d2ce2a5b..4a408ab742 100644 --- a/Command/Config.hs +++ b/Command/Config.hs @@ -72,7 +72,7 @@ seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction where ai = ActionItemOther (Just "unset") si = SeekInput [decodeBS' name] -seek (GetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $ +seek (GetConfig ck) = checkIsGlobalConfig ck $ commandAction $ startingCustomOutput ai $ do getGlobalConfig ck >>= \case Just (ConfigValue v) -> liftIO $ S8.putStrLn v diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index 6bd1a0e1a8..0597484b69 100644 --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -36,7 +36,7 @@ start :: CommandStart start = do guardTest logf <- fromRepo gitAnnexFuzzTestLogFile - showStart "fuzztest" (toRawFilePath logf) + showStart "fuzztest" (toRawFilePath logf) (SeekInput []) logh <- liftIO $ openFile logf WriteMode void $ forever $ fuzz logh stop diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index cd64153693..9e786b7b52 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -78,7 +78,7 @@ seek o = do getFeed :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> URLString -> CommandSeek getFeed addunlockedmatcher opts cache url = do - showStart' "importfeed" (Just url) + showStartOther "importfeed" (Just url) (SeekInput []) downloadFeed url >>= \case Nothing -> showEndResult =<< feedProblem url "downloading the feed failed" @@ -124,7 +124,7 @@ getCache :: Maybe String -> Annex Cache getCache opttemplate = ifM (Annex.getState Annex.force) ( ret S.empty S.empty , do - showStart "importfeed" "checking known urls" + showStart "importfeed" "checking known urls" (SeekInput []) (is, us) <- unzip <$> knownItems showEndOk ret (S.fromList us) (S.fromList (concat is)) @@ -256,7 +256,7 @@ performDownload addunlockedmatcher opts cache todownload = case location todownl case dest of Nothing -> return True Just f -> do - showStart' "addurl" (Just url) + showStartOther "addurl" (Just url) (SeekInput []) ks <- getter f if null ks then do diff --git a/Command/Info.hs b/Command/Info.hs index f89e01bfd6..2b7e3e7375 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011-2016 Joey Hess + - Copyright 2011-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -135,34 +135,34 @@ globalInfo o = do whenM ((==) DeadTrusted <$> lookupTrust u) $ earlyWarning "Warning: This repository is currently marked as dead." stats <- selStats global_fast_stats global_slow_stats - showCustom "info" $ do + showCustom "info" (SeekInput []) $ do evalStateT (mapM_ showStat stats) (emptyStatInfo o) return True itemInfo :: InfoOptions -> (SeekInput, String) -> Annex () -itemInfo o (_, p) = ifM (isdir p) - ( dirInfo o p +itemInfo o (si, p) = ifM (isdir p) + ( dirInfo o p si , do disallowMatchingOptions v <- Remote.byName' p case v of - Right r -> remoteInfo o r + Right r -> remoteInfo o r si Left _ -> do v' <- Remote.nameToUUID' p case v' of - Right u -> uuidInfo o u + Right u -> uuidInfo o u si Left _ -> do relp <- liftIO $ relPathCwdToFile p ifAnnexed (toRawFilePath relp) - (fileInfo o relp) - (treeishInfo o p) + (fileInfo o relp si) + (treeishInfo o p si) ) where isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) -noInfo :: String -> Annex () -noInfo s = do - showStart "info" (encodeBS' s) +noInfo :: String -> SeekInput -> Annex () +noInfo s si = do + showStart "info" (encodeBS' s) si showNote $ "not a directory or an annexed file or a treeish or a remote or a uuid" showEndFail @@ -170,8 +170,8 @@ disallowMatchingOptions :: Annex () disallowMatchingOptions = whenM Limit.limited $ giveup "File matching options can only be used when getting info on a directory." -dirInfo :: InfoOptions -> FilePath -> Annex () -dirInfo o dir = showCustom (unwords ["info", dir]) $ do +dirInfo :: InfoOptions -> FilePath -> SeekInput -> Annex () +dirInfo o dir si = showCustom (unwords ["info", dir]) si $ do stats <- selStats (tostats (dir_name:tree_fast_stats True)) (tostats tree_slow_stats) @@ -180,12 +180,12 @@ dirInfo o dir = showCustom (unwords ["info", dir]) $ do where tostats = map (\s -> s dir) -treeishInfo :: InfoOptions -> String -> Annex () -treeishInfo o t = do +treeishInfo :: InfoOptions -> String -> SeekInput -> Annex () +treeishInfo o t si = do mi <- getTreeStatInfo o (Git.Ref (encodeBS' t)) case mi of - Nothing -> noInfo t - Just i -> showCustom (unwords ["info", t]) $ do + Nothing -> noInfo t si + Just i -> showCustom (unwords ["info", t]) si $ do stats <- selStats (tostats (tree_name:tree_fast_stats False)) (tostats tree_slow_stats) @@ -194,13 +194,13 @@ treeishInfo o t = do where tostats = map (\s -> s t) -fileInfo :: InfoOptions -> FilePath -> Key -> Annex () -fileInfo o file k = showCustom (unwords ["info", file]) $ do +fileInfo :: InfoOptions -> FilePath -> SeekInput -> Key -> Annex () +fileInfo o file si k = showCustom (unwords ["info", file]) si $ do evalStateT (mapM_ showStat (file_stats file k)) (emptyStatInfo o) return True -remoteInfo :: InfoOptions -> Remote -> Annex () -remoteInfo o r = showCustom (unwords ["info", Remote.name r]) $ do +remoteInfo :: InfoOptions -> Remote -> SeekInput -> Annex () +remoteInfo o r si = showCustom (unwords ["info", Remote.name r]) si $ do i <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r let u = Remote.uuid r l <- selStats @@ -209,8 +209,8 @@ remoteInfo o r = showCustom (unwords ["info", Remote.name r]) $ do evalStateT (mapM_ showStat l) (emptyStatInfo o) return True -uuidInfo :: InfoOptions -> UUID -> Annex () -uuidInfo o u = showCustom (unwords ["info", fromUUID u]) $ do +uuidInfo :: InfoOptions -> UUID -> SeekInput -> Annex () +uuidInfo o u si = showCustom (unwords ["info", fromUUID u]) si $ do l <- selStats (uuid_fast_stats u) (uuid_slow_stats u) evalStateT (mapM_ showStat l) (emptyStatInfo o) return True diff --git a/Command/List.hs b/Command/List.hs index dd408b3498..fa57056019 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -78,7 +78,7 @@ printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex () printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> RawFilePath -> Key -> CommandStart -start l si file key = do +start l _si file key = do ls <- S.fromList <$> keyLocations key liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file stop diff --git a/Command/Map.hs b/Command/Map.hs index fd0e000a07..0d0e923577 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -197,7 +197,7 @@ same a b {- reads the config of a remote, with progress display -} scan :: Git.Repo -> Annex Git.Repo scan r = do - showStart' "map" (Just $ Git.repoDescribe r) + showStartOther "map" (Just $ Git.repoDescribe r) (SeekInput []) v <- tryScan r case v of Just r' -> do diff --git a/Messages.hs b/Messages.hs index f53d2273a5..324f47b167 100644 --- a/Messages.hs +++ b/Messages.hs @@ -9,7 +9,7 @@ module Messages ( showStart, - showStart', + showStartOther, showStartMessage, showEndMessage, StartMessage(..), @@ -64,39 +64,39 @@ import Types import Types.Messages import Types.ActionItem import Types.Concurrency -import Types.Command (StartMessage(..)) +import Types.Command (StartMessage(..), SeekInput) import Types.Transfer (transferKey) import Messages.Internal import Messages.Concurrent import qualified Messages.JSON as JSON import qualified Annex -showStart :: String -> RawFilePath -> Annex () -showStart command file = outputMessage json $ +showStart :: String -> RawFilePath -> SeekInput -> Annex () +showStart command file si = outputMessage json $ encodeBS' command <> " " <> file <> " " where - json = JSON.start command (Just file) Nothing + json = JSON.start command (Just file) Nothing si -showStart' :: String -> Maybe String -> Annex () -showStart' command mdesc = outputMessage json $ encodeBS' $ +showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex () +showStartKey command key ai si = outputMessage json $ + encodeBS' command <> " " <> actionItemDesc ai <> " " + where + json = JSON.start command (actionItemWorkTreeFile ai) (Just key) si + +showStartOther :: String -> Maybe String -> SeekInput -> Annex () +showStartOther command mdesc si = outputMessage json $ encodeBS' $ command ++ (maybe "" (" " ++) mdesc) ++ " " where - json = JSON.start command Nothing Nothing - -showStartKey :: String -> Key -> ActionItem -> Annex () -showStartKey command key i = outputMessage json $ - encodeBS' command <> " " <> actionItemDesc i <> " " - where - json = JSON.start command (actionItemWorkTreeFile i) (Just key) + json = JSON.start command Nothing Nothing si showStartMessage :: StartMessage -> Annex () showStartMessage (StartMessage command ai si) = case ai of - ActionItemAssociatedFile _ k -> showStartKey command k ai - ActionItemKey k -> showStartKey command k ai - ActionItemBranchFilePath _ k -> showStartKey command k ai - ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai - ActionItemWorkTreeFile file -> showStart command file - ActionItemOther msg -> showStart' command msg + ActionItemAssociatedFile _ k -> showStartKey command k ai si + ActionItemKey k -> showStartKey command k ai si + ActionItemBranchFilePath _ k -> showStartKey command k ai si + ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai si + ActionItemWorkTreeFile file -> showStart command file si + ActionItemOther msg -> showStartOther command msg si OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si) showStartMessage (StartUsualMessages command ai si) = do outputType <$> Annex.getState Annex.output >>= \case @@ -238,9 +238,9 @@ showFullJSON v = withMessageState $ bufferJSON (JSON.complete v) - a complete JSON document. - This is only needed when showStart and showEndOk is not used. -} -showCustom :: String -> Annex Bool -> Annex () -showCustom command a = do - outputMessage (JSON.start command Nothing Nothing) "" +showCustom :: String -> SeekInput -> Annex Bool -> Annex () +showCustom command si a = do + outputMessage (JSON.start command Nothing Nothing si) "" r <- a outputMessage (JSON.end r) "" diff --git a/Messages/JSON.hs b/Messages/JSON.hs index 148e392c72..5c4726b2b2 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -1,6 +1,6 @@ {- git-annex command-line JSON output and input - - - Copyright 2011-2018 Joey Hess + - Copyright 2011-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -39,6 +39,7 @@ import Data.Monoid import Prelude import Types.Messages +import Types.Command (SeekInput(..)) import Key import Utility.Metered import Utility.Percentage @@ -64,8 +65,8 @@ type JSONBuilder = Maybe (Object, Bool) -> Maybe (Object, Bool) none :: JSONBuilder none = id -start :: String -> Maybe RawFilePath -> Maybe Key -> JSONBuilder -start command file key _ = case j of +start :: String -> Maybe RawFilePath -> Maybe Key -> SeekInput -> JSONBuilder +start command file key si _ = case j of Object o -> Just (o, False) _ -> Nothing where @@ -74,6 +75,7 @@ start command file key _ = case j of , itemKey = key , itemFile = fromRawFilePath <$> file , itemAdded = Nothing + , itemSeekInput = si } end :: Bool -> JSONBuilder @@ -176,6 +178,7 @@ data JSONActionItem a = JSONActionItem , itemKey :: Maybe Key , itemFile :: Maybe FilePath , itemAdded :: Maybe a -- for additional fields added by `add` + , itemSeekInput :: SeekInput } deriving (Show) @@ -183,10 +186,11 @@ instance ToJSON' (JSONActionItem a) where toJSON' i = object $ catMaybes [ Just $ "command" .= itemCommand i , case itemKey i of - Nothing -> Nothing Just k -> Just $ "key" .= toJSON' k + Nothing -> Nothing , Just $ "file" .= toJSON' (itemFile i) -- itemAdded is not included; must be added later by 'add' + , Just $ "input" .= fromSeekInput (itemSeekInput i) ] instance FromJSON a => FromJSON (JSONActionItem a) where @@ -195,6 +199,7 @@ instance FromJSON a => FromJSON (JSONActionItem a) where <*> (maybe (return Nothing) parseJSON =<< (v .:? "key")) <*> (v .:? "file") <*> parseadded + <*> pure (SeekInput []) where parseadded = (Just <$> parseJSON (Object v)) <|> return Nothing parseJSON _ = mempty diff --git a/Types/Command.hs b/Types/Command.hs index 3806d1ebfc..2da131f534 100644 --- a/Types/Command.hs +++ b/Types/Command.hs @@ -40,7 +40,7 @@ type CommandCleanup = Annex Bool {- Input that was seeked on to make an ActionItem. Eg, the input filename, - or directory name. -} -newtype SeekInput = SeekInput [String] +newtype SeekInput = SeekInput { fromSeekInput :: [String] } deriving (Show) {- Message that is displayed when starting to perform an action on