|
| 1 | +{-# LANGUAGE DisambiguateRecordFields #-} |
| 2 | +{-# LANGUAGE NamedFieldPuns #-} |
| 3 | +{-# LANGUAGE NumericUnderscores #-} |
| 4 | +{-# LANGUAGE OverloadedStrings #-} |
| 5 | +{-# LANGUAGE ScopedTypeVariables #-} |
| 6 | +{-# LANGUAGE TypeApplications #-} |
| 7 | + |
| 8 | +module Cardano.Testnet.Test.Cli.Conway.RepeatedCertificatesInTransaction where |
| 9 | + |
| 10 | +import Cardano.Api hiding (Value) |
| 11 | + |
| 12 | +import Cardano.Testnet |
| 13 | + |
| 14 | +import Prelude |
| 15 | + |
| 16 | +import Control.Monad (void) |
| 17 | +import qualified Data.Aeson as A |
| 18 | +import qualified Data.Aeson.Lens as L |
| 19 | +import Data.String |
| 20 | +import qualified Data.Text as Text |
| 21 | +import Lens.Micro |
| 22 | +import System.FilePath ((</>)) |
| 23 | +import qualified System.Info as SYS |
| 24 | + |
| 25 | +import Testnet.Components.Configuration (anyEraToString) |
| 26 | +import Testnet.Components.Query |
| 27 | +import Testnet.Components.SPO |
| 28 | +import Testnet.Process.Cli hiding (File) |
| 29 | +import qualified Testnet.Process.Run as H |
| 30 | +import Testnet.Process.Run |
| 31 | +import qualified Testnet.Property.Utils as H |
| 32 | +import Testnet.Runtime |
| 33 | + |
| 34 | +import Hedgehog (Property, (===)) |
| 35 | +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO |
| 36 | +import qualified Hedgehog.Extras.Test.Base as H |
| 37 | +import qualified Hedgehog.Extras.Test.File as H |
| 38 | + |
| 39 | +hprop_repeated_certificates_in_transaction :: Property |
| 40 | +hprop_repeated_certificates_in_transaction = H.integrationRetryWorkspace 0 "repeated-certificates-in-tx" $ \tempAbsBasePath' -> do |
| 41 | + H.note_ SYS.os |
| 42 | + conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' |
| 43 | + let tempAbsPath' = unTmpAbsPath tempAbsPath |
| 44 | + work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work" |
| 45 | + |
| 46 | + let |
| 47 | + sbe = ShelleyBasedEraBabbage |
| 48 | + era = AnyCardanoEra $ toCardanoEra sbe |
| 49 | + eraString = anyEraToString era |
| 50 | + |
| 51 | + tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' |
| 52 | + options = cardanoDefaultTestnetOptions |
| 53 | + { cardanoNodeEra = era |
| 54 | + } |
| 55 | + |
| 56 | + TestnetRuntime |
| 57 | + { configurationFile |
| 58 | + , testnetMagic |
| 59 | + , poolNodes |
| 60 | + , wallets=wallet0:wallet1:_ |
| 61 | + } <- cardanoTestnetDefault options conf |
| 62 | + |
| 63 | + poolNode1 <- H.headM poolNodes |
| 64 | + poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 |
| 65 | + execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic |
| 66 | + |
| 67 | + let socketName' = IO.sprocketName poolSprocket1 |
| 68 | + socketBase = IO.sprocketBase poolSprocket1 -- /tmp |
| 69 | + socketPath = socketBase </> socketName' |
| 70 | + epochStateView <- getEpochStateView (File configurationFile) (File socketPath) |
| 71 | + |
| 72 | + |
| 73 | + let testStakeDelegator = work </> "test-delegator" |
| 74 | + |
| 75 | + H.createDirectoryIfMissing_ testStakeDelegator |
| 76 | + let testDelegatorVkeyFp = testStakeDelegator </> "test-delegator.vkey" |
| 77 | + testDelegatorSKeyFp = testStakeDelegator </> "test-delegator.skey" |
| 78 | + testDelegatorPaymentVKeyFp = testStakeDelegator </> "test-delegator-payment.vkey" |
| 79 | + testDelegatorPaymentSKeyFp = testStakeDelegator </> "test-delegator-payment.skey" |
| 80 | + testDelegatorRegCertFp = testStakeDelegator </> "test-delegator.regcert" |
| 81 | + testDelegatorDeregCertFp = testStakeDelegator </> "test-delegator.deregcert" |
| 82 | + |
| 83 | + _ <- cliStakeAddressKeyGen work |
| 84 | + $ KeyNames testDelegatorVkeyFp testDelegatorSKeyFp |
| 85 | + _ <- cliAddressKeyGen work |
| 86 | + $ KeyNames testDelegatorPaymentVKeyFp testDelegatorPaymentSKeyFp |
| 87 | + |
| 88 | + testDelegatorPaymentAddr <- execCli |
| 89 | + [ "address", "build" |
| 90 | + , "--testnet-magic", show @Int testnetMagic |
| 91 | + , "--payment-verification-key-file", testDelegatorPaymentVKeyFp |
| 92 | + , "--stake-verification-key-file", testDelegatorVkeyFp |
| 93 | + ] |
| 94 | + |
| 95 | + -- Test stake address registration cert |
| 96 | + createStakeKeyRegistrationCertificate |
| 97 | + tempAbsPath |
| 98 | + era |
| 99 | + testDelegatorVkeyFp |
| 100 | + 2_000_000 |
| 101 | + testDelegatorRegCertFp |
| 102 | + |
| 103 | + createStakeKeyDeregistrationCertificate |
| 104 | + tempAbsPath |
| 105 | + era |
| 106 | + testDelegatorVkeyFp |
| 107 | + 2_000_000 |
| 108 | + testDelegatorDeregCertFp |
| 109 | + |
| 110 | + txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 |
| 111 | + multipleCertTxBodyFp <- H.note $ work </> "registration.txbody" |
| 112 | + void $ execCli' execConfig |
| 113 | + [ eraString |
| 114 | + , "transaction", "build" |
| 115 | + , "--change-address", testDelegatorPaymentAddr |
| 116 | + , "--tx-in", Text.unpack $ renderTxIn txin1 |
| 117 | + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show @Int 5_000_000 |
| 118 | + , "--witness-override", show @Int 2 |
| 119 | + , "--certificate-file", testDelegatorRegCertFp |
| 120 | + , "--certificate-file", testDelegatorDeregCertFp |
| 121 | + , "--certificate-file", testDelegatorRegCertFp |
| 122 | + , "--certificate-file", testDelegatorDeregCertFp |
| 123 | + , "--certificate-file", testDelegatorRegCertFp |
| 124 | + , "--out-file", multipleCertTxBodyFp |
| 125 | + ] |
| 126 | + |
| 127 | + txJson <- (H.leftFail . A.eitherDecode @A.Value . fromString) =<< H.execCli |
| 128 | + ["transaction", "view" |
| 129 | + , "--tx-file", multipleCertTxBodyFp |
| 130 | + ] |
| 131 | + A.Success certificates <- fmap (A.fromJSON @[A.Value]) . H.nothingFail $ txJson ^? L.key "certificates" |
| 132 | + H.noteShow_ $ A.encode certificates |
| 133 | + length certificates === 5 |
| 134 | + |
0 commit comments