Permalink
Browse files

Issue #304: Initial consensus layer interface

This still lacks the split of the header into two parts
  • Loading branch information...
mdimjasevic committed Feb 11, 2019
1 parent 8a69d93 commit ec8318fd989ee9d1fd63619c7651822e7c46e316
@@ -23,12 +23,12 @@ flag development

library
exposed-modules: Cardano.Spec.Chain.STS.Block
, Cardano.Spec.Chain.STS.BlockC
, Cardano.Spec.Chain.STS.Rule.BBody
, Cardano.Spec.Chain.STS.Rule.BHead
, Cardano.Spec.Chain.STS.Rule.Chain
, Cardano.Spec.Chain.STS.Rule.Epoch
, Cardano.Spec.Chain.STS.Rule.SigCnt
, Cardano.Spec.Consensus.Block
--other-modules:
-- other-extensions:
hs-source-dirs: src

This file was deleted.

Oops, something went wrong.
@@ -0,0 +1,63 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

-- | Type classes for interfacing with the consensus layer
module Cardano.Spec.Consensus.Block where

import Control.Lens ((^.))

import qualified Cardano.Spec.Chain.STS.Block as CBM -- Concrete Block Module
import Ledger.Core
import Ledger.Delegation
import Ledger.Signatures


class BlockHeader h where
-- | Hash of the previous block header, or 'genesisHash' in case of
-- the first block in a chain.
bhPrevHash :: h -> Hash
-- | Header hash
bhHash :: h -> Hash
-- | Signature of the block by its issuer.
bSig :: h -> Sig VKey
-- | Block issuer.
bIssuer :: h -> VKey
-- | Slot for which this block is issued
bhSlot :: h -> Slot


class BlockBody bb where
-- | Delegation certificates.
bCerts :: bb -> [DCert]


class ( BlockHeader (FamBlockHeader b)
, BlockBody (FamBlockBody b)
) => Block b where
type family FamBlockHeader b :: *
type family FamBlockBody b :: *

-- | Gets the block header
bHeader :: b -> FamBlockHeader b
-- | Gets the block body
bBody :: b -> FamBlockBody b


instance BlockBody CBM.BlockBody where
bCerts (CBM.BlockBody bDCerts) = bDCerts

instance BlockHeader CBM.BlockHeader where
bhPrevHash h = h ^. CBM.prevHHash
-- TODO: a corresponding field as of Feb 11, 2019 does not exist in
-- the CBM.BlockHeader type
bhHash = undefined
bSig h = h ^. CBM.bSig
bIssuer h = h ^. CBM.bIssuer
bhSlot h = h ^. CBM.bSlot

instance Block CBM.Block where
type FamBlockHeader CBM.Block = CBM.BlockHeader
type FamBlockBody CBM.Block = CBM.BlockBody

bHeader b = b ^. CBM.bHeader
bBody b = b ^. CBM.bBody

0 comments on commit ec8318f

Please sign in to comment.