configremote: Support --json and --json-error-messages

Seems unlikely to be too useful, but who knows.

Moved the checkSafeConfig call to happen after an action is started, so
it will be captured by --json-error-messages

Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project
This commit is contained in:
Joey Hess 2023-05-10 14:19:32 -04:00
parent a242eabc7a
commit de84abb210
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 22 additions and 21 deletions

View file

@ -20,41 +20,43 @@ import Command.EnableRemote (unknownNameError, startSpecialRemote', PerformSpeci
import qualified Data.Map as M
cmd :: Command
cmd = command "configremote" SectionSetup
"changes special remote configuration"
(paramPair paramName $ paramOptional $ paramRepeating paramParamValue)
(withParams seek)
cmd = withAnnexOptions [jsonOptions] $
command "configremote" SectionSetup
"changes special remote configuration"
(paramPair paramName $ paramOptional $ paramRepeating paramParamValue)
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start [] = unknownNameError "Specify the remote to configure."
start (name:rest) = do
cfg <- safeConfig rest
deadLast name $ startSpecialRemote name cfg
start (name:inputconfig) = deadLast name $
startSpecialRemote (checkSafeConfig inputconfig) name
(Logs.Remote.keyValToConfig Proposed inputconfig)
{- Since this command stores config without calling the remote's setup
- method to validate it, it can only be used on fields that are known to
- be safe to change in all remotes. -}
safeConfig :: [String] -> Annex Remote.RemoteConfig
safeConfig cs = do
checkSafeConfig :: [String] -> Annex ()
checkSafeConfig cs = do
let rc = Logs.Remote.keyValToConfig Proposed cs
forM_ (M.keys rc) $ \k ->
when (fromProposedAccepted k `notElem` safefields) $
giveup $ "Cannot change field \"" ++ fromProposedAccepted k ++ "\" with this command. Use git-annex enableremote instead."
case SpecialRemote.parseRemoteConfig rc (Remote.RemoteConfigParser ps Nothing) of
Left err -> giveup err
Right _ -> return rc
Right _ -> return ()
where
ps = [ SpecialRemote.autoEnableFieldParser ]
safefields = [ fromProposedAccepted SpecialRemote.autoEnableField ]
startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart
startSpecialRemote = startSpecialRemote' "configremote" performSpecialRemote
startSpecialRemote :: Annex () -> Git.RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart
startSpecialRemote = startSpecialRemote' "configremote" . performSpecialRemote
performSpecialRemote :: PerformSpecialRemote
performSpecialRemote _ u _ c _ mcu = do
performSpecialRemote :: Annex () -> PerformSpecialRemote
performSpecialRemote precheck _ u _ c _ mcu = do
precheck
case mcu of
Nothing -> Logs.Remote.configSet u c
Just (SpecialRemote.ConfigFrom cu) ->