8af6d2c3c5
Fix serious regression in gcrypt and encrypted git-lfs remotes. Since version 7.20200202.7, git-annex incorrectly stored content on those remotes without encrypting it. Problem was, Remote.Git enumerates all git remotes, including git-lfs and gcrypt. It then dispatches to those. So, Remote.List used the RemoteConfigParser from Remote.Git, instead of from git-lfs or gcrypt, and that parser does not know about encryption fields, so did not include them in the ParsedRemoteConfig. (Also didn't include other fields specific to those remotes, perhaps chunking etc also didn't get through.) To fix, had to move RemoteConfig parsing down into the generate methods of each remote, rather than doing it in Remote.List. And a consequence of that was that ParsedRemoteConfig had to change to include the RemoteConfig that got parsed, so that testremote can generate a new remote based on an existing remote. (I would have rather fixed this just inside Remote.Git, but that was not practical, at least not w/o re-doing work that Remote.List already did. Big ugly mostly mechanical patch seemed preferable to making git-annex slower.)
71 lines
2.3 KiB
Haskell
71 lines
2.3 KiB
Haskell
{- git-annex remote config types
|
|
-
|
|
- Copyright 2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE GADTs #-}
|
|
|
|
module Types.RemoteConfig where
|
|
|
|
import qualified Data.Map as M
|
|
import qualified Data.Set as S
|
|
import Data.Typeable
|
|
|
|
import Types.ProposedAccepted
|
|
|
|
type RemoteConfigField = ProposedAccepted String
|
|
|
|
{- What the user provides to configure the remote, and what is stored for
|
|
- later; a bunch of fields and values. -}
|
|
type RemoteConfig = M.Map RemoteConfigField (ProposedAccepted String)
|
|
|
|
{- Before being used a RemoteConfig has to be parsed. -}
|
|
data ParsedRemoteConfig = ParsedRemoteConfig
|
|
(M.Map RemoteConfigField RemoteConfigValue)
|
|
RemoteConfig
|
|
|
|
{- Remotes can have configuration values of many types, so use Typeable
|
|
- to let them all be stored in here. -}
|
|
data RemoteConfigValue where
|
|
RemoteConfigValue :: Typeable v => v -> RemoteConfigValue
|
|
|
|
{- Parse a field's value provided by the user into a RemoteConfigValue.
|
|
-
|
|
- The RemoteConfig is provided to the parser function for cases
|
|
- where multiple fields need to be looked at. However, it's important
|
|
- that, when a parser looks at an additional field in that way, the
|
|
- parser list contains a dedicated parser for that field as well.
|
|
- Presence of fields that are not included in this list will cause
|
|
- a parse failure.
|
|
-}
|
|
data RemoteConfigFieldParser = RemoteConfigFieldParser
|
|
{ parserForField :: RemoteConfigField
|
|
, valueParser :: Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue)
|
|
, fieldDesc :: FieldDesc
|
|
, valueDesc :: Maybe ValueDesc
|
|
}
|
|
|
|
data FieldDesc
|
|
= FieldDesc String
|
|
| HiddenField
|
|
|
|
newtype ValueDesc = ValueDesc String
|
|
|
|
data RemoteConfigParser = RemoteConfigParser
|
|
{ remoteConfigFieldParsers :: [RemoteConfigFieldParser]
|
|
, remoteConfigRestPassthrough :: Maybe (RemoteConfigField -> Bool, [(String, FieldDesc)])
|
|
}
|
|
|
|
mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> RemoteConfig -> m RemoteConfigParser
|
|
mkRemoteConfigParser l _ = pure (RemoteConfigParser l Nothing)
|
|
|
|
addRemoteConfigParser :: [RemoteConfigFieldParser] -> RemoteConfigParser -> RemoteConfigParser
|
|
addRemoteConfigParser l rpc = rpc
|
|
{ remoteConfigFieldParsers =
|
|
remoteConfigFieldParsers rpc ++ filter isnew l
|
|
}
|
|
where
|
|
s = S.fromList (map parserForField (remoteConfigFieldParsers rpc))
|
|
isnew p = not (S.member (parserForField p) s)
|