tighter --json parsing for metadata

metadata --batch --json: Reject input whose "fields" does not consist of
arrays of strings. Such invalid input used to be silently ignored.

Used to be that parseJSON for a JSONActionItem ran parseJSON separately
for the itemAdded, and if that failed, did not propagate the error. That
allowed different items with differently named fields to be parsed.
But it was actually only used to parse "fields" for metadata, so that
flexability is not needed.

The fix is just to parse "fields" as-is. AddJSONActionItemFields is needed
only because of the wonky way Command.MetaData adds onto the started json
object.

Note that this line got a dummy type signature added,
just because the type checker needs it to be some type.
itemFields = Nothing :: Maybe Bool
Since it's Nothing, it doesn't really matter what type it is,
and the value gets turned into json and is then thrown away.

Sponsored-by: Kevin Mueller on Patreon

diff --git a/CHANGELOG b/CHANGELOG
index 732bbc0baa23c0ba56fbaea79cc6518ef0e0b1c5..af8d201f031834af8363572d8f4f1078d69ab0e1 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -2,6 +2,8 @@ git-annex (8.20211029) UNRELEASED; urgency=medium
 
   * metadata --batch: Avoid crashing when a non-annexed file is input,
     instead output a blank line like other batch commands do.
+  * metadata --batch --json: Reject input whose "fields" does not consist
+    of arrays of strings. Such invalid input used to be silently ignored.
 
  -- Joey Hess <id@joeyh.name>  Mon, 01 Nov 2021 13:19:46 -0400
 

diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index 08359bf8252120cf9fde5844a8708ed260aedd7b..2ab6e37ee4b61bf75e7455766eb7e7b2064bdb41 100644 (file)
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -12,7 +12,7 @@ import Annex.MetaData
 import Annex.VectorClock
 import Logs.MetaData
 import Annex.WorkTree
-import Messages.JSON (JSONActionItem(..))
+import Messages.JSON (JSONActionItem(..), AddJSONActionItemFields(..))
 import Types.Messages
 import Utility.Aeson
 import Limit
@@ -125,7 +125,7 @@ perform c o k = case getSet o of
 cleanup :: Key -> CommandCleanup
 cleanup k = do
        m <- getCurrentMetaData k
-       case toJSON' (MetaDataFields m) of
+       case toJSON' (AddJSONActionItemFields m) of
                Object o -> maybeShowJSON $ AesonObject o
                _ -> noop
        showLongNote $ unlines $ concatMap showmeta $
@@ -135,32 +135,13 @@ cleanup k = do
        unwrapmeta (f, v) = (fromMetaField f, map fromMetaValue (S.toList v))
        showmeta (f, vs) = map ((T.unpack f ++ "=") ++) (map decodeBS vs)
 
--- Metadata serialized to JSON in the field named "fields" of
--- a larger object.
-newtype MetaDataFields = MetaDataFields MetaData
-       deriving (Show)
-
-instance ToJSON' MetaDataFields where
-       toJSON' (MetaDataFields m) = object [ (fieldsField, toJSON' m) ]
-
-instance FromJSON MetaDataFields where
-       parseJSON (Object v) = do
-               f <- v .: fieldsField
-               case f of
-                       Nothing -> return (MetaDataFields emptyMetaData)
-                       Just v' -> MetaDataFields <$> parseJSON v'
-       parseJSON _ = fail "expected an object"
-
-fieldsField :: T.Text
-fieldsField = T.pack "fields"
-
 parseJSONInput :: String -> Annex (Either String (Either RawFilePath Key, MetaData))
 parseJSONInput i = case eitherDecode (BU.fromString i) of
        Left e -> return (Left e)
        Right v -> do
-               let m = case itemAdded v of
+               let m = case itemFields v of
                        Nothing -> emptyMetaData
-                       Just (MetaDataFields m') -> m'
+                       Just m' -> m'
                case (itemKey v, itemFile v) of
                        (Just k, _) -> return $
                                Right (Right k, m)

diff --git a/Messages/JSON.hs b/Messages/JSON.hs
index 2b9f6d77a4f334f0112a80f953505e9f6a189b83..1f8a332f7ae0ae1a875f3add7ef32b2f58713f1b 100644 (file)
--- a/Messages/JSON.hs
+++ b/Messages/JSON.hs
@@ -1,6 +1,6 @@
 {- git-annex command-line JSON output and input
  -
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -26,6 +26,7 @@ module Messages.JSON (
        DualDisp(..),
        ObjectMap(..),
        JSONActionItem(..),
+       AddJSONActionItemFields(..),
 ) where
 
 import Control.Applicative
@@ -78,7 +79,7 @@ start command file key si _ = case j of
                { itemCommand = Just command
                , itemKey = key
                , itemFile = fromRawFilePath <$> file
-               , itemAdded = Nothing
+               , itemFields = Nothing :: Maybe Bool
                , itemSeekInput = si
                }
 
@@ -179,19 +180,21 @@ data JSONActionItem a = JSONActionItem
        { itemCommand :: Maybe String
        , itemKey :: Maybe Key
        , itemFile :: Maybe FilePath
-       , itemAdded :: Maybe a -- for additional fields added by `add`
+       , itemFields :: Maybe a
        , itemSeekInput :: SeekInput
        }
        deriving (Show)
 
-instance ToJSON' (JSONActionItem a) where
+instance ToJSON' a => ToJSON' (JSONActionItem a) where
        toJSON' i = object $ catMaybes
                [ Just $ "command" .= itemCommand i
                , case itemKey i of
                        Just k -> Just $ "key" .= toJSON' k
                        Nothing -> Nothing
                , Just $ "file" .= toJSON' (itemFile i)
-               -- itemAdded is not included; must be added later by 'add'
+               , case itemFields i of
+                       Just f -> Just $ "fields" .= toJSON' f
+                       Nothing -> Nothing
                , Just $ "input" .= fromSeekInput (itemSeekInput i)
                ]
 
@@ -200,8 +203,14 @@ instance FromJSON a => FromJSON (JSONActionItem a) where
                <$> (v .:? "command")
                <*> (maybe (return Nothing) parseJSON =<< (v .:? "key"))
                <*> (v .:? "file")
-               <*> parseadded
+               <*> (v .:? "fields")
                <*> pure (SeekInput [])
-         where
-               parseadded = (Just <$> parseJSON (Object v)) <|> return Nothing
        parseJSON _ = mempty
+
+-- This can be used to populate the "fields" after a JSONActionItem
+-- has already been started.
+newtype AddJSONActionItemFields a = AddJSONActionItemFields a
+       deriving (Show)
+
+instance ToJSON' a => ToJSON' (AddJSONActionItemFields a) where
+       toJSON' (AddJSONActionItemFields a) = object [ ("fields", toJSON' a) ]

diff --git a/doc/bugs/metadata_--batch_--json_should_fail_on_bad_fields.mdwn b/doc/bugs/metadata_--batch_--json_should_fail_on_bad_fields.mdwn
index 0441664fcd04b51d5492331f9e9221c5ebaba585..b7ccca4096d3190be93bedd99b19ac27f3547342 100644 (file)
--- a/doc/bugs/metadata_--batch_--json_should_fail_on_bad_fields.mdwn
+++ b/doc/bugs/metadata_--batch_--json_should_fail_on_bad_fields.mdwn
@@ -1,3 +1,5 @@
 When setting file metadata using `git-annex metadata --batch --json --json-error-messages`, if the "fields" field of an input line is not 100% an object whose values are arrays of strings, then git-annex will silently ignore the "fields" field and act as though the user simply requested the metadata for the given file/key.  It would be more useful if, whenever the input contains a "fields" field that does not match the required schema, git annex treats it as an error.  This would make it easier for users to figure out that they are doing something wrong.
 
 [[!meta author=jwodder]]
+
+> [[fixed|done]] --[[Joey]]

diff --git a/doc/bugs/metadata_--batch_--json_should_fail_on_bad_fields/comment_1_aec3f1d155adcfcc176e9948aef99056._comment b/doc/bugs/metadata_--batch_--json_should_fail_on_bad_fields/comment_1_aec3f1d155adcfcc176e9948aef99056._comment
new file mode 100644 (file)
index 0000000..01d830d
--- /dev/null
+++ b/doc/bugs/metadata_--batch_--json_should_fail_on_bad_fields/comment_1_aec3f1d155adcfcc176e9948aef99056._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2021-11-01T17:49:43Z"
+ content="""
+For example with this input:
+
+       {"file":"foo","fields":{"author":[true]}}
+
+It leaves the author field set to whatever it was before.
+
+Fixed.
+"""]]