convert RemoteConfigFieldParser to data type
This commit is contained in:
parent
0b6fb506eb
commit
923230ea30
3 changed files with 39 additions and 14 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue