diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs index 7a65674f1..d2f316a53 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs @@ -134,7 +134,7 @@ data Feed | Feed1 Germs deriving (Eq, Show) ---NOTE reify type environment +-- NOTE reify type environment $(pure []) instance ToNoun Feed where @@ -270,7 +270,7 @@ data BoatEv deriveNoun ''BoatEv --- Boat Events ----------------------------------------------------------------- +-- Jael Events ----------------------------------------------------------------- data JaelEv = JaelEvRekey () (Life, Ring) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index e278f33a0..d7ae6d392 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -506,7 +506,7 @@ newShip CLI.New{..} opts = do let seed = mineComet (Set.fromList starList) eny putStrLn ("boot: found comet " ++ renderShip (sShip seed)) putStrLn ("code: " ++ (tshow $ deriveCode $ sRing seed)) - bootFromSeed pill $ Feed0 seed + bootFromFeed pill $ Feed0 seed CLI.BootFake name -> do pill <- pillFrom nPillSource @@ -526,7 +526,7 @@ newShip CLI.New{..} opts = do pill <- pillFrom nPillSource - bootFromSeed pill feed + bootFromFeed pill feed where shipFrom :: Text -> RIO HostEnv Ship @@ -547,8 +547,8 @@ newShip CLI.New{..} opts = do Nothing -> error "Urbit.ob didn't produce string with ~" Just x -> pure x - bootFromSeed :: Pill -> Feed -> RIO HostEnv () - bootFromSeed pill feed = do + bootFromFeed :: Pill -> Feed -> RIO HostEnv () + bootFromFeed pill feed = do ethReturn <- dawnVent nEthNode feed case ethReturn of diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Dawn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Dawn.hs index c2ec7d53f..debfb9a73 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Dawn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Dawn.hs @@ -359,29 +359,29 @@ validateFeedAndGetSponsor endpoint block = \case Left _ -> validateGerms $ Germs gShip f Right r -> pure (seed, r) - validateSeed (Seed ship life ring oaf) = + validateSeed (Seed ship life ring oaf) = do case clanFromShip ship of - Ob.Comet -> validateComet - Ob.Moon -> validateMoon + Ob.Comet -> pure validateComet + Ob.Moon -> pure validateMoon _ -> validateRest where - validateComet = do + cometFromPass = cometFingerprint $ ringToPass ring + validateComet -- A comet address is the fingerprint of the keypair - let shipFromPass = cometFingerprint $ ringToPass ring - if (ship /= shipFromPass) then - pure $ Left ("comet name doesn't match fingerprint " <> + | (ship /= cometFromPass) = + Left ("comet name doesn't match fingerprint " <> show ship <> " vs " <> - show shipFromPass) - else if (life /= 1) then - pure $ Left "comet can never be re-keyed" - else - pure $ Right (shipSein ship) + show cometFromPass) + | (life /= 1) = + Left "comet can never be re-keyed" + | otherwise = + Right (shipSein ship) - validateMoon = do + validateMoon = -- 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 -- on chain. - pure $ Right $ shipSein ship + Right $ shipSein ship validateRest = do putStrLn ("boot: retrieving " <> renderShip ship <> "'s public keys")