urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-26 05:23:35 +03:00
Code Issues Packages Projects Releases Wiki Activity

kh: don't error during key validation

Browse Source 
Instead produce an Either.
This commit is contained in:
fang 2021-06-17 17:42:44 +02:00
parent f8d5a1644c
commit bdaad4cf84
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
1 changed files with 23 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
pkg/hs/urbit-king/lib/Urbit/Vere/Dawn.hs
View File

@ -342,7 +342,9 @@ validateFeedAndGetSponsor :: String
validateFeedAndGetSponsor endpoint block = \case validateFeedAndGetSponsor endpoint block = \case
Feed0 s -> do Feed0 s -> do
r <- validateSeed s r <- validateSeed s
pure (s, r) case r of
Left e -> error e
Right r -> pure (s, r)
Feed1 s -> validateGerms s Feed1 s -> validateGerms s
where where
@ -351,8 +353,8 @@ validateFeedAndGetSponsor endpoint block = \case
[] -> error "no usable keys in keyfile" [] -> error "no usable keys in keyfile"
(Germ{..}:f) -> do (Germ{..}:f) -> do
let seed = Seed gShip gLife gRing Nothing let seed = Seed gShip gLife gRing Nothing
r :: Either SomeException Ship r :: Either String Ship
<- try do validateSeed seed <- validateSeed seed
case r of case r of
Left _ -> validateGerms $ Germs gShip f Left _ -> validateGerms $ Germs gShip f
Right r -> pure (seed, r) Right r -> pure (seed, r)
@ -366,18 +368,20 @@ validateFeedAndGetSponsor endpoint block = \case
validateComet = do validateComet = do
-- A comet address is the fingerprint of the keypair -- A comet address is the fingerprint of the keypair
let shipFromPass = cometFingerprint $ ringToPass ring let shipFromPass = cometFingerprint $ ringToPass ring
when (ship /= shipFromPass) $ if (ship /= shipFromPass) then
error ("comet name doesn't match fingerprint " <> show ship <> " vs " <> pure $ Left ("comet name doesn't match fingerprint " <>
show shipFromPass) show ship <> " vs " <>
when (life /= 1) $ show shipFromPass)
error ("comet can never be re-keyed") else if (life /= 1) then
pure (shipSein ship) pure $ Left "comet can never be re-keyed"
else
pure $ Right (shipSein ship)
validateMoon = do validateMoon = do
-- TODO: The current code in zuse does nothing, but we should be able -- TODO: The current code in zuse does nothing, but we should be able
-- to try to validate the oath against the current as exists planet -- to try to validate the oath against the current as exists planet
-- on chain. -- on chain.
pure $ shipSein ship pure $ Right $ shipSein ship
validateRest = do validateRest = do
putStrLn ("boot: retrieving " <> renderShip ship <> "'s public keys") putStrLn ("boot: retrieving " <> renderShip ship <> "'s public keys")
@ -385,17 +389,18 @@ validateFeedAndGetSponsor endpoint block = \case
--TODO could cache this lookup --TODO could cache this lookup
whoP <- retrievePoint endpoint block ship whoP <- retrievePoint endpoint block ship
case epNet whoP of case epNet whoP of
Nothing -> error "ship not keyed" Nothing -> pure $ Left "ship not keyed"
Just (netLife, pass, contNum, (hasSponsor, who), _) -> do Just (netLife, pass, contNum, (hasSponsor, who), _) -> do
when (netLife /= life) $ if (netLife /= life) then
error ("keyfile life mismatch; keyfile claims life " <> pure $ Left ("keyfile life mismatch; keyfile claims life " <>
show life <> ", but Azimuth claims life " <> show life <> ", but Azimuth claims life " <>
show netLife) show netLife)
when ((ringToPass ring) /= pass) $ else if ((ringToPass ring) /= pass) then
error "keyfile does not match blockchain" pure $ Left "keyfile does not match blockchain"
-- TODO: The hoon code does a breach check, but the C code never -- TODO: The hoon code does a breach check, but the C code never
-- supplies the data necessary for it to function. -- supplies the data necessary for it to function.
pure who else
pure $ Right who
-- Walk through the sponsorship chain retrieving the actual sponsorship chain -- Walk through the sponsorship chain retrieving the actual sponsorship chain