convert RemoteConfigFieldParser to data type

This commit is contained in:
Joey Hess 2020-01-20 13:49:30 -04:00
parent 0b6fb506eb
commit 923230ea30
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 39 additions and 14 deletions

View file

@ -193,19 +193,19 @@ parseRemoteConfig c rpc =
unwords (map (fromProposedAccepted . fst) leftovers')
else Right $ M.fromList $
l ++ map (uncurry passthrough) passover
go l c' ((f, p):rest) = do
v <- p (M.lookup f c) c
case v of
Just v' -> go ((f,v'):l) (M.delete f c') rest
go l c' (p:rest) = do
let f = parserForField p
(valueParser p) (M.lookup f c) c >>= \case
Just v -> go ((f,v):l) (M.delete f c') rest
Nothing -> go l (M.delete f c') rest
passthrough f v = (f, RemoteConfigValue (PassedThrough (fromProposedAccepted v)))
notaccepted (Proposed _) = True
notaccepted (Accepted _) = False
optionalStringParser :: RemoteConfigField -> RemoteConfigFieldParser
optionalStringParser f = (f, p)
optionalStringParser f = RemoteConfigFieldParser f p
where
p (Just v) _c = Right (Just (RemoteConfigValue (fromProposedAccepted v)))
p Nothing _c = Right Nothing
@ -223,7 +223,7 @@ genParser
-> RemoteConfigField
-> t -- ^ fallback value
-> RemoteConfigFieldParser
genParser parse desc f fallback = (f, p)
genParser parse desc f fallback = RemoteConfigFieldParser f p
where
p Nothing _c = Right (Just (RemoteConfigValue fallback))
p (Just v) _c = case parse (fromProposedAccepted v) of

View file

@ -55,23 +55,23 @@ encryptionAlreadySetup = EncryptionIsSetup
encryptionConfigParsers :: [RemoteConfigFieldParser]
encryptionConfigParsers =
[ (encryptionField, \v c -> Just . RemoteConfigValue <$> parseEncryptionMethod (fmap fromProposedAccepted v) c)
[ encryptionFieldParser
, optionalStringParser cipherField
, optionalStringParser cipherkeysField
, optionalStringParser pubkeysField
, yesNoParser embedCredsField False
, (macField, \v _c -> Just . RemoteConfigValue <$> parseMac v)
, macFieldParser
, optionalStringParser (Accepted "keyid")
, optionalStringParser (Accepted "keyid+")
, optionalStringParser (Accepted "keyid-")
, (highRandomQualityField, \v _c -> Just . RemoteConfigValue <$> parseHighRandomQuality (fmap fromProposedAccepted v))
, highRandomQualityFieldParser
]
highRandomQualityField :: RemoteConfigField
highRandomQualityField = Accepted "highRandomQuality"
encryptionConfigs :: S.Set RemoteConfigField
encryptionConfigs = S.fromList (map fst encryptionConfigParsers)
encryptionConfigs = S.fromList (map parserForField encryptionConfigParsers)
-- Parse only encryption fields, ignoring all others.
parseEncryptionConfig :: RemoteConfig -> Either String ParsedRemoteConfig
@ -79,6 +79,13 @@ parseEncryptionConfig c = parseRemoteConfig
(M.restrictKeys c encryptionConfigs)
(RemoteConfigParser encryptionConfigParsers (const False))
encryptionFieldParser :: RemoteConfigFieldParser
encryptionFieldParser = RemoteConfigFieldParser
{ parserForField = encryptionField
, valueParser = \v c -> Just . RemoteConfigValue
<$> parseEncryptionMethod (fmap fromProposedAccepted v) c
}
parseEncryptionMethod :: Maybe String -> RemoteConfig -> Either String EncryptionMethod
parseEncryptionMethod (Just "none") _ = Right NoneEncryption
parseEncryptionMethod (Just "shared") _ = Right SharedEncryption
@ -95,12 +102,25 @@ parseEncryptionMethod _ _ =
(map ((fromProposedAccepted encryptionField ++ "=") ++)
["none","shared","hybrid","pubkey", "sharedpubkey"])
++ "."
highRandomQualityFieldParser :: RemoteConfigFieldParser
highRandomQualityFieldParser = RemoteConfigFieldParser
{ parserForField = highRandomQualityField
, valueParser = \v _c -> Just . RemoteConfigValue
<$> parseHighRandomQuality (fmap fromProposedAccepted v)
}
parseHighRandomQuality :: Maybe String -> Either String Bool
parseHighRandomQuality Nothing = Right True
parseHighRandomQuality (Just "false") = Right False
parseHighRandomQuality (Just "true") = Right True
parseHighRandomQuality _ = Left "expected highRandomQuality=true/false"
macFieldParser :: RemoteConfigFieldParser
macFieldParser = RemoteConfigFieldParser
{ parserForField = macField
, valueParser = \v _c -> Just . RemoteConfigValue <$> parseMac v
}
parseMac :: Maybe (ProposedAccepted String) -> Either String Mac
parseMac Nothing = Right defaultMac

View file

@ -38,7 +38,12 @@ data RemoteConfigValue where
- Presence of fields that are not included in this list will cause
- a parse failure.
-}
type RemoteConfigFieldParser = (RemoteConfigField, Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue))
data RemoteConfigFieldParser = RemoteConfigFieldParser
{ parserForField :: RemoteConfigField
, valueParser :: Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue)
--, fieldDesc :: String
--, valueExample :: String
}
data RemoteConfigParser = RemoteConfigParser
{ remoteConfigFieldParsers :: [RemoteConfigFieldParser]
@ -54,5 +59,5 @@ addRemoteConfigParser l rpc = rpc
remoteConfigFieldParsers rpc ++ filter isnew l
}
where
s = S.fromList (map (\(f, _) -> f) (remoteConfigFieldParsers rpc))
isnew (f, _) = not (S.member f s)
s = S.fromList (map parserForField (remoteConfigFieldParsers rpc))
isnew p = not (S.member (parserForField p) s)