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.

diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index e88a6529ef23f9090b5f621b83d506922a218123..c25dbe5aec6426884785a287bf30f462a33fb8c1 100644 (file)
--- 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 dd4cacbd333b34d4a558e41e916a837f76f64090..b3bd319f1b134e208a27910565be4e656d4016b5 100644 (file)
--- 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 <id@joeyh.name>  Mon, 14 Sep 2020 13:13:10 -0400
 

diff --git a/Command/Config.hs b/Command/Config.hs
index f7d2ce2a5b390a81dc2e0bcbda84d0cd141810b8..4a408ab7421ae9555a33edb2adb89cb2a02f6d69 100644 (file)
--- 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 6bd1a0e1a8e6af9d51373fe5fa3aca2ac6a92368..0597484b698714399a502beb5f6ae7b140a07776 100644 (file)
--- 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 cd641536934f2e2cd90d4b0f226107475b9af46b..9e786b7b527878c0c7f66a3e4e75362ce085b283 100644 (file)
--- 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 f89e01bfd67b6a849936d636edd88e6ceda63799..2b7e3e73758a3e3cbce21afed65b415afcae2b19 100644 (file)
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2011-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  -
  - 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 dd408b34985cbebe17bb705b57b0e0ebffbbc802..fa570560196fb8e5185b8da09ccf6316d4d09e39 100644 (file)
--- 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 fd0e000a07ab42534d6cfb49cbafc2053a4a58e8..0d0e92357731bf1d9bfe5f7f87692269fe9df6b1 100644 (file)
--- 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 f53d2273a5652ddba38935d252f479af50fcf273..324f47b167213919c70675caf3431b4669e5d1f7 100644 (file)
--- 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' $
-       command ++ (maybe "" (" " ++) mdesc) ++ " "
+showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex ()
+showStartKey command key ai si = outputMessage json $
+       encodeBS' command <> " " <> actionItemDesc ai <> " "
   where
-       json = JSON.start command Nothing Nothing
+       json = JSON.start command (actionItemWorkTreeFile ai) (Just key) si
 
-showStartKey :: String -> Key -> ActionItem -> Annex ()
-showStartKey command key i = outputMessage json $
-       encodeBS' command <> " " <> actionItemDesc i <> " "
+showStartOther :: String -> Maybe String -> SeekInput -> Annex ()
+showStartOther command mdesc si = outputMessage json $ encodeBS' $
+       command ++ (maybe "" (" " ++) mdesc) ++ " "
   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 148e392c72753bd638f17c31791629f6abbb47d5..5c4726b2b27eccb512a9beb7b5c5dfdd636eeaec 100644 (file)
--- 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 <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  -
  - 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 3806d1ebfc8eecbab8e37e99c391460640d5f25d..2da131f5340fcbb0269fe144bacd02fbd10fc838 100644 (file)
--- 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