Skip to content
This repository has been archived by the owner on Feb 9, 2021. It is now read-only.

Commit

Permalink
Refactor API (#722)
Browse files Browse the repository at this point in the history
* Move 'ABlockOrBoundaryHdr' into Block module

* Refactor APIAlso try to pare down the interface.

* Update cabal file

* Address #715

Use current slot when adding update proposals to the mempool.

* Review fixes
  • Loading branch information
nc6 authored Feb 12, 2020
1 parent 00d6cf3 commit 6d533b7
Show file tree
Hide file tree
Showing 7 changed files with 692 additions and 625 deletions.
5 changes: 5 additions & 0 deletions cardano-ledger/cardano-ledger.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,11 @@ library
Cardano.Chain.Block.Validation
Cardano.Chain.Block.ValidationMode

Cardano.Chain.Byron.API.Common
Cardano.Chain.Byron.API.Mempool
Cardano.Chain.Byron.API.Protocol
Cardano.Chain.Byron.API.Validation

Cardano.Chain.Common.AddrAttributes
Cardano.Chain.Common.AddrSpendingData
Cardano.Chain.Common.Address
Expand Down
79 changes: 76 additions & 3 deletions cardano-ledger/src/Cardano/Chain/Block/Block.hs
Original file line number Diff line number Diff line change
Expand Up @@ -60,13 +60,24 @@ module Cardano.Chain.Block.Block
, fromCBORABoundaryBlock
, toCBORABoundaryBlock
, toCBORABOBBoundary
, boundaryBlockSlot

, ABoundaryBody(..)

-- * ABlockOrBoundaryHdr
, ABlockOrBoundaryHdr(..)
, aBlockOrBoundaryHdr
, fromCBORABlockOrBoundaryHdr
, abobHdrFromBlock
, abobHdrSlotNo
, abobHdrChainDifficulty
, abobHdrHash
, abobHdrPrevHash
)
where

import Cardano.Prelude

import Control.Monad.Fail (fail)
import qualified Data.ByteString as BS
import Data.Text.Lazy.Builder (Builder, fromText)
import Formatting (bprint, build, int, later, shown)
Expand Down Expand Up @@ -131,8 +142,8 @@ import Cardano.Chain.Common (ChainDifficulty(..), dropEmptyAttributes)
import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.Genesis.Hash (GenesisHash(..))
import Cardano.Chain.Slotting
( EpochSlots
, SlotNumber
( EpochSlots(..)
, SlotNumber(..)
, WithEpochSlots(WithEpochSlots)
)
import Cardano.Chain.Ssc (SscPayload)
Expand Down Expand Up @@ -477,3 +488,65 @@ instance B.Buildable (ABoundaryBlock a) where
buildBoundaryHash :: Either GenesisHash HeaderHash -> Builder
buildBoundaryHash (Left (GenesisHash _)) = fromText "Genesis"
buildBoundaryHash (Right h) = B.build h

-- | Compute the slot number assigned to a boundary block
boundaryBlockSlot
:: EpochSlots
-> Word64 -- ^ Epoch number
-> SlotNumber
boundaryBlockSlot (EpochSlots es) epoch =
SlotNumber $ es * epoch

{-------------------------------------------------------------------------------
Header of a regular block or EBB
-------------------------------------------------------------------------------}

data ABlockOrBoundaryHdr a =
ABOBBlockHdr !(AHeader a)
| ABOBBoundaryHdr !(ABoundaryHeader a)
deriving (Eq, Show, Functor, Generic, NoUnexpectedThunks)

fromCBORABlockOrBoundaryHdr :: EpochSlots
-> Decoder s (ABlockOrBoundaryHdr ByteSpan)
fromCBORABlockOrBoundaryHdr epochSlots = do
enforceSize "ABlockOrBoundaryHdr" 2
fromCBOR @Word >>= \case
0 -> ABOBBoundaryHdr <$> fromCBORABoundaryHeader
1 -> ABOBBlockHdr <$> fromCBORAHeader epochSlots
t -> fail $ "Unknown tag in encoded HeaderOrBoundary" <> show t

-- | The analogue of 'Data.Either.either'
aBlockOrBoundaryHdr :: (AHeader a -> b)
-> (ABoundaryHeader a -> b)
-> ABlockOrBoundaryHdr a -> b
aBlockOrBoundaryHdr f _ (ABOBBlockHdr hdr) = f hdr
aBlockOrBoundaryHdr _ g (ABOBBoundaryHdr hdr) = g hdr

abobHdrFromBlock :: ABlockOrBoundary a -> ABlockOrBoundaryHdr a
abobHdrFromBlock (ABOBBlock blk) = ABOBBlockHdr $ blockHeader blk
abobHdrFromBlock (ABOBBoundary blk) = ABOBBoundaryHdr $ boundaryHeader blk

-- | Slot number of the header
--
-- NOTE: Epoch slot number calculation must match the one in 'applyBoundary'.
abobHdrSlotNo :: EpochSlots -> ABlockOrBoundaryHdr a -> SlotNumber
abobHdrSlotNo epochSlots =
aBlockOrBoundaryHdr
headerSlot
(boundaryBlockSlot epochSlots . boundaryEpoch)

abobHdrChainDifficulty :: ABlockOrBoundaryHdr a -> ChainDifficulty
abobHdrChainDifficulty =
aBlockOrBoundaryHdr
headerDifficulty
boundaryDifficulty

abobHdrHash :: ABlockOrBoundaryHdr ByteString -> HeaderHash
abobHdrHash (ABOBBoundaryHdr hdr) = boundaryHeaderHashAnnotated hdr
abobHdrHash (ABOBBlockHdr hdr) = headerHashAnnotated hdr

abobHdrPrevHash :: ABlockOrBoundaryHdr a -> Maybe HeaderHash
abobHdrPrevHash =
aBlockOrBoundaryHdr
(Just . headerPrevHash)
(either (const Nothing) Just . boundaryPrevHash)
Loading

0 comments on commit 6d533b7

Please sign in to comment.