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

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) ]