Skip to content

Commit c87a740

Browse files
Jimbo4350Jimbo4350
committed
Update tests
1 parent 6fbc9d1 commit c87a740

File tree

6 files changed

+205
-189
lines changed

6 files changed

+205
-189
lines changed

‎cardano-api/cardano-api.cabal‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -236,6 +236,7 @@ library
236236
Cardano.Api.Experimental.Tx.Internal.Compatible
237237
Cardano.Api.Experimental.Tx.Internal.Fee
238238
Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
239+
Cardano.Api.Experimental.Tx.Internal.Type
239240
Cardano.Api.Genesis.Internal
240241
Cardano.Api.Genesis.Internal.Parameters
241242
Cardano.Api.Governance.Internal.Action.ProposalProcedure
@@ -306,6 +307,7 @@ library gen
306307
Test.Gen.Cardano.Api
307308
Test.Gen.Cardano.Api.Byron
308309
Test.Gen.Cardano.Api.Era
310+
Test.Gen.Cardano.Api.Experimental
309311
Test.Gen.Cardano.Api.Hardcoded
310312
Test.Gen.Cardano.Api.Metadata
311313
Test.Gen.Cardano.Api.Orphans
@@ -343,6 +345,7 @@ library gen
343345
hedgehog-extras,
344346
hedgehog-quickcheck,
345347
iproute,
348+
ordered-containers,
346349
quickcheck-instances,
347350
random,
348351
tasty,
@@ -388,6 +391,7 @@ test-suite cardano-api-test
388391
hedgehog-quickcheck,
389392
microlens,
390393
mtl,
394+
ordered-containers,
391395
ouroboros-consensus,
392396
ouroboros-consensus-protocol,
393397
raw-strings-qq,

‎cardano-api/gen/Test/Gen/Cardano/Api/Experimental.hs‎

Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
module Test.Gen.Cardano.Api.Experimental
2+
( genScriptWitnessedTxCertificates
3+
, genScriptWitnessedTxIn
4+
, genScriptWitnessedTxMintValue
5+
, genScriptWitnessedTxProposals
6+
, genScriptWitnesssedTxVotingProcedures
7+
, genScriptWitnessedTxWithdrawals
8+
)
9+
where
10+
11+
import Cardano.Api (TxIn)
12+
import Cardano.Api.Experimental
13+
import Cardano.Api.Experimental.Tx
14+
import Cardano.Api.Ledger qualified as L
15+
16+
import Data.Map.Ordered.Strict qualified as OMap
17+
18+
import Test.Gen.Cardano.Api.Typed (genExecutionUnits, genHashableScriptData, genTxIn)
19+
20+
import Hedgehog (Gen)
21+
import Hedgehog.Gen qualified as Gen
22+
23+
genAnyWitness :: Gen (AnyWitness era)
24+
genAnyWitness =
25+
Gen.choice
26+
[ return AnyKeyWitnessPlaceholder
27+
, AnySimpleScriptWitness <$> genAnySimpleScriptWitness
28+
, Gen.choice
29+
[ genAnyPlutusScriptWitnessV1
30+
, genAnyPlutusScriptWitnessV2
31+
, genAnyPlutusScriptWitnessV3
32+
, genAnyPlutusScriptWitnessV4
33+
]
34+
]
35+
36+
genAnyPlutusScriptWitnessV1 :: Gen (AnyWitness era)
37+
genAnyPlutusScriptWitnessV1 =
38+
AnyPlutusScriptWitness <$> genPlutusScriptWitness L.SPlutusV1
39+
40+
genAnyPlutusScriptWitnessV2 :: Gen (AnyWitness era)
41+
genAnyPlutusScriptWitnessV2 =
42+
AnyPlutusScriptWitness <$> genPlutusScriptWitness L.SPlutusV2
43+
44+
genAnyPlutusScriptWitnessV3 :: Gen (AnyWitness era)
45+
genAnyPlutusScriptWitnessV3 =
46+
AnyPlutusScriptWitness <$> genPlutusScriptWitness L.SPlutusV3
47+
48+
genAnyPlutusScriptWitnessV4 :: Gen (AnyWitness era)
49+
genAnyPlutusScriptWitnessV4 =
50+
AnyPlutusScriptWitness <$> genPlutusScriptWitness L.SPlutusV4
51+
52+
genAnySimpleScriptWitness :: Gen (SimpleScriptOrReferenceInput era)
53+
genAnySimpleScriptWitness = SReferenceScript <$> genTxIn
54+
55+
-- TODO: <|> (SScript <$> genSimpleScriptWitness)
56+
57+
genPlutusScriptWitness :: L.SLanguage lang -> Gen (PlutusScriptWitness lang purpose era)
58+
genPlutusScriptWitness l =
59+
PlutusScriptWitness l
60+
<$> genPlutusScript
61+
<*> genMaybeDatum
62+
<*> genHashableScriptData
63+
<*> genExecutionUnits
64+
65+
genPlutusScript :: Gen (PlutusScriptOrReferenceInput era lang)
66+
genPlutusScript = PReferenceScript <$> genTxIn
67+
68+
genMaybeDatum :: Gen (PlutusScriptDatum lang purpose)
69+
genMaybeDatum = return NoScriptDatum -- TODO: Write proper generator
70+
71+
genScriptWitnessedTxIn :: Gen (TxIn, AnyWitness era)
72+
genScriptWitnessedTxIn = do
73+
(,) <$> genTxIn <*> genAnyWitness
74+
75+
genScriptWitnessedTxMintValue :: Gen (TxMintValue era)
76+
genScriptWitnessedTxMintValue = return $ TxMintValue mempty
77+
78+
genScriptWitnessedTxCertificates :: Gen (TxCertificates era)
79+
genScriptWitnessedTxCertificates = return $ TxCertificates OMap.empty
80+
81+
genScriptWitnessedTxWithdrawals :: Gen (TxWithdrawals era)
82+
genScriptWitnessedTxWithdrawals = return $ TxWithdrawals mempty
83+
84+
genScriptWitnesssedTxVotingProcedures :: Gen (TxVotingProcedures era)
85+
genScriptWitnesssedTxVotingProcedures = return $ TxVotingProcedures (L.VotingProcedures mempty) mempty
86+
87+
genScriptWitnessedTxProposals :: Gen (TxProposalProcedures era)
88+
genScriptWitnessedTxProposals = return $ TxProposalProcedures OMap.empty

‎cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Type.hs‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -16,23 +16,22 @@ module Cardano.Api.Experimental.Tx.Internal.Type
1616
)
1717
where
1818

19-
2019
import Cardano.Api.Experimental.Era
21-
2220
import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
2321
import Cardano.Api.Ledger.Internal.Reexport qualified as L
2422
import Cardano.Api.ProtocolParameters
2523
import Cardano.Api.Serialise.Raw
2624
( SerialiseAsRawBytes (..)
2725
, SerialiseAsRawBytesError (SerialiseAsRawBytesError)
2826
)
27+
2928
import Cardano.Ledger.Binary qualified as Ledger
3029
import Cardano.Ledger.Core qualified as Ledger
30+
3131
import Control.Exception (displayException)
3232
import Data.Bifunctor (bimap)
3333
import Data.ByteString.Lazy (fromStrict)
3434

35-
3635
-- | A transaction that can contain everything
3736
-- except key witnesses.
3837
data UnsignedTx era
@@ -65,4 +64,4 @@ instance
6564

6665
deriving instance Eq (UnsignedTx era)
6766

68-
deriving instance Show (UnsignedTx era)
67+
deriving instance Show (UnsignedTx era)

‎cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs‎

Lines changed: 51 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE NumericUnderscores #-}
33
{-# LANGUAGE OverloadedLists #-}
44
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeApplications #-}
56
{-# LANGUAGE TypeFamilies #-}
67

78
module Test.Cardano.Api.Experimental
@@ -12,6 +13,7 @@ where
1213
import Cardano.Api qualified as Api
1314
import Cardano.Api.Experimental qualified as Exp
1415
import Cardano.Api.Experimental.Era (convert)
16+
import Cardano.Api.Experimental.Tx qualified as Exp
1517
import Cardano.Api.Genesis qualified as Genesis
1618
import Cardano.Api.Ledger qualified as Ledger
1719
import Cardano.Api.Plutus qualified as Script
@@ -73,7 +75,7 @@ prop_created_transaction_with_both_apis_are_the_same = H.propertyOnce $ do
7375
let sbe = Api.convert era
7476

7577
signedTxTraditional <- exampleTransactionTraditionalWay sbe
76-
signedTxExperimental <- exampleTransactionExperimentalWay era sbe
78+
signedTxExperimental <- exampleTransactionExperimentalWay era
7779

7880
let oldStyleTx :: Api.Tx Api.ConwayEra = ShelleyTx sbe signedTxExperimental
7981

@@ -84,7 +86,7 @@ prop_created_transaction_with_both_apis_are_the_same = H.propertyOnce $ do
8486
=> Api.ShelleyBasedEra Exp.ConwayEra
8587
-> m (Tx Exp.ConwayEra)
8688
exampleTransactionTraditionalWay sbe = do
87-
txBodyContent <- exampleTxBodyContent Api.AsConwayEra sbe
89+
txBodyContent <- exampleTxBodyContent sbe
8890
signingKey <- exampleSigningKey
8991

9092
txBody <- H.evalEither $ Api.createTransactionBody sbe txBodyContent
@@ -96,10 +98,9 @@ prop_created_transaction_with_both_apis_are_the_same = H.propertyOnce $ do
9698
exampleTransactionExperimentalWay
9799
:: H.MonadTest m
98100
=> Exp.Era Exp.ConwayEra
99-
-> Api.ShelleyBasedEra Exp.ConwayEra
100101
-> m (Ledger.Tx (Exp.LedgerEra Exp.ConwayEra))
101-
exampleTransactionExperimentalWay era sbe = do
102-
txBodyContent <- exampleTxBodyContent Api.AsConwayEra sbe
102+
exampleTransactionExperimentalWay era = do
103+
txBodyContent <- exampleTxBodyContentExperimental era
103104
signingKey <- exampleSigningKey
104105

105106
unsignedTx <- H.evalEither $ Exp.makeUnsignedTx era txBodyContent
@@ -119,7 +120,7 @@ prop_balance_transaction_two_ways = H.propertyOnce $ do
119120

120121
changeAddress <- getExampleChangeAddress sbe
121122

122-
txBodyContent <- exampleTxBodyContent Api.AsConwayEra sbe
123+
txBodyContent <- exampleTxBodyContent sbe
123124
txBody <- H.evalEither $ Api.createTransactionBody sbe txBodyContent
124125

125126
-- Simple way (fee calculation)
@@ -244,13 +245,23 @@ getExampleSrcTxId = do
244245
return $ Api.TxIn srcTxId srcTxIx
245246

246247
getExampleDestAddress
247-
:: (H.MonadTest m, Api.IsCardanoEra era) => Script.AsType era -> m (Api.AddressInEra era)
248-
getExampleDestAddress eraAsType = do
248+
:: forall m era. (H.MonadTest m, Api.IsCardanoEra era) => m (Api.AddressInEra era)
249+
getExampleDestAddress = do
249250
H.evalMaybe $
250251
Api.deserialiseAddress
251-
(Api.AsAddressInEra eraAsType)
252+
(Api.AsAddressInEra (Api.proxyToAsType (Api.Proxy @era)))
252253
"addr_test1vzpfxhjyjdlgk5c0xt8xw26avqxs52rtf69993j4tajehpcue4v2v"
253254

255+
getExampleDestAddressExp
256+
:: H.MonadTest m => m Ledger.Addr
257+
getExampleDestAddressExp = do
258+
Api.toShelleyAddr
259+
<$> H.evalMaybe
260+
( Api.deserialiseAddress
261+
(Api.AsAddressInEra (Api.proxyToAsType (Api.Proxy @Api.ConwayEra)))
262+
"addr_test1vzpfxhjyjdlgk5c0xt8xw26avqxs52rtf69993j4tajehpcue4v2v"
263+
)
264+
254265
getExampleChangeAddress :: H.MonadTest m => Api.ShelleyBasedEra era -> m (Api.AddressInEra era)
255266
getExampleChangeAddress sbe = do
256267
signingKey <- exampleSigningKey
@@ -261,14 +272,40 @@ getExampleChangeAddress sbe = do
261272
(Api.PaymentCredentialByKey $ Api.verificationKeyHash $ Api.getVerificationKey signingKey)
262273
Api.NoStakeAddress
263274

275+
exampleTxBodyContentExperimental
276+
:: forall m era
277+
. H.MonadTest m
278+
=> Exp.Era era
279+
-> m (Exp.TxBodyContent (Exp.LedgerEra era))
280+
exampleTxBodyContentExperimental era = do
281+
srcTxIn <- getExampleSrcTxId
282+
addr <- getExampleDestAddressExp
283+
let value = Ledger.valueFromList 10_000_000 []
284+
out :: Ledger.TxOut (Exp.LedgerEra era)
285+
out = Exp.obtainCommonConstraints era $ Ledger.mkBasicTxOut addr value
286+
let txBodyContent =
287+
Exp.defaultTxBodyContent
288+
& Exp.setTxIns
289+
[
290+
( srcTxIn
291+
, Exp.AnyKeyWitnessPlaceholder
292+
)
293+
]
294+
& Exp.setTxOuts
295+
[ Exp.obtainCommonConstraints era $ Exp.TxOut out Nothing
296+
]
297+
& Exp.setTxFee 2_000_000
298+
return txBodyContent
299+
264300
exampleTxBodyContent
265-
:: (Api.ShelleyBasedEraConstraints era, H.MonadTest m)
266-
=> Api.AsType era
267-
-> Api.ShelleyBasedEra era
301+
:: forall m era
302+
. H.MonadTest m
303+
=> Api.IsCardanoEra era
304+
=> Api.ShelleyBasedEra era
268305
-> m (Api.TxBodyContent Api.BuildTx era)
269-
exampleTxBodyContent eraAsType sbe = do
306+
exampleTxBodyContent sbe = do
270307
srcTxIn <- getExampleSrcTxId
271-
destAddress <- getExampleDestAddress eraAsType
308+
destAddress <- getExampleDestAddress @_ @era
272309
let txBodyContent =
273310
Api.defaultTxBodyContent sbe
274311
& Api.setTxIns

‎cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -14,10 +14,10 @@ where
1414

1515
import Cardano.Api
1616
import Cardano.Api.Experimental qualified as Exp
17-
import Cardano.Api.Experimental.Tx
17+
import Cardano.Api.Experimental.Tx qualified as Exp
1818
import Cardano.Api.Ledger qualified as L
1919
import Cardano.Api.Parser.Text qualified as P
20-
import Cardano.Api.Tx qualified as L
20+
import Cardano.Api.Tx qualified as Api
2121

2222
import Cardano.Ledger.Alonzo.Core qualified as L
2323
import Cardano.Ledger.Coin qualified as L
@@ -296,7 +296,7 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr
296296
, executionMemory = 325_610
297297
}
298298
]
299-
=== extractExecutionUnits scriptWitReqsWithAsset
299+
=== Exp.extractExecutionUnits scriptWitReqsWithAsset
300300

301301
-- the correct amount with manual balancing of assets
302302
335_299 === feeWithTxoutAsset
@@ -326,7 +326,7 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr
326326
, executionMemory = 325_610
327327
}
328328
]
329-
=== extractExecutionUnits scriptWitReqsBalanced
329+
=== Exp.extractExecutionUnits scriptWitReqsBalanced
330330

331331
H.noteShow_ feeWithTxoutAsset
332332
H.noteShow_ fee
@@ -465,7 +465,7 @@ prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $
465465
, executionMemory = 325_610
466466
}
467467
]
468-
=== extractExecutionUnits scriptWitReqsBalanced
468+
=== Exp.extractExecutionUnits scriptWitReqsBalanced
469469

470470
335_299 === fee
471471
TxReturnCollateral _ (TxOut _ txOutValue _ _) <- H.noteShow $ txReturnCollateral balancedContent
@@ -484,7 +484,7 @@ prop_calcReturnAndTotalCollateral = H.withTests 400 . H.property $ do
484484
era = convert beo
485485
feeCoin@(L.Coin fee) <- forAll genLovelace
486486
totalCollateral <- forAll $ genLedgerValueForTxOut sbe
487-
let totalCollateralAda = totalCollateral ^. L.adaAssetL sbe
487+
let totalCollateralAda = totalCollateral ^. Api.adaAssetL sbe
488488
pparams <-
489489
H.readJsonFileOk "test/cardano-api-test/files/input/protocol-parameters/conway.json"
490490
requiredCollateralPct <- H.noteShow . fromIntegral $ pparams ^. L.ppCollateralPercentageL
@@ -518,7 +518,7 @@ prop_calcReturnAndTotalCollateral = H.withTests 400 . H.property $ do
518518
collBalance = totalCollateral <-> resRetCollValue
519519

520520
resTotCollValue <-
521-
H.noteShow $ mconcat [L.mkAdaValue sbe lovelace | TxTotalCollateral _ lovelace <- pure resTotColl]
521+
H.noteShow $ mconcat [Api.mkAdaValue sbe lovelace | TxTotalCollateral _ lovelace <- pure resTotColl]
522522

523523
if
524524
| txInsColl == TxInsCollateralNone -> do

0 commit comments

Comments
 (0)