mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

tighter --json parsing for metadata

Browse source 
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
This commit is contained in:
Joey Hess 2021-11-01 14:40:33 -04:00
parent 70c06b4434
commit 438e5b56aa
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 38 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

27
Command/MetaData.hs
View file

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