Skip to content

Commit 329563d

Browse files
kdermekderme
committed
Make tests compile
1 parent b4d7d3d commit 329563d

File tree

11 files changed

+270
-117
lines changed

11 files changed

+270
-117
lines changed

‎cardano-chain-gen/cardano-chain-gen.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -203,6 +203,7 @@ test-suite cardano-chain-gen
203203
, text
204204
, transformers
205205
, transformers-except
206+
, tree-diff
206207
, tasty-hunit
207208
, monad-logger
208209
, ouroboros-consensus

‎cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -32,8 +32,7 @@ module Cardano.Mock.Forging.Interpreter (
3232
mkTxId,
3333
) where
3434

35-
import Cardano.Ledger.Block (txid)
36-
import qualified Cardano.Ledger.Core as Core
35+
import Cardano.Ledger.Core (txIdTx)
3736
import Cardano.Ledger.Crypto (StandardCrypto)
3837
import qualified Cardano.Ledger.Shelley.API.Mempool as Ledger
3938
import Cardano.Ledger.Shelley.LedgerState (NewEpochState (..))
@@ -66,7 +65,6 @@ import qualified Data.Text as Text
6665
import qualified Data.Text.IO as Text
6766
import Data.Word (Word64)
6867
import GHC.Generics (Generic)
69-
import Lens.Micro
7068
import NoThunks.Class (OnlyCheckWhnfNamed (..))
7169
import Ouroboros.Consensus.Block (
7270
BlockForging,
@@ -545,10 +543,10 @@ withShelleyLedgerState inter mk = do
545543
mkTxId :: TxEra -> Ledger.TxId StandardCrypto
546544
mkTxId txe =
547545
case txe of
548-
TxAlonzo tx -> txid @StandardAlonzo (tx ^. Core.bodyTxL)
549-
TxBabbage tx -> txid @StandardBabbage (tx ^. Core.bodyTxL)
550-
TxConway tx -> txid @StandardConway (tx ^. Core.bodyTxL)
551-
TxShelley tx -> txid @StandardShelley (tx ^. Core.bodyTxL)
546+
TxAlonzo tx -> txIdTx @StandardAlonzo tx
547+
TxBabbage tx -> txIdTx @StandardBabbage tx
548+
TxConway tx -> txIdTx @StandardConway tx
549+
TxShelley tx -> txIdTx @StandardShelley tx
552550

553551
mkValidated :: TxEra -> Validated (Consensus.GenTx CardanoBlock)
554552
mkValidated txe =

‎cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo.hs

Lines changed: 30 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ module Cardano.Mock.Forging.Tx.Alonzo (
2020
mkUnlockScriptTx,
2121
mkScriptInp,
2222
mkScriptMint,
23+
mkScriptMint',
2324
mkMAssetsScriptTx,
2425
mkDCertTx,
2526
mkSimpleDCertTx,
@@ -44,11 +45,10 @@ import Cardano.Ledger.Alonzo.Tx
4445
import Cardano.Ledger.Alonzo.TxBody
4546
import Cardano.Ledger.Alonzo.TxWits
4647
import Cardano.Ledger.BaseTypes
47-
import Cardano.Ledger.Block (txid)
4848
import Cardano.Ledger.Coin
49+
import Cardano.Ledger.Core
4950
import qualified Cardano.Ledger.Core as Core
5051
import Cardano.Ledger.Credential
51-
import Cardano.Ledger.Hashes
5252
import Cardano.Ledger.Keys
5353
import Cardano.Ledger.Mary.Value
5454
import Cardano.Ledger.Shelley.TxCert
@@ -203,38 +203,45 @@ mkUnlockScriptTx inputIndex colInputIndex outputIndex succeeds amount fees sta =
203203

204204
mkScriptInp' ::
205205
(Word64, (TxIn StandardCrypto, Core.TxOut StandardAlonzo)) ->
206-
Maybe (RdmrPtr, Maybe (ScriptHash StandardCrypto, Core.Script StandardAlonzo))
206+
Maybe (AlonzoPlutusPurpose AsIndex era, Maybe (ScriptHash StandardCrypto, Core.Script StandardAlonzo))
207207
mkScriptInp' = map (second Just) . mkScriptInp
208208

209209
mkScriptInp ::
210210
(Word64, (TxIn StandardCrypto, Core.TxOut StandardAlonzo)) ->
211-
Maybe (RdmrPtr, (ScriptHash StandardCrypto, Core.Script StandardAlonzo))
211+
Maybe (AlonzoPlutusPurpose AsIndex era, (ScriptHash StandardCrypto, Core.Script StandardAlonzo))
212212
mkScriptInp (n, (_txIn, txOut))
213213
| addr == alwaysFailsScriptAddr =
214214
Just
215-
(RdmrPtr Spend n, (alwaysFailsScriptHash, alwaysFailsScript))
215+
(AlonzoSpending (AsIndex $ fromIntegral n), (alwaysFailsScriptHash, alwaysFailsScript))
216216
| addr == alwaysSucceedsScriptAddr =
217217
Just
218-
(RdmrPtr Spend n, (alwaysSucceedsScriptHash, alwaysSucceedsScript))
218+
(AlonzoSpending (AsIndex $ fromIntegral n), (alwaysSucceedsScriptHash, alwaysSucceedsScript))
219219
| addr == alwaysMintScriptAddr =
220-
Just (RdmrPtr Spend n, (alwaysMintScriptHash, alwaysMintScript))
220+
Just (AlonzoSpending (AsIndex $ fromIntegral n), (alwaysMintScriptHash, alwaysMintScript))
221221
| otherwise = Nothing
222222
where
223223
addr = txOut ^. Core.addrTxOutL
224224

225+
mkScriptMint' ::
226+
AlonzoEraScript era =>
227+
MultiAsset StandardCrypto ->
228+
[(AlonzoPlutusPurpose AsIndex era, Maybe (ScriptHash StandardCrypto, AlonzoScript era))]
229+
mkScriptMint' = fmap (first $ AlonzoMinting . AsIndex) . mkScriptMint
230+
225231
mkScriptMint ::
232+
AlonzoEraScript era =>
226233
MultiAsset StandardCrypto ->
227-
[(RdmrPtr, Maybe (ScriptHash StandardCrypto, Core.Script StandardAlonzo))]
234+
[(Word32, Maybe (ScriptHash StandardCrypto, AlonzoScript era))]
228235
mkScriptMint (MultiAsset mp) = mapMaybe f $ zip [0 ..] (Map.keys mp)
229236
where
230237
f (n, policyId)
231238
| policyID policyId == alwaysFailsScriptHash =
232-
Just (RdmrPtr Mint n, Just (alwaysFailsScriptHash, alwaysFailsScript))
239+
Just (n, Just (alwaysFailsScriptHash, alwaysFailsScript))
233240
| policyID policyId == alwaysSucceedsScriptHash =
234241
Just
235-
(RdmrPtr Mint n, Just (alwaysSucceedsScriptHash, alwaysSucceedsScript))
242+
(n, Just (alwaysSucceedsScriptHash, alwaysSucceedsScript))
236243
| policyID policyId == alwaysMintScriptHash =
237-
Just (RdmrPtr Mint n, Just (alwaysMintScriptHash, alwaysMintScript))
244+
Just (n, Just (alwaysMintScriptHash, alwaysMintScript))
238245
| otherwise = Nothing
239246

240247
mkMAssetsScriptTx ::
@@ -256,7 +263,7 @@ mkMAssetsScriptTx inputIndex colInputIndex outputIndex minted succeeds fees sta
256263
$ mkScriptTx
257264
succeeds
258265
( mapMaybe mkScriptInp' (zip [0 ..] inputPairs)
259-
++ mkScriptMint minted
266+
++ mkScriptMint' minted
260267
)
261268
$ consPaymentTxBody inpts colInput (StrictSeq.fromList outps) (Coin fees) minted
262269
where
@@ -314,8 +321,8 @@ mkScriptDCertTx consDert valid st = do
314321
else
315322
Just $
316323
if bl
317-
then (RdmrPtr Cert n, (alwaysFailsScriptHash, alwaysFailsScript))
318-
else (RdmrPtr Cert n, (alwaysSucceedsScriptHash, alwaysSucceedsScript))
324+
then (AlonzoCertifying (AsIndex n), (alwaysFailsScriptHash, alwaysFailsScript))
325+
else (AlonzoCertifying (AsIndex n), (alwaysSucceedsScriptHash, alwaysSucceedsScript))
319326
prepareRedeemer _ = Nothing
320327

321328
mkDepositTxPools ::
@@ -355,13 +362,13 @@ consPoolParamsTwoOwners _ _ = panic "expected 2 pool owners"
355362

356363
mkScriptTx ::
357364
forall era.
358-
( Core.Era era
359-
, Core.EraCrypto era ~ StandardCrypto
365+
( Core.EraCrypto era ~ StandardCrypto
360366
, Core.Script era ~ AlonzoScript era
361367
, Core.TxWits era ~ AlonzoTxWits era
368+
, AlonzoEraScript era
362369
) =>
363370
Bool ->
364-
[(RdmrPtr, Maybe (ScriptHash StandardCrypto, Core.Script era))] ->
371+
[(PlutusPurpose AsIndex era, Maybe (ScriptHash StandardCrypto, Core.Script era))] ->
365372
Core.TxBody era ->
366373
AlonzoTx era
367374
mkScriptTx valid rdmrs txBody =
@@ -378,8 +385,11 @@ mkScriptTx valid rdmrs txBody =
378385
[(hashData @era plutusDataList, plutusDataList)]
379386

380387
mkWitnesses ::
381-
(Core.Era era, Core.EraCrypto era ~ StandardCrypto, Script era ~ AlonzoScript era) =>
382-
[(RdmrPtr, Maybe (ScriptHash StandardCrypto, Core.Script era))] ->
388+
( Core.EraCrypto era ~ StandardCrypto
389+
, Script era ~ AlonzoScript era
390+
, AlonzoEraScript era
391+
) =>
392+
[(PlutusPurpose AsIndex era, Maybe (ScriptHash StandardCrypto, Core.Script era))] ->
383393
[(DataHash StandardCrypto, Data era)] ->
384394
AlonzoTxWits era
385395
mkWitnesses rdmrs datas =
@@ -404,7 +414,7 @@ mkUTxOAlonzo tx =
404414
| (out, idx) <- zip (toList (tx ^. outputsL)) (TxIx <$> [0 ..])
405415
]
406416
where
407-
transId = txid $ getField @"body" tx
417+
transId = txIdTx tx
408418
outputsL = Core.bodyTxL . Core.outputsTxBodyL
409419

410420
emptyTxBody :: AlonzoTxBody StandardAlonzo

‎cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs

Lines changed: 27 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE FlexibleContexts #-}
23
{-# LANGUAGE GADTs #-}
34
{-# LANGUAGE OverloadedStrings #-}
@@ -6,15 +7,18 @@
67
{-# LANGUAGE TypeOperators #-}
78

89
module Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples (
10+
alwaysSucceedsPlutusBinary,
911
alwaysSucceedsScript,
1012
alwaysSucceedsScriptHash,
1113
alwaysSucceedsScriptAddr,
1214
alwaysSucceedsScriptStake,
15+
alwaysFailsPlutusBinary,
1316
alwaysFailsScript,
1417
alwaysFailsScriptHash,
1518
alwaysFailsScriptAddr,
1619
alwaysFailsScriptStake,
1720
plutusDataList,
21+
alwaysMintPlutusBinary,
1822
alwaysMintScript,
1923
alwaysMintScriptHash,
2024
alwaysMintScriptAddr,
@@ -24,7 +28,6 @@ module Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples (
2428
plutusData2,
2529
plutusDataEncLen,
2630
plutusDataEncIndef,
27-
toBinaryPlutus,
2831
) where
2932

3033
import Cardano.Ledger.Address
@@ -39,17 +42,20 @@ import Cardano.Ledger.Hashes
3942
import Cardano.Ledger.Mary.Value
4043
import Cardano.Ledger.Plutus.Data
4144
import Cardano.Ledger.Plutus.Language
42-
import Cardano.Prelude (panic)
4345
import Codec.CBOR.Write (toStrictByteString)
4446
import Codec.Serialise
4547
import Codec.Serialise.Encoding
4648
import Data.ByteString.Short
49+
import Data.Maybe
4750
import Ouroboros.Consensus.Cardano.Block (StandardAlonzo)
4851
import qualified PlutusCore.Data as Plutus
4952
import qualified PlutusLedgerApi.Test.Examples as Plutus
5053

51-
alwaysSucceedsScript :: forall era. AlonzoScript era
52-
alwaysSucceedsScript = PlutusScript $ Plutus PlutusV1 (BinaryPlutus $ Plutus.alwaysSucceedingNAryFunction 0)
54+
alwaysSucceedsPlutusBinary :: PlutusBinary
55+
alwaysSucceedsPlutusBinary = PlutusBinary $ Plutus.alwaysSucceedingNAryFunction 0
56+
57+
alwaysSucceedsScript :: AlonzoEraScript era => AlonzoScript era
58+
alwaysSucceedsScript = mkPlutusScriptEra alwaysSucceedsPlutusBinary
5359

5460
alwaysSucceedsScriptHash :: ScriptHash StandardCrypto
5561
alwaysSucceedsScriptHash = scriptHash @StandardAlonzo alwaysSucceedsScript
@@ -60,8 +66,11 @@ alwaysSucceedsScriptAddr = Addr Testnet (ScriptHashObj alwaysSucceedsScriptHash)
6066
alwaysSucceedsScriptStake :: StakeCredential StandardCrypto
6167
alwaysSucceedsScriptStake = ScriptHashObj alwaysSucceedsScriptHash
6268

63-
alwaysFailsScript :: forall era. AlonzoScript era
64-
alwaysFailsScript = PlutusScript $ Plutus PlutusV1 (BinaryPlutus $ Plutus.alwaysFailingNAryFunction 0)
69+
alwaysFailsPlutusBinary :: PlutusBinary
70+
alwaysFailsPlutusBinary = PlutusBinary $ Plutus.alwaysFailingNAryFunction 0
71+
72+
alwaysFailsScript :: AlonzoEraScript era => AlonzoScript era
73+
alwaysFailsScript = mkPlutusScriptEra alwaysFailsPlutusBinary
6574

6675
alwaysFailsScriptHash :: ScriptHash StandardCrypto
6776
alwaysFailsScriptHash = scriptHash @StandardAlonzo alwaysFailsScript
@@ -76,8 +85,11 @@ alwaysFailsScriptStake = ScriptHashObj alwaysFailsScriptHash
7685
plutusDataList :: forall era. Era era => Data era
7786
plutusDataList = Data $ Plutus.List []
7887

79-
alwaysMintScript :: forall era. AlonzoScript era
80-
alwaysMintScript = PlutusScript $ Plutus PlutusV1 (BinaryPlutus $ Plutus.alwaysFailingNAryFunction 1)
88+
alwaysMintPlutusBinary :: PlutusBinary
89+
alwaysMintPlutusBinary = PlutusBinary $ Plutus.alwaysFailingNAryFunction 1
90+
91+
alwaysMintScript :: AlonzoEraScript era => AlonzoScript era
92+
alwaysMintScript = mkPlutusScriptEra alwaysMintPlutusBinary
8193

8294
alwaysMintScriptHash :: ScriptHash StandardCrypto
8395
alwaysMintScriptHash = scriptHash @StandardAlonzo alwaysMintScript
@@ -88,6 +100,9 @@ alwaysMintScriptAddr = Addr Testnet (ScriptHashObj alwaysMintScriptHash) StakeRe
88100
alwaysMintScriptStake :: StakeCredential StandardCrypto
89101
alwaysMintScriptStake = ScriptHashObj alwaysMintScriptHash
90102

103+
mkPlutusScriptEra :: AlonzoEraScript era => PlutusBinary -> AlonzoScript era
104+
mkPlutusScriptEra sh = PlutusScript $ fromJust $ mkBinaryPlutusScript PlutusV1 sh
105+
91106
scriptHash ::
92107
forall era.
93108
( EraCrypto era ~ StandardCrypto
@@ -114,7 +129,7 @@ plutusDataEncLen = toShort $ toStrictByteString $ mconcat (encodeListLen 2 : (en
114129
plutusDataEncIndef :: ShortByteString
115130
plutusDataEncIndef = toShort $ toStrictByteString $ encodeList plutusData2
116131

117-
toBinaryPlutus :: AlonzoScript era -> BinaryPlutus
118-
toBinaryPlutus as = case as of
119-
TimelockScript _ -> panic "expected Alonzo script"
120-
PlutusScript (Plutus _ sbs) -> sbs
132+
-- toBinaryPlutus :: AlonzoEraScript era => AlonzoScript era -> PlutusBinary
133+
-- toBinaryPlutus as = case mkPlutusScript as of
134+
-- Nothing -> panic "expected Alonzo script"
135+
-- PlutusScript (Plutus _ sbs) -> sbs

0 commit comments

Comments
 (0)