Skip to content

Commit 92ab64c

Browse files
SoupstrawSoupstraw
committed
Dijkstra ImpTest done
1 parent 8d8fe3a commit 92ab64c

File tree

16 files changed

+490
-25
lines changed

16 files changed

+490
-25
lines changed

‎docs/NewEra.md‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,8 @@ instances.
1313

1414
Add the `Cardano.Ledger.<era>.Core` module and re-export the `Core` module from
1515
the previous era. Use the `Core` module from the current era whenever you need
16-
to import anything from the core module.
16+
to import anything from the core module. Do the same for
17+
`Cardano.Ledger.<era>.State`.
1718

1819
It's a good idea to re-use the data types defined in the previous era at first.
1920
You might need to use `coerce` in a couple of places to change the era parameter

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/Context.hs‎

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DefaultSignatures #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE GADTs #-}
45
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -69,6 +70,7 @@ import Cardano.Slotting.Time (SystemStart)
6970
import Control.DeepSeq (NFData)
7071
import Control.Monad.Trans.Fail.String (errorFail)
7172
import Data.Aeson (ToJSON)
73+
import Data.Coerce (Coercible, coerce)
7274
import Data.Kind (Type)
7375
import Data.List.NonEmpty (NonEmpty, nonEmpty)
7476
import Data.Text (Text)
@@ -93,17 +95,52 @@ class (PlutusLanguage l, EraPlutusContext era) => EraPlutusTxInfo (l :: Language
9395
ProtVer ->
9496
TxCert era ->
9597
Either (ContextError era) (PlutusTxCert l)
98+
default toPlutusTxCert ::
99+
forall proxy.
100+
( Era era
101+
, EraPlutusTxInfo l (PreviousEra era)
102+
, Coercible (ContextError (PreviousEra era)) (ContextError era)
103+
, Coercible (TxCert era) (TxCert (PreviousEra era))
104+
) =>
105+
proxy l ->
106+
ProtVer ->
107+
TxCert era ->
108+
Either (ContextError era) (PlutusTxCert l)
109+
toPlutusTxCert = coerce $ toPlutusTxCert @l @(PreviousEra era) @proxy
96110

97111
toPlutusScriptPurpose ::
98112
proxy l ->
99113
ProtVer ->
100114
PlutusPurpose AsIxItem era ->
101115
Either (ContextError era) (PlutusScriptPurpose l)
116+
default toPlutusScriptPurpose ::
117+
forall proxy.
118+
( Era era
119+
, EraPlutusTxInfo l (PreviousEra era)
120+
, Coercible (ContextError (PreviousEra era)) (ContextError era)
121+
, Coercible (PlutusPurpose AsIxItem era) (PlutusPurpose AsIxItem (PreviousEra era))
122+
) =>
123+
proxy l ->
124+
ProtVer ->
125+
PlutusPurpose AsIxItem era ->
126+
Either (ContextError era) (PlutusScriptPurpose l)
127+
toPlutusScriptPurpose = coerce $ toPlutusScriptPurpose @l @(PreviousEra era) @proxy
102128

103129
toPlutusTxInfo ::
104130
proxy l ->
105131
LedgerTxInfo era ->
106132
Either (ContextError era) (PlutusTxInfo l)
133+
default toPlutusTxInfo ::
134+
forall proxy.
135+
( Era era
136+
, EraPlutusTxInfo l (PreviousEra era)
137+
, Coercible (ContextError (PreviousEra era)) (ContextError era)
138+
, Coercible (LedgerTxInfo era) (LedgerTxInfo (PreviousEra era))
139+
) =>
140+
proxy l ->
141+
LedgerTxInfo era ->
142+
Either (ContextError era) (PlutusTxInfo l)
143+
toPlutusTxInfo = coerce $ toPlutusTxInfo @l @(PreviousEra era) @proxy
107144

108145
toPlutusArgs ::
109146
proxy l ->
@@ -113,6 +150,21 @@ class (PlutusLanguage l, EraPlutusContext era) => EraPlutusTxInfo (l :: Language
113150
Maybe (Data era) ->
114151
Data era ->
115152
Either (ContextError era) (PlutusArgs l)
153+
default toPlutusArgs ::
154+
forall proxy.
155+
( Era era
156+
, EraPlutusTxInfo l (PreviousEra era)
157+
, Coercible (ContextError (PreviousEra era)) (ContextError era)
158+
, Coercible (PlutusPurpose AsIxItem era) (PlutusPurpose AsIxItem (PreviousEra era))
159+
) =>
160+
proxy l ->
161+
ProtVer ->
162+
PlutusTxInfo l ->
163+
PlutusPurpose AsIxItem era ->
164+
Maybe (Data era) ->
165+
Data era ->
166+
Either (ContextError era) (PlutusArgs l)
167+
toPlutusArgs = coerce $ toPlutusArgs @l @(PreviousEra era) @proxy
116168

117169
class
118170
( AlonzoEraScript era

‎eras/conway/impl/src/Cardano/Ledger/Conway/TxInfo.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,15 @@ module Cardano.Ledger.Conway.TxInfo (
2727
transMap,
2828
transTxInInfoV1,
2929
transTxOutV1,
30+
transMintValue,
31+
transTxBodyId,
32+
transVotingProcedures,
33+
transProposal,
3034
toPlutusV3Args,
35+
transTxCertV1V2,
36+
transPlutusPurposeV1V2,
37+
guardConwayFeaturesForPlutusV1V2,
38+
transTxInInfoV3,
3139
) where
3240

3341
import Cardano.Crypto.Hash.Class (hashToBytes)

‎eras/conway/impl/src/Cardano/Ledger/Conway/UTxO.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ module Cardano.Ledger.Conway.UTxO (
1313
conwayConsumed,
1414
conwayProducedValue,
1515
getConwayWitsVKeyNeeded,
16+
getConwayScriptsNeeded,
1617
txNonDistinctRefScriptsSize,
1718
getConwayMinFeeTxUtxo,
1819
) where

‎eras/dijkstra/cardano-ledger-dijkstra.cabal‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,14 +29,17 @@ library
2929
Cardano.Ledger.Dijkstra.Era
3030
Cardano.Ledger.Dijkstra.Genesis
3131
Cardano.Ledger.Dijkstra.Governance
32+
Cardano.Ledger.Dijkstra.State
3233
Cardano.Ledger.Dijkstra.State.CertState
3334
Cardano.Ledger.Dijkstra.State.Stake
3435
Cardano.Ledger.Dijkstra.Tx
3536
Cardano.Ledger.Dijkstra.TxAuxData
3637
Cardano.Ledger.Dijkstra.TxBody
3738
Cardano.Ledger.Dijkstra.TxCert
39+
Cardano.Ledger.Dijkstra.TxInfo
3840
Cardano.Ledger.Dijkstra.TxOut
3941
Cardano.Ledger.Dijkstra.TxWits
42+
Cardano.Ledger.Dijkstra.UTxO
4043
Cardano.Ledger.Dijkstra.PParams
4144
Cardano.Ledger.Dijkstra.Rules
4245
Cardano.Ledger.Dijkstra.Scripts
@@ -91,6 +94,7 @@ library
9194
mempack,
9295
microlens,
9396
nothunks,
97+
plutus-ledger-api,
9498
if flag(asserts)
9599
ghc-options: -fno-ignore-asserts
96100

@@ -99,6 +103,8 @@ library testlib
99103
visibility: public
100104
hs-source-dirs: testlib
101105
exposed-modules:
106+
Test.Cardano.Ledger.Dijkstra.Arbitrary
107+
Test.Cardano.Ledger.Dijkstra.Era
102108
Test.Cardano.Ledger.Dijkstra.ImpTest
103109
other-modules: Paths_cardano_ledger_dijkstra
104110
default-language: Haskell2010
@@ -113,8 +119,8 @@ library testlib
113119

114120
build-depends:
115121
base,
116-
cardano-ledger-core:cardano-ledger-core,
117-
cardano-ledger-conway:{cardano-ledger-conway, testlib},
122+
cardano-ledger-core:{cardano-ledger-core, testlib},
123+
cardano-ledger-conway:testlib,
118124
cardano-ledger-dijkstra,
119125

120126
test-suite tests

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra.hs‎

Lines changed: 20 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,27 @@
1+
{-# LANGUAGE TypeApplications #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# OPTIONS_GHC -Wno-orphans #-}
14
module Cardano.Ledger.Dijkstra (DijkstraEra) where
25

36
import Cardano.Ledger.Dijkstra.Era
47
import Cardano.Ledger.Dijkstra.Genesis ()
8+
import Cardano.Ledger.Dijkstra.Governance ()
9+
import Cardano.Ledger.Dijkstra.Rules ()
510
import Cardano.Ledger.Dijkstra.Scripts ()
11+
import Cardano.Ledger.Dijkstra.State.CertState ()
12+
import Cardano.Ledger.Dijkstra.State.Stake ()
13+
import Cardano.Ledger.Dijkstra.Translation ()
614
import Cardano.Ledger.Dijkstra.Tx ()
715
import Cardano.Ledger.Dijkstra.TxBody ()
8-
import Cardano.Ledger.Dijkstra.Governance ()
9-
import Cardano.Ledger.Dijkstra.State.Stake ()
10-
import Cardano.Ledger.Dijkstra.State.CertState ()
16+
import Cardano.Ledger.Dijkstra.TxWits ()
17+
import Cardano.Ledger.Dijkstra.TxInfo ()
18+
import Cardano.Ledger.Dijkstra.UTxO ()
19+
import Cardano.Ledger.Shelley.API (ApplyTx (..), ApplyBlock, ruleApplyTxValidation)
20+
import Cardano.Ledger.Conway.Governance (RunConwayRatify)
21+
22+
instance ApplyTx DijkstraEra where
23+
applyTxValidation = ruleApplyTxValidation @"MEMPOOL"
24+
25+
instance ApplyBlock DijkstraEra
26+
27+
instance RunConwayRatify DijkstraEra

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1 +1,16 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE MultiParamTypeClasses #-}
3+
{-# LANGUAGE TypeFamilies #-}
4+
{-# OPTIONS_GHC -Wno-orphans #-}
5+
16
module Cardano.Ledger.Dijkstra.Rules.Gov () where
7+
8+
import Cardano.Ledger.Conway.Rules (ConwayGovEvent, ConwayGovPredFailure)
9+
import Cardano.Ledger.Dijkstra.Core
10+
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
11+
12+
type instance EraRuleFailure "GOV" DijkstraEra = ConwayGovPredFailure DijkstraEra
13+
14+
type instance EraRuleEvent "GOV" DijkstraEra = ConwayGovEvent DijkstraEra
15+
16+
instance InjectRuleFailure "GOV" ConwayGovPredFailure DijkstraEra

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/Rules/Utxos.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import Cardano.Ledger.Conway.Rules (
1212
alonzoToConwayUtxosEvent,
1313
alonzoToConwayUtxosPredFailure,
1414
)
15-
import Cardano.Ledger.Dijkstra (DijkstraEra)
15+
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
1616
import Cardano.Ledger.Dijkstra.Core (
1717
EraRuleEvent,
1818
EraRuleFailure,

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/Scripts.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
{-# LANGUAGE TypeFamilies #-}
77
{-# OPTIONS_GHC -Wno-orphans #-}
88

9-
module Cardano.Ledger.Dijkstra.Scripts () where
9+
module Cardano.Ledger.Dijkstra.Scripts (PlutusScript (..)) where
1010

1111
import Cardano.Ledger.Allegra.Scripts (
1212
AllegraEraScript (..),
@@ -61,7 +61,8 @@ instance MemPack (PlutusScript DijkstraEra) where
6161
unpackM = undefined
6262

6363
instance AlonzoEraScript DijkstraEra where
64-
newtype PlutusScript DijkstraEra = MkDijkstraPlutusScript (PlutusScript ConwayEra)
64+
newtype PlutusScript DijkstraEra = MkDijkstraPlutusScript
65+
{unDijkstraPlutusScript :: PlutusScript ConwayEra}
6566
deriving newtype (SafeToHash, Show, NFData, NoThunks, Eq, Ord)
6667

6768
type PlutusPurpose f DijkstraEra = ConwayPlutusPurpose f DijkstraEra

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/State.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
module Cardano.Ledger.Dijkstra.State (module Cardano.Ledger.Conway.State) where
2+
3+
import Cardano.Ledger.Conway.State

0 commit comments

Comments
 (0)