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

View file

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

View file

@ -38,7 +38,12 @@ data RemoteConfigValue where
- Presence of fields that are not included in this list will cause - Presence of fields that are not included in this list will cause
- a parse failure. - 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 data RemoteConfigParser = RemoteConfigParser
{ remoteConfigFieldParsers :: [RemoteConfigFieldParser] { remoteConfigFieldParsers :: [RemoteConfigFieldParser]
@ -54,5 +59,5 @@ addRemoteConfigParser l rpc = rpc
remoteConfigFieldParsers rpc ++ filter isnew l remoteConfigFieldParsers rpc ++ filter isnew l
} }
where where
s = S.fromList (map (\(f, _) -> f) (remoteConfigFieldParsers rpc)) s = S.fromList (map parserForField (remoteConfigFieldParsers rpc))
isnew (f, _) = not (S.member f s) isnew p = not (S.member (parserForField p) s)