Skip to content
Permalink
Browse files

Merge #353

353: Implement the update endorsement rules r=dnadales a=dnadales

Closes #188 

Co-authored-by: Damian Nadales <damian.nadales@iohk.io>
Co-authored-by: Rupert Horlick <rupert.horlick@iohk.io>
Co-authored-by: Michael Hueschen <michaelhueschen@gmail.com>
  • Loading branch information...
4 people committed Mar 14, 2019
2 parents a88428b + f49f0fe commit a6ee022ae6a64bb3e86ec5ac3469c4b779bd8a07
@@ -105,6 +105,7 @@ library
Cardano.Chain.Update.SoftwareVersion
Cardano.Chain.Update.SystemTag
Cardano.Chain.Update.Undo
Cardano.Chain.Update.Validation.Endorsement
Cardano.Chain.Update.Validation.Registration
Cardano.Chain.Update.Validation.Voting
Cardano.Chain.Update.Vote
@@ -26,6 +26,9 @@ module Cardano.Chain.Delegation.Validation
, initialInterfaceState
, delegates
, updateDelegation

-- * Misc utility functions
, delegatorOf
)
where

@@ -167,6 +170,16 @@ data ActivationState = ActivationState
} deriving (Eq, Show, Generic, NFData)


-- | Find the delegator of the given stakeholder-id.
--
-- The function returns nothing if no delegator is found. This function does
-- not check injectivity of the delegation map.
delegatorOf
:: StakeholderId -> Map StakeholderId StakeholderId -> Maybe StakeholderId
delegatorOf vk dms = case M.keys $ M.filter (== vk) dms of
vkS : _ -> Just vkS
_ -> Nothing

-- | Activate a 'ScheduledDelegation' if its activation slot is less than the
-- previous delegation slot for this delegate, otherwise discard it. This is
-- an implementation of the delegation activation rule in the ledger
@@ -0,0 +1,169 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}

module Cardano.Chain.Update.Validation.Endorsement
( registerEndorsement
)
where

import Cardano.Prelude hiding (State)

import qualified Data.Map as M
import qualified Data.Set as Set

import Cardano.Chain.Common
import Cardano.Chain.Delegation.Validation
import Cardano.Chain.Slotting
import Cardano.Chain.Update.ProtocolParameters
import Cardano.Chain.Update.ProtocolVersion
import Cardano.Chain.Update.SoftforkRule
import Cardano.Chain.Update.Vote
import qualified Cardano.Chain.Update.Validation.Registration as Registration

data Environment = Environment
{ k :: !BlockCount
-- ^ Chain stability parameter.
, currentSlot :: !FlatSlotId
, delegationMap :: !(Map StakeholderId StakeholderId)
, adoptedProtocolParameters :: !ProtocolParameters
, confirmedProposals :: !(Map UpId FlatSlotId)
, registeredUpdateProposals :: !Registration.ProtocolUpdateProposals
, numGenesisKeys :: !Word8
-- ^ Number of genesis keys. This is used in combination with the
-- 'ppUpdateProposalThd' protocol parameter to calculate the proportion of
-- genesis keys that need to endorse a new protocol version for it to be considered for
-- adoption.
}

data State = State
{ candidateProtocolVersions :: [CandidateProtocolVersion]
, registeredEndorsements :: Set Endorsement
}


data CandidateProtocolVersion = CandidateProtocolVersion
{ cpvSlot :: FlatSlotId
-- ^ Slot at which this protocol version and parameters gathered enough
-- endorsements and became a candidate. This is used to check which
-- versions became candidates 2k slots before the end of an epoch (and only
-- those can be adopted at that epoch). Versions that became candidates
-- later than 2k slots before the end of an epoch can be adopted in
-- following epochs.
, cpvProtocolVersion :: ProtocolVersion
, cpvProtocolParameters :: ProtocolParameters
}

data Endorsement = Endorsement
{ endorsementProtocolVersion :: ProtocolVersion
, endorsementStakeholder :: StakeholderId
} deriving (Eq, Ord)

data Error
= MultipleProposalsForProtocolVersion ProtocolVersion
-- ^ Multiple proposals were found, which propose an update to the same
-- protocol version.

-- | Register an endorsement.
--
-- This corresponds to the @UPEND@ rule.
registerEndorsement
:: MonadError Error m => Environment -> State -> Endorsement -> m State
registerEndorsement env st endorsement =
case M.toList (M.filter ((== pv) . fst) registeredUpdateProposals) of
-- We ignore endorsement of proposals that aren't registered
[] -> pure st

-- Try to register the endorsement and check if we can adopt the proposal
[(upId, (_, pps'))] -> if isConfirmedAndStable upId
then if canAdopt numGenesisKeys pps registeredEndorsements' pv
-- Register the endorsement and adopt the proposal in the next epoch
then do
let
cpv = CandidateProtocolVersion
{ cpvSlot = currentSlot
, cpvProtocolVersion = pv
, cpvProtocolParameters = pps'
}
cpvs' =
updateCandidateProtocolVersions candidateProtocolVersions cpv
pure $ State
{ candidateProtocolVersions = cpvs'
, registeredEndorsements = registeredEndorsements'
}

-- Just register the endorsement if we cannot adopt
else pure $ st { registeredEndorsements = registeredEndorsements' }

-- Ignore the endorsement if the registration isn't stable
else pure st

-- Throw an error if there are multiple proposals for this protocol version
_ -> throwError $ MultipleProposalsForProtocolVersion pv
where
Environment { k, currentSlot, delegationMap, confirmedProposals, registeredUpdateProposals, numGenesisKeys }
= env

isConfirmedAndStable upId = upId `M.member` scps
where
-- Stable and confirmed proposals.
scps = M.filter (stableAt <=) confirmedProposals
stableAt = currentSlot - FlatSlotId (2 * getBlockCount k)

pps = adoptedProtocolParameters env
pv = endorsementProtocolVersion endorsement

State { candidateProtocolVersions, registeredEndorsements } = st

registeredEndorsements' = case delegatorOf vk delegationMap of
Just vkS -> Set.insert (Endorsement epv vkS) registeredEndorsements
Nothing -> registeredEndorsements
-- Note that we do not throw an error if there is no corresponding
-- delegate for the given endorsement stakeholder. This is consistent
-- with the @UPEND@ rules. The check that there is a delegator should be
-- done in the rule that checks that the block issuer is a delegate of a
-- genesis key.
where
vk = endorsementStakeholder endorsement
epv = endorsementProtocolVersion endorsement

canAdopt
:: Word8
-- ^ Number of genesis keys.
-> ProtocolParameters
-> Set Endorsement
-> ProtocolVersion
-> Bool
canAdopt ngk pps endorsements protocolVersion =
upAdptThd <= numberOfEndorsements
where
-- In Byron we do not have a @upAdptThd@ protocol parameter, so we have to
-- use the existing ones.
--
-- @lovelacePortionToDouble . srMinThd . ppSoftforkRule@ will give us the
-- ratio (in the interval @[0, 1]@) of the total stake that has to endorse a
-- protocol version to become adopted. In genesis configuration, this ratio
-- will evaluate to @0.6@, so if we have 7 genesis keys, @upAdptThd = 4@.
upAdptThd :: Int
upAdptThd = floor $ stakeRatio * fromIntegral ngk
where
stakeRatio = lovelacePortionToDouble . srMinThd . ppSoftforkRule $ pps

numberOfEndorsements :: Int
numberOfEndorsements = length $ Set.filter
((== protocolVersion) . endorsementProtocolVersion)
endorsements

-- | Add a newly endorsed protocol version to the 'CandidateProtocolVersion's
--
-- We only add it to the list if the 'ProtocolVersion' is strictly greater
-- than all other `CandidateProtocolVersion`s
--
-- This corresponds to the @FADS@ rule.
updateCandidateProtocolVersions
:: [CandidateProtocolVersion]
-> CandidateProtocolVersion
-> [CandidateProtocolVersion]
updateCandidateProtocolVersions [] cpv = [cpv]
updateCandidateProtocolVersions cpvs@(cpv : _) cpv'
| cpvProtocolVersion cpv < cpvProtocolVersion cpv' = cpv' : cpvs
| otherwise = cpvs
@@ -7,6 +7,7 @@
module Cardano.Chain.Update.Validation.Registration
( RegistrationError
, RegistrationState(..)
, ProtocolUpdateProposals
, registerProposal
)
where
@@ -27,7 +27,7 @@ import Cardano.Crypto

-- | Environment used to register votes and confirm proposals
data VotingEnvironment = VotingEnvironment
{ veCurrentSlot :: SlotId
{ veCurrentSlot :: FlatSlotId
, veProtocolParameters :: ProtocolParameters
, veVotingRegistrationEnvironment :: VoteRegistrationEnvironment
}
@@ -41,7 +41,7 @@ data VoteRegistrationEnvironment = VoteRegistrationEnvironment
-- | VotingState keeps track of registered votes and confirmed proposals
data VotingState = VotingState
{ vsVotes :: RegisteredVotes
, vsConfirmedProposals :: Map UpId SlotId
, vsConfirmedProposals :: Map UpId FlatSlotId
}

type RegisteredVotes = Map UpId (Set StakeholderId)

0 comments on commit a6ee022

Please sign in to comment.
You can’t perform that action at this time.
You signed in with another tab or window. Reload to refresh your session. You signed out in another tab or window. Reload to refresh your session.