be stricter about rejecting invalid configurations for remotes
This is a first step toward that goal, using the ProposedAccepted type in RemoteConfig lets initremote/enableremote reject bad parameters that were passed in a remote's configuration, while avoiding enableremote rejecting bad parameters that have already been stored in remote.log This does not eliminate every place where a remote config is parsed and a default value is used if the parse false. But, I did fix several things that expected foo=yes/no and so confusingly accepted foo=true but treated it like foo=no. There are still some fields that are parsed with yesNo but not not checked when initializing a remote, and there are other fields that are parsed in other ways and not checked when initializing a remote. This also lays groundwork for rejecting unknown/typoed config keys.
This commit is contained in:
parent
ea3f206fd1
commit
71ecfbfccf
45 changed files with 395 additions and 224 deletions
64
Types/ProposedAccepted.hs
Normal file
64
Types/ProposedAccepted.hs
Normal file
|
@ -0,0 +1,64 @@
|
|||
{- proposed and accepted values
|
||||
-
|
||||
- Copyright 2020 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Types.ProposedAccepted where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Test.QuickCheck
|
||||
|
||||
-- | A value that may be proposed, or accepted.
|
||||
--
|
||||
-- When parsing/validating the value, may want to error out on invalid
|
||||
-- input. But if a previous version of git-annex accepted an invalid value,
|
||||
-- it's too late to error out, and instead the bad value may be ignored.
|
||||
data ProposedAccepted t = Proposed t | Accepted t
|
||||
deriving (Show)
|
||||
|
||||
fromProposedAccepted :: ProposedAccepted t -> t
|
||||
fromProposedAccepted (Proposed t) = t
|
||||
fromProposedAccepted (Accepted t) = t
|
||||
|
||||
-- | Whether a value is proposed or accepted does not matter when checking
|
||||
-- equality.
|
||||
instance Eq t => Eq (ProposedAccepted t) where
|
||||
a == b = fromProposedAccepted a == fromProposedAccepted b
|
||||
|
||||
-- | Order by the contained value, not by whether it's proposed or
|
||||
-- accepted.
|
||||
instance Ord t => Ord (ProposedAccepted t) where
|
||||
compare a b = compare (fromProposedAccepted a) (fromProposedAccepted b)
|
||||
|
||||
instance Arbitrary t => Arbitrary (ProposedAccepted t) where
|
||||
arbitrary = oneof
|
||||
[ Proposed <$> arbitrary
|
||||
, Accepted <$> arbitrary
|
||||
]
|
||||
|
||||
-- | Looks up a config in the map, and parses its value if found.
|
||||
--
|
||||
-- Accepted values will always result in a Right, using a fallback value
|
||||
-- if unable to parse.
|
||||
--
|
||||
-- Proposed values that cannot be parsed will result in a Left message.
|
||||
parseProposedAccepted
|
||||
:: ProposedAccepted String
|
||||
-> M.Map (ProposedAccepted String) (ProposedAccepted v) -- config map
|
||||
-> (v -> Maybe a) -- ^ parse the value
|
||||
-> a -- ^ fallback used when accepted value cannot be parsed
|
||||
-> String -- ^ short description of expected value
|
||||
-> Either String (Maybe a)
|
||||
parseProposedAccepted k m parser fallback desc =
|
||||
case M.lookup k m of
|
||||
Nothing -> Right Nothing
|
||||
Just (Proposed v) -> case parser v of
|
||||
Nothing -> Left $
|
||||
"bad " ++ fromProposedAccepted k ++
|
||||
" value (expected " ++ desc ++ ")"
|
||||
Just a -> Right (Just a)
|
||||
Just (Accepted v) -> case parser v of
|
||||
Nothing -> Right (Just fallback)
|
||||
Just a -> Right (Just a)
|
|
@ -42,6 +42,7 @@ import Types.UrlContents
|
|||
import Types.NumCopies
|
||||
import Types.Export
|
||||
import Types.Import
|
||||
import Types.ProposedAccepted
|
||||
import Config.Cost
|
||||
import Utility.Metered
|
||||
import Git.Types (RemoteName)
|
||||
|
@ -49,9 +50,9 @@ import Utility.SafeCommand
|
|||
import Utility.Url
|
||||
import Utility.DataUnits
|
||||
|
||||
type RemoteConfigField = String
|
||||
type RemoteConfigField = ProposedAccepted String
|
||||
|
||||
type RemoteConfig = M.Map RemoteConfigField String
|
||||
type RemoteConfig = M.Map RemoteConfigField (ProposedAccepted String)
|
||||
|
||||
data SetupStage = Init | Enable RemoteConfig
|
||||
|
||||
|
|
|
@ -11,9 +11,9 @@ module Types.StandardGroups where
|
|||
|
||||
import Types.Remote (RemoteConfig)
|
||||
import Types.Group
|
||||
import Types.ProposedAccepted
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
|
||||
type PreferredContentExpression = String
|
||||
|
||||
|
@ -71,7 +71,8 @@ associatedDirectory :: Maybe RemoteConfig -> StandardGroup -> Maybe FilePath
|
|||
associatedDirectory _ SmallArchiveGroup = Just "archive"
|
||||
associatedDirectory _ FullArchiveGroup = Just "archive"
|
||||
associatedDirectory (Just c) PublicGroup = Just $
|
||||
fromMaybe "public" $ M.lookup "preferreddir" c
|
||||
maybe "public" fromProposedAccepted $
|
||||
M.lookup (Accepted "preferreddir") c
|
||||
associatedDirectory Nothing PublicGroup = Just "public"
|
||||
associatedDirectory _ _ = Nothing
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue