-
Notifications
You must be signed in to change notification settings - Fork 20
/
Protocol.hs
52 lines (43 loc) · 2.08 KB
/
Protocol.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Shelley.Ledger.Protocol () where
import qualified Cardano.Ledger.Shelley.API as SL
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Protocol.Signed
import Ouroboros.Consensus.Protocol.TPraos
import Ouroboros.Consensus.Shelley.Eras (EraCrypto)
import Ouroboros.Consensus.Shelley.Ledger.Block
import Ouroboros.Consensus.Shelley.Ledger.Config (BlockConfig (..))
import Ouroboros.Consensus.Shelley.Protocol.Abstract
(ShelleyProtocolHeader, pHeaderIssueNo, pHeaderIssuer,
pTieBreakVRFValue, protocolHeaderView)
{-------------------------------------------------------------------------------
Support for Transitional Praos consensus algorithm
-------------------------------------------------------------------------------}
type instance BlockProtocol (ShelleyBlock proto era) = proto
instance ShelleyCompatible proto era => BlockSupportsProtocol (ShelleyBlock proto era) where
validateView _cfg = protocolHeaderView @proto . shelleyHeaderRaw
selectView _ hdr@(ShelleyHeader shdr _) = PraosChainSelectView {
csvChainLength = blockNo hdr
, csvSlotNo = blockSlot hdr
, csvIssuer = hdrIssuer
, csvIssueNo = pHeaderIssueNo shdr
, csvTieBreakVRF = pTieBreakVRFValue shdr
}
where
hdrIssuer :: SL.VKey 'SL.BlockIssuer (EraCrypto era)
hdrIssuer = pHeaderIssuer shdr
projectChainOrderConfig = shelleyVRFTiebreakerFlavor
-- TODO correct place for these two?
type instance Signed (Header (ShelleyBlock proto era)) =
Signed (ShelleyProtocolHeader proto)
instance SignedHeader (ShelleyProtocolHeader proto) =>
SignedHeader (Header (ShelleyBlock proto era))
where
headerSigned = headerSigned . shelleyHeaderRaw