17
17
18
18
module Cardano.Ledger.Conway.Rules.NewEpoch (
19
19
ConwayNEWEPOCH ,
20
- ConwayNewEpochPredFailure (.. ),
21
20
ConwayNewEpochEvent (.. ),
22
21
) where
23
22
@@ -54,28 +53,15 @@ import Cardano.Ledger.Slot (EpochNo (EpochNo))
54
53
import Cardano.Ledger.State
55
54
import qualified Cardano.Ledger.Val as Val
56
55
import Control.DeepSeq (NFData )
56
+ import Control.Exception (assert )
57
57
import Control.State.Transition
58
58
import Data.Default (Default (.. ))
59
59
import qualified Data.Map.Strict as Map
60
60
import Data.Set (Set )
61
+ import Data.Void (Void )
61
62
import GHC.Generics (Generic )
62
63
import Lens.Micro ((%~) , (&) , (^.) )
63
64
64
- newtype ConwayNewEpochPredFailure era
65
- = CorruptRewardUpdate
66
- RewardUpdate -- The reward update which violates an invariant
67
- deriving (Generic )
68
-
69
- deriving instance Eq (ConwayNewEpochPredFailure era )
70
-
71
- deriving instance
72
- ( Show (PredicateFailure (EraRule " EPOCH" era ))
73
- , Show (PredicateFailure (EraRule " RATIFY" era ))
74
- ) =>
75
- Show (ConwayNewEpochPredFailure era )
76
-
77
- instance NFData (ConwayNewEpochPredFailure era )
78
-
79
65
data ConwayNewEpochEvent era
80
66
= DeltaRewardEvent ! (Event (EraRule " RUPD" era ))
81
67
| RestrainedRewards
@@ -121,14 +107,16 @@ instance
121
107
, GovState era ~ ConwayGovState era
122
108
, Eq (PredicateFailure (EraRule " RATIFY" era ))
123
109
, Show (PredicateFailure (EraRule " RATIFY" era ))
110
+ , Eq (PredicateFailure (ConwayNEWEPOCH era ))
111
+ , Show (PredicateFailure (ConwayNEWEPOCH era ))
124
112
) =>
125
113
STS (ConwayNEWEPOCH era )
126
114
where
127
115
type State (ConwayNEWEPOCH era ) = NewEpochState era
128
116
type Signal (ConwayNEWEPOCH era ) = EpochNo
129
117
type Environment (ConwayNEWEPOCH era ) = ()
130
118
type BaseM (ConwayNEWEPOCH era ) = ShelleyBase
131
- type PredicateFailure (ConwayNEWEPOCH era ) = ConwayNewEpochPredFailure era
119
+ type PredicateFailure (ConwayNEWEPOCH era ) = Void
132
120
type Event (ConwayNEWEPOCH era ) = ConwayNewEpochEvent era
133
121
134
122
initialRules =
@@ -162,6 +150,8 @@ newEpochTransition ::
162
150
, GovState era ~ ConwayGovState era
163
151
, Eq (PredicateFailure (EraRule " RATIFY" era ))
164
152
, Show (PredicateFailure (EraRule " RATIFY" era ))
153
+ , Eq (PredicateFailure (ConwayNEWEPOCH era ))
154
+ , Show (PredicateFailure (ConwayNEWEPOCH era ))
165
155
) =>
166
156
TransitionRule (ConwayNEWEPOCH era )
167
157
newEpochTransition = do
@@ -216,7 +206,7 @@ updateRewards ::
216
206
Rule (ConwayNEWEPOCH era ) 'Transition (EpochState era )
217
207
updateRewards es e ru'@ (RewardUpdate dt dr rs_ df _) = do
218
208
let totRs = sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_
219
- Val. isZero (dt <> dr <> toDeltaCoin totRs <> df) ?! CorruptRewardUpdate ru'
209
+ in assert ( Val. isZero (dt <> dr <> toDeltaCoin totRs <> df)) ( pure () )
220
210
let ! (! es', filtered) = applyRUpdFiltered ru' es
221
211
tellEvent $ RestrainedRewards e (frShelleyIgnored filtered) (frUnregistered filtered)
222
212
-- This event (which is only generated once per epoch) must be generated even if the
@@ -226,8 +216,8 @@ updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do
226
216
227
217
instance
228
218
( STS (ConwayNEWEPOCH era )
229
- , PredicateFailure (EraRule " NEWEPOCH" era ) ~ ConwayNewEpochPredFailure era
230
219
, Event (EraRule " NEWEPOCH" era ) ~ ConwayNewEpochEvent era
220
+ , PredicateFailure (EraRule " NEWEPOCH" era ) ~ PredicateFailure (ConwayNEWEPOCH era )
231
221
) =>
232
222
Embed (ConwayNEWEPOCH era ) (ShelleyTICK era )
233
223
where
0 commit comments