-
Notifications
You must be signed in to change notification settings - Fork 86
/
Abstract.hs
203 lines (175 loc) · 7.57 KB
/
Abstract.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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Commonality between multiple protocols.
--
-- Everything in this module is indexed on the protocol (or the crypto),
-- rather than on the block type. This allows it to be imported in
-- @Ouroboros.Consensus.Shelley.Ledger.Block@.
module Ouroboros.Consensus.Shelley.Protocol.Abstract (
ProtoCrypto
, ProtocolHeaderSupportsEnvelope (..)
, ProtocolHeaderSupportsKES (..)
, ProtocolHeaderSupportsLedger (..)
, ProtocolHeaderSupportsProtocol (..)
, ShelleyHash (..)
, ShelleyProtocol
, ShelleyProtocolHeader
) where
import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR))
import Cardano.Crypto.Hash (Hash)
import Cardano.Crypto.VRF (OutputVRF)
import Cardano.Ledger.BHeaderView (BHeaderView)
import Cardano.Ledger.BaseTypes (ProtVer)
import Cardano.Ledger.Crypto (Crypto, HASH, VRF)
import Cardano.Ledger.Hashes (EraIndependentBlockBody,
EraIndependentBlockHeader)
import Cardano.Ledger.Keys (KeyRole (BlockIssuer), VKey)
import Cardano.Protocol.TPraos.BHeader (PrevHash)
import Cardano.Slotting.Block (BlockNo)
import Cardano.Slotting.Slot (SlotNo)
import Codec.Serialise (Serialise (..))
import Control.Monad.Except (Except)
import Data.Kind (Type)
import Data.Typeable (Typeable)
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Numeric.Natural (Natural)
import Ouroboros.Consensus.Protocol.Abstract (CanBeLeader,
ChainDepState, ConsensusConfig, ConsensusProtocol,
IsLeader, LedgerView, ValidateView)
import Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey)
import Ouroboros.Consensus.Protocol.Signed (SignedHeader)
import Ouroboros.Consensus.Ticked (Ticked)
import Ouroboros.Consensus.Util.Condense (Condense (..))
{-------------------------------------------------------------------------------
Crypto
-------------------------------------------------------------------------------}
type family ProtoCrypto proto :: Type
{-------------------------------------------------------------------------------
Header hash
-------------------------------------------------------------------------------}
newtype ShelleyHash crypto = ShelleyHash
{ unShelleyHash :: Hash (HASH crypto) EraIndependentBlockHeader
}
deriving stock (Eq, Ord, Show, Generic)
deriving anyclass (NoThunks)
deriving newtype instance Crypto crypto => ToCBOR (ShelleyHash crypto)
deriving newtype instance Crypto crypto => FromCBOR (ShelleyHash crypto)
instance
Crypto crypto =>
Serialise (ShelleyHash crypto)
where
encode = toCBOR
decode = fromCBOR
instance Condense (ShelleyHash crypto) where
condense = show . unShelleyHash
{-------------------------------------------------------------------------------
Header
-------------------------------------------------------------------------------}
-- | Shelley header, determined by the associated protocol.
--
type family ShelleyProtocolHeader proto = (sh :: Type) | sh -> proto
-- | Indicates that the header (determined by the protocol) supports " Envelope
-- " functionality. Envelope functionality refers to the minimal functionality
-- required to construct a chain.
class
( Eq (EnvelopeCheckError proto),
NoThunks (EnvelopeCheckError proto),
Show (EnvelopeCheckError proto)
) =>
ProtocolHeaderSupportsEnvelope proto
where
pHeaderHash :: ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto)
pHeaderPrevHash :: ShelleyProtocolHeader proto -> PrevHash (ProtoCrypto proto)
pHeaderBodyHash :: ShelleyProtocolHeader proto -> Hash (HASH (ProtoCrypto proto)) EraIndependentBlockBody
pHeaderSlot :: ShelleyProtocolHeader proto -> SlotNo
pHeaderBlock :: ShelleyProtocolHeader proto -> BlockNo
pHeaderSize :: ShelleyProtocolHeader proto -> Natural
pHeaderBlockSize :: ShelleyProtocolHeader proto -> Natural
type EnvelopeCheckError proto :: Type
-- | Carry out any protocol-specific envelope checks. For example, this might
-- check things like maximum header size.
envelopeChecks ::
ConsensusConfig proto ->
Ticked (LedgerView proto) ->
ShelleyProtocolHeader proto ->
Except (EnvelopeCheckError proto) ()
-- | `ProtocolHeaderSupportsKES` describes functionality common to protocols
-- using key evolving signature schemes. This includes verifying the header
-- integrity (e.g. validating the KES signature), as well as constructing the
-- header (made specific to KES-using protocols through the need to handle
-- the hot key).
class ProtocolHeaderSupportsKES proto where
-- | Extract the "slots per KES period" value from the protocol config.
--
-- Note that we do not require `ConsensusConfig` in 'verifyHeaderIntegrity'
-- since that function is also invoked with 'StorageConfig'.
configSlotsPerKESPeriod :: ConsensusConfig proto -> Word64
-- | Verify that the signature on a header is correct and valid.
verifyHeaderIntegrity ::
-- | Slots per KES period
Word64 ->
ShelleyProtocolHeader proto ->
Bool
mkHeader ::
forall crypto m.
(Crypto crypto, Monad m, crypto ~ ProtoCrypto proto) =>
HotKey crypto m ->
CanBeLeader proto ->
IsLeader proto ->
-- | Slot no
SlotNo ->
-- | Block no
BlockNo ->
-- | Hash of the previous block
PrevHash crypto ->
-- | Hash of the block body to include in the header
Hash (HASH crypto) EraIndependentBlockBody ->
-- | Size of the block body
Int ->
-- | Protocol version
ProtVer ->
m (ShelleyProtocolHeader proto)
-- | ProtocolHeaderSupportsProtocol` provides support for the concrete
-- block header to support the `ConsensusProtocol` itself.
class ProtocolHeaderSupportsProtocol proto where
type CannotForgeError proto :: Type
protocolHeaderView ::
ShelleyProtocolHeader proto -> ValidateView proto
pHeaderIssuer ::
ShelleyProtocolHeader proto -> VKey 'BlockIssuer (ProtoCrypto proto)
pHeaderIssueNo ::
ShelleyProtocolHeader proto -> Word64
-- | A VRF value in the header, used to choose between otherwise equally
-- preferable chains.
pTieBreakVRFValue ::
ShelleyProtocolHeader proto -> OutputVRF (VRF (ProtoCrypto proto))
-- | Indicates that the protocol header supports the Shelley ledger. We may need
-- to generalise this if, in the future, the ledger requires different things
-- from the protocol.
class ProtocolHeaderSupportsLedger proto where
mkHeaderView :: ShelleyProtocolHeader proto -> BHeaderView (ProtoCrypto proto)
{-------------------------------------------------------------------------------
Key constraints
-------------------------------------------------------------------------------}
class
( ConsensusProtocol proto,
Typeable (ShelleyProtocolHeader proto),
ProtocolHeaderSupportsEnvelope proto,
ProtocolHeaderSupportsKES proto,
ProtocolHeaderSupportsProtocol proto,
ProtocolHeaderSupportsLedger proto,
Serialise (ChainDepState proto),
SignedHeader (ShelleyProtocolHeader proto)
) =>
ShelleyProtocol proto