Skip to content
Permalink
Browse files

Implement the UPIREG rule.

  • Loading branch information...
dnadales committed Mar 14, 2019
1 parent a88428b commit 35a7350581c1a8a474ad975fa1c1533759fd89a1
@@ -105,6 +105,7 @@ library
Cardano.Chain.Update.SoftwareVersion
Cardano.Chain.Update.SystemTag
Cardano.Chain.Update.Undo
Cardano.Chain.Update.Validation.Interface
Cardano.Chain.Update.Validation.Registration
Cardano.Chain.Update.Validation.Voting
Cardano.Chain.Update.Vote
@@ -0,0 +1,104 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Blockchain interface validation rules.
--
module Cardano.Chain.Update.Validation.Interface
( State(..)
)
where

import Cardano.Prelude
( ByteString
, Map
, MonadError
, Set
, ($!)
, (&)
, pure
, undefined
, wrapError
)

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

import Cardano.Chain.Slotting (EpochIndex, FlatSlotId)
import Cardano.Chain.Common.StakeholderId (StakeholderId)

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)
import qualified Cardano.Chain.Update.Validation.Registration as Registration
import Cardano.Chain.Update.Vote (UpId, AProposal, recoverUpId)
import Cardano.Crypto (ProtocolMagicId)

data TODO

data Environment
= Environment
{ _protocolMagic :: ProtocolMagicId
, _currentEpoch :: !EpochIndex
, _currentSlot :: !FlatSlotId
, _delegationMap :: !(Map StakeholderId StakeholderId)
}

makeLenses ''Environment

-- | Update interface state.
data State
= State
{ _prevEpoch :: !EpochIndex
-- ^ Previously seen epoch
, _adoptedProtocolParams :: !ProtocolParameters
-- ^ Adopted protocol parameters
, _futureAdopts :: !TODO -- We should take this from Cardano.Chain.Update.Validation.Endorsement
-- ^ Future protocol version adoptions
, _appVersions :: !(Map ApplicationName (NumSoftwareVersion, FlatSlotId))
-- ^ Current application versions (by application name)
, _registeredProtocolUpdateProposals :: !(Map UpId (ProtocolVersion, ProtocolParameters))
-- ^ Registered protocol update proposals
, _registeredSoftwareUpdateProposals :: !(Map UpId SoftwareVersion)
-- ^ Registered software update proposals
, _confirmedProposals :: !(Map UpId FlatSlotId)
-- ^ Confirmed update proposals
, _proposalVotes :: !(Map UpId (Set StakeholderId))
-- ^ Update proposals votes
, _proposalsEndorsements :: TODO -- We should take this from Cardano.Chain.Update.Validation.Endorsement
-- So this should be a @Set Endorsement@
-- ^ Update proposals endorsements
, _proposalRegistrationSlot :: Map UpId FlatSlotId
-- ^ Slot at which an update proposal was registered
}

makeLenses ''State

data Error =
Registration Registration.Error

-- | Register an update proposal.
--
-- This corresponds to the @UPIREG@ rules in the spec.
registerProposal
:: MonadError Error m
=> Environment
-> State
-> AProposal ByteString
-> m State
registerProposal env st proposal = do
let
pm = undefined
pv = undefined
pps = undefined
avs = undefined
dms = undefined
regSubSt = undefined
Registration.State rpus raus <-
(Registration.registerProposal pm pv pps avs dms regSubSt proposal)
`wrapError` Registration
pure $! st
& registeredProtocolUpdateProposals .~ rpus
& registeredSoftwareUpdateProposals .~ raus
& proposalRegistrationSlot %~ M.insert (recoverUpId proposal) (env ^. currentSlot)
@@ -5,13 +5,13 @@
-- This is an implementation of the rules defined in the Byron ledger
-- specification
module Cardano.Chain.Update.Validation.Registration
( RegistrationError
, RegistrationState(..)
( Error
, State(..)
, registerProposal
)
where

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

import qualified Data.ByteString as BS
import qualified Data.Map.Strict as M
@@ -27,9 +27,9 @@ import Cardano.Chain.Update.Vote
import Cardano.Crypto


-- | RegistrationState keeps track of registered protocol and software update
-- | State keeps track of registered protocol and software update
-- proposals
data RegistrationState = RegistrationState
data State = State
{ rsProtocolUpdateProposals :: !ProtocolUpdateProposals
, rsSoftwareUpdateProposals :: !SoftwareUpdateProposals
}
@@ -39,8 +39,8 @@ type SoftwareUpdateProposals = Map UpId SoftwareVersion

type ApplicationVersions = Map ApplicationName (NumSoftwareVersion, SlotId)

-- | RegistrationError captures the ways in which registration could fail
data RegistrationError
-- | Error captures the ways in which registration could fail
data Error
= RegistrationDuplicateProtocolVersion ProtocolVersion
| RegistrationDuplicateSoftwareVersion SoftwareVersion
| RegistrationInvalidProposer StakeholderId
@@ -61,17 +61,17 @@ data TooLarge n = TooLarge


-- | Register an update proposal after verifying its signature and validating
-- its contents. This corresponds to the `UPREG` rules in the spec.
-- its contents. This corresponds to the @UPREG@ rules in the spec.
registerProposal
:: MonadError RegistrationError m
:: MonadError Error m
=> ProtocolMagicId
-> ProtocolVersion
-> ProtocolParameters
-> ApplicationVersions
-> Map StakeholderId StakeholderId
-> RegistrationState
-> State
-> AProposal ByteString
-> m RegistrationState
-> m State
registerProposal pm adoptedPV adoptedPP appVersions delegation rs proposal = do

-- Check that the proposer is delegated to by a genesis key
@@ -94,13 +94,13 @@ registerProposal pm adoptedPV adoptedPP appVersions delegation rs proposal = do
-- The proposal may contain a protocol update, a software update, or both.
-- This corresponds to the `UPV` rules in the spec.
registerProposalComponents
:: MonadError RegistrationError m
:: MonadError Error m
=> ProtocolVersion
-> ProtocolParameters
-> ApplicationVersions
-> RegistrationState
-> State
-> AProposal ByteString
-> m RegistrationState
-> m State
registerProposalComponents adoptedPV adoptedPP appVersions rs proposal = do

(protocolVersionChanged || softwareVersionChanged)
@@ -116,7 +116,7 @@ registerProposalComponents adoptedPV adoptedPP appVersions rs proposal = do
then registerSoftwareUpdate appVersions registeredSUPs proposal
else pure registeredSUPs

pure $ RegistrationState registeredPUPs' registeredSUPs'
pure $ State registeredPUPs' registeredSUPs'
where
ProposalBody protocolVersion ppu softwareVersion _ _ =
proposalBody proposal
@@ -129,7 +129,7 @@ registerProposalComponents adoptedPV adoptedPP appVersions rs proposal = do
protocolVersionChanged =
not $ protocolVersion == adoptedPV && PPU.isEmpty ppu

RegistrationState registeredPUPs registeredSUPs = rs
State registeredPUPs registeredSUPs = rs


-- | Validate a protocol update
@@ -142,7 +142,7 @@ registerProposalComponents adoptedPV adoptedPP appVersions rs proposal = do
--
-- This corresponds to the `UPPVV` rule in the spec.
registerProtocolUpdate
:: MonadError RegistrationError m
:: MonadError Error m
=> ProtocolVersion
-> ProtocolParameters
-> ProtocolUpdateProposals
@@ -184,7 +184,7 @@ pvCanFollow newPV adoptedPV = adoptedPV < newPV && isNextVersion
--
-- This is where we enforce constraints on how the 'ProtocolParameters' change
canUpdate
:: MonadError RegistrationError m
:: MonadError Error m
=> ProtocolParameters
-> ProtocolParameters
-> AProposal ByteString
@@ -233,7 +233,7 @@ canUpdate adoptedPP newPP proposal = do
--
-- This corresponds to the `UPSVV` rule in the spec.
registerSoftwareUpdate
:: MonadError RegistrationError m
:: MonadError Error m
=> ApplicationVersions
-> SoftwareUpdateProposals
-> AProposal ByteString

0 comments on commit 35a7350

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