Skip to content

Commit e6c49a9

Browse files
committed
wip
1 parent d0dcd9b commit e6c49a9

File tree

6 files changed

+170
-7
lines changed

6 files changed

+170
-7
lines changed

cardano-testnet/cardano-testnet.cabal

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -185,7 +185,9 @@ test-suite cardano-testnet-test
185185

186186
main-is: cardano-testnet-test.hs
187187

188-
other-modules: Cardano.Testnet.Test.Cli.Conway.Plutus
188+
other-modules:
189+
Cardano.Testnet.Test.Api.TxSupplementalDatum
190+
Cardano.Testnet.Test.Cli.Conway.Plutus
189191
Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
190192
Cardano.Testnet.Test.Cli.KesPeriodInfo
191193
Cardano.Testnet.Test.Cli.LeadershipSchedule

cardano-testnet/src/Testnet/Components/Query.hs

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,14 +36,16 @@ module Testnet.Components.Query
3636
, checkDRepsNumber
3737
, checkDRepState
3838
, assertNewEpochState
39+
, getProtocolParams
3940
, getGovActionLifetime
4041
, getKeyDeposit
4142
, getDelegationState
4243
) where
4344

4445
import Cardano.Api as Api
4546
import Cardano.Api.Ledger (Credential, DRepState, EpochInterval (..), KeyRole (DRepRole))
46-
import Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut)
47+
import Cardano.Api.Shelley (LedgerProtocolParameters (..), ShelleyLedgerEra,
48+
fromShelleyTxIn, fromShelleyTxOut)
4749

4850
import Cardano.Ledger.Api (ConwayGovState)
4951
import qualified Cardano.Ledger.Api as L
@@ -566,6 +568,15 @@ assertNewEpochState epochStateView sbe maxWait lens expected = withFrozenCallSta
566568
Refl <- H.leftFail $ assertErasEqual sbe actualEra
567569
pure $ newEpochState ^. lens
568570

571+
-- | Return current protocol parameters from the governance state
572+
getProtocolParams :: (H.MonadAssertion m, MonadTest m, MonadIO m)
573+
=> EpochStateView
574+
-> ConwayEraOnwards era
575+
-> m (LedgerProtocolParameters era)
576+
getProtocolParams epochStateView ceo = conwayEraOnwardsConstraints ceo $ do
577+
govState :: ConwayGovState era <- getGovState epochStateView ceo
578+
pure . LedgerProtocolParameters $ govState ^. L.cgsCurPParamsL
579+
569580

570581
-- | Obtains the @govActionLifetime@ from the protocol parameters.
571582
-- The @govActionLifetime@ or governance action maximum lifetime in epochs is

cardano-testnet/src/Testnet/Types.hs

Lines changed: 18 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ module Testnet.Types
2121
, testnetSprockets
2222
, TestnetNode(..)
2323
, nodeSocketPath
24+
, node0ConnectionInfo
2425
, isTestnetNodeSpo
2526
, SpoNodeKeys(..)
2627
, Delegator(..)
@@ -61,7 +62,6 @@ import Data.List (intercalate)
6162
import Data.Maybe
6263
import Data.MonoTraversable (Element, MonoFunctor (..))
6364
import Data.Text (Text)
64-
import Data.Time.Clock (UTCTime)
6565
import GHC.Exts (IsString (..))
6666
import GHC.Generics (Generic)
6767
import qualified GHC.IO.Handle as IO
@@ -72,7 +72,9 @@ import qualified System.Process as IO
7272

7373
import Testnet.Start.Types
7474

75+
import Hedgehog (MonadTest)
7576
import qualified Hedgehog as H
77+
import qualified Hedgehog.Extras as H
7678
import qualified Hedgehog.Extras.Stock as H
7779
import Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
7880

@@ -114,7 +116,7 @@ data SKey k
114116
data TestnetRuntime = TestnetRuntime
115117
{ configurationFile :: !(NodeConfigFile In)
116118
, shelleyGenesisFile :: !FilePath
117-
, testnetMagic :: !Int
119+
, testnetMagic :: !Int -- TODO change to Word32
118120
, testnetNodes :: ![TestnetNode]
119121
, wallets :: ![PaymentKeyInfo]
120122
, delegators :: ![Delegator]
@@ -147,6 +149,18 @@ isTestnetNodeSpo = isJust . poolKeys
147149
nodeSocketPath :: TestnetNode -> SocketPath
148150
nodeSocketPath = File . H.sprocketSystemName . nodeSprocket
149151

152+
-- | Connection data for the first node in the testnet
153+
node0ConnectionInfo :: MonadTest m => TestnetRuntime -> m LocalNodeConnectInfo
154+
node0ConnectionInfo TestnetRuntime{testnetMagic, testnetNodes} = do
155+
case testnetNodes of
156+
[] -> H.note_ "There are no nodes in the testnet" >> H.failure
157+
node0:_ -> do
158+
pure LocalNodeConnectInfo
159+
{ localNodeSocketPath= nodeSocketPath node0
160+
, localNodeNetworkId=Testnet (NetworkMagic $ fromIntegral testnetMagic)
161+
, localConsensusModeParams=CardanoModeParams $ EpochSlots 21600}
162+
163+
150164
data StakingKey
151165
data SpoColdKey
152166

@@ -189,14 +203,14 @@ getStartTime
189203
=> HasCallStack
190204
=> FilePath
191205
-> TestnetRuntime
192-
-> m UTCTime
206+
-> m SystemStart
193207
getStartTime tempRootPath TestnetRuntime{configurationFile} = withFrozenCallStack $ H.evalEither <=< H.evalIO . runExceptT $ do
194208
byronGenesisFile <-
195209
decodeNodeConfiguration configurationFile >>= \case
196210
NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ _ ->
197211
pure $ unGenesisFile npcByronGenesisFile
198212
let byronGenesisFilePath = tempRootPath </> byronGenesisFile
199-
G.gdStartTime . G.configGenesisData <$> decodeGenesisFile byronGenesisFilePath
213+
SystemStart . G.gdStartTime . G.configGenesisData <$> decodeGenesisFile byronGenesisFilePath
200214
where
201215
decodeNodeConfiguration :: File NodeConfig In -> ExceptT String IO NodeProtocolConfiguration
202216
decodeNodeConfiguration (File file) = do
Lines changed: 132 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,132 @@
1+
{-# LANGUAGE LambdaCase #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE NumericUnderscores #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
6+
7+
module Cardano.Testnet.Test.Api.TxSupplementalDatum
8+
( hprop_tx_supp_datum
9+
)
10+
where
11+
12+
import Cardano.Api
13+
import qualified Cardano.Api.Network as Net
14+
import qualified Cardano.Api.Network as Net.Tx
15+
import Cardano.Api.Shelley
16+
17+
import Cardano.Testnet
18+
19+
import Prelude
20+
21+
import Control.Monad
22+
import Data.Default.Class
23+
import qualified Data.Map.Strict as M
24+
import Data.Proxy
25+
import GHC.Exts (IsList (..))
26+
import Lens.Micro
27+
28+
import Testnet.Components.Query
29+
import Testnet.Property.Util (integrationRetryWorkspace)
30+
import Testnet.Types
31+
32+
import Hedgehog (Property, (===))
33+
import qualified Hedgehog as H
34+
import qualified Hedgehog.Extras.Test.Base as H
35+
import qualified Hedgehog.Extras.Test.TestWatchdog as H
36+
37+
hprop_tx_supp_datum :: Property
38+
hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do
39+
conf@Conf{tempAbsPath} <- mkConf tempAbsBasePath'
40+
let tempAbsPath' = unTmpAbsPath tempAbsPath
41+
42+
let ceo = ConwayEraOnwardsConway
43+
sbe = convert ceo
44+
eraProxy = proxyToAsType Proxy
45+
options = def{cardanoNodeEra = AnyShelleyBasedEra sbe}
46+
47+
tr@TestnetRuntime
48+
{ configurationFile
49+
, testnetNodes = node0 : _
50+
, wallets = wallet0@(PaymentKeyInfo _ addrTxt0) : wallet1 : _
51+
} <-
52+
cardanoTestnetDefault options def conf
53+
54+
systemStart <- H.noteShowM $ getStartTime tempAbsPath' tr
55+
epochStateView <- getEpochStateView configurationFile (nodeSocketPath node0)
56+
connectionInfo <- node0ConnectionInfo tr
57+
pparams <- getProtocolParams epochStateView ceo
58+
59+
-- prepare tx inputs and output address
60+
H.noteShow_ addrTxt0
61+
addr0 <- H.nothingFail $ deserialiseAddress (AsAddressInEra eraProxy) addrTxt0
62+
txIn <- findLargestUtxoForPaymentKey epochStateView sbe wallet0
63+
64+
let (PaymentKeyInfo _ addrTxt1) = wallet1
65+
H.noteShow_ addrTxt1
66+
addr1 <- H.nothingFail $ deserialiseAddress (AsAddressInEra eraProxy) addrTxt1
67+
68+
let txOutValue = lovelaceToTxOutValue sbe 1_000_000
69+
txOut =
70+
TxOut
71+
addr1
72+
txOutValue
73+
TxOutDatumNone
74+
ReferenceScriptNone
75+
76+
-- read key witnesses
77+
wit <-
78+
H.leftFailM . H.evalIO $
79+
readFileTextEnvelopeAnyOf
80+
[FromSomeType (proxyToAsType Proxy) WitnessGenesisUTxOKey]
81+
(signingKey $ paymentKeyInfoPair wallet0)
82+
83+
-- query node for era history
84+
epochInfo <-
85+
(H.leftFail <=< H.leftFailM) . H.evalIO $
86+
executeLocalStateQueryExpr connectionInfo Net.VolatileTip $
87+
fmap toLedgerEpochInfo <$> queryEraHistory
88+
89+
-- build a transaction
90+
let content =
91+
defaultTxBodyContent sbe
92+
& setTxIns [(txIn, pure $ KeyWitness KeyWitnessForSpending)]
93+
& setTxOuts [txOut]
94+
& setTxProtocolParams (pure $ pure pparams)
95+
96+
utxo <- UTxO <$> findAllUtxos epochStateView sbe
97+
98+
BalancedTxBody _ txBody _ _ <-
99+
H.leftFail $
100+
makeTransactionBodyAutoBalance
101+
sbe
102+
systemStart
103+
epochInfo
104+
pparams
105+
mempty
106+
mempty
107+
mempty
108+
utxo
109+
content
110+
addr0
111+
Nothing -- keys override
112+
let tx = signShelleyTransaction sbe txBody [wit]
113+
txId <- H.noteShow . getTxId $ getTxBody tx
114+
115+
H.evalIO (submitTxToNodeLocal connectionInfo (TxInMode sbe tx)) >>= \case
116+
Net.Tx.SubmitFail reason -> H.noteShow_ reason >> H.failure
117+
Net.Tx.SubmitSuccess -> H.success
118+
119+
-- wait till transaction gets included in the block
120+
_ <- waitForBlocks epochStateView 1
121+
122+
-- test if it's in UTxO set
123+
utxos1 <- findAllUtxos epochStateView sbe
124+
let txUtxo = M.filterWithKey (\(TxIn txId' _) _ -> txId == txId') utxos1
125+
2 === length txUtxo
126+
127+
[(_, firstTxOut)] <-
128+
pure . toList $ M.filterWithKey (\(TxIn txId' txIx') _ -> txId == txId' && txIx' == TxIx 0) utxos1
129+
130+
txOut === firstTxOut
131+
132+
H.failure

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ module Cardano.Testnet.Test.Cli.QuerySlotNumber
1414

1515
import Cardano.Ledger.Shelley.Genesis (fromNominalDiffTimeMicro)
1616
import Cardano.Slotting.Slot
17+
import Cardano.Slotting.Time (SystemStart (..))
1718
import Cardano.Testnet
1819

1920
import Prelude
@@ -47,7 +48,7 @@ hprop_querySlotNumber = integrationRetryWorkspace 2 "query-slot-number" $ \tempA
4748
, testnetNodes
4849
} <- cardanoTestnetDefault def def conf
4950
ShelleyGenesis{sgSlotLength, sgEpochLength} <- H.noteShowM $ shelleyGenesis tr
50-
startTime <- H.noteShowM $ getStartTime tempAbsBasePath' tr
51+
SystemStart startTime <- H.noteShowM $ getStartTime tempAbsBasePath' tr
5152

5253
let slotLength = fromNominalDiffTimeMicro sgSlotLength
5354
-- how many slots can the checked value differ from

cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ module Main
55
) where
66

77
import qualified Cardano.Crypto.Init as Crypto
8+
import qualified Cardano.Testnet.Test.Api.TxSupplementalDatum
89
import qualified Cardano.Testnet.Test.Cli.Conway.Plutus
910
import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo
1011
import qualified Cardano.Testnet.Test.Cli.Query
@@ -74,6 +75,8 @@ tests = do
7475
, T.testGroup "Plutus"
7576
[ ignoreOnWindows "PlutusV3" Cardano.Testnet.Test.Cli.Conway.Plutus.hprop_plutus_v3]
7677
]
78+
, T.testGroup "API"
79+
[ignoreOnWindows "transaction with supplemental datum" Cardano.Testnet.Test.Api.TxSupplementalDatum.hprop_tx_supp_datum]
7780
, T.testGroup "CLI"
7881
[ ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown
7982
-- ShutdownOnSigint fails on Mac with

0 commit comments

Comments
 (0)