git-annex/Command/ConfigRemote.hs
Joey Hess de84abb210
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
2023-05-10 14:21:42 -04:00

64 lines
2.3 KiB
Haskell

{- git-annex command
-
- Copyright 2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.ConfigRemote where
import Command
import qualified Logs.Remote
import qualified Git.Types as Git
import qualified Annex.SpecialRemote as SpecialRemote
import qualified Types.Remote as Remote
import Types.ProposedAccepted
import Command.EnableRemote (unknownNameError, startSpecialRemote', PerformSpecialRemote, deadLast)
import qualified Data.Map as M
cmd :: Command
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: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. -}
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 ()
where
ps = [ SpecialRemote.autoEnableFieldParser ]
safefields = [ fromProposedAccepted SpecialRemote.autoEnableField ]
startSpecialRemote :: Annex () -> Git.RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart
startSpecialRemote = startSpecialRemote' "configremote" . performSpecialRemote
performSpecialRemote :: Annex () -> PerformSpecialRemote
performSpecialRemote precheck _ u _ c _ mcu = do
precheck
case mcu of
Nothing -> Logs.Remote.configSet u c
Just (SpecialRemote.ConfigFrom cu) ->
Logs.Remote.configSet cu c
next $ return True