Skip to content
Permalink
Browse files

Merge #566 #569

566: Changes for epoch boundary integration r=nc6 a=nc6

Unfortunately we do need to serialise boundary blocks, because we need to create the initial one for testing.

569: Add ToCBOR and FromCBOR instances for ChainValidationState r=intricate a=mrBliss

This requires `ToCBOR` and `FromCBOR` instances for a whole bunch of other types
too.

The consensus storage layer needs these instances in order to write/read snapshots of the ledger state to/from disk.

Roundtrip property tests and golden tests still need to be written. Can somebody of the ledger team do this? Feel free to push more commits to this PR.

 I tried to adhere to the existing style as much as I could, but I might have made some mistakes.

Co-authored-by: Nicholas Clarke <nick@topos.org.uk>
Co-authored-by: mrBliss <dewinant@gmail.com>
Co-authored-by: Luke Nadur <19835357+intricate@users.noreply.github.com>
  • Loading branch information...
4 people committed Jul 11, 2019
3 parents c7d5632 + 2404ee9 + f544b36 commit 5241971fe563c90ea82b20af344116d46d672835

Some generated files are not rendered by default. Learn more.

@@ -56,27 +56,34 @@ module Cardano.Chain.Block.Block

-- * BoundaryValidationData
, BoundaryValidationData(..)
, boundaryHashAnnotated
, dropBoundaryBlock
, toCBORABOBBoundary
, toCBORBoundaryBlock
)
where

import Cardano.Prelude

import Data.Coerce (coerce)
import qualified Data.ByteString as BS
import Data.Text.Lazy.Builder (Builder)
import Formatting (bprint, build, int, shown)
import Data.Text.Lazy.Builder (Builder, fromText)
import Formatting (bprint, build, int, later, shown)
import qualified Formatting.Buildable as B

import Cardano.Binary
( Annotated(..)
, ByteSpan(..)
, Decoded(..)
, Decoder
, DecoderError(..)
, Encoding
, FromCBOR(..)
, ToCBOR(..)
, annotatedDecoder
, encodeBreak
, encodeListLen
, encodeListLenIndef
, enforceSize
)
import Cardano.Chain.Block.Body
@@ -114,6 +121,7 @@ import Cardano.Chain.Block.Header
, headerToSign
, mkHeaderExplicit
, toCBORHeader
, wrapBoundaryBytes
)
import Cardano.Chain.Block.Proof (Proof(..))
import Cardano.Chain.Common (ChainDifficulty(..), dropEmptyAttributes)
@@ -129,7 +137,7 @@ import Cardano.Chain.UTxO.TxPayload (ATxPayload)
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import qualified Cardano.Chain.Update.Payload as Update
import Cardano.Chain.Update.SoftwareVersion (SoftwareVersion)
import Cardano.Crypto (ProtocolMagicId, SigningKey, VerificationKey)
import Cardano.Crypto (ProtocolMagicId, SigningKey, VerificationKey, hashDecoded, hash)


--------------------------------------------------------------------------------
@@ -377,15 +385,25 @@ data BoundaryValidationData a = BoundaryValidationData
-- ^ The hash of the previous block. Should only be GenesisHash for the
-- initial boundary block.
, boundaryEpoch :: !Word64
, boundaryDifficulty :: !ChainDifficulty
-- ^ Block number
, boundaryHeaderBytes :: !a
-- ^ Annotation representing the header bytes
} deriving (Eq, Show, Functor)

instance Decoded (BoundaryValidationData ByteString) where
type BaseType (BoundaryValidationData ByteString) = BoundaryValidationData ()
recoverBytes = boundaryHeaderBytes

-- | Extract the hash of a boundary block from its annotation.
boundaryHashAnnotated :: BoundaryValidationData ByteString -> HeaderHash
boundaryHashAnnotated = coerce . hashDecoded . fmap wrapBoundaryBytes

-- | A decoder that drops the boundary block, but preserves the 'ByteSpan' of
-- the header for hashing
dropBoundaryBlock :: Decoder s (BoundaryValidationData ByteSpan)
dropBoundaryBlock = do
Annotated (Annotated (hh, epoch) bs) (ByteSpan start end) <- annotatedDecoder $ do
Annotated (Annotated (hh, epoch, difficulty) bs) (ByteSpan start end) <- annotatedDecoder $ do
enforceSize "BoundaryBlock" 3
aHeaderStuff <- annotatedDecoder dropBoundaryHeader
dropBoundaryBody
@@ -397,5 +415,60 @@ dropBoundaryBlock = do
-- and for all subsequent blocks it's a 'HeaderHash'.
, boundaryPrevHash = if epoch == 0 then Left (coerce hh) else Right hh
, boundaryEpoch = epoch
, boundaryDifficulty = difficulty
, boundaryHeaderBytes = bs
}

toCBORABOBBoundary :: ProtocolMagicId -> BoundaryValidationData a -> Encoding
toCBORABOBBoundary pm bvd =
encodeListLen 2
<> toCBOR (0 :: Word)
<> toCBORBoundaryBlock pm bvd

-- See https://github.com/input-output-hk/cardano-sl/blob/develop/docs/on-the-wire/current-spec.cddl
toCBORBoundaryBlock :: ProtocolMagicId -> BoundaryValidationData a -> Encoding
toCBORBoundaryBlock pm bvd = let
bodyProof = hash (mempty :: LByteString)
in encodeListLen 3
-- Header
<> ( encodeListLen 5
-- Protocol magic
<> toCBOR pm
-- Previous block
<> ( case boundaryPrevHash bvd of
Left gh -> toCBOR (genesisHeaderHash gh)
Right hh -> toCBOR hh
)
-- Body proof
<> toCBOR bodyProof
-- Consensus data
<> ( encodeListLen 2
-- Epoch
<> toCBOR (boundaryEpoch bvd)
-- Chain difficulty
<> toCBOR (boundaryDifficulty bvd)
)
-- Extra data
<> (encodeListLen 1 <> toCBOR (mempty :: Map Word8 LByteString))
)
-- Body
<> (encodeListLenIndef <> encodeBreak)
-- Attributes
<> ( encodeListLen 1
<> toCBOR (mempty :: Map Word8 LByteString)
)

instance B.Buildable (BoundaryValidationData a) where
build bvd = bprint
( "Boundary:\n"
. " Starting epoch: " . int . "\n"
. " " . later buildBoundaryHash . "\n"
. " Block number: " . build
)
(boundaryEpoch bvd)
(boundaryPrevHash bvd)
(boundaryDifficulty bvd)
where
buildBoundaryHash :: Either GenesisHash HeaderHash -> Builder
buildBoundaryHash (Left (GenesisHash _)) = fromText "Genesis"
buildBoundaryHash (Right h) = B.build h
@@ -3,36 +3,31 @@
-- | Boundary blocks have been deprecated, but we keep functions to decode them

module Cardano.Chain.Block.Boundary
( dropBoundaryConsensusData
, dropBoundaryConsensusDataRetainEpochNumber
( fromCBORBoundaryConsensusData
, dropBoundaryExtraHeaderData
, dropBoundaryBody
, dropBoundaryExtraBodyData
)
where

import Control.Monad (return, void)
import Control.Monad (return)
import Data.Word (Word64)

import Cardano.Binary
(Decoder, Dropper, decodeWord64, dropBytes, dropList, enforceSize)
import Cardano.Chain.Common (dropAttributes, dropChainDifficulty)
(Decoder, Dropper, decodeWord64, dropBytes, dropList, enforceSize, fromCBOR)
import Cardano.Chain.Common (ChainDifficulty, dropAttributes)


--------------------------------------------------------------------------------
-- BoundaryConsensusData
--------------------------------------------------------------------------------

dropBoundaryConsensusData :: Dropper s
dropBoundaryConsensusData = void dropBoundaryConsensusDataRetainEpochNumber

dropBoundaryConsensusDataRetainEpochNumber :: Decoder s Word64
dropBoundaryConsensusDataRetainEpochNumber = do
fromCBORBoundaryConsensusData :: Decoder s (Word64, ChainDifficulty)
fromCBORBoundaryConsensusData = do
enforceSize "BoundaryConsensusData" 2
w <- decodeWord64
dropChainDifficulty
return w

cd <- fromCBOR
return (w, cd)

--------------------------------------------------------------------------------
-- BoundaryExtraHeaderData
@@ -90,7 +90,7 @@ import Cardano.Binary
)
import Cardano.Chain.Block.Body (Body)
import Cardano.Chain.Block.Boundary
(dropBoundaryConsensusDataRetainEpochNumber, dropBoundaryExtraHeaderData)
(fromCBORBoundaryConsensusData, dropBoundaryExtraHeaderData)
import Cardano.Chain.Block.Proof (Proof(..), mkProof)
import Cardano.Chain.Common (ChainDifficulty(..), dropEmptyAttributes)
import qualified Cardano.Chain.Delegation.Certificate as Delegation
@@ -438,17 +438,17 @@ headerHashAnnotated = hashDecoded . fmap wrapHeaderBytes
-- BoundaryHeader
--------------------------------------------------------------------------------

dropBoundaryHeader :: Decoder s (HeaderHash, Word64)
dropBoundaryHeader :: Decoder s (HeaderHash, Word64, ChainDifficulty)
dropBoundaryHeader = do
enforceSize "BoundaryHeader" 5
dropInt32
-- HeaderHash
hh <- fromCBOR
-- BoundaryBodyProof
dropBytes
epoch <- dropBoundaryConsensusDataRetainEpochNumber
(epoch, difficulty) <- fromCBORBoundaryConsensusData
dropBoundaryExtraHeaderData
pure (hh, epoch)
pure (hh, epoch, difficulty)

-- | These bytes must be prepended when hashing raw boundary header data
--
@@ -42,11 +42,19 @@ import qualified Data.ByteString.Lazy as BSL
import Data.Coerce (coerce)
import qualified Data.Map.Strict as M
import Data.Sequence (Seq(..), (<|))
import qualified Data.Sequence as Seq
import Formatting.Buildable (Buildable)
import Streaming (Of(..), Stream, hoist)
import qualified Streaming.Prelude as S

import Cardano.Binary (Annotated(..), serialize')
import Cardano.Binary
( Annotated(..)
, FromCBOR(..)
, ToCBOR(..)
, encodeListLen
, enforceSize
, serialize'
)
import Cardano.Chain.Block.Body (ABody (..))
import Cardano.Chain.Block.Block
( ABlock(..)
@@ -127,9 +135,24 @@ import Cardano.Chain.ValidationMode
data SigningHistory = SigningHistory
{ shK :: !BlockCount
, shSigningQueue :: !(Seq KeyHash)
, shKeyHashCounts :: !(Map KeyHash BlockCount)
, shKeyHashCounts :: !(Map KeyHash BlockCount)
} deriving (Eq, Show, Generic, NFData)

instance FromCBOR SigningHistory where
fromCBOR = do
enforceSize "SigningHistory" 3
SigningHistory
<$> fromCBOR
<*> (Seq.fromList <$> fromCBOR)
<*> fromCBOR

instance ToCBOR SigningHistory where
toCBOR sh =
encodeListLen 3
<> toCBOR (shK sh)
<> toCBOR (toList (shSigningQueue sh))
<> toCBOR (shKeyHashCounts sh)

-- | Update the `SigningHistory` with a new signer, removing the oldest value if
-- the sequence is @K@ blocks long
updateSigningHistory :: VerificationKey -> SigningHistory -> SigningHistory
@@ -175,6 +198,27 @@ data ChainValidationState = ChainValidationState
, cvsDelegationState :: !DI.State
} deriving (Eq, Show, Generic, NFData)

instance FromCBOR ChainValidationState where
fromCBOR = do
enforceSize "ChainValidationState" 6
ChainValidationState
<$> fromCBOR
<*> fromCBOR
<*> fromCBOR
<*> fromCBOR
<*> fromCBOR
<*> fromCBOR

instance ToCBOR ChainValidationState where
toCBOR c =
encodeListLen 6
<> toCBOR (cvsLastSlot c)
<> toCBOR (cvsSigningHistory c)
<> toCBOR (cvsPreviousHash c)
<> toCBOR (cvsUtxo c)
<> toCBOR (cvsUpdateState c)
<> toCBOR (cvsDelegationState c)

-- | Create the state needed to validate the zeroth epoch of the chain. The
-- zeroth epoch starts with a boundary block where the previous hash is the
-- genesis hash.
@@ -13,7 +13,7 @@ where

import Cardano.Prelude

import Cardano.Binary (serialize', decodeFull')
import Cardano.Binary (FromCBOR(..), ToCBOR(..), serialize', decodeFull')
import qualified Data.ByteString.Short as BSS (fromShort, toShort)
import Data.ByteString.Short (ShortByteString)

@@ -32,6 +32,12 @@ newtype CompactAddress = CompactAddress ShortByteString
deriving newtype HeapWords
deriving anyclass NFData

instance FromCBOR CompactAddress where
fromCBOR = CompactAddress . BSS.toShort <$> fromCBOR

instance ToCBOR CompactAddress where
toCBOR (CompactAddress sbs) = toCBOR (BSS.fromShort sbs)

toCompactAddress :: Address -> CompactAddress
toCompactAddress addr =
CompactAddress (BSS.toShort (serialize' addr))
@@ -25,6 +25,7 @@ import Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap
import qualified Data.Set as Set

import Cardano.Binary (FromCBOR(..), ToCBOR(..))
import Cardano.Chain.Common.KeyHash (KeyHash)


@@ -33,6 +34,11 @@ newtype Map = Map
} deriving (Eq, Show, Generic)
deriving anyclass NFData

instance FromCBOR Map where
fromCBOR = Map . Bimap.fromList <$> fromCBOR

instance ToCBOR Map where
toCBOR = toCBOR . Bimap.toList . unMap

--------------------------------------------------------------------------------
-- Query
@@ -1,6 +1,7 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Chain.Delegation.Validation.Activation
(
@@ -14,6 +15,7 @@ import Cardano.Prelude hiding (State)

import qualified Data.Map.Strict as M

import Cardano.Binary (FromCBOR(..), ToCBOR(..), encodeListLen, enforceSize)
import Cardano.Chain.Common (KeyHash)
import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.Delegation.Validation.Scheduling (ScheduledDelegation(..))
@@ -31,6 +33,19 @@ data State = State
, delegationSlots :: !(Map KeyHash SlotNumber)
} deriving (Eq, Show, Generic, NFData)

instance FromCBOR State where
fromCBOR = do
enforceSize "State" 2
State
<$> fromCBOR
<*> fromCBOR

instance ToCBOR State where
toCBOR s =
encodeListLen 2
<> toCBOR (delegationMap s)
<> toCBOR (delegationSlots s)

-- | 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 comments on commit 5241971

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