Skip to content
Permalink
Browse files

Implement UPIVOTE [skip ci]

  • Loading branch information...
dnadales committed Mar 14, 2019
1 parent 2551b82 commit 1c9ea79905ae654ec3d9c508731d5fa377689cd8
Showing with 73 additions and 27 deletions.
  1. +50 −4 src/Cardano/Chain/Update/Validation/Interface.hs
  2. +23 −23 src/Cardano/Chain/Update/Validation/Voting.hs
@@ -42,10 +42,13 @@ import Cardano.Prelude
, pure
, undefined
, wrapError
, elem
, notElem
)

import Control.Lens ((.~), makeLenses, (^.), (%~))
import qualified Data.Map.Strict as M
import qualified Data.Set as S

import Cardano.Chain.Slotting (EpochIndex, FlatSlotId)
import Cardano.Chain.Common.StakeholderId (StakeholderId)
@@ -54,9 +57,14 @@ import Cardano.Chain.Update.ApplicationName (ApplicationName)
import Cardano.Chain.Update.ProtocolParameters (ProtocolParameters)
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import Cardano.Chain.Update.SoftwareVersion
(NumSoftwareVersion, SoftwareVersion)
( NumSoftwareVersion
, SoftwareVersion
, svAppName
, svNumber
)
import qualified Cardano.Chain.Update.Validation.Registration as Registration
import Cardano.Chain.Update.Vote (UpId, AProposal, recoverUpId)
import qualified Cardano.Chain.Update.Validation.Voting as Voting
import Cardano.Chain.Update.Vote (UpId, AProposal, recoverUpId, AVote)
import Cardano.Crypto (ProtocolMagicId)

data TODO
@@ -100,8 +108,9 @@ data State

makeLenses ''State

data Error =
Registration Registration.Error
data Error
= Registration Registration.Error
| Voting Voting.Error

-- | Register an update proposal.
--
@@ -129,3 +138,40 @@ registerProposal env st proposal = do
& registeredProtocolUpdateProposals .~ rpus'
& registeredSoftwareUpdateProposals .~ raus'
& proposalRegistrationSlot %~ M.insert (recoverUpId proposal) (env ^. currentSlot)

-- | Register a vote for the given proposal.
--
-- If the proposal gets enough confirmations after adding the given vote, then
-- it will get added to the set of confirmed proposals.
--
registerVote
:: MonadError Error m
=> Environment
-> State
-> AVote ByteString
-> m State
registerVote env st vote = do
let pm = env ^. protocolMagic
subEnv = Voting.Environment sn pps (Voting.RegistrationEnvironment rups dms)
sn = env ^. currentSlot
pps = st ^. adoptedProtocolParams
rups = S.fromAscList $! M.keys (st ^. proposalRegistrationSlot)
dms = env ^. delegationMap
subSt = Voting.State vts cps
vts = st ^. proposalVotes
cps = st ^. confirmedProposals
Voting.State vts' cps' <-
Voting.registerVoteWithConfirmation pm subEnv subSt vote
`wrapError` Voting
let avsNew =
M.fromList $! [ (svAppName sv, (svNumber sv, sn))
| (pid, sv) <- M.toList raus
, pid `elem` M.keys cps'
]
raus = st ^. registeredSoftwareUpdateProposals
pure $! st
& confirmedProposals .~ cps'
& proposalVotes .~ vts'
& appVersions %~ M.union avsNew
& registeredSoftwareUpdateProposals %~ (`M.withoutKeys` S.fromAscList (M.keys cps))
-- TODO: consider using the `Relation` instances from `fm-ledger-rules` (see `Ledger.Core`)
@@ -5,15 +5,15 @@
-- This is an implementation of the rules defined in the Byron ledger
-- specification
module Cardano.Chain.Update.Validation.Voting
( VotingEnvironment(..)
, VoteRegistrationEnvironment(..)
, VotingState(..)
, VotingError(..)
( Environment(..)
, RegistrationEnvironment(..)
, State(..)
, Error(..)
, registerVoteWithConfirmation
)
where

import Cardano.Prelude
import Cardano.Prelude hiding (State)

import qualified Data.Map as M
import qualified Data.Set as Set
@@ -26,42 +26,42 @@ import Cardano.Crypto


-- | Environment used to register votes and confirm proposals
data VotingEnvironment = VotingEnvironment
data Environment = Environment
{ veCurrentSlot :: FlatSlotId
, veProtocolParameters :: ProtocolParameters
, veVotingRegistrationEnvironment :: VoteRegistrationEnvironment
, veVotingRegistrationEnvironment :: RegistrationEnvironment
}

-- | Environment required to validate and register a vote
data VoteRegistrationEnvironment = VoteRegistrationEnvironment
data RegistrationEnvironment = RegistrationEnvironment
{ vreRegisteredUpdateProposal :: Set UpId
, vreDelegationMap :: Map StakeholderId StakeholderId
}

-- | VotingState keeps track of registered votes and confirmed proposals
data VotingState = VotingState
-- | State keeps track of registered votes and confirmed proposals
data State = State
{ vsVotes :: RegisteredVotes
, vsConfirmedProposals :: Map UpId FlatSlotId
}

type RegisteredVotes = Map UpId (Set StakeholderId)

-- | VotingError captures the ways in which vote registration could fail
data VotingError
-- | Error captures the ways in which vote registration could fail
data Error
= VotingInvalidSignature
| VotingProposalNotRegistered UpId
| VotingVoterNotDelegate StakeholderId


-- | Register a vote and confirm the corresponding proposal if it passes the
-- voting threshold. This corresponds to the `UPVOTE` rules in the spec.
-- voting threshold. This corresponds to the @UPVOTE@ rules in the spec.
registerVoteWithConfirmation
:: MonadError VotingError m
:: MonadError Error m
=> ProtocolMagicId
-> VotingEnvironment
-> VotingState
-> Environment
-> State
-> AVote ByteString
-> m VotingState
-> m State
registerVoteWithConfirmation pm votingEnv vs vote = do

-- Register the vote ignoring proposal confirmation
@@ -74,13 +74,13 @@ registerVoteWithConfirmation pm votingEnv vs vote = do
else confirmedProposals

-- Return the new state with additional vote and maybe confirmation
pure $ VotingState
pure $ State
{ vsVotes = votes'
, vsConfirmedProposals = confirmedProposals'
}
where
VotingEnvironment slot _ voteRegEnv = votingEnv
VotingState votes confirmedProposals = vs
Environment slot _ voteRegEnv = votingEnv
State votes confirmedProposals = vs

-- | This is the number of genesis keys that need to support a proposal
threshold :: Int
@@ -105,9 +105,9 @@ registerVoteWithConfirmation pm votingEnv vs vote = do
--
-- This corresponds to the `ADDVOTE` rule in the spec.
registerVote
:: MonadError VotingError m
:: MonadError Error m
=> ProtocolMagicId
-> VoteRegistrationEnvironment
-> RegistrationEnvironment
-> RegisteredVotes
-> AVote ByteString
-> m RegisteredVotes
@@ -130,7 +130,7 @@ registerVote pm vre votes vote = do
-- Add the delegators to the set of votes for this proposal
pure $ M.insertWith Set.union upId delegators votes
where
VoteRegistrationEnvironment registeredProposals delegationMap = vre
RegistrationEnvironment registeredProposals delegationMap = vre

voterPK = uvKey vote
voter = mkStakeholderId voterPK

0 comments on commit 1c9ea79

Please sign in to comment.
You can’t perform that action at this time.