From eb3b0b1f004d28b3dd96e3077aba3dc89aa79123 Mon Sep 17 00:00:00 2001 From: John Ky Date: Mon, 29 May 2023 14:11:40 +1000 Subject: [PATCH] Use cardano-api from CHaP --- .github/workflows/haskell-linux.yml | 8 +- .github/workflows/haskell.yml | 4 +- .github/workflows/stylish-haskell.yml | 1 - cabal.project | 6 +- cardano-cli/CHANGELOG.md | 754 ---- cardano-cli/LICENSE | 177 - cardano-cli/NOTICE | 13 - cardano-cli/README.md | 81 - cardano-cli/app/cardano-cli.hs | 34 - cardano-cli/cardano-cli.cabal | 321 -- cardano-cli/src/Cardano/CLI/Byron/Commands.hs | 144 - .../src/Cardano/CLI/Byron/Delegation.hs | 130 - cardano-cli/src/Cardano/CLI/Byron/Genesis.hs | 215 - cardano-cli/src/Cardano/CLI/Byron/Key.hs | 107 - cardano-cli/src/Cardano/CLI/Byron/Legacy.hs | 80 - cardano-cli/src/Cardano/CLI/Byron/Parsers.hs | 737 ---- cardano-cli/src/Cardano/CLI/Byron/Query.hs | 40 - cardano-cli/src/Cardano/CLI/Byron/Run.hs | 224 -- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 264 -- .../src/Cardano/CLI/Byron/UpdateProposal.hs | 97 - cardano-cli/src/Cardano/CLI/Byron/Vote.hs | 90 - cardano-cli/src/Cardano/CLI/Common/Parsers.hs | 149 - cardano-cli/src/Cardano/CLI/Environment.hs | 57 - cardano-cli/src/Cardano/CLI/Helpers.hs | 140 - cardano-cli/src/Cardano/CLI/IO/Lazy.hs | 66 - cardano-cli/src/Cardano/CLI/Parsers.hs | 93 - cardano-cli/src/Cardano/CLI/Ping.hs | 198 - cardano-cli/src/Cardano/CLI/Pretty.hs | 72 - cardano-cli/src/Cardano/CLI/Render.hs | 61 - cardano-cli/src/Cardano/CLI/Run.hs | 137 - cardano-cli/src/Cardano/CLI/Run/Friendly.hs | 488 --- .../src/Cardano/CLI/Shelley/Commands.hs | 605 --- cardano-cli/src/Cardano/CLI/Shelley/Key.hs | 211 - .../src/Cardano/CLI/Shelley/Orphans.hs | 82 - cardano-cli/src/Cardano/CLI/Shelley/Output.hs | 334 -- .../src/Cardano/CLI/Shelley/Parsers.hs | 3446 ----------------- cardano-cli/src/Cardano/CLI/Shelley/Run.hs | 88 - .../src/Cardano/CLI/Shelley/Run/Address.hs | 208 - .../Cardano/CLI/Shelley/Run/Address/Info.hs | 83 - .../src/Cardano/CLI/Shelley/Run/Genesis.hs | 1392 ------- .../src/Cardano/CLI/Shelley/Run/Governance.hs | 350 -- .../src/Cardano/CLI/Shelley/Run/Key.hs | 657 ---- .../src/Cardano/CLI/Shelley/Run/Node.hs | 268 -- .../src/Cardano/CLI/Shelley/Run/Pool.hs | 198 - .../src/Cardano/CLI/Shelley/Run/Query.hs | 1487 ------- .../src/Cardano/CLI/Shelley/Run/Read.hs | 839 ---- .../Cardano/CLI/Shelley/Run/StakeAddress.hs | 202 - .../src/Cardano/CLI/Shelley/Run/TextView.hs | 46 - .../Cardano/CLI/Shelley/Run/Transaction.hs | 1456 ------- .../src/Cardano/CLI/Shelley/Run/Validate.hs | 359 -- cardano-cli/src/Cardano/CLI/TopHandler.hs | 106 - cardano-cli/src/Cardano/CLI/Types.hs | 361 -- .../Test/Golden/Byron/SigningKeys.hs | 127 - .../Test/Golden/Byron/Tx.hs | 80 - .../Test/Golden/Byron/TxBody.hs | 12 - .../Test/Golden/Byron/UpdateProposal.hs | 59 - .../Test/Golden/Byron/Vote.hs | 82 - .../Test/Golden/Byron/Witness.hs | 12 - .../cardano-cli-golden/Test/Golden/Help.hs | 115 - .../cardano-cli-golden/Test/Golden/Key.hs | 21 - .../Test/Golden/Key/NonExtendedKey.hs | 62 - .../cardano-cli-golden/Test/Golden/Shelley.hs | 202 - .../Test/Golden/Shelley/Address/Build.hs | 53 - .../Test/Golden/Shelley/Address/Info.hs | 49 - .../Test/Golden/Shelley/Address/KeyGen.hs | 34 - .../Test/Golden/Shelley/Genesis/Create.hs | 231 -- .../Golden/Shelley/Genesis/InitialTxIn.hs | 31 - .../Golden/Shelley/Genesis/KeyGenDelegate.hs | 38 - .../Golden/Shelley/Genesis/KeyGenGenesis.hs | 31 - .../Test/Golden/Shelley/Genesis/KeyGenUtxo.hs | 31 - .../Test/Golden/Shelley/Genesis/KeyHash.hs | 30 - .../Golden/Shelley/Governance/AnswerPoll.hs | 81 - .../Golden/Shelley/Governance/CreatePoll.hs | 56 - .../Golden/Shelley/Governance/VerifyPoll.hs | 96 - .../Shelley/Key/ConvertCardanoAddressKey.hs | 192 - .../Shelley/Metadata/StakePoolMetadata.hs | 43 - .../Test/Golden/Shelley/MultiSig/Address.hs | 63 - .../Test/Golden/Shelley/Node/IssueOpCert.hs | 45 - .../Test/Golden/Shelley/Node/KeyGen.hs | 35 - .../Test/Golden/Shelley/Node/KeyGenKes.hs | 31 - .../Test/Golden/Shelley/Node/KeyGenVrf.hs | 31 - .../Test/Golden/Shelley/StakeAddress/Build.hs | 28 - .../StakeAddress/DeregistrationCertificate.hs | 43 - .../Golden/Shelley/StakeAddress/KeyGen.hs | 31 - .../StakeAddress/RegistrationCertificate.hs | 43 - .../StakePool/RegistrationCertificate.hs | 38 - .../GenesisKeyDelegationCertificate.hs | 88 - .../Certificates/MIRCertificate.hs | 53 - .../Certificates/OperationalCertificate.hs | 67 - .../Certificates/StakeAddressCertificates.hs | 78 - .../Certificates/StakePoolCertificates.hs | 103 - .../TextEnvelope/Keys/ExtendedPaymentKeys.hs | 43 - .../TextEnvelope/Keys/GenesisDelegateKeys.hs | 47 - .../Shelley/TextEnvelope/Keys/GenesisKeys.hs | 42 - .../TextEnvelope/Keys/GenesisUTxOKeys.hs | 42 - .../Shelley/TextEnvelope/Keys/KESKeys.hs | 42 - .../Shelley/TextEnvelope/Keys/PaymentKeys.hs | 42 - .../Shelley/TextEnvelope/Keys/StakeKeys.hs | 42 - .../Shelley/TextEnvelope/Keys/VRFKeys.hs | 42 - .../Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs | 51 - .../Golden/Shelley/TextEnvelope/Tx/TxBody.hs | 39 - .../Golden/Shelley/TextEnvelope/Tx/Witness.hs | 12 - .../Golden/Shelley/TextView/DecodeCbor.hs | 34 - .../Golden/Shelley/Transaction/Assemble.hs | 32 - .../Test/Golden/Shelley/Transaction/Build.hs | 144 - .../Shelley/Transaction/CalculateMinFee.hs | 36 - .../Shelley/Transaction/CreateWitness.hs | 49 - .../Test/Golden/Shelley/Transaction/Sign.hs | 67 - .../cardano-cli-golden/Test/Golden/TxView.hs | 317 -- .../cardano-cli-golden/Test/Golden/Version.hs | 18 - .../cardano-cli-golden/cardano-cli-golden.hs | 33 - .../files/golden/allegra/transaction-view.out | 27 - .../golden/alonzo/genesis.alonzo.spec.json | 194 - .../golden/alonzo/signed-transaction-view.out | 25 - .../files/golden/alonzo/signing.key | 5 - .../files/golden/alonzo/transaction-view.out | 39 - .../cardano-cli-golden/files/golden/alonzo/tx | 5 - .../files/golden/alonzo/verification.key | 5 - .../files/golden/byron/keys/byron.skey | 2 - .../files/golden/byron/keys/legacy.skey | 1 - .../files/golden/byron/transaction-view.out | 20 - .../files/golden/byron/tx/legacy.tx | Bin 240 -> 0 bytes .../files/golden/byron/tx/normal.tx | Bin 240 -> 0 bytes .../files/golden/byron/update-proposal | Bin 310 -> 0 bytes .../files/golden/byron/votes/vote-no | 2 - .../files/golden/byron/votes/vote-yes | 4 - .../golden/conway/genesis.conway.spec.json | 3 - .../cardano-cli-golden/files/golden/help.cli | 1435 ------- .../files/golden/help/address.cli | 13 - .../files/golden/help/address_build.cli | 34 - .../files/golden/help/address_info.cli | 8 - .../files/golden/help/address_key-gen.cli | 14 - .../files/golden/help/address_key-hash.cli | 15 - .../files/golden/help/byron.cli | 15 - .../help/byron_create-proposal-vote.cli | 21 - .../help/byron_create-update-proposal.cli | 81 - .../files/golden/help/byron_genesis.cli | 7 - .../golden/help/byron_genesis_genesis.cli | 39 - .../help/byron_genesis_print-genesis-hash.cli | 7 - .../byron_governance_create-proposal-vote.cli | 21 - ...yron_governance_create-update-proposal.cli | 81 - .../byron_governance_submit-proposal-vote.cli | 18 - ...yron_governance_submit-update-proposal.cli | 18 - .../files/golden/help/byron_key.cli | 18 - .../files/golden/help/byron_key_keygen.cli | 7 - .../byron_key_migrate-delegate-key-from.cli | 9 - .../help/byron_key_signing-key-address.cli | 16 - .../help/byron_key_signing-key-public.cli | 11 - .../golden/help/byron_key_to-verification.cli | 14 - .../files/golden/help/byron_miscellaneous.cli | 7 - .../byron_miscellaneous_pretty-print-cbor.cli | 7 - .../byron_miscellaneous_validate-cbor.cli | 21 - .../files/golden/help/byron_query_get-tip.cli | 16 - .../help/byron_submit-proposal-vote.cli | 17 - .../help/byron_submit-update-proposal.cli | 17 - .../files/golden/help/byron_transaction.cli | 18 - ...saction_issue-genesis-utxo-expenditure.cli | 26 - ...ron_transaction_issue-utxo-expenditure.cli | 26 - .../help/byron_transaction_submit-tx.cli | 18 - .../golden/help/byron_transaction_txid.cli | 7 - .../files/golden/help/genesis.cli | 37 - .../golden/help/genesis_create-cardano.cli | 49 - .../golden/help/genesis_create-staked.cli | 50 - .../files/golden/help/genesis_create.cli | 26 - .../files/golden/help/genesis_get-ver-key.cli | 10 - .../files/golden/help/genesis_hash.cli | 7 - .../golden/help/genesis_initial-addr.cli | 15 - .../golden/help/genesis_initial-txin.cli | 15 - .../golden/help/genesis_key-gen-delegate.cli | 14 - .../golden/help/genesis_key-gen-genesis.cli | 10 - .../golden/help/genesis_key-gen-utxo.cli | 10 - .../files/golden/help/genesis_key-hash.cli | 8 - .../files/golden/help/get-tip.cli | 16 - .../files/golden/help/governance.cli | 23 - .../golden/help/governance_answer-poll.cli | 12 - ...ate-genesis-key-delegation-certificate.cli | 38 - .../governance_create-mir-certificate.cli | 26 - ...create-mir-certificate_stake-addresses.cli | 15 - ...te-mir-certificate_transfer-to-rewards.cli | 10 - ...e-mir-certificate_transfer-to-treasury.cli | 10 - .../golden/help/governance_create-poll.cli | 14 - .../governance_create-update-proposal.cli | 108 - .../golden/help/governance_verify-poll.cli | 12 - .../files/golden/help/help.cli | 0 .../help/issue-genesis-utxo-expenditure.cli | 26 - .../golden/help/issue-utxo-expenditure.cli | 25 - .../files/golden/help/key.cli | 40 - .../help/key_convert-byron-genesis-vkey.cli | 11 - .../golden/help/key_convert-byron-key.cli | 33 - .../help/key_convert-cardano-address-key.cli | 22 - .../golden/help/key_convert-itn-bip32-key.cli | 11 - .../help/key_convert-itn-extended-key.cli | 11 - .../files/golden/help/key_convert-itn-key.cli | 14 - .../golden/help/key_non-extended-key.cli | 12 - .../golden/help/key_verification-key.cli | 10 - .../files/golden/help/keygen.cli | 7 - .../golden/help/migrate-delegate-key-from.cli | 8 - .../files/golden/help/node.cli | 22 - .../files/golden/help/node_issue-op-cert.cli | 22 - .../files/golden/help/node_key-gen-KES.cli | 10 - .../files/golden/help/node_key-gen-VRF.cli | 10 - .../files/golden/help/node_key-gen.cli | 16 - .../files/golden/help/node_key-hash-VRF.cli | 13 - .../files/golden/help/node_new-counter.cli | 22 - .../files/golden/help/ping.cli | 20 - .../files/golden/help/pretty-print-cbor.cli | 7 - .../files/golden/help/print-genesis-hash.cli | 7 - .../files/golden/help/query.cli | 49 - .../golden/help/query_kes-period-info.cli | 33 - .../golden/help/query_leadership-schedule.cli | 50 - .../files/golden/help/query_ledger-state.cli | 31 - .../files/golden/help/query_pool-params.cli | 35 - .../files/golden/help/query_pool-state.cli | 33 - .../golden/help/query_protocol-parameters.cli | 30 - .../golden/help/query_protocol-state.cli | 31 - .../files/golden/help/query_slot-number.cli | 30 - .../golden/help/query_stake-address-info.cli | 32 - .../golden/help/query_stake-distribution.cli | 30 - .../files/golden/help/query_stake-pools.cli | 30 - .../golden/help/query_stake-snapshot.cli | 37 - .../files/golden/help/query_tip.cli | 30 - .../files/golden/help/query_tx-mempool.cli | 39 - .../golden/help/query_tx-mempool_info.cli | 12 - .../golden/help/query_tx-mempool_next-tx.cli | 12 - .../help/query_tx-mempool_tx-exists_TX_ID.cli | 12 - .../files/golden/help/query_utxo.cli | 35 - .../files/golden/help/signing-key-address.cli | 16 - .../files/golden/help/signing-key-public.cli | 10 - .../files/golden/help/stake-address.cli | 22 - .../files/golden/help/stake-address_build.cli | 22 - .../stake-address_delegation-certificate.cli | 31 - ...ake-address_deregistration-certificate.cli | 19 - .../golden/help/stake-address_key-gen.cli | 10 - .../golden/help/stake-address_key-hash.cli | 15 - ...stake-address_registration-certificate.cli | 19 - .../files/golden/help/stake-pool.cli | 18 - .../stake-pool_deregistration-certificate.cli | 17 - .../files/golden/help/stake-pool_id.cli | 16 - .../golden/help/stake-pool_metadata-hash.cli | 10 - .../stake-pool_registration-certificate.cli | 67 - .../files/golden/help/submit-tx.cli | 18 - .../golden/help/text-view_decode-cbor.cli | 8 - .../files/golden/help/to-verification.cli | 13 - .../files/golden/help/transaction.cli | 43 - .../golden/help/transaction_assemble.cli | 11 - .../golden/help/transaction_build-raw.cli | 388 -- .../files/golden/help/transaction_build.cli | 389 -- .../help/transaction_calculate-min-fee.cli | 24 - ...ransaction_calculate-min-required-utxo.cli | 82 - .../help/transaction_calculate-min-value.cli | 81 - .../help/transaction_hash-script-data.cli | 20 - .../golden/help/transaction_policyid.cli | 7 - .../golden/help/transaction_sign-witness.cli | 10 - .../files/golden/help/transaction_sign.cli | 18 - .../files/golden/help/transaction_submit.cli | 31 - .../files/golden/help/transaction_txid.cli | 8 - .../files/golden/help/transaction_view.cli | 8 - .../files/golden/help/transaction_witness.cli | 18 - .../files/golden/help/txid.cli | 7 - .../files/golden/help/validate-cbor.cli | 21 - .../files/golden/help/version.cli | 0 .../non-extended-shelley.000.vkey | 5 - .../non-extended-stake.000.vkey | 5 - .../key/non-extended-keys/shelley.000.vkey | 5 - .../key/non-extended-keys/stake.000.vkey | 5 - .../files/golden/mary/scripts/mint.all | 3 - .../files/golden/mary/scripts/mint.sig | 10 - .../files/golden/mary/transaction-view.out | 44 - .../shelley/addresses/enterprise-address.hex | 1 - .../shelley/addresses/staking-address.hex | 1 - .../genesis_key_delegation_certificate | 5 - .../shelley/certificates/mir_certificate | 5 - .../certificates/operational_certificate | 5 - .../stake_address_deregistration_certificate | 5 - .../stake_address_registration_certificate | 5 - .../stake_pool_deregistration_certificate | 5 - .../stake_pool_registration_certificate | 5 - .../golden/shelley/genesis.conway.spec.json | 3 - .../golden/shelley/genesis/genesis.spec.json | 40 - .../shelley/governance/answer/basic.json | 22 - .../files/golden/shelley/governance/cold.sk | 5 - .../files/golden/shelley/governance/cold.vk | 5 - .../shelley/governance/create/basic.json | 41 - .../shelley/governance/create/long-text.json | 47 - .../governance/polls/basic.answer.0.json | 22 - .../governance/polls/basic.answer.1.json | 22 - .../shelley/governance/polls/basic.json | 5 - .../shelley/governance/polls/long-text.json | 5 - .../golden/shelley/governance/verify/invalid | 5 - .../shelley/governance/verify/malformed | 5 - .../golden/shelley/governance/verify/mismatch | 5 - .../golden/shelley/governance/verify/none | 5 - .../golden/shelley/governance/verify/valid | 5 - .../byron_signing_key | 5 - .../icarus_signing_key | 5 - .../shelley_payment_signing_key | 5 - .../shelley_stake_signing_key | 5 - .../keys/extended_payment_keys/signing_key | 5 - .../extended_payment_keys/verification_key | 5 - .../operational_certificate_counter | 5 - .../keys/genesis_delegate_keys/signing_key | 5 - .../genesis_delegate_keys/verification_key | 5 - .../shelley/keys/genesis_keys/signing_key | 5 - .../keys/genesis_keys/verification_key | 5 - .../genesis_keys/verification_key.key-hash | 1 - .../keys/genesis_utxo_hashes/utxo_hash | 1 - .../keys/genesis_utxo_keys/signing_key | 5 - .../keys/genesis_utxo_keys/verification_key | 5 - .../genesis-utxo.vkey | 5 - .../golden/shelley/keys/kes_keys/signing_key | 5 - .../shelley/keys/kes_keys/verification_key | 5 - .../shelley/keys/payment_keys/signing_key | 5 - .../keys/payment_keys/verification_key | 5 - .../shelley/keys/stake_keys/reward_address | 1 - .../shelley/keys/stake_keys/signing_key | 5 - .../shelley/keys/stake_keys/verification_key | 5 - .../golden/shelley/keys/vrf_keys/signing_key | 5 - .../shelley/keys/vrf_keys/verification_key | 5 - .../shelley/metadata/stake_pool_metadata_hash | 1 - .../golden/shelley/multisig/addresses/all | 1 - .../golden/shelley/multisig/addresses/any | 1 - .../golden/shelley/multisig/addresses/atleast | 1 - .../files/golden/shelley/multisig/scripts/all | 37 - .../files/golden/shelley/multisig/scripts/any | 29 - .../golden/shelley/multisig/scripts/atleast | 22 - .../golden/shelley/node-pool/operator.vkey | 5 - .../files/golden/shelley/node-pool/owner.vkey | 5 - .../files/golden/shelley/node-pool/vrf.vkey | 5 - .../protocol-params.json | 22 - .../tx-body-file | 5 - .../transaction-sign/initial-utxo1.skey | 5 - .../transaction-sign/initial-utxo2.skey | 5 - .../shelley/transaction-sign/node-cold.skey | 5 - .../shelley/transaction-sign/stake.skey | 5 - .../shelley/transaction-sign/tx-body-file | 5 - .../golden/shelley/transaction-sign/utxo.skey | 5 - .../files/golden/shelley/transaction-view.out | 79 - .../files/golden/shelley/tx/tx | 5 - .../files/golden/shelley/tx/txbody | 5 - .../files/golden/shelley/tx/unsigned.tx | 5 - .../files/golden/shelley/update-proposal | 5 - .../shelley/witnesses/singleSigningKeyWitness | 5 - .../Test/Cardano/CLI/Util.hs | 218 -- cardano-cli/test/cardano-cli-test/Readme.md | 38 - .../Test/Cli/CliIntermediateFormat.hs | 54 - .../Test/Cli/FilePermissions.hs | 49 - .../test/cardano-cli-test/Test/Cli/ITN.hs | 159 - .../test/cardano-cli-test/Test/Cli/JSON.hs | 82 - .../Test/Cli/MultiAssetParsing.hs | 38 - .../Test/Cli/Pioneers/Exercise1.hs | 85 - .../Test/Cli/Pioneers/Exercise2.hs | 68 - .../Test/Cli/Pioneers/Exercise3.hs | 67 - .../Test/Cli/Pioneers/Exercise4.hs | 48 - .../Test/Cli/Pioneers/Exercise5.hs | 65 - .../Test/Cli/Pioneers/Exercise6.hs | 65 - .../test/cardano-cli-test/Test/Cli/Pipes.hs | 99 - .../Test/Cli/Shelley/Run/Query.hs | 26 - .../cardano-cli-test/Test/Config/Mainnet.hs | 50 - .../test/cardano-cli-test/cardano-cli-test.hs | 46 - .../golden/babbage/deprecated-cli-format.body | 5 - .../files/golden/babbage/tx-key-witness | 5 - .../shelley/keys/payment_keys/signing_key | 5 - .../files/golden/shelley/multisig/scripts/all | 37 - 363 files changed, 10 insertions(+), 28937 deletions(-) delete mode 100644 cardano-cli/CHANGELOG.md delete mode 100644 cardano-cli/LICENSE delete mode 100644 cardano-cli/NOTICE delete mode 100644 cardano-cli/README.md delete mode 100644 cardano-cli/app/cardano-cli.hs delete mode 100644 cardano-cli/cardano-cli.cabal delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Commands.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Delegation.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Genesis.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Key.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Legacy.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Parsers.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Query.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Run.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Tx.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Byron/Vote.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Common/Parsers.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Environment.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Helpers.hs delete mode 100644 cardano-cli/src/Cardano/CLI/IO/Lazy.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Parsers.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Ping.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Pretty.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Render.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Run.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Run/Friendly.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Commands.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Key.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Output.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Address/Info.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Node.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Pool.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/TextView.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Shelley/Run/Validate.hs delete mode 100644 cardano-cli/src/Cardano/CLI/TopHandler.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Types.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/SigningKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Tx.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/TxBody.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/UpdateProposal.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Vote.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Witness.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Help.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Key.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Key/NonExtendedKey.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/Build.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/Info.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/KeyGen.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/Create.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/InitialTxIn.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenDelegate.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenGenesis.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenUtxo.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyHash.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/AnswerPoll.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/CreatePoll.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/VerifyPoll.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Key/ConvertCardanoAddressKey.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Metadata/StakePoolMetadata.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/MultiSig/Address.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/IssueOpCert.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGen.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGenKes.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGenVrf.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/Build.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/DeregistrationCertificate.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/KeyGen.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/RegistrationCertificate.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakePool/RegistrationCertificate.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/GenesisKeyDelegationCertificate.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/MIRCertificate.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/OperationalCertificate.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/StakeAddressCertificates.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/StakePoolCertificates.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/ExtendedPaymentKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisDelegateKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisUTxOKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/KESKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/PaymentKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/StakeKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/VRFKeys.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/TxBody.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/Witness.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextView/DecodeCbor.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Assemble.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Build.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/CalculateMinFee.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/CreateWitness.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Sign.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Version.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/cardano-cli-golden.hs delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/alonzo/genesis.alonzo.spec.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signing.key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/alonzo/tx delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/alonzo/verification.key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/byron/keys/byron.skey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/byron/keys/legacy.skey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/byron/transaction-view.out delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/byron/tx/legacy.tx delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/byron/tx/normal.tx delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/byron/update-proposal delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/byron/votes/vote-no delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/byron/votes/vote-yes delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/conway/genesis.conway.spec.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/address.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/address_build.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/address_info.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/address_key-gen.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/address_key-hash.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_create-proposal-vote.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_create-update-proposal.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_genesis.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_genesis_genesis.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_genesis_print-genesis-hash.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_governance_create-proposal-vote.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_governance_create-update-proposal.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_governance_submit-proposal-vote.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_governance_submit-update-proposal.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_key_keygen.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_key_migrate-delegate-key-from.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_key_signing-key-address.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_key_signing-key-public.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_key_to-verification.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_miscellaneous.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_miscellaneous_pretty-print-cbor.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_miscellaneous_validate-cbor.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_query_get-tip.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_submit-proposal-vote.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_submit-update-proposal.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_transaction.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_transaction_issue-genesis-utxo-expenditure.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_transaction_issue-utxo-expenditure.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_transaction_submit-tx.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/byron_transaction_txid.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_create-cardano.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_create-staked.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_create.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_get-ver-key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_hash.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_initial-addr.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_initial-txin.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_key-gen-delegate.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_key-gen-genesis.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_key-gen-utxo.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/genesis_key-hash.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/get-tip.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_answer-poll.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_create-genesis-key-delegation-certificate.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_create-mir-certificate.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_create-mir-certificate_stake-addresses.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_create-mir-certificate_transfer-to-rewards.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_create-mir-certificate_transfer-to-treasury.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_create-poll.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_create-update-proposal.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/governance_verify-poll.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/help.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/issue-genesis-utxo-expenditure.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/issue-utxo-expenditure.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key_convert-byron-genesis-vkey.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key_convert-byron-key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key_convert-cardano-address-key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key_convert-itn-bip32-key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key_convert-itn-extended-key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key_convert-itn-key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key_non-extended-key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/key_verification-key.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/keygen.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/migrate-delegate-key-from.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/node.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/node_issue-op-cert.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/node_key-gen-KES.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/node_key-gen-VRF.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/node_key-gen.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/node_key-hash-VRF.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/node_new-counter.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/ping.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/pretty-print-cbor.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/print-genesis-hash.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_kes-period-info.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_leadership-schedule.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_ledger-state.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_pool-params.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_pool-state.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_protocol-parameters.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_protocol-state.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_slot-number.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_stake-address-info.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_stake-distribution.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_stake-pools.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_stake-snapshot.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_tip.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_tx-mempool.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_tx-mempool_info.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_tx-mempool_next-tx.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_tx-mempool_tx-exists_TX_ID.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/query_utxo.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/signing-key-address.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/signing-key-public.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-address.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-address_build.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-address_delegation-certificate.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-address_deregistration-certificate.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-address_key-gen.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-address_key-hash.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-address_registration-certificate.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-pool.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-pool_deregistration-certificate.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-pool_id.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-pool_metadata-hash.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/stake-pool_registration-certificate.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/submit-tx.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/text-view_decode-cbor.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/to-verification.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_assemble.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_build-raw.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_build.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-fee.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-required-utxo.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-value.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_hash-script-data.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_policyid.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_sign-witness.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_sign.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_submit.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_txid.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_view.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_witness.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/txid.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/validate-cbor.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/version.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/key/non-extended-keys/non-extended-shelley.000.vkey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/key/non-extended-keys/non-extended-stake.000.vkey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/key/non-extended-keys/shelley.000.vkey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/key/non-extended-keys/stake.000.vkey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/mary/scripts/mint.all delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/mary/scripts/mint.sig delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/addresses/enterprise-address.hex delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/addresses/staking-address.hex delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/certificates/genesis_key_delegation_certificate delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/certificates/mir_certificate delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/certificates/operational_certificate delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/certificates/stake_address_deregistration_certificate delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/certificates/stake_address_registration_certificate delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/certificates/stake_pool_deregistration_certificate delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/certificates/stake_pool_registration_certificate delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/genesis.conway.spec.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/genesis/genesis.spec.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/answer/basic.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/cold.sk delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/cold.vk delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/create/basic.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/create/long-text.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.answer.0.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.answer.1.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/polls/long-text.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/verify/invalid delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/verify/malformed delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/verify/mismatch delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/verify/none delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/governance/verify/valid delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/converted_cardano-address_keys/byron_signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/converted_cardano-address_keys/icarus_signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/converted_cardano-address_keys/shelley_payment_signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/converted_cardano-address_keys/shelley_stake_signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/extended_payment_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/extended_payment_keys/verification_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_delegate_keys/operational_certificate_counter delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_delegate_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_delegate_keys/verification_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/verification_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/verification_key.key-hash delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_utxo_hashes/utxo_hash delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_utxo_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_utxo_keys/verification_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/genesis_verification_keys/genesis-utxo.vkey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/kes_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/kes_keys/verification_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/payment_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/payment_keys/verification_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/reward_address delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/verification_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/vrf_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/keys/vrf_keys/verification_key delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/metadata/stake_pool_metadata_hash delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/multisig/addresses/all delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/multisig/addresses/any delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/multisig/addresses/atleast delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/multisig/scripts/all delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/multisig/scripts/any delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/multisig/scripts/atleast delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/node-pool/operator.vkey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/node-pool/owner.vkey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/node-pool/vrf.vkey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-calculate-min-fee/protocol-params.json delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-calculate-min-fee/tx-body-file delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-sign/initial-utxo1.skey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-sign/initial-utxo2.skey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-sign/node-cold.skey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-sign/stake.skey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-sign/tx-body-file delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-sign/utxo.skey delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/tx/tx delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/tx/txbody delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/tx/unsigned.tx delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/update-proposal delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/shelley/witnesses/singleSigningKeyWitness delete mode 100644 cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Readme.md delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/CliIntermediateFormat.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/ITN.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/JSON.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/MultiAssetParsing.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise1.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise2.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise3.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise4.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise5.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise6.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs delete mode 100644 cardano-cli/test/cardano-cli-test/Test/Config/Mainnet.hs delete mode 100644 cardano-cli/test/cardano-cli-test/cardano-cli-test.hs delete mode 100644 cardano-cli/test/cardano-cli-test/files/golden/babbage/deprecated-cli-format.body delete mode 100644 cardano-cli/test/cardano-cli-test/files/golden/babbage/tx-key-witness delete mode 100644 cardano-cli/test/cardano-cli-test/files/golden/shelley/keys/payment_keys/signing_key delete mode 100644 cardano-cli/test/cardano-cli-test/files/golden/shelley/multisig/scripts/all diff --git a/.github/workflows/haskell-linux.yml b/.github/workflows/haskell-linux.yml index 852978f8da3..5901d1a25f8 100644 --- a/.github/workflows/haskell-linux.yml +++ b/.github/workflows/haskell-linux.yml @@ -147,6 +147,12 @@ jobs: skip: "${{ vars.BINARY_CACHE_URI != '' }}" enable-save: false + - name: Build core components + run: | + # The tests call out to msys2 commands. We generally do not want to mix toolchains, so + # we are very deliberate about only adding msys64 to the path where absolutely necessary. + ${{ (runner.os == 'Windows' && '$env:PATH=("C:\msys64\mingw64\bin;{0}" -f $env:PATH)') || '' }} + cabal build cardano-node cardano-cli cardano-node-chairman cardano-submit-api - name: Build remaining components run: cabal build all @@ -156,7 +162,7 @@ jobs: TMPDIR: ${{ runner.temp }} TMP: ${{ runner.temp }} KEEP_WORKSPACE: 1 - run: cabal test cardano-testnet cardano-node cardano-node-chairman cardano-cli cardano-submit-api + run: cabal test cardano-testnet cardano-node cardano-node-chairman cardano-submit-api - name: Tar failed tests workspaces if: ${{ failure() }} diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 92684714c7a..83d7e6f8a80 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -167,7 +167,7 @@ jobs: # The tests call out to msys2 commands. We generally do not want to mix toolchains, so # we are very deliberate about only adding msys64 to the path where absolutely necessary. ${{ (runner.os == 'Windows' && '$env:PATH=("C:\msys64\mingw64\bin;{0}" -f $env:PATH)') || '' }} - cabal build cardano-node cardano-cli cardano-node-chairman cardano-submit-api -j1 + cabal build cardano-node cardano-cli cardano-node-chairman cardano-submit-api - name: Build remaining components run: | @@ -185,7 +185,7 @@ jobs: # The tests call out to msys2 commands. We generally do not want to mix toolchains, so # we are very deliberate about only adding msys64 to the path where absolutely necessary. ${{ (runner.os == 'Windows' && '$env:PATH=("C:\msys64\mingw64\bin;{0}" -f $env:PATH)') || '' }} - cabal test cardano-testnet cardano-node cardano-node-chairman cardano-cli cardano-submit-api + cabal test cardano-testnet cardano-node cardano-node-chairman cardano-submit-api - name: Tar failed tests workspaces if: ${{ failure() }} diff --git a/.github/workflows/stylish-haskell.yml b/.github/workflows/stylish-haskell.yml index dfa7c773d7d..54d549c6bae 100644 --- a/.github/workflows/stylish-haskell.yml +++ b/.github/workflows/stylish-haskell.yml @@ -42,7 +42,6 @@ jobs: cardano-node-capi trace-dispatcher trace-forward - cardano-cli cardano-submit-api steps: diff --git a/cabal.project b/cabal.project index ab070ba767e..750231149ae 100644 --- a/cabal.project +++ b/cabal.project @@ -14,10 +14,9 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2023-05-10T10:34:57Z - , cardano-haskell-packages 2023-05-25T10:00:00Z + , cardano-haskell-packages 2023-05-29T01:40:13Z packages: - cardano-cli cardano-client-demo cardano-git-rev cardano-node @@ -37,9 +36,6 @@ packages: package cardano-api ghc-options: -Werror -package cardano-cli - ghc-options: -Werror - package cardano-client-demo ghc-options: -Werror diff --git a/cardano-cli/CHANGELOG.md b/cardano-cli/CHANGELOG.md deleted file mode 100644 index 3fe8a180f92..00000000000 --- a/cardano-cli/CHANGELOG.md +++ /dev/null @@ -1,754 +0,0 @@ -# Changelog for cardano-cli - -## 8.1.0 - -- - -## 8.0.0 -- May 2023 - -- Remove cardano-cli address build-script ([PR 4700](https://github.com/input-output-hk/cardano-node/pull/4700)) -- Remove support for reading protocol parameters from Shelley genesis file ([PR 5053](https://github.com/input-output-hk/cardano-node/pull/5053)) - -- New commands for on-chain SPOs polls under `shelley governance`: - - `create-poll`: - For the current governing entities, as a means to create new polls. - - - `answer-poll`: - For participants who want to answer a given poll. - - - `verify-poll`: - For anyone who seek to verify a poll entry (e.g. explorers) - - The commands are built to fit and play nicely within the cardano-cli. - The poll and answers structures are based on transaction metadata and - require to be embedded in an actual transaction. The added commands - however only works from metadata and raw "GovernancePoll" envelopes. - - See [CIP proposal](https://github.com/cardano-foundation/CIPs/pull/496) for details. - - - ([PR 5132](https://github.com/input-output-hk/cardano-node/pull/5132)) - - ([PR 5112](https://github.com/input-output-hk/cardano-node/pull/5112)) - - ([PR 5172](https://github.com/input-output-hk/cardano-node/pull/5172)) - - ([PR 5184](https://github.com/input-output-hk/cardano-node/pull/5184)) - -- Any command that takes a `--mainnet` flag or a `--testnet-magic` flag can have that setting - supplied with the `CARDANO_NODE_NETWORK_ID=mainnet` or `CARDANO_NODE_NETWORK_ID=` - instead where `` is the network id. - ([PR5119](https://github.com/input-output-hk/cardano-node/pull/5119)) - ([PR5119](https://github.com/input-output-hk/cardano-node/pull/5119)) - -### Features - -- The `--socket-path` option is now a required CLI argument for relevant commands if `CARDANO_NODE_SOCKET_PATH` is not supplied. - ([PR 5120](https://github.com/input-output-hk/cardano-node/pull/5120)) - -- Default to the ledger's CDDL format for transaction body creation by removing flags `--cddl-format` and `--cli-format` from `build` and `build-raw` ([PR 4303](https://github.com/input-output-hk/cardano-node/pull/4303)) - -- Add `query tx-mempool` ([PR 4276](https://github.com/input-output-hk/cardano-node/pull/4276)) - -- Allow assembling transactions with no witnesses ([PR 4408](https://github.com/input-output-hk/cardano-node/pull/4408)) - -- Add `slotInEpoch` and `slotsToEpochEnd` to output of `query tip` command ([PR 4912](https://github.com/input-output-hk/cardano-node/pull/4912)) - -- Add `--stake-address` option to the following CLI commands ([PR 3404](https://github.com/input-output-hk/cardano-node/pull/3404)): - - address build - - stake-address build - - stake-address registration-certificate - - stake-address delegation-certificate - - stake-address deregistration-certificate - -- Add `--socket-path` CLI option for CLI commands that use `CARDANO_NODE_SOCKET_PATH` ([PR 4910](https://github.com/input-output-hk/cardano-node/pull/4910)) - -- Add `utcTimeToSlotNo` function to support UTC -> slot number conversion ([PR 5130](https://github.com/input-output-hk/cardano-node/pull/5130)) - -- Add `query slot-number` command line option to support UTC -> slot number conversion ([PR 5149](https://github.com/input-output-hk/cardano-node/pull/5149)) - -- Remove `--stake-address` option from `stake-address build` - ([PR 5061](https://github.com/input-output-hk/cardano-node/pull/5061)) - -- The bounds of many CLI arguments are now checked - ([PR 4919](https://github.com/input-output-hk/cardano-node/pull/4919)) - -- Re-add support for decoding `GenesisExtendedKey` text envelope - ([PR 4894](https://github.com/input-output-hk/cardano-node/pull/4894)) - -- Preserve `ScriptData` bytes with `HashableScriptData` - ([PR 4886](https://github.com/input-output-hk/cardano-node/pull/4886)) - -- Disallow empty cost model for create update proposal - ([PR 4885](https://github.com/input-output-hk/cardano-node/pull/4885)) - -- Detect invalid counter and certificate - ([PR 4880](https://github.com/input-output-hk/cardano-node/pull/4880)) - -- Filter out duplicate collateral inputs in transaction build commands - ([PR 4839](https://github.com/input-output-hk/cardano-node/pull/4839)) - -- Update cardano-cli banner - ([PR 4816](https://github.com/input-output-hk/cardano-node/pull/4816)) - -- Better error message for `query utxo` command - ([PR 4788](https://github.com/input-output-hk/cardano-node/pull/4788)) - -- Remove simple script distinction - ([PR 4763](https://github.com/input-output-hk/cardano-node/pull/4763)) - -- Optimise `query stake-snapshot` command - ([PR 4654](https://github.com/input-output-hk/cardano-node/pull/4754)) - -- Filter out duplicate collateral inputs in `transaction build` and `transaction build-raw` comands - ([PR 4649](https://github.com/input-output-hk/cardano-node/pull/4749)) - -- Add support for `ghc-9.2` and partial support for `CHaP` - ([PR 4701](https://github.com/input-output-hk/cardano-node/pull/4701)) - -- Update cli's help to indicate that Babbage is the default era - ([PR 4674](https://github.com/input-output-hk/cardano-node/pull/4674)) - -- New `cardano-cli ping` command - ([PR 4664](https://github.com/input-output-hk/cardano-node/pull/4664)) - -- Improved error message for failed asset name decode - ([PR 4626](https://github.com/input-output-hk/cardano-node/pull/4626)) - -- Better pipe handling - ([PR 4625](https://github.com/input-output-hk/cardano-node/pull/4625)) - -- Restore `--cddl-format` - ([PR 4617](https://github.com/input-output-hk/cardano-node/pull/4617)) - -- Switch default era to Babbage - ([PR 4485](https://github.com/input-output-hk/cardano-node/pull/4485)) - -- Update error message for incorrectly witnessed collateral inputs - ([PR 4484](https://github.com/input-output-hk/cardano-node/pull/4484)) - -- Return `Lovelace` for `calculateMinimumUTxO` - ([PR 4482](https://github.com/input-output-hk/cardano-node/pull/4482)) - -- Infer protocol params in `transaction build` command - ([PR 4431](https://github.com/input-output-hk/cardano-node/pull/4431)) - -- Use `openFileBlocking` for reading signing keys - ([PR 4342](https://github.com/input-output-hk/cardano-node/pull/4342)) - -- Multiple pools support in `query stake-snapshot` - ([PR 4279](https://github.com/input-output-hk/cardano-node/pull/4279)) - -- Optimise `query leadership-schedule` command - ([PR 4250](https://github.com/input-output-hk/cardano-node/pull/4250)) - -- Update `create-staked` with the ability to specify relays for all created stake pools - ([PR 4234](https://github.com/input-output-hk/cardano-node/pull/4234)) - -- More memory efficient `query ledger-state` command - ([PR 4205](https://github.com/input-output-hk/cardano-node/pull/4205)) - -- Render reference script hashes when using `--calculate-plutus-script-cost` option - ([PR 4204](https://github.com/input-output-hk/cardano-node/pull/4204)) - -- Update build command to automatically calculate the total and return collateral values - ([PR 4198](https://github.com/input-output-hk/cardano-node/pull/4198)) - -- Optimise `query stake-snapshot` command - ([PR 4179](https://github.com/input-output-hk/cardano-node/pull/4179)) - -- New `query pool-state` command - ([PR 4170](https://github.com/input-output-hk/cardano-node/pull/4170)) - -- Add `utxoCostPerByte` protocol parameter - ([PR 4141](https://github.com/input-output-hk/cardano-node/pull/4141)) - -- Transaction build in any alonzo era when on babbage testnet - ([PR 4135](https://github.com/input-output-hk/cardano-node/pull/4135)) - -- Expose Key interface in Cardano.Api.Shelley - ([PR 4048](https://github.com/input-output-hk/cardano-node/pull/4048)) - -- Reduce memory usage of create staked command - ([PR 4021](https://github.com/input-output-hk/cardano-node/pull/4021)) - -- Add new interim governance commands: {create, answer, verify}-poll - ([PR 5112](https://github.com/input-output-hk/cardano-node/pull/5112)) - -- Frozen callstack for checkTextEnvelopeFormat function - ([PR 5059](https://github.com/input-output-hk/cardano-node/pull/5059)) - -- Split serialisation from IO - ([PR 5049](https://github.com/input-output-hk/cardano-node/pull/5049)) - -- Move parsers to reusable location - ([PR 5046](https://github.com/input-output-hk/cardano-node/pull/5046)) - -- Remove unused error constructors - ([PR 5041](https://github.com/input-output-hk/cardano-node/pull/5041)) - -- Integrate latest ledger dependencies - ([PR 5013](https://github.com/input-output-hk/cardano-node/pull/5013)) - -- Remove error calls in Cardano.CLI.Shelley.Run.Transaction - ([PR 4958](https://github.com/input-output-hk/cardano-node/pull/4958)) - -- Preserve ScriptData bytes fix - ([PR 4926](https://github.com/input-output-hk/cardano-node/pull/4926)) - -- Reduce number of calls to toLedgerPParams - ([PR 4903](https://github.com/input-output-hk/cardano-node/pull/4903)) - -- Simplify SerialiseAsRawBytes type class - ([PR 4876](https://github.com/input-output-hk/cardano-node/pull/4876)) - -- Modify constructBalancedTx to take LedgerEpochInfo - ([PR 4858](https://github.com/input-output-hk/cardano-node/pull/4858)) - -- Node 1.35.5 - ([PR 4851](https://github.com/input-output-hk/cardano-node/pull/4851)) - -- UTxO-HD: Make devops-shell compile again and fix cli parser - ([PR 4843](https://github.com/input-output-hk/cardano-node/pull/4843)) - -- Add ReaderT of NodeToClientVersion to LocalStateQueryExpr - ([PR 4809](https://github.com/input-output-hk/cardano-node/pull/4809)) - -- Move signing key reading to cardano-api - ([PR 4698](https://github.com/input-output-hk/cardano-node/pull/4698)) - -- Replace Data.Map with Data.Map.Strict - ([PR 4675](https://github.com/input-output-hk/cardano-node/pull/4675)) - -- Move implementation inside `runTransactionCmd` to toplevel definitions - ([PR 4673]](https://github.com/input-output-hk/cardano-node/pull/4673)) - -- Remove error calls in renderShelleyTxCmdError - ([PR 4644](https://github.com/input-output-hk/cardano-node/pull/4644)) - -### Bugs - -- Allow reading signing keys from a pipe ([PR 4342](https://github.com/input-output-hk/cardano-node/pull/4342)) - -- Query protocol parameters from the node in the `transaction build` command ([PR 4431](https://github.com/input-output-hk/cardano-node/pull/4431)) - -- Fix `qKesKesKeyExpiry` in `kes-period-info` ([PR 4909](https://github.com/input-output-hk/cardano-node/pull/4909)) - -- Fix query era mismatch bug in transaction build command when using flag `--calculate-plutus-script-cost` - ([PR 4538](https://github.com/input-output-hk/cardano-node/pull/4538)) - -- Fix bug - TxWitness text envelope format does not roundtrip in Shelley era - ([PR 4501](https://github.com/input-output-hk/cardano-node/pull/4501)) - -- Fix query protocol-state - ([PR 4102](https://github.com/input-output-hk/cardano-node/pull/4102)) - -- Fix help message for `--script-invalid` option of `build`/`build-raw` - ([PR 4121](https://github.com/input-output-hk/cardano-node/pull/4121)) - -- Fix transaction build command era backwards incompatibility - ([PR 4483](https://github.com/input-output-hk/cardano-node/pull/4483)) - -- Fix minUTxO calculation in `calculate-min-required-utxo` - -- Fix key non extended key for `StakeExtendedVerificationKeyShelley_ed25519_bip32` envelope - ([PR 4918](https://github.com/input-output-hk/cardano-node/pull/4918)) - -- Fix `qKesKesKeyExpiry` to not always be `null` - ([PR 4909](https://github.com/input-output-hk/cardano-node/pull/4909)) - -- `create-staked` command: Fix UTxO size distribution - ([PR 4765](https://github.com/input-output-hk/cardano-node/pull/4765)) - -- Fix bug in hash computation in `genesis create-cardano` command - ([PR 4761](https://github.com/input-output-hk/cardano-node/pull/4761)) - -## 1.35.3 -- August 2022 - -- Update build and build-raw commands to accept simple reference minting scripts (#4087) -- Fix query protocol-state (#4102) -- Render reference script hashes when using `--calculate-plutus-script-cost` option (#4204) -- Transaction build in any alonzo era when on babbage testnet (#4135) - -## 1.35.2 -- July 2022 (not released) - -None - -## 1.35.1 -- July 2022 (not released) - -None - -## 1.35.0 -- June 2022 -- Add Vasil hardfork to cardano-api and cardano-cli (#3765) -- Reference script integration (#3953) -- Wire up remaining Plutusv2 reference script types (#4034) -- Add friendly printing of transactions (envelopes) with signatures (#3617) -- cardano-cli transaction view: Add friendly certificate printing (#3377) -- cardano-cli query kes-period-info: Always display metrics (#3683) -- JSON format for leadership schedule (#3687) -- Vasil cardano-cli update (#3810) -- Prevent return collateral from including reference scripts and datums (#3850) -- kes-period-info property test (#3718) -- Extend deserialiseFromRawBytesHex to produce error description (#3304) -- add genesis create-cardano command (#3832) -- Propagate protocol in block type (#3818) -- Fix kes period info command (#3945) -- Create VRF signing key file with correct permissions (#1948) -- Set local encoding to UTF-8 in cardano-cli (#4018) -- Update example-reference-script-usage.sh to also use inline datums (#4006) -- Wire up simple reference scripts in cardano-cli (#4014) -- Add read-only-tx-in-reference option to cardano-cli #(4042) - -## 1.34.0 -- February 2022 - -- Fix some spelling errors in the CLI help text. (#3499) -- Add a prettier rendering of update proposals. (#3208) -- Add support for CBOR-encoded blobs in the `transaction build` and `transaction - build-raw` commands. (#3483) -- Implement a `leadership-schedule` command. This can calculate a stake pool's - leadership schedule for the current and following epoch. It requires access to - the VRF signing key for that stake pool. - - ``` - > cardano-cli query leadership-schedule \ - --testnet-magic 42 \ - --genesis example/shelley/genesis.json \ - --stake-pool-id pool12t0y7agkqct89pf00eeytkvfjlquv76tjy27duannan9w63ckxv \ - --vrf-signing-key-file example/node-pool1/shelley/vrf.skey - --current - SlotNo UTC Time - -------------------------------------------------------- - 4073 2021-12-29 17:26:54.998001755 UTC - 4126 2021-12-29 17:27:00.298001755 UTC - 4206 2021-12-29 17:27:08.298001755 UTC - 4256 2021-12-29 17:27:13.298001755 UTC - 4309 2021-12-29 17:27:18.598001755 UTC - 4376 2021-12-29 17:27:25.298001755 UTC - 4423 2021-12-29 17:27:29.998001755 UTC - 4433 2021-12-29 17:27:30.998001755 UTC - ``` (#3464, #3494) -- The CLI now supports outputting transaction bodies in ledger-compliant CDDL in - the `transaction build` and `transaction build-raw` commands. This is - specified by using the `--cddl-format` flag. (#3505) -- Implement a `kes-period-info` command in the CLI. This checks that your - operational certificate is correct. It checks: - - The counters match what is in the node's protocol state - - The KES period in the operational certificate is correct (based on the - current slot). - ``` - > cardano-cli query kes-period-info --testnet-magic 42 \ - --op-cert-file example/node-pool1/shelley/node.cert - ✓ The operational certificate counter agrees with the node protocol state counter - ✓ Operational certificate's kes period is within the correct KES period interval - { - "qKesNodeStateOperationalCertificateNumber": 6, - "qKesCurrentKesPeriod": 404, - "qKesOnDiskOperationalCertificateNumber": 6, - "qKesRemainingSlotsInKesPeriod": 3760228, - "qKesMaxKESEvolutions": 62, - "qKesKesKeyExpiry": "2022-03-20T21:44:51Z", - "qKesEndKesInterval": 434, - "qKesStartKesInterval": 372, - "qKesSlotsPerKesPeriod": 129600 - } - ``` (#3459, #3572, #3599) -- The CLI now displays collateral inputs in a nicer fashion. (#3463) -- The `transaction sign` command now allows for incremental signing by providing - an already signed transaction via `--tx-file`. This allows more easily adding - multiple signatures to a transaction. (#3549) -- The `transaction build` command now supports an option - (`--calculate-plutus-script-cost`) to compute the cost for included scripts. - ``` - cardano-cli transaction build \ - --alonzo-era \ - --cardano-mode \ - --testnet-magic "$TESTNET_MAGIC" \ - --change-address "$utxoaddr" \ - --tx-in "$plutusutxotxin" \ - --tx-in-collateral "$txinCollateral" \ - --tx-out "$dummyaddress+10000000" \ - --tx-in-script-file "$plutusscriptinuse" \ - --tx-in-datum-file "$datumfilepath" \ - --protocol-params-file "$WORK/pparams.json" \ - --tx-in-redeemer-file "$redeemerfilepath" \ - --calculate-plutus-script-cost "$WORK/create-datum-output.scriptcost" - > cat $WORK/create-datum-output.scriptcost - [ - { - "executionUnits": { - "memory": 1700, - "steps": 476468 - }, - "lovelaceCost": 133, - "scriptHash": "67f33146617a5e61936081db3b2117cbf59bd2123748f58ac9678656" - } - ] - ``` (#3589) - -## 1.33.0 -- December 2021 -## 1.32.1 -- November 2021 - -- Default CLI commands to the Alonzo era. (#3339) -- Add defaults for building the Alonzo genesis. (#3346) - -## 1.31.0 -- October 2021 - -- Restore support for deserialising transactions built by pre-1.27.0.0 node - versions. (#3226) -- Various internal refactorings and improvements. (#3234) -- Use the new `GetChainBlockNo` and `GetChainPoint` queries in the query tip - command. There is a fallback to the older method using the full chain sync - query. (#3179) -- Allow provision of optional datums to a transaction using the CLI option - `--tx-out-datum-embed-value`. This mechanism can for example be used to - provide the actual script locking an output, for use when spending it. (#3171) -- Fix the use of withdrawals using the `transaction build` command. (#3317) -- Allow extended payment keys to be specified as a Plutus required signer. - (#3319) - -## 1.30.0 -- September 2021 - -- Allow the user to specify a signature as required when spending from a - multisig/timelock script using the `build` or `build-raw` commands. Required - signers *must* be present in the witnesses, and only required signers are - visible to Plutus scripts. (#3123) -- Use a separate connection for the `query tip` command. This fixes an - occasional bug where the `query tip` command would fail. (#3130) -- Print the Tx fee when using the `tx build` command. (#3032) -- The `tx build` command now validates its inputs (ensuring they are in the UTxO - and that only basic VKey-locked inputs are used as collateral.) (#3151) -- Add a new comment to query the stake pools. (#3152) -- `tx build` now uses the set of existing stake pools to determing if a pool is - already registered (and hence whether it must pay a deposit). (#3152) -- `calculate-min-req-utxo` now requires a transaction output, not just a value - as before. This is required in the Alonzo era, and the change is made - everywhere for consistency. (#3181) -- Allow the `tx build` command to spend the entirety of a UTxO and create no - change output. (#3188) -- Add withdrawals to the `tx view` command. (#2613) -## 1.29.0 -- August 2021 - -- Add a "tx build" command to the CLI. This command takes care of calculating - the appropriate fee for a transaction, and balancing the transaction - appropriately. It does not do input selection for fees, so sufficient balance - must be available in the inputs to pay the computed fee, and sufficient - collateral must also be present when phase-2 validating scripts are used. The - tx build command is capable of computing both the fees required from - transaction size and the fees incurred by script execution. (#2921, #2953, - #2995, #3025) -- Improve the output format for rational fields in protocol parameters and - genesis. When these are simple, we now convert them to decimal format. (#2992) -- Various internal improvements. (#2932) -- Make the CLI help text more nicely formatted. (#2945) -- Introduce the `--script-valid` and `--script-invalid` flags. The latter can be - used to mark a script as being known invalid, such that the node will allow it - to be submitted anyway (whereas under normal operation it would reject such a - transaction in order to avoid loss of collateral). This flag is only likely to - be of use in testing. The `--script-valid` flag is set as a default. (#3050, - #3091, #3093) -- Add colours to the CLI output. (#3023) -## 1.28.0 -- July 2021 - -- The query tip command is now tidier and shows various additional pieces of - information: - - The epoch number is now shown during the Byron era. Previously this worked - only in the Shelley and subsequent eras. (#2688) - - The sync progress of the node. This will only be available with new network - protocols (not yet in this release.) (#2842, #2899) - (#2885) -- Attempting to use an IPv6/IPv4 address where the other is expected will now - give a more helpful error message. (#2691) -- Queries should now work during the Alonzo era. (#2727, #2755) -- Support for submitting transactions during the Alonzo era. (#2774, #2798, - #2806, #2811, #2823, #2863, #2848) -- `cardano-cli genesis create` now also creates the new Alonzo genesis file. - (#2743) -- The UTxO CLI query now allows an additional `--tx-in` flag which allows - filtering the UTxO by TxIn, and requires the addition of the `--whole-utxo` - flag to return the complete UTxO set (which was previously the default). - Returning the whole UTxO set is an expensive operation only useful in small - testnets, so we don't want it as the default option. (#2843, #2854) -- The parser for rational units (as used in for example execution unit prices) - now supports rational syntax (e.g. 1/2). (#2922) - -## 1.27.0 -- April 2021 - -- The query tip now also returns the era (e.g. Shelley, Allegra, Alonzo). - (#2561, #2562, #2598) -- The `address build` command now incorporates the functionality of the script - address build command, which is now deprecated. (#2486, #2587) -- Add additional commands for creating MIR certificates to the CLI. This - supports the ability to transfer funds to the treasury for Catalyst projects. - (#2503) -- As a result of refactoring in preparation for the upcoming Alonzo release, - there are a couple of breaking changes in CLI commands referring to scripts: - - Auxiliary scripts (i.e. those included in the Tx auxiliary data, which are - not required as transaction signers) must now be included with - `--auxiliary-script-file` rather than with `--script-file`. - - Scripts witnessing txins, certificates, withdrawals and minting must now be - paired with the thing they are witnessing. E.g. - ``` - --certificate-file $certfile --certificate-script-file $scriptfile - --tx-out $txout --mint-script-file $scriptfile - --withdrawal $withdrawal --withdrawal-script-file $scriptfile - --tx-in $txin --txin-script-file $scriptfile - ``` - - Scripts should now be specified when creating the txbody, rather than when - signing the transaction. (#2547) -- The transaction view command now additionally shows detailed of minted - non-native tokens. (#2550) -- Removed support for Byron addresses using the Bech32 encoding. The only - supported way to use Byron-era addresses is through a file, using the text - envelope format. (#2605) -- Add a new command which computes the minimum ADA value/deposit for a - multi-asset value. (#2612) -- Add two new query commands: - - `query stake-snapshot` allows querying the three stake snapshots for a given - stake pool. - - `query pool-params` returns the current and future parameters, as well as - the retiring information. - (#2560) -- Updated the CLI reference documentation. (#2665) - -## 1.26.1 -- March 2021 -- It's no longer necessary to specify the era when making a CLI query. When not - specified, the current era will be used as a default. (#2470) - -## 1.26.0 -- March 2021 -- Add three new queries to the CLI, exposing functionality already present in - the API: - - Protocol parameters - - Stake distribution - - Individual stake addresses - (#2275, #2290) -- Fix the rendering of Byron-era `TxOut`s to be consistent with the rendering for - Shelley-era addresses. (#2472) -- Add `cardano-cli transaction view`, which allows for pretty-printing details - about a serialised transaction. (#2348) -- When constructing MIR certificates, the CLI now takes stake addresses rather - than stake certificates. These are strictly more general and can be deduced - from the certificates. -- Make the Mary era the default era in the CLI (#2415) -- Migrate the `cardano-submit-api` tool from `cardano-rest`. (#2370) -- The 'tip' query now additionally returns the epoch at the tip (#2440) -- Various internal improvements and refactoring (#2458) - -## 1.25.0 -- January 2021 -- Allow creating transactions with no outputs (#2223, #2226) -- Improved error messages for syntax errors in out-of-range lovelace quantities - in transaction outputs (#2063, #2079) -- Improved reference documentation for simple scripts and their use (#2165) -- Refactoring in the Byron part of the CLI to make more extensive use of the - Cardano API and reduce the maintenance burden (#2103, #2228) -- Remove support for changing the delegation from Genesis keys to operational - keys in the Byron era. This feature was never used on the mainnet during the - Byron era. (#2219) -- Clearer usage information in the CLI `--help` output (#2203) - -## 1.24.2 -- December 2020 - -- Rename the flags `--lower-bound` and `--upper-bound` to be `--invalid-before` - and `--invalid-hereafter` respectively, for naming consistency (#2186, #2190) -- Hide the deprecated `--ttl` flag in the `--help` output (#2189, #2190) - -## 1.24.1 -- December 2020 - -- New command `transaction policyid` for making multi-asset policy ids (#2176) -- New command `byron transaction txid` to help scripts with getting the - transaction id for Byron transactions made using the cli (#2169) -- New `--tx-file` flag for the command `transaction txid` to accept complete - txs, not just tx bodies (#2169) -- Add a regression test for the "0" case of multi-asset tx out values (#2155) - -## 1.24.0 -- December 2020 - -- CLI support for the Allegra and Mary eras, including creating transactions - for the new eras, and support for the special new features in the new eras: - script extensions, tx validity intervals, auxiliary scripts, multi-asset tx - outputs and asset minting. (#2072, #2129, #2136) -- New flags for the `build-raw` command: - + `--invalid-before` and `--invalid-hereafter` for the new Allegra-era feature - of transaction validity intervals. The existing flag `--ttl` is equivalent to - the new `--invalid-hereafter`, but it is now optional in the Allegra era. - + `--script-file` for the new Allegra-era feature of being able to include - auxiliary scripts in a transaction. - + `--mint` for the Mary-era token minting feature. -- It is now necessary to specify the target era (e.g. `--allegra-era`) when - creating a transaction (with `build-raw`) so that the right format and - feature-set is used. The `--shelley-era` remains the default. -- It is necessary for now to specify the target era when using the CLI query - commands. This may become automatic in future. The default is `--shelley-era`. -- Move all the Shelley sub-commands to the top level of the command line. - For example `cardano-cli shelley transaction build-raw` becomes simply - `cardano-cli transaction build-raw`. The existing names are also kept for - compatibility. (#2076, #2145) -- Updated help text for the ledger/protocol state queries to clarify that they - are primarily for debugging and are not stable interfaces (#2125, #2126, #2133) -- New command `genesis create-staked` to make it easier to set up Shelley-based - testnets with stake pools and delegation set up from the genesis. (#2052) - -## 1.23.0 -- November 2020 - -- Create VRF keys with the correct file permissions (#1948) -- New command to query the Shelley protocol (not just ledger) state (#2057) -- Skeletons of the new commands and flags for the multi-asset extensions (#2081) - -## 1.22.1 -- October 2020 - -None - -## 1.22.0 -- October 2020 - -- Adjust the ledger state dump to return the "extended" ledger state (#2019) -- Preliminary support for the upcoming Allegra and Mary eras (#1958, #2019) - -## 1.21.2 -- October 2020 - -- Support bech32 and hex formats for reading verification keys (#1852) -- Minor help text improvements (#1661, #1956) -- Fix typo in KES docs (#1917, #1953) -- Improved documentation for CLI multi-signature support (#1976) - -## 1.21.1 -- September 2020 - -None - -## 1.21.0 -- September 2020 -- Support for multi-signature scripts (#1788, #1880) - -## 1.20.0 -- September 2020 - -- New command for creating genesis key delegation certificates (#1784) -- New command for converting more legacy signing key formats (#1756, #1822) -- Improved support for JSON to Tx metadata conversions, with two supported - JSON schemas, suitable for different use cases (#1797) -- Support bech32 and hex formats for reading signing keys (#1790) -- Improved error messages for cli errors (#1801, #1839) - -## 1.19.1 -- September 2020 - -- Fix the testnet vs mainnet argument for the genesis create command (#1761) -- Fix the --treasury flag for MIR cert creation (#1780) -- Fix the output rendering in the command to hash genesis files (#1713, #1767) -- Validate CBOR tx metadata when building tx bodies (#1432, #1677) - -## 1.19.0 -- August 2020 - -- Support for converting ITN extended keys to Shelley stake keys (#1579) -- Support for converting password-protected Byron signing keys (#1633) -- Support for building script addresses (#1641) -- Improve the output of the stake-address-info query (#1546, #1636, #1671) -- Support for Bech32-encoded stake pool IDs (#1528, #1638, #1730) -- Reorganise the Byron CLI commands similarly to the Shelley ones (#1609, #1628) -- Code organisation refactoring (#1457, #1594) -- Extra tests and refactoring of tests (#1565, #1566, #1602, #1668) -- Code tidying using hlint and style tool (#1590, #1625, #1663, #1707, #1708) - -## 1.18.0 -- July 2020 - -- Properly display the tx hash in the UTxO query command output (#1526, #1535) -- Refactoring and minor improvements in tests (#1538, #1541) - -## 1.17.0 -- July 2020 - -- Allow genesis keys as tx witnesses (#1483) -- Allow extended genesis delegate keys to sign operational certs (#1497) -- New cli "key" command with key utilities (#1487, #1493) -- More helpful flag defaults in cli command for fee calculation (#1516) -- Default to the Cardano protocol for talking to a node (#1515) - -## 1.16.0 -- July 2020 - -- Accept either a pool id or verification key in delegation cli command (#1460) -- Improved bash completion for flags that accept files (#1459) -- More and improved integration tests (#1429, #1450, #1453) - -## 1.15.1 -- July 2020 - -- Support for interacting with nodes running in Byron-only, Shelley-only or - the composite Cardano mode (Byron;Shelley) (#1435) -- Add support for byron keys and extended ed25519 keys (#1411) -- Port the CLI command implementations to the new API (#1416) -- Fix the output of the calculate-min-fee command (#1408) -- New stake and VRF key hashing commands (#1407) -- Use JSON output format for the address info command (#1426) - -## 1.15.0 -- July 2020 - -- Fix the ledger state dump query (#1333, #1334) -- Fix the format of Byron addresses used in Byron CLI commands (#1326) -- Port CLI commands to use the new API (#1341, #1375, #1396, #1397) -- Change to JSON output for the "query tip" command (#1340, #1365) -- Moving code around to eliminate the cardano-config package (#1289, #1316) - -## 1.14.2 -- June 2020 - -- Fix the hashing of stake pool metadata -- Fix the query that dumps the ledger state as JSON (#1333) - -## 1.14.1 -- June 2020 - -No changes in the cardano-cli. There were changes in the cardano-node. - -## 1.14.0 -- June 2020 - -- New flags for transaction metadata in tx construction (#1233) -- New flags for reward account withdrawals in tx construction (#1237) -- New command for pool metadata JSON validation and hashing (#1234, #1299) -- New flags for pool metadata in pool registration cert command (#1234) -- New flags for pool relays in pool registration cert command (#1282, #1296) -- New command to convert ITN keys (#1070, #1136) -- New command to get the txid of a tx body (#1231) -- Return appropriate exit code for tx submission failures (#1226) -- Fix the query stake-address-info to accept stake addresses (#1194, #1197) -- More regression tests (pioneer exercises 2, 3, 4) (#1209, #1247, #1279, #1287) -- Start to migrate to using the new typed API from cardano-api lib (#1284, #1298) -- Fix reporting of git revision via version command (#1283) - -## 1.13.0 -- June 2020 - -- Fix the parsing of the pool margin in pool registration certs (#1063, #1110) -- Change the Shelley cli command and flag names to be more consistent (#1068) -- Add a command to query stake addresses, balance and delegation (#1053, #1129) -- Add a command to get the stake pool id (#1069) -- Add a command to create MIR certificates (#1075) -- Improved human readable error messages for Shelley commands (#1021) -- Improve error message for tx-in parser errors (#1066) -- Use a better default value of eMax in generated example genesis files (#1145) -- Regression tests covering the "pioneer" exercises 1 (#1073) -- Prerequisites for Tx metadata support (but not full support yet) (#1080) -- Updated Shelley from scratch documentation (#1062) - -## 1.12.0 -- May 2020 - -- Reorganise the `shelley` subcommands (#840, #845) -- New `shelley genesis create` command (#852, #864, #908, #926, #929) -- New key-gen commands for various Shelley keys (#846, #870) -- New commands for Shelley address construction (#870, #872, #887) -- New Shelley transaction sign command (#894, #900) -- New Shelley transaction submission command (#904) -- New node query commands (#880, #884, #903, #918, #920, #933, #994, #1008, #1016) -- New commands to create stake address certificates (#890, #919, #967) -- New commands to create stake pool certificates (#922) -- New system commands to update genesis delgations and create MIR certs (#895) -- New command to calculate the minimum fee for a transaction (#931) -- New command to view the content of the various binary files (#915) -- New command to create Shelley protocol param updates (#950, #1004) -- Byron update proposal vote creation and submission (#804) -- Various refactoring (#874, #875, #949, #958, #966, #972) -- Commands that talk to the node no longer require the node config file (#901, - #907, #917, #913, #928) -- Improved human readable error messages for Byron commands (#1003) -- Documentation on constructing a Shelley chain from scratch (#893, #932, #1000) -- Add `version` command and `--version` flag, with git revision (#959) -- Additional tests (#898, #935, #941, #952) - - -## 1.11.0 -- April 2020 - -- First version of the CLI as a separate package. The package provides a CLI - (command line interface) to various low level node-related functionality. - - The CLI is not yet stable in this release. - -- Split the `cardano-cli` package out of `cardano-node` (#819) -- Initial structure of Shelley CLI commands with a top-level "shelley" command -- Group Byron commands under a top-level "byron" command -- Commands to generate Shelley KES and VRF keys (#816) -- Command to generate Shelley address keys (#824) diff --git a/cardano-cli/LICENSE b/cardano-cli/LICENSE deleted file mode 100644 index f433b1a53f5..00000000000 --- a/cardano-cli/LICENSE +++ /dev/null @@ -1,177 +0,0 @@ - - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS diff --git a/cardano-cli/NOTICE b/cardano-cli/NOTICE deleted file mode 100644 index 50a04bb6ae1..00000000000 --- a/cardano-cli/NOTICE +++ /dev/null @@ -1,13 +0,0 @@ -Copyright 2021-2023 Input Output Global Inc (IOG). - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. diff --git a/cardano-cli/README.md b/cardano-cli/README.md deleted file mode 100644 index 0be7d765b9b..00000000000 --- a/cardano-cli/README.md +++ /dev/null @@ -1,81 +0,0 @@ -# cardano-cli - - -A CLI utility to support a variety of key material operations (genesis, migration, pretty-printing..) for different system generations. - -The general synopsis is as follows: - -``` - Usage: cardano-cli (Genesis related CMDs | Key related CMDs | Delegation related CMDs | Transaction related CMDs | Local node related CMDs) -``` - -The top-level commands are as shown below. - -```bash -$ cardano-cli --help -cardano-cli - utility to support a variety of key operations (genesis -generation, migration, pretty-printing..) for different system generations. - -Usage: cardano-cli (Era based commands | Byron specific commands | - Miscellaneous commands) - -Available options: - --version Show the cardano-cli version - -h,--help Show this help text - -Era based commands - address Payment address commands - stake-address Stake address commands - key Key utility commands - transaction Transaction commands - node Node operation commands - stake-pool Stake pool commands - query Node query commands. Will query the local node whose - Unix domain socket is obtained from the - CARDANO_NODE_SOCKET_PATH environment variable. - genesis Genesis block commands - governance Governance commands - text-view Commands for dealing with Shelley TextView files. - Transactions, addresses etc are stored on disk as - TextView files. - -Byron specific commands - byron Byron specific commands - -Miscellaneous commands - version Show the cardano-cli version -``` - -Byron-specific commands - -```bash -$ cardano-cli byron --help -Usage: cardano-cli byron (key | transaction | query | genesis | governance | - miscellaneous) - Byron specific commands - -Available options: - -h,--help Show this help text - -Available commands: - key Byron key utility commands - transaction Byron transaction commands - query Byron node query commands. - genesis Byron genesis block commands - governance Byron governance commands - miscellaneous Byron miscellaneous commands -``` - -## How to build - -### Cabal - -Use [Cabal - Version 3.6.2.0](https://www.haskell.org/cabal/) to build and/or install this project: - -``` -$ cd cardano-cli -$ cabal build -$ cabal install -``` - -It may be necessary to specify the installation directory when installing the command using the `--installdir` option. diff --git a/cardano-cli/app/cardano-cli.hs b/cardano-cli/app/cardano-cli.hs deleted file mode 100644 index e05cb0fd336..00000000000 --- a/cardano-cli/app/cardano-cli.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} - -#if !defined(mingw32_HOST_OS) -#define UNIX -#endif - -import Control.Monad.Trans.Except.Exit (orDie) -import qualified Options.Applicative as Opt - -import Cardano.CLI.Environment (getEnvCli) -import Cardano.CLI.Parsers (opts, pref) -import Cardano.CLI.Run (renderClientCommandError, runClientCommand) -import Cardano.CLI.TopHandler -import qualified Cardano.Crypto.Libsodium as Crypto -#ifdef UNIX -import System.Posix.Files -#endif - -import qualified GHC.IO.Encoding as GHC - -main :: IO () -main = toplevelExceptionHandler $ do - envCli <- getEnvCli - - -- TODO: Remove sodiumInit: https://github.com/input-output-hk/cardano-base/issues/175 - Crypto.sodiumInit - GHC.mkTextEncoding "UTF-8" >>= GHC.setLocaleEncoding -#ifdef UNIX - _ <- setFileCreationMask (otherModes `unionFileModes` groupModes) -#endif - co <- Opt.customExecParser pref (opts envCli) - - orDie renderClientCommandError $ runClientCommand co diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal deleted file mode 100644 index fa03a24fddc..00000000000 --- a/cardano-cli/cardano-cli.cabal +++ /dev/null @@ -1,321 +0,0 @@ -cabal-version: 3.4 - -name: cardano-cli -version: 8.1.0 -synopsis: The Cardano command-line interface -description: The Cardano command-line interface. -copyright: 2020-2023 Input Output Global Inc (IOG). -author: IOHK -maintainer: operations@iohk.io -category: Cardano, - CLI, -license: Apache-2.0 -license-files: LICENSE - NOTICE -build-type: Simple -extra-source-files: README.md - -Flag unexpected_thunks - Description: Turn on unexpected thunks checks - Default: False - -common project-config - default-language: Haskell2010 - - default-extensions: OverloadedStrings - build-depends: base >= 4.14 && < 4.17 - - ghc-options: -Wall - -Wcompat - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wno-unticked-promoted-constructors - -Wpartial-fields - -Wredundant-constraints - -Wunused-packages - -common maybe-unix - if !os(windows) - build-depends: unix - -common maybe-bytestring - if !os(windows) - build-depends: bytestring - -library - import: project-config - - if flag(unexpected_thunks) - cpp-options: -DUNEXPECTED_THUNKS - - hs-source-dirs: src - - exposed-modules: Cardano.CLI.Environment - Cardano.CLI.Helpers - Cardano.CLI.Parsers - Cardano.CLI.Render - Cardano.CLI.Run - Cardano.CLI.Run.Friendly - Cardano.CLI.Types - - Cardano.CLI.Byron.Commands - Cardano.CLI.Byron.Parsers - Cardano.CLI.Byron.Run - Cardano.CLI.Byron.Delegation - Cardano.CLI.Byron.Genesis - Cardano.CLI.Byron.Key - Cardano.CLI.Byron.Legacy - Cardano.CLI.Byron.Tx - Cardano.CLI.Byron.Query - Cardano.CLI.Byron.UpdateProposal - Cardano.CLI.Byron.Vote - - Cardano.CLI.Common.Parsers - Cardano.CLI.Pretty - Cardano.CLI.IO.Lazy - - Cardano.CLI.Shelley.Commands - Cardano.CLI.Shelley.Key - Cardano.CLI.Shelley.Orphans - Cardano.CLI.Shelley.Output - Cardano.CLI.Shelley.Parsers - Cardano.CLI.Shelley.Run - Cardano.CLI.Shelley.Run.Address - Cardano.CLI.Shelley.Run.Address.Info - Cardano.CLI.Shelley.Run.Genesis - Cardano.CLI.Shelley.Run.Governance - Cardano.CLI.Shelley.Run.Key - Cardano.CLI.Shelley.Run.Node - Cardano.CLI.Shelley.Run.Pool - Cardano.CLI.Shelley.Run.Query - Cardano.CLI.Shelley.Run.StakeAddress - Cardano.CLI.Shelley.Run.TextView - Cardano.CLI.Shelley.Run.Transaction - Cardano.CLI.Shelley.Run.Read - Cardano.CLI.Shelley.Run.Validate - - Cardano.CLI.Ping - - Cardano.CLI.TopHandler - - other-modules: Paths_cardano_cli - autogen-modules: Paths_cardano_cli - - build-depends: aeson >= 1.5.6.0 - , aeson-pretty >= 0.8.5 - , ansi-terminal - , attoparsec - , base16-bytestring >= 1.0 - , bech32 >= 1.1.0 - , binary - , bytestring - , canonical-json - , cardano-api ^>= 8.1.0.1 - , cardano-binary - , cardano-crypto - , cardano-crypto-class >= 2.1.1 - , cardano-crypto-wrapper ^>= 1.5 - , cardano-data >= 1.0 - , cardano-git-rev - , cardano-ledger-alonzo >= 1.1.1 - , cardano-ledger-byron >= 1.0 - , cardano-ledger-binary >= 1.0 - , cardano-ledger-core >= 1.1 - , cardano-ledger-conway >= 1.1 - , cardano-ledger-shelley >= 1.1.1 - , cardano-ping ^>= 0.1.0.1 - , cardano-prelude - , cardano-protocol-tpraos >= 1.0 - , cardano-slotting ^>= 0.1 - , cardano-strict-containers ^>= 0.1 - , cborg >= 0.2.4 && < 0.3 - , containers - , contra-tracer - , cryptonite - , deepseq - , directory - , filepath - , formatting - , io-classes - , iproute - , mtl - , microlens - , network - , optparse-applicative-fork - , ouroboros-consensus >= 0.6 - , ouroboros-consensus-cardano >= 0.5 - , ouroboros-consensus-protocol >= 0.5 - , ouroboros-network-api - , ouroboros-network-protocols - , parsec - , prettyprinter - , prettyprinter-ansi-terminal - , random - , split - , strict-stm - , text - , time - , transformers - , transformers-except ^>= 0.1.3 - , unliftio-core - , utf8-string - , vector - , yaml - -executable cardano-cli - import: project-config - , maybe-unix - hs-source-dirs: app - main-is: cardano-cli.hs - ghc-options: -threaded -rtsopts "-with-rtsopts=-T" - - build-depends: cardano-cli - , cardano-crypto-class ^>= 2.1 - , optparse-applicative-fork - , transformers-except - -library cardano-cli-test-lib - import: project-config - visibility: public - hs-source-dirs: test/cardano-cli-test-lib - exposed-modules: Test.Cardano.CLI.Util - build-depends: cardano-api - , cardano-cli - , exceptions - , hedgehog - , hedgehog-extras ^>= 0.4.5.1 - , process - , transformers - -test-suite cardano-cli-test - import: project-config, maybe-unix - - hs-source-dirs: test/cardano-cli-test - main-is: cardano-cli-test.hs - type: exitcode-stdio-1.0 - - build-depends: aeson - , base16-bytestring - , bech32 >= 1.1.0 - , bytestring - , cardano-api ^>= 8.1.0.1 - , cardano-api-gen ^>= 8.1.0.2 - , cardano-cli - , cardano-cli:cardano-cli-test-lib - , cardano-node - , cardano-slotting ^>= 0.1 - , containers - , directory - , filepath - , hedgehog - , hedgehog-extras ^>= 0.4.5.1 - , parsec - , text - , time - , transformers - , yaml - - other-modules: Test.Config.Mainnet - Test.Cli.CliIntermediateFormat - Test.Cli.FilePermissions - Test.Cli.ITN - Test.Cli.JSON - Test.Cli.MultiAssetParsing - Test.Cli.Pioneers.Exercise1 - Test.Cli.Pioneers.Exercise2 - Test.Cli.Pioneers.Exercise3 - Test.Cli.Pioneers.Exercise4 - Test.Cli.Pioneers.Exercise5 - Test.Cli.Pioneers.Exercise6 - Test.Cli.Pipes - Test.Cli.Shelley.Run.Query - - ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T - -test-suite cardano-cli-golden - import: project-config - - hs-source-dirs: test/cardano-cli-golden - main-is: cardano-cli-golden.hs - type: exitcode-stdio-1.0 - - build-depends: aeson >= 1.5.6.0 - , base16-bytestring - , bytestring - , cardano-api ^>= 8.1.0.1 - , cardano-cli - , cardano-cli:cardano-cli-test-lib - , cardano-crypto-wrapper ^>= 1.5.1 - , cardano-ledger-byron ^>= 1.0 - , cborg - , containers - , filepath - , hedgehog ^>= 1.2 - , hedgehog-extras ^>= 0.4.5.1 - , regex-compat - , text - , time - , transformers - , unordered-containers - build-tool-depends: cardano-cli:cardano-cli - - other-modules: Test.Golden.Byron.SigningKeys - Test.Golden.Byron.Tx - Test.Golden.Byron.TxBody - Test.Golden.Byron.UpdateProposal - Test.Golden.Byron.Vote - Test.Golden.Byron.Witness - Test.Golden.Help - Test.Golden.Key - Test.Golden.Key.NonExtendedKey - Test.Golden.Shelley - Test.Golden.Shelley.Address.Build - Test.Golden.Shelley.Address.Info - Test.Golden.Shelley.Address.KeyGen - Test.Golden.Shelley.Genesis.Create - Test.Golden.Shelley.Genesis.InitialTxIn - Test.Golden.Shelley.Genesis.KeyGenDelegate - Test.Golden.Shelley.Genesis.KeyGenGenesis - Test.Golden.Shelley.Genesis.KeyGenUtxo - Test.Golden.Shelley.Genesis.KeyHash - Test.Golden.Shelley.Governance.AnswerPoll - Test.Golden.Shelley.Governance.CreatePoll - Test.Golden.Shelley.Governance.VerifyPoll - Test.Golden.Shelley.Key.ConvertCardanoAddressKey - Test.Golden.Shelley.Metadata.StakePoolMetadata - Test.Golden.Shelley.MultiSig.Address - Test.Golden.Shelley.Node.IssueOpCert - Test.Golden.Shelley.Node.KeyGen - Test.Golden.Shelley.Node.KeyGenKes - Test.Golden.Shelley.Node.KeyGenVrf - Test.Golden.Shelley.StakeAddress.Build - Test.Golden.Shelley.StakeAddress.DeregistrationCertificate - Test.Golden.Shelley.StakeAddress.KeyGen - Test.Golden.Shelley.StakeAddress.RegistrationCertificate - Test.Golden.Shelley.StakePool.RegistrationCertificate - Test.Golden.Shelley.TextEnvelope.Certificates.GenesisKeyDelegationCertificate - Test.Golden.Shelley.TextEnvelope.Certificates.MIRCertificate - Test.Golden.Shelley.TextEnvelope.Certificates.OperationalCertificate - Test.Golden.Shelley.TextEnvelope.Certificates.StakeAddressCertificates - Test.Golden.Shelley.TextEnvelope.Certificates.StakePoolCertificates - Test.Golden.Shelley.TextEnvelope.Keys.ExtendedPaymentKeys - Test.Golden.Shelley.TextEnvelope.Keys.GenesisDelegateKeys - Test.Golden.Shelley.TextEnvelope.Keys.GenesisKeys - Test.Golden.Shelley.TextEnvelope.Keys.GenesisUTxOKeys - Test.Golden.Shelley.TextEnvelope.Keys.KESKeys - Test.Golden.Shelley.TextEnvelope.Keys.PaymentKeys - Test.Golden.Shelley.TextEnvelope.Keys.StakeKeys - Test.Golden.Shelley.TextEnvelope.Keys.VRFKeys - Test.Golden.Shelley.TextEnvelope.Tx.Tx - Test.Golden.Shelley.TextEnvelope.Tx.TxBody - Test.Golden.Shelley.TextEnvelope.Tx.Witness - Test.Golden.Shelley.TextView.DecodeCbor - Test.Golden.Shelley.Transaction.Assemble - Test.Golden.Shelley.Transaction.Build - Test.Golden.Shelley.Transaction.CalculateMinFee - Test.Golden.Shelley.Transaction.CreateWitness - Test.Golden.Shelley.Transaction.Sign - Test.Golden.TxView - Test.Golden.Version - - ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T diff --git a/cardano-cli/src/Cardano/CLI/Byron/Commands.hs b/cardano-cli/src/Cardano/CLI/Byron/Commands.hs deleted file mode 100644 index d90473213ae..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Commands.hs +++ /dev/null @@ -1,144 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GeneralisedNewtypeDeriving #-} - -module Cardano.CLI.Byron.Commands - ( ByronCommand (..) - , NodeCmd (..) - , VerificationKeyFile - , NewVerificationKeyFile (..) - , CertificateFile (..) - , NewCertificateFile (..) - ) where - -import Data.String (IsString) - -import Cardano.Chain.Update (InstallerHash (..), ProtocolVersion (..), - SoftwareVersion (..), SystemTag (..)) - -import Cardano.Api hiding (GenesisParameters) -import Cardano.Api.Byron hiding (GenesisParameters) - -import Cardano.CLI.Byron.Genesis -import Cardano.CLI.Byron.Key -import Cardano.CLI.Byron.Tx -import Cardano.CLI.Types - -import Cardano.CLI.Shelley.Commands (ByronKeyFormat) - -data ByronCommand = - - --- Node Related Commands --- - NodeCmd - NodeCmd - - --- Genesis Related Commands --- - | Genesis - NewDirectory - GenesisParameters - - | PrintGenesisHash - GenesisFile - - --- Key Related Commands --- - | Keygen - NewSigningKeyFile - - | ToVerification - ByronKeyFormat - (SigningKeyFile In) - NewVerificationKeyFile - - | PrettySigningKeyPublic - ByronKeyFormat - (SigningKeyFile In) - - | MigrateDelegateKeyFrom - (SigningKeyFile In) - -- ^ Old key - NewSigningKeyFile - -- ^ New Key - - | PrintSigningKeyAddress - ByronKeyFormat - NetworkId - (SigningKeyFile In) - - | GetLocalNodeTip - SocketPath - NetworkId - - ----------------------------------- - - | SubmitTx - SocketPath - NetworkId - (TxFile In) - -- ^ Filepath of transaction to submit. - - | SpendGenesisUTxO - GenesisFile - NetworkId - ByronKeyFormat - NewTxFile - -- ^ Filepath of the newly created transaction. - (SigningKeyFile In) - -- ^ Signing key of genesis UTxO owner. - (Address ByronAddr) - -- ^ Genesis UTxO address. - [TxOut CtxTx ByronEra] - -- ^ Tx output. - | SpendUTxO - NetworkId - ByronKeyFormat - NewTxFile - -- ^ Filepath of the newly created transaction. - (SigningKeyFile In) - -- ^ Signing key of Tx underwriter. - [TxIn] - -- ^ Inputs available for spending to the Tx underwriter's key. - [TxOut CtxTx ByronEra] - -- ^ Genesis UTxO output Address. - - | GetTxId (TxFile In) - - --- Misc Commands --- - - | ValidateCBOR - CBORObject - -- ^ Type of the CBOR object - FilePath - - | PrettyPrintCBOR - FilePath - deriving Show - - -data NodeCmd = - CreateVote - NetworkId - (SigningKeyFile In) - FilePath -- ^ filepath to update proposal - Bool - FilePath - | UpdateProposal - NetworkId - (SigningKeyFile In) - ProtocolVersion - SoftwareVersion - SystemTag - InstallerHash - FilePath - ByronProtocolParametersUpdate - | SubmitUpdateProposal - SocketPath - NetworkId - FilePath -- ^ Update proposal filepath. - | SubmitVote - SocketPath - NetworkId - FilePath -- ^ Vote filepath. - deriving Show - -newtype NewCertificateFile - = NewCertificateFile { nFp :: FilePath } - deriving (Eq, Show, IsString) diff --git a/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs b/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs deleted file mode 100644 index f24872f5770..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Byron.Delegation - ( ByronDelegationError(..) - , checkByronGenesisDelegation - , issueByronGenesisDelegation - , renderByronDelegationError - , serialiseDelegationCert - , serialiseByronWitness - ) -where - -import Prelude hiding ((.)) - -import Control.Category -import Control.Monad.Trans.Except.Extra (left) -import qualified Data.ByteString.Lazy as LB -import Formatting (Format, sformat) - -import Cardano.Api.Byron - -import Cardano.Ledger.Binary (Annotated (..), serialize', byronProtVer) -import qualified Cardano.Chain.Delegation as Dlg -import Cardano.Chain.Slotting (EpochNumber) -import Cardano.Crypto (ProtocolMagicId) -import qualified Cardano.Crypto as Crypto - -import Cardano.CLI.Byron.Key (ByronKeyFailure, renderByronKeyFailure) -import Cardano.CLI.Types (CertificateFile (..)) -import Cardano.Prelude (canonicalDecodePretty, canonicalEncodePretty) -import Control.Monad (unless) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Data.ByteString (ByteString) -import Data.Text (Text) - -data ByronDelegationError - = CertificateValidationErrors !FilePath ![Text] - | DlgCertificateDeserialisationFailed !FilePath !Text - | ByronDelegationKeyError !ByronKeyFailure - deriving Show - -renderByronDelegationError :: ByronDelegationError -> Text -renderByronDelegationError err = - case err of - CertificateValidationErrors certFp errs -> - "Certificate validation error(s) at: " <> textShow certFp <> " Errors: " <> textShow errs - DlgCertificateDeserialisationFailed certFp deSererr -> - "Certificate deserialisation error at: " <> textShow certFp <> " Error: " <> textShow deSererr - ByronDelegationKeyError kerr -> renderByronKeyFailure kerr - --- TODO: we need to support password-protected secrets. --- | Issue a certificate for genesis delegation to a delegate key, signed by the --- issuer key, for a given protocol magic and coming into effect at given epoch. -issueByronGenesisDelegation - :: ProtocolMagicId - -> EpochNumber - -> Crypto.SigningKey - -> Crypto.VerificationKey - -> Dlg.Certificate -issueByronGenesisDelegation magic epoch issuerSK delegateVK = - Dlg.signCertificate magic delegateVK epoch $ - Crypto.noPassSafeSigner issuerSK - --- | Verify that a certificate signifies genesis delegation by assumed genesis key --- to a delegate key, for a given protocol magic. --- If certificate fails validation, throw an error. -checkByronGenesisDelegation - :: CertificateFile - -> ProtocolMagicId - -> Crypto.VerificationKey - -> Crypto.VerificationKey - -> ExceptT ByronDelegationError IO () -checkByronGenesisDelegation (CertificateFile certF) magic issuer delegate = do - ecert <- liftIO $ canonicalDecodePretty <$> LB.readFile certF - case ecert of - Left e -> left $ DlgCertificateDeserialisationFailed certF e - Right (cert :: Dlg.Certificate) -> do - let issues = checkDlgCert cert magic issuer delegate - unless (null issues) $ - left $ CertificateValidationErrors certF issues - -checkDlgCert - :: Dlg.ACertificate a - -> ProtocolMagicId - -> Crypto.VerificationKey - -> Crypto.VerificationKey -> [Text] -checkDlgCert cert magic issuerVK' delegateVK' = - mconcat - [ [ sformat "Certificate does not have a valid signature." - | not (Dlg.isValid magic' cert') - ] - , [ sformat ("Certificate issuer ".vkF." doesn't match expected: ".vkF) - ( Dlg.issuerVK cert) issuerVK' - | Dlg.issuerVK cert /= issuerVK' - ] - , [ sformat ("Certificate delegate ".vkF." doesn't match expected: ".vkF) - ( Dlg.delegateVK cert) delegateVK' - | Dlg.delegateVK cert /= delegateVK' - ] - ] - where - magic' :: Annotated ProtocolMagicId ByteString - magic' = Annotated magic (serialize' byronProtVer magic) - - epoch :: EpochNumber - epoch = unAnnotated $ Dlg.aEpoch cert - - cert' :: Dlg.ACertificate ByteString - cert' = - let unannotated = cert { Dlg.aEpoch = Annotated epoch () - , Dlg.annotation = () } - in unannotated { Dlg.annotation = serialize' byronProtVer unannotated - , Dlg.aEpoch = Annotated epoch (serialize' byronProtVer epoch) } - - vkF :: forall r. Format r (Crypto.VerificationKey -> r) - vkF = Crypto.fullVerificationKeyF - - -serialiseDelegationCert :: Dlg.Certificate -> ByteString -serialiseDelegationCert = LB.toStrict . canonicalEncodePretty - -serialiseByronWitness :: SomeByronSigningKey -> ByteString -serialiseByronWitness sk = - case sk of - AByronSigningKeyLegacy bSkey -> serialiseToRawBytes bSkey - AByronSigningKey legBKey -> serialiseToRawBytes legBKey - diff --git a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs deleted file mode 100644 index 01096671b20..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs +++ /dev/null @@ -1,215 +0,0 @@ -{-# LANGUAGE GeneralisedNewtypeDeriving #-} - - -module Cardano.CLI.Byron.Genesis - ( ByronGenesisError(..) - , GenesisParameters(..) - , NewDirectory(..) - , dumpGenesis - , mkGenesis - , readGenesis - , renderByronGenesisError - ) -where - -import Cardano.Prelude (canonicalDecodePretty, canonicalEncodePretty) - -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans (MonadTrans (..)) -import Control.Monad.Trans.Except (ExceptT (..), withExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, left, right) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Lazy as LB -import qualified Data.List as List -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.String (IsString) -import Data.Text (Text) -import qualified Data.Text.Encoding as Text -import Data.Text.Lazy (toStrict) -import Data.Text.Lazy.Builder (toLazyText) -import Data.Time (UTCTime) -import Formatting.Buildable - -import Cardano.Api (Key (..), NetworkId, textShow, writeSecrets) - -import Cardano.Api.Byron (ByronKey, SerialiseAsRawBytes (..), SigningKey (..), - toByronRequiresNetworkMagic) -import System.Directory (createDirectory, doesPathExist) - -import qualified Cardano.Chain.Common as Common -import Cardano.Chain.Delegation hiding (Map, epoch) -import Cardano.Chain.Genesis (GeneratedSecrets (..)) -import qualified Cardano.Chain.Genesis as Genesis -import qualified Cardano.Chain.UTxO as UTxO - -import qualified Cardano.Crypto as Crypto - -import Cardano.CLI.Byron.Delegation -import Cardano.CLI.Byron.Key -import Cardano.CLI.Types (GenesisFile (..)) - -data ByronGenesisError - = ByronDelegationCertSerializationError !ByronDelegationError - | ByronDelegationKeySerializationError ByronDelegationError - | GenesisGenerationError !Genesis.GenesisDataGenerationError - | GenesisOutputDirAlreadyExists FilePath - | GenesisReadError !FilePath !Genesis.GenesisDataError - | GenesisSpecError !Text - | MakeGenesisDelegationError !Genesis.GenesisDelegationError - | NoGenesisDelegationForKey !Text - | ProtocolParametersParseFailed !FilePath !Text - | PoorKeyFailure !ByronKeyFailure - - deriving Show - -renderByronGenesisError :: ByronGenesisError -> Text -renderByronGenesisError err = - case err of - ProtocolParametersParseFailed pParamFp parseError -> - "Protocol parameters parse failed at: " <> textShow pParamFp <> " Error: " <> parseError - ByronDelegationCertSerializationError bDelegSerErr -> - "Error while serializing the delegation certificate: " <> textShow bDelegSerErr - ByronDelegationKeySerializationError bKeySerErr -> - "Error while serializing the delegation key: " <> textShow bKeySerErr - PoorKeyFailure bKeyFailure -> - "Error creating poor keys: " <> textShow bKeyFailure - MakeGenesisDelegationError genDelegError -> - "Error creating genesis delegation: " <> textShow genDelegError - GenesisGenerationError genDataGenError -> - "Error generating genesis: " <> textShow genDataGenError - GenesisOutputDirAlreadyExists genOutDir -> - "Genesis output directory already exists: " <> textShow genOutDir - GenesisReadError genFp genDataError -> - "Error while reading genesis file at: " <> textShow genFp <> " Error: " <> textShow genDataError - GenesisSpecError genSpecError -> - "Error while creating genesis spec" <> textShow genSpecError - NoGenesisDelegationForKey verKey -> - "Error while creating genesis, no delegation certificate for this verification key:" <> textShow verKey - -newtype NewDirectory = - NewDirectory FilePath - deriving (Eq, Ord, Show, IsString) - --- | Parameters required for generation of new genesis. -data GenesisParameters = GenesisParameters - { gpStartTime :: !UTCTime - , gpProtocolParamsFile :: !FilePath - , gpK :: !Common.BlockCount - , gpProtocolMagic :: !Crypto.ProtocolMagic - , gpTestnetBalance :: !Genesis.TestnetBalanceOptions - , gpFakeAvvmOptions :: !Genesis.FakeAvvmOptions - , gpAvvmBalanceFactor :: !Common.LovelacePortion - , gpSeed :: !(Maybe Integer) - } deriving Show - - -mkGenesisSpec :: GenesisParameters -> ExceptT ByronGenesisError IO Genesis.GenesisSpec -mkGenesisSpec gp = do - protoParamsRaw <- lift . LB.readFile $ gpProtocolParamsFile gp - - protocolParameters <- withExceptT - (ProtocolParametersParseFailed (gpProtocolParamsFile gp)) $ - ExceptT . pure $ canonicalDecodePretty protoParamsRaw - - -- We're relying on the generator to fake AVVM and delegation. - genesisDelegation <- withExceptT MakeGenesisDelegationError $ - Genesis.mkGenesisDelegation [] - - withExceptT GenesisSpecError $ - ExceptT . pure $ Genesis.mkGenesisSpec - (Genesis.GenesisAvvmBalances mempty) - genesisDelegation - protocolParameters - (gpK gp) - (gpProtocolMagic gp) - (mkGenesisInitialiser True) - - where - mkGenesisInitialiser :: Bool -> Genesis.GenesisInitializer - mkGenesisInitialiser = - Genesis.GenesisInitializer - (gpTestnetBalance gp) - (gpFakeAvvmOptions gp) - (Common.lovelacePortionToRational (gpAvvmBalanceFactor gp)) - --- | Generate a genesis, for given blockchain start time, protocol parameters, --- security parameter, protocol magic, testnet balance options, fake AVVM options, --- AVVM balance factor and seed. Throw an error in the following cases: if the --- protocol parameters file can't be read or fails parse, if genesis delegation --- couldn't be generated, if the parameter-derived genesis specification is wrong, --- or if the genesis fails generation. -mkGenesis - :: GenesisParameters - -> ExceptT ByronGenesisError IO (Genesis.GenesisData, Genesis.GeneratedSecrets) -mkGenesis gp = do - genesisSpec <- mkGenesisSpec gp - - withExceptT GenesisGenerationError $ - Genesis.generateGenesisData (gpStartTime gp) genesisSpec - --- | Read genesis from a file. -readGenesis :: GenesisFile - -> NetworkId - -> ExceptT ByronGenesisError IO Genesis.Config -readGenesis (GenesisFile file) nw = - firstExceptT (GenesisReadError file) $ do - (genesisData, genesisHash) <- Genesis.readGenesisData file - return Genesis.Config { - Genesis.configGenesisData = genesisData, - Genesis.configGenesisHash = genesisHash, - Genesis.configReqNetMagic = toByronRequiresNetworkMagic nw, - Genesis.configUTxOConfiguration = UTxO.defaultUTxOConfiguration - } - --- | Write out genesis into a directory that must not yet exist. An error is --- thrown if the directory already exists, or the genesis has delegate keys that --- are not delegated to. -dumpGenesis - :: NewDirectory - -> Genesis.GenesisData - -> Genesis.GeneratedSecrets - -> ExceptT ByronGenesisError IO () -dumpGenesis (NewDirectory outDir) genesisData gs = do - exists <- liftIO $ doesPathExist outDir - if exists - then left $ GenesisOutputDirAlreadyExists outDir - else liftIO $ createDirectory outDir - liftIO $ LB.writeFile genesisJSONFile (canonicalEncodePretty genesisData) - - dlgCerts <- mapM (findDelegateCert . ByronSigningKey) $ gsRichSecrets gs - - liftIO $ wOut "genesis-keys" "key" - serialiseToRawBytes - (map ByronSigningKey $ gsDlgIssuersSecrets gs) - liftIO $ wOut "delegate-keys" "key" - serialiseToRawBytes - (map ByronSigningKey $ gsRichSecrets gs) - liftIO $ wOut "poor-keys" "key" - serialiseToRawBytes - (map (ByronSigningKey . Genesis.poorSecretToKey) $ gsPoorSecrets gs) - liftIO $ wOut "delegation-cert" "json" serialiseDelegationCert dlgCerts - liftIO $ wOut "avvm-secrets" "secret" printFakeAvvmSecrets $ gsFakeAvvmSecrets gs - where - dlgCertMap :: Map Common.KeyHash Certificate - dlgCertMap = Genesis.unGenesisDelegation $ Genesis.gdHeavyDelegation genesisData - - findDelegateCert :: SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate - findDelegateCert bSkey@(ByronSigningKey sk) = - case List.find (isCertForSK sk) (Map.elems dlgCertMap) of - Nothing -> left . NoGenesisDelegationForKey - . prettyPublicKey $ getVerificationKey bSkey - Just x -> right x - - genesisJSONFile :: FilePath - genesisJSONFile = outDir <> "/genesis.json" - - printFakeAvvmSecrets :: Crypto.RedeemSigningKey -> ByteString - printFakeAvvmSecrets rskey = Text.encodeUtf8 . toStrict . toLazyText $ build rskey - - -- Compare a given 'SigningKey' with a 'Certificate' 'VerificationKey' - isCertForSK :: Crypto.SigningKey -> Certificate -> Bool - isCertForSK sk cert = delegateVK cert == Crypto.toVerification sk - - wOut :: String -> String -> (a -> ByteString) -> [a] -> IO () - wOut = writeSecrets outDir diff --git a/cardano-cli/src/Cardano/CLI/Byron/Key.hs b/cardano-cli/src/Cardano/CLI/Byron/Key.hs deleted file mode 100644 index 84c3a8f9549..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Key.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GeneralisedNewtypeDeriving #-} - -module Cardano.CLI.Byron.Key - ( -- * Keys - ByronKeyFailure(..) - , NewSigningKeyFile(..) - , NewVerificationKeyFile(..) - , VerificationKeyFile - , prettyPublicKey - , readByronSigningKey - , readPaymentVerificationKey - , renderByronKeyFailure - , byronWitnessToVerKey - ) -where - -import Control.Exception (Exception (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, - right) -import qualified Data.ByteString as SB -import qualified Data.ByteString.UTF8 as UTF8 -import Data.String (IsString, fromString) -import Data.Text (Text) -import qualified Data.Text as T -import Formatting (build, sformat, (%)) - -import Cardano.Api.Byron - -import qualified Cardano.Chain.Common as Common -import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) -import Cardano.CLI.Types -import qualified Cardano.Crypto.Signing as Crypto - - -data ByronKeyFailure - = ReadSigningKeyFailure !FilePath !Text - | ReadVerificationKeyFailure !FilePath !Text - | LegacySigningKeyDeserialisationFailed !FilePath - | SigningKeyDeserialisationFailed !FilePath - | VerificationKeyDeserialisationFailed !FilePath !Text - | CannotMigrateFromNonLegacySigningKey !FilePath - deriving Show - -renderByronKeyFailure :: ByronKeyFailure -> Text -renderByronKeyFailure err = - case err of - CannotMigrateFromNonLegacySigningKey fp -> - "Migrate from non-legacy Byron key unnecessary: " <> textShow fp - ReadSigningKeyFailure sKeyFp readErr -> - "Error reading signing key at: " <> textShow sKeyFp <> " Error: " <> textShow readErr - ReadVerificationKeyFailure vKeyFp readErr -> - "Error reading verification key at: " <> textShow vKeyFp <> " Error: " <> textShow readErr - LegacySigningKeyDeserialisationFailed fp -> - "Error attempting to deserialise a legacy signing key at: " <> textShow fp - SigningKeyDeserialisationFailed sKeyFp -> - "Error deserialising signing key at: " <> textShow sKeyFp - VerificationKeyDeserialisationFailed vKeyFp deSerError -> - "Error deserialising verification key at: " <> textShow vKeyFp <> " Error: " <> textShow deSerError - -newtype NewSigningKeyFile = - NewSigningKeyFile FilePath - deriving (Eq, Ord, Show, IsString) - -newtype NewVerificationKeyFile = - NewVerificationKeyFile FilePath - deriving (Eq, Ord, Show, IsString) - --- | Print some invariant properties of a public key: --- its hash and formatted view. -prettyPublicKey :: VerificationKey ByronKey-> Text -prettyPublicKey (ByronVerificationKey vk) = - sformat ( " public key hash: " % build % - "\npublic key (base64): " % Crypto.fullVerificationKeyF % - "\n public key (hex): " % Crypto.fullVerificationKeyHexF) - (Common.addressHash vk) vk vk - -byronWitnessToVerKey :: SomeByronSigningKey -> VerificationKey ByronKey -byronWitnessToVerKey (AByronSigningKeyLegacy sKeyLeg) = castVerificationKey $ getVerificationKey sKeyLeg -byronWitnessToVerKey (AByronSigningKey sKeyNonLeg) = getVerificationKey sKeyNonLeg - --- TODO: we need to support password-protected secrets. --- | Read signing key from a file. -readByronSigningKey :: ByronKeyFormat -> SigningKeyFile In -> ExceptT ByronKeyFailure IO SomeByronSigningKey -readByronSigningKey bKeyFormat (File fp) = do - sK <- handleIOExceptT (ReadSigningKeyFailure fp . T.pack . displayException) $ SB.readFile fp - case bKeyFormat of - LegacyByronKeyFormat -> - case deserialiseFromRawBytes (AsSigningKey AsByronKeyLegacy) sK of - Right legKey -> right $ AByronSigningKeyLegacy legKey - Left _ -> left $ LegacySigningKeyDeserialisationFailed fp - NonLegacyByronKeyFormat -> - case deserialiseFromRawBytes (AsSigningKey AsByronKey) sK of - Right nonLegSKey -> right $ AByronSigningKey nonLegSKey - Left _ -> left $ SigningKeyDeserialisationFailed fp - --- | Read verification key from a file. Throw an error if the file can't be read --- or the key fails to deserialise. -readPaymentVerificationKey :: VerificationKeyFile In -> ExceptT ByronKeyFailure IO Crypto.VerificationKey -readPaymentVerificationKey (File fp) = do - vkB <- handleIOExceptT (ReadVerificationKeyFailure fp . T.pack . displayException) (SB.readFile fp) - -- Verification Key - let eVk = hoistEither . Crypto.parseFullVerificationKey . fromString $ UTF8.toString vkB - -- Convert error to 'CliError' - firstExceptT (VerificationKeyDeserialisationFailed fp . T.pack . show) eVk - diff --git a/cardano-cli/src/Cardano/CLI/Byron/Legacy.hs b/cardano-cli/src/Cardano/CLI/Byron/Legacy.hs deleted file mode 100644 index bd44c0ada63..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Legacy.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Byron.Legacy ( - LegacyDelegateKey(..) - , encodeLegacyDelegateKey - , decodeLegacyDelegateKey - ) where - -import Cardano.Prelude (cborError) - -import Control.Monad (when) -import Formatting (build, formatToString) - -import qualified Codec.CBOR.Decoding as D -import qualified Codec.CBOR.Encoding as E - -import Cardano.Api (textShow) -import Cardano.Crypto.Signing (SigningKey (..)) -import qualified Cardano.Crypto.Wallet as Wallet -import Data.Text (Text) - - --- | LegacyDelegateKey is a subset of the UserSecret's from the legacy codebase: --- 1. the VSS keypair must be present --- 2. the signing key must be present --- 3. the rest must be absent (Nothing) --- --- Legacy reference: https://github.com/input-output-hk/cardano-sl/blob/release/3.0.1/lib/src/Pos/Util/UserSecret.hs#L189 -newtype LegacyDelegateKey = LegacyDelegateKey { lrkSigningKey :: SigningKey} - -encodeXPrv :: Wallet.XPrv -> E.Encoding -encodeXPrv a = E.encodeBytes $ Wallet.unXPrv a - -decodeXPrv :: D.Decoder s Wallet.XPrv -decodeXPrv = - either (fail . formatToString build) pure . Wallet.xprv =<< D.decodeBytesCanonical - --- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs --- | Enforces that the input size is the same as the decoded one, failing in --- case it's not. -enforceSize :: Text -> Int -> D.Decoder s () -enforceSize lbl requestedSize = D.decodeListLenCanonical >>= matchSize requestedSize lbl - --- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs --- | Compare two sizes, failing if they are not equal. -matchSize :: Int -> Text -> Int -> D.Decoder s () -matchSize requestedSize lbl actualSize = - when (actualSize /= requestedSize) $ - cborError (lbl <> " failed the size check. Expected " <> textShow requestedSize <> ", found " <> textShow actualSize) - --- | Encoder for a Byron/Classic signing key. --- Lifted from cardano-sl legacy codebase. -encodeLegacyDelegateKey :: LegacyDelegateKey -> E.Encoding -encodeLegacyDelegateKey (LegacyDelegateKey (SigningKey sk)) - = E.encodeListLen 4 - <> E.encodeListLen 1 <> E.encodeBytes "vss deprecated" - <> E.encodeListLen 1 <> encodeXPrv sk - <> E.encodeListLenIndef <> E.encodeBreak - <> E.encodeListLen 0 - --- | Decoder for a Byron/Classic signing key. --- Lifted from cardano-sl legacy codebase. -decodeLegacyDelegateKey :: D.Decoder s LegacyDelegateKey -decodeLegacyDelegateKey = do - enforceSize "UserSecret" 4 - _ <- do - enforceSize "vss" 1 - D.decodeBytes - pkey <- do - enforceSize "pkey" 1 - SigningKey <$> decodeXPrv - _ <- do - D.decodeListLenIndef - D.decodeSequenceLenIndef (flip (:)) [] reverse D.decodeNull - _ <- do - enforceSize "wallet" 0 - pure $ LegacyDelegateKey pkey diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs deleted file mode 100644 index 0212c90d2ed..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs +++ /dev/null @@ -1,737 +0,0 @@ -{-# LANGUAGE DataKinds #-} - -module Cardano.CLI.Byron.Parsers - ( ByronCommand(..) - , NodeCmd(..) - , backwardsCompatibilityCommands - , parseByronCommands - , parseHeavyDelThd - , parseInstallerHash - , parseMaxBlockSize - , parseMaxHeaderSize - , parseMaxTxSize - , parseMaxProposalSize - , parseMpcThd - , parseScriptVersion - , parseSlotDuration - , parseSoftforkRule - , parseSystemTag - , parseTxFeePolicy - , parseUpdateProposalThd - , parseUpdateProposalTTL - , parseUnlockStakeEpoch - , parseUpdateVoteThd - ) where - - -import Cardano.Prelude (ConvertText (..)) - -import Control.Monad (when) -import qualified Data.Attoparsec.ByteString.Char8 as Atto -import Data.Attoparsec.Combinator (()) -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy.Char8 as C8 -import qualified Data.Char as Char -import Data.Foldable -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Data.Word (Word16, Word64) -import Formatting (build, sformat) -import GHC.Natural (Natural) -import GHC.Word (Word8) - -import Options.Applicative -import qualified Options.Applicative as Opt - -import Cardano.Ledger.Binary (Annotated (..)) - -import Cardano.Crypto (RequiresNetworkMagic (..)) -import Cardano.Crypto.Hashing (hashRaw) -import Cardano.Crypto.ProtocolMagic (AProtocolMagic (..), ProtocolMagic, - ProtocolMagicId (..)) - -import Cardano.Chain.Common (BlockCount (..), TxFeePolicy (..), TxSizeLinear (..), - decodeAddressBase58, rationalToLovelacePortion) -import qualified Cardano.Chain.Common as Byron -import Cardano.Chain.Genesis (FakeAvvmOptions (..), TestnetBalanceOptions (..)) -import Cardano.Chain.Slotting (EpochNumber (..), SlotNumber (..)) -import Cardano.Chain.Update (ApplicationName (..), InstallerHash (..), NumSoftwareVersion, - ProtocolVersion (..), SoftforkRule (..), SoftwareVersion (..), SystemTag (..), - checkApplicationName, checkSystemTag) - -import Cardano.Api hiding (GenesisParameters, UpdateProposal) -import Cardano.Api.Byron (Address (..), ByronProtocolParametersUpdate (..), - toByronLovelace) - -import Cardano.Api.Shelley (ReferenceScript (ReferenceScriptNone)) -import Cardano.CLI.Byron.Commands -import Cardano.CLI.Byron.Genesis -import Cardano.CLI.Byron.Key -import Cardano.CLI.Byron.Tx -import Cardano.CLI.Common.Parsers -import Cardano.CLI.Environment (EnvCli (..)) -import Cardano.CLI.Run (ClientCommand (ByronCommand)) -import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) -import Cardano.CLI.Types - - -backwardsCompatibilityCommands :: EnvCli -> Parser ClientCommand -backwardsCompatibilityCommands envCli = - asum hiddenCmds - - where - convertToByronCommand :: Mod CommandFields ByronCommand -> Parser ClientCommand - convertToByronCommand p = ByronCommand <$> Opt.subparser (p <> Opt.internal) - - hiddenCmds :: [Parser ClientCommand] - hiddenCmds = - concatMap (fmap convertToByronCommand) - [ parseGenesisRelatedValues - , parseKeyRelatedValues envCli - , parseTxRelatedValues envCli - , return (parseLocalNodeQueryValues envCli) - , parseMiscellaneous - ] - --- Implemented with asum so all commands don't get hidden when trying to hide --- the 'pNodeCmdBackwardCompatible' parser. -parseByronCommands :: EnvCli -> Parser ByronCommand -parseByronCommands envCli = asum - [ subParser "key" (Opt.info (asum $ map Opt.subparser (parseKeyRelatedValues envCli)) - $ Opt.progDesc "Byron key utility commands") - , subParser "transaction" (Opt.info (asum $ map Opt.subparser (parseTxRelatedValues envCli)) - $ Opt.progDesc "Byron transaction commands") - , subParser "query" (Opt.info (Opt.subparser (parseLocalNodeQueryValues envCli)) - $ Opt.progDesc "Byron node query commands.") - , subParser "genesis" (Opt.info (asum $ map Opt.subparser parseGenesisRelatedValues) - $ Opt.progDesc "Byron genesis block commands") - , subParser "governance" (Opt.info (NodeCmd <$> Opt.subparser (pNodeCmd envCli)) - $ Opt.progDesc "Byron governance commands") - , subParser "miscellaneous" (Opt.info (asum $ map Opt.subparser parseMiscellaneous) - $ Opt.progDesc "Byron miscellaneous commands") - , NodeCmd <$> pNodeCmdBackwardCompatible envCli - ] - where - subParser :: String -> ParserInfo ByronCommand -> Parser ByronCommand - subParser name pInfo = Opt.subparser $ Opt.command name pInfo <> Opt.metavar name - -pNodeCmdBackwardCompatible :: EnvCli -> Parser NodeCmd -pNodeCmdBackwardCompatible envCli = Opt.subparser $ pNodeCmd envCli <> Opt.internal - -parseCBORObject :: Parser CBORObject -parseCBORObject = asum - [ CBORBlockByron <$> Opt.option auto - ( long "byron-block" - <> help - ( "The CBOR file is a byron era block." - <> " Enter the number of slots in an epoch. The default value is 21600") - <> metavar "INT" - <> value (EpochSlots 21600) - ) - - , flag' CBORDelegationCertificateByron $ - long "byron-delegation-certificate" - <> help "The CBOR file is a byron era delegation certificate" - - , flag' CBORTxByron $ - long "byron-tx" - <> help "The CBOR file is a byron era tx" - - , flag' CBORUpdateProposalByron $ - long "byron-update-proposal" - <> help "The CBOR file is a byron era update proposal" - , flag' CBORVoteByron $ - long "byron-vote" - <> help "The CBOR file is a byron era vote" - ] - --- | Values required to create genesis. -parseGenesisParameters :: Parser GenesisParameters -parseGenesisParameters = - GenesisParameters - <$> parseUTCTime - "start-time" - "Start time of the new cluster to be enshrined in the new genesis." - <*> parseFilePath - "protocol-parameters-file" - "JSON file with protocol parameters." - <*> parseK - <*> parseProtocolMagic - <*> parseTestnetBalanceOptions - <*> parseFakeAvvmOptions - <*> (rationalToLovelacePortion <$> - parseFractionWithDefault - "avvm-balance-factor" - "AVVM balances will be multiplied by this factor (defaults to 1)." - 1) - <*> optional - ( parseIntegral - "secret-seed" - "Optionally specify the seed of generation." - ) - -parseGenesisRelatedValues :: [Mod CommandFields ByronCommand] -parseGenesisRelatedValues = - [ command' "genesis" "Create genesis." - $ Genesis - <$> parseNewDirectory - "genesis-output-dir" - "Non-existent directory where genesis JSON file and secrets shall be placed." - <*> parseGenesisParameters - , command' "print-genesis-hash" "Compute hash of a genesis file." - $ PrintGenesisHash - <$> parseGenesisFile "genesis-json" - ] - --- | Values required to create keys and perform --- transformation on keys. -parseKeyRelatedValues :: EnvCli -> [Mod CommandFields ByronCommand] -parseKeyRelatedValues envCli = - [ command' "keygen" "Generate a signing key." - $ Keygen - <$> parseNewSigningKeyFile "secret" - , command' - "to-verification" - "Extract a verification key in its base64 form." - $ ToVerification - <$> parseByronKeyFormat - <*> parseSigningKeyFile - "secret" - "Signing key file to extract the verification part from." - <*> parseNewVerificationKeyFile "to" - , command' - "signing-key-public" - "Pretty-print a signing key's verification key (not a secret)." - $ PrettySigningKeyPublic - <$> parseByronKeyFormat - <*> parseSigningKeyFile - "secret" - "Signing key to pretty-print." - , command' - "signing-key-address" - "Print address of a signing key." - $ PrintSigningKeyAddress - <$> parseByronKeyFormat - <*> pNetworkId envCli - <*> parseSigningKeyFile - "secret" - "Signing key, whose address is to be printed." - , command' - "migrate-delegate-key-from" - "Migrate a delegate key from an older version." - $ MigrateDelegateKeyFrom - <$> parseSigningKeyFile "from" "Legacy signing key file to migrate." - <*> parseNewSigningKeyFile "to" - ] - -parseLocalNodeQueryValues :: EnvCli -> Mod CommandFields ByronCommand -parseLocalNodeQueryValues envCli = - command' "get-tip" "Get the tip of your local node's blockchain" - $ GetLocalNodeTip - <$> pSocketPath envCli - <*> pNetworkId envCli - - -parseMiscellaneous :: [Mod CommandFields ByronCommand] -parseMiscellaneous = - [ command' - "validate-cbor" - "Validate a CBOR blockchain object." - $ ValidateCBOR - <$> parseCBORObject - <*> parseFilePath "filepath" "Filepath of CBOR file." - , command' - "pretty-print-cbor" - "Pretty print a CBOR file." - $ PrettyPrintCBOR - <$> parseFilePath "filepath" "Filepath of CBOR file." - ] - - - -parseTestnetBalanceOptions :: Parser TestnetBalanceOptions -parseTestnetBalanceOptions = - TestnetBalanceOptions - <$> parseIntegral - "n-poor-addresses" - "Number of poor nodes (with small balance)." - <*> parseIntegral - "n-delegate-addresses" - "Number of delegate nodes (with huge balance)." - <*> parseLovelace - "total-balance" - "Total balance owned by these nodes." - <*> parseFraction - "delegate-share" - "Portion of stake owned by all delegates together." - -parseTxIn :: Parser TxIn -parseTxIn = - Opt.option - (readerFromAttoParser parseTxInAtto) - $ long "txin" - <> metavar "(TXID,INDEX)" - <> help "Transaction input is a pair of an UTxO TxId and a zero-based output index." - -parseTxInAtto :: Atto.Parser TxIn -parseTxInAtto = - TxIn <$> (Atto.char '(' *> parseTxIdAtto <* Atto.char ',') - <*> (parseTxIxAtto <* Atto.char ')') - - -parseTxIdAtto :: Atto.Parser TxId -parseTxIdAtto = ( "Transaction ID (hexadecimal)") $ do - bstr <- Atto.takeWhile1 Char.isHexDigit - case deserialiseFromRawBytesHex AsTxId bstr of - Right addr -> return addr - Left e -> fail $ "Incorrect transaction id format: " ++ displayError e - -parseTxIxAtto :: Atto.Parser TxIx -parseTxIxAtto = toEnum <$> Atto.decimal - -parseTxOut :: Parser (TxOut CtxTx ByronEra) -parseTxOut = - Opt.option - ( (\(addr, lovelace) -> TxOut (pAddressInEra addr) - (pLovelaceTxOut lovelace) - TxOutDatumNone - ReferenceScriptNone) - <$> auto - ) - $ long "txout" - <> metavar "'(\"ADDR\", LOVELACE)'" - <> help "Specify a transaction output, as a pair of an address and lovelace." - where - pAddressInEra :: Text -> AddressInEra ByronEra - pAddressInEra t = - case decodeAddressBase58 t of - Left err -> error $ "Bad Base58 address: " <> show err - Right byronAddress -> AddressInEra ByronAddressInAnyEra $ ByronAddress byronAddress - - pLovelaceTxOut :: Word64 -> TxOutValue ByronEra - pLovelaceTxOut l = - if l > (maxBound :: Word64) - then error $ show l <> " lovelace exceeds the Word64 upper bound" - else TxOutAdaOnly AdaOnlyInByronEra . Lovelace $ toInteger l - -readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a -readerFromAttoParser p = - Opt.eitherReader (Atto.parseOnly (p <* Atto.endOfInput) . BSC.pack) - -parseTxRelatedValues :: EnvCli -> [Mod CommandFields ByronCommand] -parseTxRelatedValues envCli = - [ command' - "submit-tx" - "Submit a raw, signed transaction, in its on-wire representation." - $ SubmitTx - <$> pSocketPath envCli - <*> pNetworkId envCli - <*> parseTxFile "tx" - , command' - "issue-genesis-utxo-expenditure" - "Write a file with a signed transaction, spending genesis UTxO." - $ SpendGenesisUTxO - <$> parseGenesisFile "genesis-json" - <*> pNetworkId envCli - <*> parseByronKeyFormat - <*> parseNewTxFile "tx" - <*> parseSigningKeyFile - "wallet-key" - "Key that has access to all mentioned genesis UTxO inputs." - <*> parseAddress - "rich-addr-from" - "Tx source: genesis UTxO richman address (non-HD)." - <*> some parseTxOut - - , command' - "issue-utxo-expenditure" - "Write a file with a signed transaction, spending normal UTxO." - $ SpendUTxO - <$> pNetworkId envCli - <*> parseByronKeyFormat - <*> parseNewTxFile "tx" - <*> parseSigningKeyFile - "wallet-key" - "Key that has access to all mentioned genesis UTxO inputs." - <*> some parseTxIn - <*> some parseTxOut - - , command' - "txid" - "Print the txid of a raw, signed transaction." - $ GetTxId - <$> parseTxFile "tx" - ] - -pNodeCmd :: EnvCli -> Mod CommandFields NodeCmd -pNodeCmd envCli = - mconcat - [ Opt.command "create-update-proposal" $ - Opt.info (parseByronUpdateProposal envCli) $ Opt.progDesc "Create an update proposal." - , Opt.command "create-proposal-vote" $ - Opt.info (parseByronVote envCli) $ Opt.progDesc "Create an update proposal vote." - , Opt.command "submit-update-proposal" $ - Opt.info (parseByronUpdateProposalSubmission envCli) $ Opt.progDesc "Submit an update proposal." - , Opt.command "submit-proposal-vote" $ - Opt.info (parseByronVoteSubmission envCli) $ Opt.progDesc "Submit a proposal vote." - ] - -parseByronUpdateProposal :: EnvCli -> Parser NodeCmd -parseByronUpdateProposal envCli = do - UpdateProposal - <$> pNetworkId envCli - <*> parseSigningKeyFile "signing-key" "Path to signing key." - <*> parseProtocolVersion - <*> parseSoftwareVersion - <*> parseSystemTag - <*> parseInstallerHash - <*> parseFilePath "filepath" "Byron proposal output filepath." - <*> pByronProtocolParametersUpdate - -parseByronVoteSubmission :: EnvCli -> Parser NodeCmd -parseByronVoteSubmission envCli = do - SubmitVote - <$> pSocketPath envCli - <*> pNetworkId envCli - <*> parseFilePath "filepath" "Filepath of Byron update proposal vote." - - -pByronProtocolParametersUpdate :: Parser ByronProtocolParametersUpdate -pByronProtocolParametersUpdate = - ByronProtocolParametersUpdate - <$> optional parseScriptVersion - <*> optional parseSlotDuration - <*> optional parseMaxBlockSize - <*> optional parseMaxHeaderSize - <*> optional parseMaxTxSize - <*> optional parseMaxProposalSize - <*> optional parseMpcThd - <*> optional parseHeavyDelThd - <*> optional parseUpdateVoteThd - <*> optional parseUpdateProposalThd - <*> optional parseUpdateProposalTTL - <*> optional parseSoftforkRule - <*> optional parseTxFeePolicy - <*> optional parseUnlockStakeEpoch - -parseByronUpdateProposalSubmission :: EnvCli -> Parser NodeCmd -parseByronUpdateProposalSubmission envCli = - SubmitUpdateProposal - <$> pSocketPath envCli - <*> pNetworkId envCli - <*> parseFilePath "filepath" "Filepath of Byron update proposal." - -parseByronVote :: EnvCli -> Parser NodeCmd -parseByronVote envCli = - CreateVote - <$> pNetworkId envCli - <*> (File <$> parseFilePath "signing-key" "Filepath of signing key.") - <*> parseFilePath "proposal-filepath" "Filepath of Byron update proposal." - <*> parseVoteBool - <*> parseFilePath "output-filepath" "Byron vote output filepath." - --------------------------------------------------------------------------------- --- CLI Parsers --------------------------------------------------------------------------------- - -parseScriptVersion :: Parser Word16 -parseScriptVersion = - Opt.option auto - ( long "script-version" - <> metavar "WORD16" - <> help "Proposed script version." - ) - -parseSlotDuration :: Parser Natural -parseSlotDuration = - Opt.option auto - ( long "slot-duration" - <> metavar "NATURAL" - <> help "Proposed slot duration." - ) - -parseSystemTag :: Parser SystemTag -parseSystemTag = Opt.option (eitherReader checkSysTag) - ( long "system-tag" - <> metavar "STRING" - <> help "Identify which system (linux, win64, etc) the update proposal is for." - ) - where - checkSysTag :: String -> Either String SystemTag - checkSysTag name = - let tag = SystemTag $ toS name - in case checkSystemTag tag of - Left err -> Left . toS $ sformat build err - Right () -> Right tag - -parseInstallerHash :: Parser InstallerHash -parseInstallerHash = - InstallerHash . hashRaw . C8.pack - <$> strOption ( long "installer-hash" - <> metavar "HASH" - <> help "Software hash." - ) - -parseMaxBlockSize :: Parser Natural -parseMaxBlockSize = - Opt.option auto - ( long "max-block-size" - <> metavar "NATURAL" - <> help "Proposed max block size." - ) - -parseMaxHeaderSize :: Parser Natural -parseMaxHeaderSize = - Opt.option auto - ( long "max-header-size" - <> metavar "NATURAL" - <> help "Proposed max block header size." - ) - -parseMaxTxSize :: Parser Natural -parseMaxTxSize = - Opt.option auto - ( long "max-tx-size" - <> metavar "NATURAL" - <> help "Proposed max transaction size." - ) - -parseMaxProposalSize :: Parser Natural -parseMaxProposalSize = - Opt.option auto - ( long "max-proposal-size" - <> metavar "NATURAL" - <> help "Proposed max update proposal size." - ) - -parseMpcThd :: Parser Byron.LovelacePortion -parseMpcThd = - rationalToLovelacePortion - <$> parseFraction "max-mpc-thd" "Proposed max mpc threshold." - -parseProtocolVersion :: Parser ProtocolVersion -parseProtocolVersion = - ProtocolVersion <$> (parseWord "protocol-version-major" "Protocol version major." "WORD16" :: Parser Word16) - <*> (parseWord "protocol-version-minor" "Protocol version minor." "WORD16" :: Parser Word16) - <*> (parseWord "protocol-version-alt" "Protocol version alt." "WORD8" :: Parser Word8) - -parseHeavyDelThd :: Parser Byron.LovelacePortion -parseHeavyDelThd = - rationalToLovelacePortion - <$> parseFraction "heavy-del-thd" "Proposed heavy delegation threshold." - -parseUpdateVoteThd :: Parser Byron.LovelacePortion -parseUpdateVoteThd = - rationalToLovelacePortion - <$> parseFraction "update-vote-thd" "Propose update vote threshold." - -parseUpdateProposalThd :: Parser Byron.LovelacePortion -parseUpdateProposalThd = - rationalToLovelacePortion - <$> parseFraction "update-proposal-thd" "Propose update proposal threshold." - -parseUpdateProposalTTL :: Parser SlotNumber -parseUpdateProposalTTL = - SlotNumber - <$> Opt.option auto - ( long "time-to-live" - <> metavar "WORD64" - <> help "Proposed time for an update proposal to live." - ) - -parseSoftforkRule :: Parser SoftforkRule -parseSoftforkRule = - SoftforkRule - <$> (rationalToLovelacePortion <$> parseFraction "softfork-init-thd" "Propose initial threshold (right after proposal is confirmed).") - <*> (rationalToLovelacePortion <$> parseFraction "softfork-min-thd" "Propose minimum threshold (threshold can't be less than this).") - <*> (rationalToLovelacePortion <$> parseFraction "softfork-thd-dec" "Propose threshold decrement (threshold will decrease by this amount after each epoch).") - - -parseSoftwareVersion :: Parser SoftwareVersion -parseSoftwareVersion = - SoftwareVersion <$> parseApplicationName <*> parseNumSoftwareVersion - -parseApplicationName :: Parser ApplicationName -parseApplicationName = Opt.option (eitherReader checkAppNameLength) - ( long "application-name" - <> metavar "STRING" - <> help "The name of the application." - ) - where - checkAppNameLength :: String -> Either String ApplicationName - checkAppNameLength name = - let appName = ApplicationName $ toS name - in case checkApplicationName appName of - Left err -> Left . toS $ sformat build err - Right () -> Right appName - -parseNumSoftwareVersion :: Parser NumSoftwareVersion -parseNumSoftwareVersion = - parseWord - "software-version-num" - "Numeric software version associated with application name." - "WORD32" - -parseTxFeePolicy :: Parser TxFeePolicy -parseTxFeePolicy = - TxFeePolicyTxSizeLinear - <$> ( TxSizeLinear <$> parseLovelace "tx-fee-a-constant" "Propose the constant a for txfee = a + b*s where s is the size." - <*> parseFraction "tx-fee-b-constant" "Propose the constant b for txfee = a + b*s where s is the size." - ) - -parseVoteBool :: Parser Bool -parseVoteBool = flag' True (long "vote-yes" <> help "Vote yes with respect to an update proposal.") - <|> flag' False (long "vote-no" <> help "Vote no with respect to an update proposal.") - -parseUnlockStakeEpoch :: Parser EpochNumber -parseUnlockStakeEpoch = - EpochNumber - <$> Opt.option auto - ( long "unlock-stake-epoch" - <> metavar "WORD64" - <> help "Proposed epoch to unlock all stake." - ) - - -parseWord :: Integral a => String -> String -> String -> Parser a -parseWord optname desc metvar = Opt.option (fromInteger <$> auto) - $ long optname <> metavar metvar <> help desc - - - -parseAddress :: String -> String -> Parser (Address ByronAddr) -parseAddress opt desc = - Opt.option (cliParseBase58Address <$> str) - $ long opt <> metavar "ADDR" <> help desc - -parseByronKeyFormat :: Parser ByronKeyFormat -parseByronKeyFormat = asum - [ flag' LegacyByronKeyFormat $ - long "byron-legacy-formats" - <> help "Byron/cardano-sl formats and compatibility" - - , flag' NonLegacyByronKeyFormat $ - long "byron-formats" - <> help "Byron era formats and compatibility" - - -- And hidden compatibility flag aliases that should be deprecated: - , flag' LegacyByronKeyFormat $ hidden <> long "byron-legacy" - , flag' NonLegacyByronKeyFormat $ hidden <> long "real-pbft" - - -- Default Byron key format - , pure NonLegacyByronKeyFormat - ] - - -parseFakeAvvmOptions :: Parser FakeAvvmOptions -parseFakeAvvmOptions = - FakeAvvmOptions - <$> parseIntegral "avvm-entry-count" "Number of AVVM addresses." - <*> parseLovelace "avvm-entry-balance" "AVVM address." - -parseK :: Parser BlockCount -parseK = - BlockCount - <$> parseIntegral "k" "The security parameter of the Ouroboros protocol." - -parseNewDirectory :: String -> String -> Parser NewDirectory -parseNewDirectory opt desc = NewDirectory <$> parseFilePath opt desc - -parseFractionWithDefault - :: String - -> String - -> Double - -> Parser Rational -parseFractionWithDefault optname desc w = - toRational <$> Opt.option readDouble - ( long optname - <> metavar "DOUBLE" - <> help desc - <> value w - ) - -parseNewSigningKeyFile :: String -> Parser NewSigningKeyFile -parseNewSigningKeyFile opt = - NewSigningKeyFile - <$> parseFilePath opt "Non-existent file to write the signing key to." - -parseNewTxFile :: String -> Parser NewTxFile -parseNewTxFile opt = - NewTxFile - <$> parseFilePath opt "Non-existent file to write the signed transaction to." - -parseNewVerificationKeyFile :: String -> Parser NewVerificationKeyFile -parseNewVerificationKeyFile opt = - NewVerificationKeyFile - <$> parseFilePath opt "Non-existent file to write the verification key to." - -parseProtocolMagicId :: String -> Parser ProtocolMagicId -parseProtocolMagicId arg = - ProtocolMagicId - <$> parseIntegral arg "The magic number unique to any instance of Cardano." - -parseProtocolMagic :: Parser ProtocolMagic -parseProtocolMagic = - flip AProtocolMagic RequiresMagic . flip Annotated () - <$> parseProtocolMagicId "protocol-magic" - -parseTxFile :: String -> Parser (TxFile In) -parseTxFile opt = - File - <$> parseFilePath opt "File containing the signed transaction." - -parseUTCTime :: String -> String -> Parser UTCTime -parseUTCTime optname desc = - Opt.option (posixSecondsToUTCTime . fromInteger <$> auto) - $ long optname <> metavar "POSIXSECONDS" <> help desc - -cliParseBase58Address :: Text -> Address ByronAddr -cliParseBase58Address t = - case decodeAddressBase58 t of - Left err -> error $ "Bad Base58 address: " <> show err - Right byronAddress -> ByronAddress byronAddress - -parseFraction :: String -> String -> Parser Rational -parseFraction optname desc = - Opt.option (toRational <$> readDouble) $ - long optname - <> metavar "DOUBLE" - <> help desc - -parseIntegral :: Integral a => String -> String -> Parser a -parseIntegral optname desc = Opt.option (fromInteger <$> auto) - $ long optname <> metavar "INT" <> help desc - -parseLovelace :: String -> String -> Parser Byron.Lovelace -parseLovelace optname desc = - Opt.option (readerFromAttoParser parseLovelaceAtto) - ( long optname - <> metavar "INT" - <> help desc - ) - where - parseLovelaceAtto :: Atto.Parser Byron.Lovelace - parseLovelaceAtto = do - i <- Atto.decimal - if i > toInteger (maxBound :: Word64) - then fail $ show i <> " lovelace exceeds the Word64 upper bound" - else case toByronLovelace (Lovelace i) of - Just byronLovelace -> return byronLovelace - Nothing -> error $ "Error converting lovelace: " <> show i - -readDouble :: ReadM Double -readDouble = do - f <- auto - when (f < 0) $ readerError "fraction must be >= 0" - when (f > 1) $ readerError "fraction must be <= 1" - return f - -parseSigningKeyFile :: String -> String -> Parser (SigningKeyFile In) -parseSigningKeyFile opt desc = File <$> parseFilePath opt desc - - -parseGenesisFile :: String -> Parser GenesisFile -parseGenesisFile opt = - GenesisFile <$> parseFilePath opt "Genesis JSON file." - diff --git a/cardano-cli/src/Cardano/CLI/Byron/Query.hs b/cardano-cli/src/Cardano/CLI/Byron/Query.hs deleted file mode 100644 index 9613584d770..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Query.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Byron.Query - ( runGetLocalNodeTip - ) where - -import Cardano.Api - -import Data.Aeson.Encode.Pretty (encodePretty) - -import qualified Data.ByteString.Lazy as LB -import qualified Data.Text.Encoding as Text -import qualified Data.Text.IO as Text - - -{- HLINT ignore "Reduce duplication" -} - --------------------------------------------------------------------------------- --- Query local node's chain tip --------------------------------------------------------------------------------- - -runGetLocalNodeTip - :: SocketPath - -> NetworkId - -> IO () -runGetLocalNodeTip socketPath networkId = do - let connctInfo = - LocalNodeConnectInfo - { localNodeSocketPath = socketPath - , localNodeNetworkId = networkId - , localConsensusModeParams = ByronModeParams (EpochSlots 21600) - } - - tip <- getLocalChainTip connctInfo - Text.putStrLn . Text.decodeUtf8 . LB.toStrict $ encodePretty tip - - diff --git a/cardano-cli/src/Cardano/CLI/Byron/Run.hs b/cardano-cli/src/Cardano/CLI/Byron/Run.hs deleted file mode 100644 index 957086dc107..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Run.hs +++ /dev/null @@ -1,224 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} - -module Cardano.CLI.Byron.Run - ( ByronClientCmdError - , renderByronClientCmdError - , runByronClientCommand - ) where - -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, left) -import Data.Bifunctor (Bifunctor (..)) -import qualified Data.ByteString.Char8 as BS -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import qualified Data.Text.Lazy.Builder as Builder -import qualified Data.Text.Lazy.IO as TL -import qualified Formatting as F - -import qualified Cardano.Chain.Genesis as Genesis - -import qualified Cardano.Crypto.Hashing as Crypto -import qualified Cardano.Crypto.Signing as Crypto - -import Cardano.Api hiding (GenesisParameters, UpdateProposal) -import Cardano.Api.Byron (SomeByronSigningKey (..), Tx (..)) - -import Ouroboros.Consensus.Byron.Ledger (ByronBlock) -import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr) - -import Cardano.CLI.Byron.Commands -import Cardano.CLI.Byron.Delegation -import Cardano.CLI.Byron.Genesis -import Cardano.CLI.Byron.Key -import Cardano.CLI.Byron.Query -import Cardano.CLI.Byron.Tx -import Cardano.CLI.Byron.UpdateProposal -import Cardano.CLI.Byron.Vote -import Cardano.CLI.Helpers -import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) -import Cardano.CLI.Types - --- | Data type that encompasses all the possible errors of the --- Byron client. -data ByronClientCmdError - = ByronCmdDelegationError !ByronDelegationError - | ByronCmdGenesisError !ByronGenesisError - | ByronCmdHelpersError !HelpersError - | ByronCmdKeyFailure !ByronKeyFailure - | ByronCmdTxError !ByronTxError - | ByronCmdTxSubmitError !(ApplyTxErr ByronBlock) - | ByronCmdUpdateProposalError !ByronUpdateProposalError - | ByronCmdVoteError !ByronVoteError - deriving Show - -renderByronClientCmdError :: ByronClientCmdError -> Text -renderByronClientCmdError err = - case err of - ByronCmdDelegationError e -> renderByronDelegationError e - ByronCmdGenesisError e -> renderByronGenesisError e - ByronCmdHelpersError e -> renderHelpersError e - ByronCmdKeyFailure e -> renderByronKeyFailure e - ByronCmdTxError e -> renderByronTxError e - ByronCmdTxSubmitError e -> - "Error while submitting Byron tx: " <> Text.pack (show e) - ByronCmdUpdateProposalError e -> renderByronUpdateProposalError e - ByronCmdVoteError e -> renderByronVoteError e - -runByronClientCommand :: ByronCommand -> ExceptT ByronClientCmdError IO () -runByronClientCommand c = - case c of - NodeCmd bc -> runNodeCmd bc - Genesis outDir params -> runGenesisCommand outDir params - GetLocalNodeTip mNodeSocketPath network -> liftIO $ runGetLocalNodeTip mNodeSocketPath network - ValidateCBOR cborObject fp -> runValidateCBOR cborObject fp - PrettyPrintCBOR fp -> runPrettyPrintCBOR fp - PrettySigningKeyPublic bKeyFormat skF -> runPrettySigningKeyPublic bKeyFormat skF - MigrateDelegateKeyFrom oldKey nskf -> - runMigrateDelegateKeyFrom oldKey nskf - PrintGenesisHash genFp -> runPrintGenesisHash genFp - PrintSigningKeyAddress bKeyFormat networkid skF -> runPrintSigningKeyAddress bKeyFormat networkid skF - Keygen nskf -> runKeygen nskf - ToVerification bKeyFormat skFp nvkFp -> runToVerification bKeyFormat skFp nvkFp - SubmitTx socketPath network fp -> runSubmitTx socketPath network fp - GetTxId fp -> runGetTxId fp - SpendGenesisUTxO genFp nw era nftx ctKey genRichAddr outs -> - runSpendGenesisUTxO genFp nw era nftx ctKey genRichAddr outs - SpendUTxO nw era nftx ctKey ins outs -> - runSpendUTxO nw era nftx ctKey ins outs - - -runNodeCmd :: NodeCmd -> ExceptT ByronClientCmdError IO () -runNodeCmd (CreateVote nw sKey upPropFp voteBool outputFp) = - firstExceptT ByronCmdVoteError $ runVoteCreation nw sKey upPropFp voteBool outputFp - -runNodeCmd (SubmitUpdateProposal nodeSocketPath network proposalFp) = do - firstExceptT ByronCmdUpdateProposalError - $ submitByronUpdateProposal nodeSocketPath network proposalFp - -runNodeCmd (SubmitVote nodeSocketPath network voteFp) = do - firstExceptT ByronCmdVoteError $ submitByronVote nodeSocketPath network voteFp - -runNodeCmd (UpdateProposal nw sKey pVer sVer sysTag insHash outputFp params) = - firstExceptT ByronCmdUpdateProposalError - $ runProposalCreation nw sKey pVer sVer sysTag insHash outputFp params - -runGenesisCommand :: NewDirectory -> GenesisParameters -> ExceptT ByronClientCmdError IO () -runGenesisCommand outDir params = do - (genData, genSecrets) <- firstExceptT ByronCmdGenesisError $ mkGenesis params - firstExceptT ByronCmdGenesisError $ dumpGenesis outDir genData genSecrets - -runValidateCBOR :: CBORObject -> FilePath -> ExceptT ByronClientCmdError IO () -runValidateCBOR cborObject fp = do - bs <- firstExceptT ByronCmdHelpersError $ readCBOR fp - res <- hoistEither . first ByronCmdHelpersError $ validateCBOR cborObject bs - liftIO $ Text.putStrLn res - -runPrettyPrintCBOR :: FilePath -> ExceptT ByronClientCmdError IO () -runPrettyPrintCBOR fp = do - bs <- firstExceptT ByronCmdHelpersError $ readCBOR fp - firstExceptT ByronCmdHelpersError $ pPrintCBOR bs - -runPrettySigningKeyPublic :: ByronKeyFormat -> SigningKeyFile In -> ExceptT ByronClientCmdError IO () -runPrettySigningKeyPublic bKeyFormat skF = do - sK <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey bKeyFormat skF - liftIO . Text.putStrLn . prettyPublicKey $ byronWitnessToVerKey sK - -runMigrateDelegateKeyFrom - :: SigningKeyFile In - -- ^ Legacy Byron signing key - -> NewSigningKeyFile - -> ExceptT ByronClientCmdError IO () -runMigrateDelegateKeyFrom oldKey@(File fp) (NewSigningKeyFile newKey) = do - sk <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey LegacyByronKeyFormat oldKey - migratedWitness <- case sk of - AByronSigningKeyLegacy (ByronSigningKeyLegacy sKey) -> - return . AByronSigningKey $ ByronSigningKey sKey - AByronSigningKey _ -> - left . ByronCmdKeyFailure $ CannotMigrateFromNonLegacySigningKey fp - firstExceptT ByronCmdHelpersError . ensureNewFileLBS newKey $ serialiseByronWitness migratedWitness - -runPrintGenesisHash :: GenesisFile -> ExceptT ByronClientCmdError IO () -runPrintGenesisHash genFp = do - genesis <- firstExceptT ByronCmdGenesisError $ - readGenesis genFp dummyNetwork - liftIO . Text.putStrLn $ formatter genesis - where - -- For this purpose of getting the hash, it does not matter what network - -- value we use here. - dummyNetwork :: NetworkId - dummyNetwork = Mainnet - - formatter :: Genesis.Config -> Text - formatter = F.sformat Crypto.hashHexF - . Genesis.unGenesisHash - . Genesis.configGenesisHash - -runPrintSigningKeyAddress - :: ByronKeyFormat - -> NetworkId - -> SigningKeyFile In - -> ExceptT ByronClientCmdError IO () -runPrintSigningKeyAddress bKeyFormat networkid skF = do - sK <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey bKeyFormat skF - let sKeyAddr = prettyAddress . makeByronAddress networkid $ byronWitnessToVerKey sK - liftIO $ Text.putStrLn sKeyAddr - -runKeygen :: NewSigningKeyFile -> ExceptT ByronClientCmdError IO () -runKeygen (NewSigningKeyFile skF) = do - sK <- liftIO $ generateSigningKey AsByronKey - firstExceptT ByronCmdHelpersError . ensureNewFileLBS skF $ serialiseToRawBytes sK - -runToVerification :: ByronKeyFormat -> SigningKeyFile In -> NewVerificationKeyFile -> ExceptT ByronClientCmdError IO () -runToVerification bKeyFormat skFp (NewVerificationKeyFile vkFp) = do - sk <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey bKeyFormat skFp - let ByronVerificationKey vK = byronWitnessToVerKey sk - let vKey = Builder.toLazyText $ Crypto.formatFullVerificationKey vK - firstExceptT ByronCmdHelpersError $ ensureNewFile TL.writeFile vkFp vKey - -runSubmitTx ::SocketPath -> NetworkId -> TxFile In -> ExceptT ByronClientCmdError IO () -runSubmitTx nodeSocketPath network fp = do - tx <- firstExceptT ByronCmdTxError $ readByronTx fp - - firstExceptT ByronCmdTxError $ - nodeSubmitTx nodeSocketPath network (normalByronTxToGenTx tx) - -runGetTxId :: TxFile In -> ExceptT ByronClientCmdError IO () -runGetTxId fp = firstExceptT ByronCmdTxError $ do - tx <- readByronTx fp - let txbody = getTxBody (ByronTx tx) - txid = getTxId txbody - liftIO $ BS.putStrLn $ serialiseToRawBytesHex txid - -runSpendGenesisUTxO - :: GenesisFile - -> NetworkId - -> ByronKeyFormat - -> NewTxFile - -> SigningKeyFile In - -> Address ByronAddr - -> [TxOut CtxTx ByronEra] - -> ExceptT ByronClientCmdError IO () -runSpendGenesisUTxO genesisFile nw bKeyFormat (NewTxFile ctTx) ctKey genRichAddr outs = do - genesis <- firstExceptT ByronCmdGenesisError $ readGenesis genesisFile nw - sk <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey bKeyFormat ctKey - - let tx = txSpendGenesisUTxOByronPBFT genesis nw sk genRichAddr outs - firstExceptT ByronCmdHelpersError . ensureNewFileLBS ctTx $ serialiseToCBOR tx - -runSpendUTxO - :: NetworkId - -> ByronKeyFormat - -> NewTxFile - -> SigningKeyFile In - -> [TxIn] - -> [TxOut CtxTx ByronEra] - -> ExceptT ByronClientCmdError IO () -runSpendUTxO nw bKeyFormat (NewTxFile ctTx) ctKey ins outs = do - sk <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey bKeyFormat ctKey - - let gTx = txSpendUTxOByronPBFT nw sk ins outs - firstExceptT ByronCmdHelpersError . ensureNewFileLBS ctTx $ serialiseToCBOR gTx diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs deleted file mode 100644 index 52a5369e081..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ /dev/null @@ -1,264 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralisedNewtypeDeriving #-} -{-# LANGUAGE NamedFieldPuns #-} - -module Cardano.CLI.Byron.Tx - ( ByronTxError(..) - , Tx - , TxFile - , NewTxFile(..) - , prettyAddress - , readByronTx - , normalByronTxToGenTx - , txSpendGenesisUTxOByronPBFT - , txSpendUTxOByronPBFT - , nodeSubmitTx - , renderByronTxError - - --TODO: remove when they are exported from the ledger - , fromCborTxAux - , toCborTxAux - - , ScriptValidity(..) - ) -where - -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (left) -import Data.Bifunctor (Bifunctor (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as LB -import qualified Data.List as List -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe, mapMaybe) -import Data.String (IsString) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import Formatting (sformat, (%)) - -import Cardano.Api -import Cardano.Api.Byron - -import qualified Cardano.Binary as Binary -import qualified Cardano.Ledger.Binary.Decoding as LedgerBinary - -import qualified Cardano.Chain.Common as Common -import Cardano.Chain.Genesis as Genesis -import qualified Cardano.Chain.UTxO as UTxO -import qualified Cardano.Crypto.Signing as Crypto - -import Cardano.CLI.Byron.Key (byronWitnessToVerKey) -import Cardano.CLI.Types (TxFile) - -import Ouroboros.Consensus.Byron.Ledger (ByronBlock, GenTx (..)) -import qualified Ouroboros.Consensus.Byron.Ledger as Byron -import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) -import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx - -data ByronTxError - = TxDeserialisationFailed !FilePath !Binary.DecoderError - | ByronTxSubmitError !Text - | ByronTxSubmitErrorEraMismatch !EraMismatch - deriving Show - -renderByronTxError :: ByronTxError -> Text -renderByronTxError err = - case err of - ByronTxSubmitError res -> "Error while submitting tx: " <> res - ByronTxSubmitErrorEraMismatch EraMismatch{ledgerEraName, otherEraName} -> - "The era of the node and the tx do not match. " <> - "The node is running in the " <> ledgerEraName <> - " era, but the transaction is for the " <> otherEraName <> " era." - TxDeserialisationFailed txFp decErr -> - "Transaction deserialisation failed at " <> textShow txFp <> " Error: " <> textShow decErr - -newtype NewTxFile = - NewTxFile FilePath - deriving (Eq, Ord, Show, IsString) - - --- | Pretty-print an address in its Base58 form, and also --- its full structure. -prettyAddress :: Address ByronAddr -> Text -prettyAddress (ByronAddress addr) = sformat - (Common.addressF % "\n" % Common.addressDetailedF) - addr addr - -readByronTx :: TxFile In -> ExceptT ByronTxError IO (UTxO.ATxAux ByteString) -readByronTx (File fp) = do - txBS <- liftIO $ LB.readFile fp - case fromCborTxAux txBS of - Left e -> left $ TxDeserialisationFailed fp e - Right tx -> pure tx - --- | The 'GenTx' is all the kinds of transactions that can be submitted --- and \"normal\" Byron transactions are just one of the kinds. -normalByronTxToGenTx :: UTxO.ATxAux ByteString -> GenTx ByronBlock -normalByronTxToGenTx tx' = Byron.ByronTx (Byron.byronIdTx tx') tx' - --- | Given a genesis, and a pair of a genesis public key and address, --- reconstruct a TxIn corresponding to the genesis UTxO entry. -genesisUTxOTxIn :: Genesis.Config -> Crypto.VerificationKey -> Common.Address -> UTxO.TxIn -genesisUTxOTxIn gc vk genAddr = - handleMissingAddr $ fst <$> Map.lookup genAddr initialUtxo - where - initialUtxo :: Map Common.Address (UTxO.TxIn, UTxO.TxOut) - initialUtxo = - Map.fromList - . mapMaybe (\(inp, out) -> mkEntry inp genAddr <$> keyMatchesUTxO vk out) - . fromCompactTxInTxOutList - . Map.toList - . UTxO.unUTxO - . UTxO.genesisUtxo - $ gc - where - mkEntry :: UTxO.TxIn - -> Common.Address - -> UTxO.TxOut - -> (Common.Address, (UTxO.TxIn, UTxO.TxOut)) - mkEntry inp addr out = (addr, (inp, out)) - - fromCompactTxInTxOutList :: [(UTxO.CompactTxIn, UTxO.CompactTxOut)] - -> [(UTxO.TxIn, UTxO.TxOut)] - fromCompactTxInTxOutList = - map (bimap UTxO.fromCompactTxIn UTxO.fromCompactTxOut) - - keyMatchesUTxO :: Crypto.VerificationKey -> UTxO.TxOut -> Maybe UTxO.TxOut - keyMatchesUTxO key out = - if Common.checkVerKeyAddress key (UTxO.txOutAddress out) - then Just out else Nothing - - handleMissingAddr :: Maybe UTxO.TxIn -> UTxO.TxIn - handleMissingAddr = fromMaybe . error - $ "\nGenesis UTxO has no address\n" - <> Text.unpack (prettyAddress (ByronAddress genAddr)) - <> "\n\nIt has the following, though:\n\n" - <> List.concatMap (Text.unpack . prettyAddress . ByronAddress) (Map.keys initialUtxo) - --- | Generate a transaction spending genesis UTxO at a given address, --- to given outputs, signed by the given key. -txSpendGenesisUTxOByronPBFT - :: Genesis.Config - -> NetworkId - -> SomeByronSigningKey - -> Address ByronAddr - -> [TxOut CtxTx ByronEra] - -> Tx ByronEra -txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do - let txBodyCont = - TxBodyContent - [ (fromByronTxIn txIn - , BuildTxWith (KeyWitness KeyWitnessForSpending)) - ] - TxInsCollateralNone - TxInsReferenceNone - outs - TxTotalCollateralNone - TxReturnCollateralNone - (TxFeeImplicit TxFeesImplicitInByronEra) - ( TxValidityNoLowerBound - , TxValidityNoUpperBound ValidityNoUpperBoundInByronEra - ) - TxMetadataNone - TxAuxScriptsNone - TxExtraKeyWitnessesNone - (BuildTxWith Nothing) - TxWithdrawalsNone - TxCertificatesNone - TxUpdateProposalNone - TxMintNone - TxScriptValidityNone - case createAndValidateTransactionBody txBodyCont of - Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err - Right txBody -> let bWit = fromByronWitness sk nId txBody - in makeSignedTransaction [bWit] txBody - where - ByronVerificationKey vKey = byronWitnessToVerKey sk - - txIn :: UTxO.TxIn - txIn = genesisUTxOTxIn gc vKey bAddr - --- | Generate a transaction from given Tx inputs to outputs, --- signed by the given key. -txSpendUTxOByronPBFT - :: NetworkId - -> SomeByronSigningKey - -> [TxIn] - -> [TxOut CtxTx ByronEra] - -> Tx ByronEra -txSpendUTxOByronPBFT nId sk txIns outs = do - let txBodyCont = TxBodyContent - [ ( txIn - , BuildTxWith (KeyWitness KeyWitnessForSpending) - ) | txIn <- txIns - ] - TxInsCollateralNone - TxInsReferenceNone - outs - TxTotalCollateralNone - TxReturnCollateralNone - (TxFeeImplicit TxFeesImplicitInByronEra) - ( TxValidityNoLowerBound - , TxValidityNoUpperBound ValidityNoUpperBoundInByronEra - ) - TxMetadataNone - TxAuxScriptsNone - TxExtraKeyWitnessesNone - (BuildTxWith Nothing) - TxWithdrawalsNone - TxCertificatesNone - TxUpdateProposalNone - TxMintNone - TxScriptValidityNone - case createAndValidateTransactionBody txBodyCont of - Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err - Right txBody -> let bWit = fromByronWitness sk nId txBody - in makeSignedTransaction [bWit] txBody - -fromByronWitness :: SomeByronSigningKey -> NetworkId -> TxBody ByronEra -> KeyWitness ByronEra -fromByronWitness bw nId txBody = - case bw of - AByronSigningKeyLegacy sk -> makeByronKeyWitness nId txBody sk - AByronSigningKey sk' -> makeByronKeyWitness nId txBody sk' - --- | Submit a transaction to a node specified by topology info. -nodeSubmitTx - :: SocketPath - -> NetworkId - -> GenTx ByronBlock - -> ExceptT ByronTxError IO () -nodeSubmitTx nodeSocketPath network gentx = do - let connctInfo = - LocalNodeConnectInfo { - localNodeSocketPath = nodeSocketPath, - localNodeNetworkId = network, - localConsensusModeParams = CardanoModeParams (EpochSlots 21600) - } - res <- liftIO $ submitTxToNodeLocal connctInfo (TxInByronSpecial gentx ByronEraInCardanoMode) - case res of - Net.Tx.SubmitSuccess -> liftIO $ Text.putStrLn "Transaction successfully submitted." - Net.Tx.SubmitFail reason -> - case reason of - TxValidationErrorInMode err _eraInMode -> left . ByronTxSubmitError . Text.pack $ show err - TxValidationEraMismatch mismatchErr -> left $ ByronTxSubmitErrorEraMismatch mismatchErr - - return () - - ---TODO: remove these local definitions when the updated ledger lib is available -fromCborTxAux :: LB.ByteString -> Either Binary.DecoderError (UTxO.ATxAux B.ByteString) -fromCborTxAux lbs = - annotationBytes lbs - <$> Binary.decodeFullDecoder "Cardano.Chain.UTxO.TxAux.fromCborTxAux" - Binary.fromCBOR lbs - where - annotationBytes :: Functor f => LB.ByteString -> f LedgerBinary.ByteSpan -> f B.ByteString - annotationBytes bytes = fmap (LB.toStrict . LedgerBinary.slice bytes) - -toCborTxAux :: UTxO.ATxAux ByteString -> LB.ByteString -toCborTxAux = LB.fromStrict . UTxO.aTaAnnotation -- The ByteString anotation is the CBOR encoded version. diff --git a/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs b/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs deleted file mode 100644 index 3b3ce3c448d..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} - -module Cardano.CLI.Byron.UpdateProposal - ( ByronUpdateProposalError(..) - , runProposalCreation - , readByronUpdateProposal - , renderByronUpdateProposalError - , submitByronUpdateProposal - ) where - -import Cardano.Prelude (ConvertText (..)) - -import Control.Exception (Exception (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither) -import Control.Tracer (stdoutTracer, traceWith) -import Data.Bifunctor (Bifunctor (..)) -import qualified Data.ByteString as BS -import Data.Text (Text) - -import Cardano.Chain.Update (InstallerHash (..), ProtocolVersion (..), - SoftwareVersion (..), SystemTag (..)) - -import Ouroboros.Consensus.Ledger.SupportsMempool (txId) -import Ouroboros.Consensus.Util.Condense (condense) - -import Cardano.Api (NetworkId, SerialiseAsRawBytes (..), SocketPath, textShow) -import Cardano.Api.Byron (AsType (AsByronUpdateProposal), ByronProtocolParametersUpdate, - ByronUpdateProposal, makeByronUpdateProposal, toByronLedgerUpdateProposal) - -import Cardano.CLI.Byron.Genesis (ByronGenesisError) -import Cardano.CLI.Byron.Key (ByronKeyFailure, readByronSigningKey) -import Cardano.CLI.Byron.Tx (ByronTxError, nodeSubmitTx) -import Cardano.CLI.Helpers (HelpersError, ensureNewFileLBS, renderHelpersError) -import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) -import Cardano.CLI.Types - -data ByronUpdateProposalError - = ByronReadUpdateProposalFileFailure !FilePath !Text - | ByronUpdateProposalWriteError !HelpersError - | ByronUpdateProposalGenesisReadError !FilePath !ByronGenesisError - | ByronUpdateProposalTxError !ByronTxError - | ReadSigningKeyFailure !FilePath !ByronKeyFailure - | UpdateProposalDecodingError !FilePath - deriving Show - -renderByronUpdateProposalError :: ByronUpdateProposalError -> Text -renderByronUpdateProposalError err = - case err of - ByronReadUpdateProposalFileFailure fp rErr -> - "Error reading update proposal at " <> textShow fp <> " Error: " <> textShow rErr - ByronUpdateProposalWriteError hErr -> - "Error writing update proposal: " <> renderHelpersError hErr - ByronUpdateProposalGenesisReadError fp rErr -> - "Error reading update proposal at: " <> textShow fp <> " Error: " <> textShow rErr - ByronUpdateProposalTxError txErr -> - "Error submitting update proposal: " <> textShow txErr - ReadSigningKeyFailure fp rErr -> - "Error reading signing key at: " <> textShow fp <> " Error: " <> textShow rErr - UpdateProposalDecodingError fp -> - "Error decoding update proposal at: " <> textShow fp - -runProposalCreation - :: NetworkId - -> SigningKeyFile In - -> ProtocolVersion - -> SoftwareVersion - -> SystemTag - -> InstallerHash - -> FilePath - -> ByronProtocolParametersUpdate - -> ExceptT ByronUpdateProposalError IO () -runProposalCreation nw sKey@(File sKeyfp) pVer sVer - sysTag insHash outputFp params = do - sK <- firstExceptT (ReadSigningKeyFailure sKeyfp) $ readByronSigningKey NonLegacyByronKeyFormat sKey - let proposal = makeByronUpdateProposal nw pVer sVer sysTag insHash sK params - firstExceptT ByronUpdateProposalWriteError $ - ensureNewFileLBS outputFp $ serialiseToRawBytes proposal - -readByronUpdateProposal :: FilePath -> ExceptT ByronUpdateProposalError IO ByronUpdateProposal -readByronUpdateProposal fp = do - proposalBs <- handleIOExceptT (ByronReadUpdateProposalFileFailure fp . toS . displayException) - $ BS.readFile fp - let proposalResult = deserialiseFromRawBytes AsByronUpdateProposal proposalBs - hoistEither $ first (const (UpdateProposalDecodingError fp)) proposalResult - -submitByronUpdateProposal - :: SocketPath - -> NetworkId - -> FilePath - -> ExceptT ByronUpdateProposalError IO () -submitByronUpdateProposal nodeSocketPath network proposalFp = do - proposal <- readByronUpdateProposal proposalFp - let genTx = toByronLedgerUpdateProposal proposal - traceWith stdoutTracer $ "Update proposal TxId: " ++ condense (txId genTx) - firstExceptT ByronUpdateProposalTxError $ nodeSubmitTx nodeSocketPath network genTx diff --git a/cardano-cli/src/Cardano/CLI/Byron/Vote.hs b/cardano-cli/src/Cardano/CLI/Byron/Vote.hs deleted file mode 100644 index 11294a83831..00000000000 --- a/cardano-cli/src/Cardano/CLI/Byron/Vote.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} - -module Cardano.CLI.Byron.Vote - ( ByronVoteError(..) - , readByronVote - , renderByronVoteError - , runVoteCreation - , submitByronVote - ) where - -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither) -import Control.Tracer (stdoutTracer, traceWith) -import qualified Data.ByteString as BS -import Data.Text (Text) -import qualified Data.Text as Text - -import qualified Cardano.Binary as Binary -import Cardano.CLI.Byron.UpdateProposal (ByronUpdateProposalError, - readByronUpdateProposal) -import Ouroboros.Consensus.Ledger.SupportsMempool (txId) -import Ouroboros.Consensus.Util.Condense (condense) - -import Cardano.Api.Byron - -import Cardano.CLI.Byron.Genesis (ByronGenesisError) -import Cardano.CLI.Byron.Key (ByronKeyFailure, readByronSigningKey) -import Cardano.CLI.Byron.Tx (ByronTxError, nodeSubmitTx) -import Cardano.CLI.Helpers (HelpersError, ensureNewFileLBS) -import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) -import Cardano.CLI.Types -import Control.Monad.IO.Class (MonadIO (..)) -import Data.Bifunctor (first) - - -data ByronVoteError - = ByronVoteDecodingError !FilePath - | ByronVoteGenesisReadError !ByronGenesisError - | ByronVoteKeyReadFailure !ByronKeyFailure - | ByronVoteReadFileFailure !FilePath !Text - | ByronVoteTxSubmissionError !ByronTxError - | ByronVoteUpdateProposalFailure !ByronUpdateProposalError - | ByronVoteUpdateProposalDecodingError !Binary.DecoderError - | ByronVoteUpdateHelperError !HelpersError - deriving Show - -renderByronVoteError :: ByronVoteError -> Text -renderByronVoteError bVerr = - case bVerr of - ByronVoteDecodingError fp -> "Error decoding Byron vote at " <> Text.pack fp - ByronVoteGenesisReadError genErr -> "Error reading the genesis file:" <> Text.pack (show genErr) - ByronVoteReadFileFailure fp err -> "Error reading Byron vote at " <> Text.pack fp <> " Error: " <> err - ByronVoteTxSubmissionError txErr -> "Error submitting the transaction: " <> Text.pack (show txErr) - ByronVoteUpdateProposalDecodingError err -> "Error decoding Byron update proposal: " <> Text.pack (show err) - ByronVoteUpdateProposalFailure err -> "Error reading the update proposal: " <> Text.pack (show err) - ByronVoteUpdateHelperError err ->"Error creating the vote: " <> Text.pack (show err) - ByronVoteKeyReadFailure err -> "Error reading the signing key: " <> Text.pack (show err) - - -runVoteCreation - :: NetworkId - -> SigningKeyFile In - -> FilePath - -> Bool - -> FilePath - -> ExceptT ByronVoteError IO () -runVoteCreation nw sKey upPropFp voteBool outputFp = do - sK <- firstExceptT ByronVoteKeyReadFailure $ readByronSigningKey NonLegacyByronKeyFormat sKey - proposal <- firstExceptT ByronVoteUpdateProposalFailure $ readByronUpdateProposal upPropFp - let vote = makeByronVote nw sK proposal voteBool - firstExceptT ByronVoteUpdateHelperError . ensureNewFileLBS outputFp - $ serialiseToRawBytes vote - -submitByronVote - :: SocketPath - -> NetworkId - -> FilePath - -> ExceptT ByronVoteError IO () -submitByronVote nodeSocketPath network voteFp = do - vote <- readByronVote voteFp - let genTx = toByronLedgertoByronVote vote - traceWith stdoutTracer ("Vote TxId: " ++ condense (txId genTx)) - firstExceptT ByronVoteTxSubmissionError $ nodeSubmitTx nodeSocketPath network genTx - -readByronVote :: FilePath -> ExceptT ByronVoteError IO ByronVote -readByronVote fp = do - voteBs <- liftIO $ BS.readFile fp - let voteResult = deserialiseFromRawBytes AsByronVote voteBs - hoistEither $ first (const (ByronVoteDecodingError fp)) voteResult diff --git a/cardano-cli/src/Cardano/CLI/Common/Parsers.hs b/cardano-cli/src/Cardano/CLI/Common/Parsers.hs deleted file mode 100644 index 544999a1090..00000000000 --- a/cardano-cli/src/Cardano/CLI/Common/Parsers.hs +++ /dev/null @@ -1,149 +0,0 @@ -module Cardano.CLI.Common.Parsers - ( command' - , pCardanoEra - , pNetworkId - , pConsensusModeParams - , pSocketPath - ) where - -import Cardano.Api (AnyCardanoEra (..), AnyConsensusModeParams (..), CardanoEra (..), - ConsensusModeParams (..), EpochSlots (..), File (..), NetworkId (..), - NetworkMagic (..), SocketPath, bounded) -import Cardano.CLI.Environment (EnvCli (..)) - -import Data.Foldable -import Data.Maybe (maybeToList) -import Data.Word (Word64) -import Options.Applicative -import qualified Options.Applicative as Opt - -pCardanoEra :: Parser AnyCardanoEra -pCardanoEra = asum - [ Opt.flag' (AnyCardanoEra ByronEra) - ( Opt.long "byron-era" - <> Opt.help "Specify the Byron era" - ) - , Opt.flag' (AnyCardanoEra ShelleyEra) - ( Opt.long "shelley-era" - <> Opt.help "Specify the Shelley era" - ) - , Opt.flag' (AnyCardanoEra AllegraEra) - ( Opt.long "allegra-era" - <> Opt.help "Specify the Allegra era" - ) - , Opt.flag' (AnyCardanoEra MaryEra) - ( Opt.long "mary-era" - <> Opt.help "Specify the Mary era" - ) - , Opt.flag' (AnyCardanoEra AlonzoEra) - ( Opt.long "alonzo-era" - <> Opt.help "Specify the Alonzo era" - ) - , Opt.flag' (AnyCardanoEra BabbageEra) - ( Opt.long "babbage-era" - <> Opt.help "Specify the Babbage era (default)" - ) - -- Default for now: - , pure (AnyCardanoEra BabbageEra) - ] -command' :: String -> String -> Parser a -> Mod CommandFields a -command' c descr p = - mconcat - [ command c (info (p <**> helper) $ mconcat [ progDesc descr ]) - , metavar c - ] - -pNetworkId :: EnvCli -> Parser NetworkId -pNetworkId envCli = asum $ mconcat - [ [ Opt.flag' Mainnet $ mconcat - [ Opt.long "mainnet" - , Opt.help $ mconcat - [ "Use the mainnet magic id. This overrides the CARDANO_NODE_NETWORK_ID " - , "environment variable" - ] - ] - , fmap (Testnet . NetworkMagic) $ Opt.option (bounded "TESTNET_MAGIC") $ mconcat - [ Opt.long "testnet-magic" - , Opt.metavar "NATURAL" - , Opt.help $ mconcat - [ "Specify a testnet magic id. This overrides the CARDANO_NODE_NETWORK_ID " - , "environment variable" - ] - ] - ] - , -- Default to the network id specified by the environment variable if it is available. - pure <$> maybeToList (envCliNetworkId envCli) - ] - -pConsensusModeParams :: Parser AnyConsensusModeParams -pConsensusModeParams = asum - [ pShelleyMode *> pShelleyConsensusMode - , pByronMode *> pByronConsensusMode - , pCardanoMode *> pCardanoConsensusMode - , pDefaultConsensusMode - ] - where - pShelleyMode :: Parser () - pShelleyMode = - Opt.flag' () $ mconcat - [ Opt.long "shelley-mode" - , Opt.help "For talking to a node running in Shelley-only mode." - ] - - pByronMode :: Parser () - pByronMode = - Opt.flag' () $ mconcat - [ Opt.long "byron-mode" - , Opt.help "For talking to a node running in Byron-only mode." - ] - - pCardanoMode :: Parser () - pCardanoMode = - Opt.flag' () $ mconcat - [ Opt.long "cardano-mode" - , Opt.help "For talking to a node running in full Cardano mode (default)." - ] - - pCardanoConsensusMode :: Parser AnyConsensusModeParams - pCardanoConsensusMode = AnyConsensusModeParams . CardanoModeParams <$> pEpochSlots - - pByronConsensusMode :: Parser AnyConsensusModeParams - pByronConsensusMode = AnyConsensusModeParams . ByronModeParams <$> pEpochSlots - - pShelleyConsensusMode :: Parser AnyConsensusModeParams - pShelleyConsensusMode = pure (AnyConsensusModeParams ShelleyModeParams) - - pDefaultConsensusMode :: Parser AnyConsensusModeParams - pDefaultConsensusMode = - pure . AnyConsensusModeParams . CardanoModeParams $ EpochSlots defaultByronEpochSlots - -defaultByronEpochSlots :: Word64 -defaultByronEpochSlots = 21600 - -pEpochSlots :: Parser EpochSlots -pEpochSlots = - fmap EpochSlots $ Opt.option (bounded "SLOTS") $ mconcat - [ Opt.long "epoch-slots" - , Opt.metavar "SLOTS" - , Opt.help "The number of slots per epoch for the Byron era." - , Opt.value defaultByronEpochSlots -- Default to the mainnet value. - , Opt.showDefault - ] - -pSocketPath :: EnvCli -> Parser SocketPath -pSocketPath envCli = - asum $ mconcat - [ [ fmap File $ Opt.strOption $ mconcat - [ Opt.long "socket-path" - , Opt.metavar "SOCKET_PATH" - , Opt.help $ mconcat - [ "Path to the node socket. This overrides the CARDANO_NODE_SOCKET_PATH " - , "environment variable. The argument is optional if CARDANO_NODE_SOCKET_PATH " - , "is defined and mandatory otherwise." - ] - , Opt.completer (Opt.bashCompleter "file") - ] - ] - , -- Default to the socket path specified by the environment variable if it is available. - pure . File <$> maybeToList (envCliSocketPath envCli) - ] diff --git a/cardano-cli/src/Cardano/CLI/Environment.hs b/cardano-cli/src/Cardano/CLI/Environment.hs deleted file mode 100644 index ef8416fa626..00000000000 --- a/cardano-cli/src/Cardano/CLI/Environment.hs +++ /dev/null @@ -1,57 +0,0 @@ -{-# LANGUAGE TypeApplications #-} - --- | This module defines constants derived from the environment. -module Cardano.CLI.Environment - ( EnvCli(..) - , getEnvCli - , getEnvNetworkId - , getEnvSocketPath - ) where - -import Cardano.Api (NetworkId (..), NetworkMagic (..)) - -import Data.Word (Word32) -import qualified System.Environment as IO -import qualified System.IO as IO -import Text.Read (readMaybe) - -data EnvCli = EnvCli - { envCliNetworkId :: Maybe NetworkId - , envCliSocketPath :: Maybe FilePath - } - -getEnvCli :: IO EnvCli -getEnvCli = do - mNetworkId <- getEnvNetworkId - mSocketPath <- getEnvSocketPath - - pure EnvCli - { envCliNetworkId = mNetworkId - , envCliSocketPath = mSocketPath - } - --- | If the environment variable @CARDANO_NODE_NETWORK_ID@ is set, then return the network id therein. --- Otherwise, return 'Nothing'. -getEnvNetworkId :: IO (Maybe NetworkId) -getEnvNetworkId = do - mNetworkIdString <- IO.lookupEnv "CARDANO_NODE_NETWORK_ID" - - case mNetworkIdString of - Nothing -> pure Nothing - Just networkIdString -> do - case networkIdString of - "mainnet" -> pure $ Just Mainnet - _ -> - case readMaybe @Word32 networkIdString of - Just networkId -> pure $ Just $ Testnet $ NetworkMagic networkId - Nothing -> do - IO.hPutStrLn IO.stderr $ mconcat - [ "The network id specified in CARDANO_NODE_NETWORK_ID invalid: " <> networkIdString - , " It should be either 'mainnet' or a number." - ] - pure Nothing - --- | If the environment variable @CARDANO_NODE_SOCKET_PATH@ is set, then return the set value. --- Otherwise, return 'Nothing'. -getEnvSocketPath :: IO (Maybe FilePath) -getEnvSocketPath = IO.lookupEnv "CARDANO_NODE_SOCKET_PATH" diff --git a/cardano-cli/src/Cardano/CLI/Helpers.hs b/cardano-cli/src/Cardano/CLI/Helpers.hs deleted file mode 100644 index 03414091f5b..00000000000 --- a/cardano-cli/src/Cardano/CLI/Helpers.hs +++ /dev/null @@ -1,140 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Helpers - ( HelpersError(..) - , printWarning - , deprecationWarning - , ensureNewFile - , ensureNewFileLBS - , pPrintCBOR - , readCBOR - , renderHelpersError - , validateCBOR - , hushM - ) where - -import Cardano.Prelude (ConvertText (..)) - -import Codec.CBOR.Pretty (prettyHexEnc) -import Codec.CBOR.Read (DeserialiseFailure, deserialiseFromBytes) -import Codec.CBOR.Term (decodeTerm, encodeTerm) -import Control.Exception (Exception (..), IOException) -import Control.Monad (unless, when) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (handleIOExceptT, left) -import Data.Bifunctor (Bifunctor (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LB -import Data.Functor (void) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import qualified System.Console.ANSI as ANSI -import System.Console.ANSI -import qualified System.Directory as IO -import qualified System.IO as IO - -import Cardano.Chain.Block (decCBORABlockOrBoundary) -import qualified Cardano.Chain.Delegation as Delegation -import qualified Cardano.Chain.Update as Update -import qualified Cardano.Chain.UTxO as UTxO -import Cardano.CLI.Types -import Cardano.Ledger.Binary (byronProtVer, toPlainDecoder) -import Cardano.Ledger.Binary.Plain (Decoder, fromCBOR) - -data HelpersError - = CBORPrettyPrintError !DeserialiseFailure - | CBORDecodingError !DeserialiseFailure - | IOError' !FilePath !IOException - | OutputMustNotAlreadyExist FilePath - | ReadCBORFileFailure !FilePath !Text - deriving Show - -renderHelpersError :: HelpersError -> Text -renderHelpersError err = - case err of - OutputMustNotAlreadyExist fp -> "Output file/directory must not already exist: " <> Text.pack fp - ReadCBORFileFailure fp err' -> "CBOR read failure at: " <> Text.pack fp <> Text.pack (show err') - CBORPrettyPrintError err' -> "Error with CBOR decoding: " <> Text.pack (show err') - CBORDecodingError err' -> "Error with CBOR decoding: " <> Text.pack (show err') - IOError' fp ioE -> "Error at: " <> Text.pack fp <> " Error: " <> Text.pack (show ioE) - -decodeCBOR - :: LB.ByteString - -> (forall s. Decoder s a) - -> Either HelpersError (LB.ByteString, a) -decodeCBOR bs decoder = - first CBORDecodingError $ deserialiseFromBytes decoder bs - -printWarning :: String -> IO () -printWarning warning = do - ANSI.hSetSGR IO.stderr [SetColor Foreground Vivid Yellow] - IO.hPutStrLn IO.stderr $ "WARNING: " <> warning - ANSI.hSetSGR IO.stderr [Reset] - -- We need to flush, or otherwise what's on stdout may have the wrong colour - -- since it's likely sharing a console with stderr - IO.hFlush IO.stderr - -deprecationWarning :: String -> IO () -deprecationWarning cmd = printWarning $ - "This CLI command is deprecated. Please use " <> cmd <> " command instead." - --- | Checks if a path exists and throws and error if it does. -ensureNewFile :: (FilePath -> a -> IO ()) -> FilePath -> a -> ExceptT HelpersError IO () -ensureNewFile writer outFile blob = do - exists <- liftIO $ IO.doesPathExist outFile - when exists $ - left $ OutputMustNotAlreadyExist outFile - liftIO $ writer outFile blob - -ensureNewFileLBS :: FilePath -> ByteString -> ExceptT HelpersError IO () -ensureNewFileLBS = ensureNewFile BS.writeFile - -pPrintCBOR :: LB.ByteString -> ExceptT HelpersError IO () -pPrintCBOR bs = do - case deserialiseFromBytes decodeTerm bs of - Left err -> left $ CBORPrettyPrintError err - Right (remaining, decodedVal) -> do - liftIO . Text.putStrLn . toS . prettyHexEnc $ encodeTerm decodedVal - unless (LB.null remaining) $ - pPrintCBOR remaining - -readCBOR :: FilePath -> ExceptT HelpersError IO LB.ByteString -readCBOR fp = - handleIOExceptT - (ReadCBORFileFailure fp . toS . displayException) - (LB.readFile fp) - -validateCBOR :: CBORObject -> LB.ByteString -> Either HelpersError Text -validateCBOR cborObject bs = - case cborObject of - CBORBlockByron epochSlots -> do - void $ decodeCBOR bs (toPlainDecoder byronProtVer (decCBORABlockOrBoundary epochSlots)) - Right "Valid Byron block." - - CBORDelegationCertificateByron -> do - void $ decodeCBOR bs (fromCBOR :: Decoder s Delegation.Certificate) - Right "Valid Byron delegation certificate." - - CBORTxByron -> do - void $ decodeCBOR bs (fromCBOR :: Decoder s UTxO.Tx) - Right "Valid Byron Tx." - - CBORUpdateProposalByron -> do - void $ decodeCBOR bs (fromCBOR :: Decoder s Update.Proposal) - Right "Valid Byron update proposal." - - CBORVoteByron -> do - void $ decodeCBOR bs (fromCBOR :: Decoder s Update.Vote) - Right "Valid Byron vote." - --- | Convert an Either to a Maybe and execute the supplied handler --- in the Left case. -hushM :: forall e m a. Monad m => Either e a -> (e -> m ()) -> m (Maybe a) -hushM r f = case r of - Right a -> return (Just a) - Left e -> f e >> return Nothing diff --git a/cardano-cli/src/Cardano/CLI/IO/Lazy.hs b/cardano-cli/src/Cardano/CLI/IO/Lazy.hs deleted file mode 100644 index 16f50c63307..00000000000 --- a/cardano-cli/src/Cardano/CLI/IO/Lazy.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.IO.Lazy - ( replicateM - , sequenceM - , traverseM - , traverseStateM - , forM - , forStateM - ) where - -import Control.Monad.IO.Unlift (MonadIO (liftIO), MonadUnliftIO, UnliftIO (unliftIO), - askUnliftIO) - -import qualified Data.List as L -import qualified System.IO.Unsafe as IO - -replicateM :: MonadUnliftIO m => Int -> m a -> m [a] -replicateM n f = sequenceM (L.replicate n f) - -sequenceM :: MonadUnliftIO m => [m a] -> m [a] -sequenceM as = do - f <- askUnliftIO - liftIO $ sequenceIO (L.map (unliftIO f) as) - --- | Traverses the function over the list and produces a lazy list in a --- monadic context. --- --- It is intended to be like the "standard" 'traverse' except --- that the list is generated lazily. -traverseM :: MonadUnliftIO m => (a -> m b) -> [a] -> m [b] -traverseM f as = do - u <- askUnliftIO - liftIO $ IO.unsafeInterleaveIO (go u as) - where - go _ [] = pure [] - go !u (v:vs) = do - !res <- unliftIO u (f v) - rest <- IO.unsafeInterleaveIO (go u vs) - pure (res:rest) - -traverseStateM :: forall m s a b. MonadUnliftIO m => s -> (s -> a -> m (s, b)) -> [a] -> m [b] -traverseStateM s f as = do - u <- askUnliftIO - liftIO $ IO.unsafeInterleaveIO (go s u as) - where - go :: s -> UnliftIO m -> [a] -> IO [b] - go _ _ [] = pure [] - go t !u (v:vs) = do - (t', !res) <- unliftIO u (f t v) - rest <- IO.unsafeInterleaveIO (go t' u vs) - pure (res:rest) - -forM :: MonadUnliftIO m => [a] -> (a -> m b) -> m [b] -forM = flip traverseM - -forStateM :: MonadUnliftIO m => s -> [a] -> (s -> a -> m (s, b)) -> m [b] -forStateM s as f = traverseStateM s f as - --- Internal -sequenceIO :: [IO a] -> IO [a] -sequenceIO = IO.unsafeInterleaveIO . go - where go :: [IO a] -> IO [a] - go [] = return [] - go (fa:fas) = (:) <$> fa <*> IO.unsafeInterleaveIO (go fas) diff --git a/cardano-cli/src/Cardano/CLI/Parsers.hs b/cardano-cli/src/Cardano/CLI/Parsers.hs deleted file mode 100644 index c2875a69b2f..00000000000 --- a/cardano-cli/src/Cardano/CLI/Parsers.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - -{- HLINT ignore "Monoid law, left identity" -} - -module Cardano.CLI.Parsers - ( opts - , pref - ) where - -import Cardano.CLI.Byron.Parsers (backwardsCompatibilityCommands, parseByronCommands) -import Cardano.CLI.Common.Parsers -import Cardano.CLI.Environment (EnvCli) -import Cardano.CLI.Ping (parsePingCmd) -import Cardano.CLI.Render (customRenderHelp) -import Cardano.CLI.Run (ClientCommand (..)) -import Cardano.CLI.Shelley.Parsers (parseShelleyCommands) - -import Data.Foldable -import Options.Applicative - -import qualified Options.Applicative as Opt - - -opts :: EnvCli -> ParserInfo ClientCommand -opts envCli = - Opt.info (parseClientCommand envCli <**> Opt.helper) $ mconcat - [ Opt.fullDesc - , Opt.header $ mconcat - [ "cardano-cli - General purpose command-line utility to interact with cardano-node." - , " Provides specific commands to manage keys, addresses, build & submit transactions," - , " certificates, etc." - ] - ] - -pref :: ParserPrefs -pref = Opt.prefs $ mconcat - [ showHelpOnEmpty - , helpHangUsageOverflow 10 - , helpRenderHelp customRenderHelp - ] - -parseClientCommand :: EnvCli -> Parser ClientCommand -parseClientCommand envCli = - asum - -- There are name clashes between Shelley commands and the Byron backwards - -- compat commands (e.g. "genesis"), and we need to prefer the Shelley ones - -- so we list it first. - [ parseShelley envCli - , parseByron envCli - , parsePing - , backwardsCompatibilityCommands envCli - , parseDisplayVersion (opts envCli) - ] - -parseByron :: EnvCli -> Parser ClientCommand -parseByron mNetworkId = - fmap ByronCommand $ - subparser $ mconcat - [ commandGroup "Byron specific commands" - , metavar "Byron specific commands" - , command' "byron" "Byron specific commands" $ parseByronCommands mNetworkId - ] - -parsePing :: Parser ClientCommand -parsePing = CliPingCommand <$> parsePingCmd - --- | Parse Shelley-related commands at the top level of the CLI. -parseShelley :: EnvCli -> Parser ClientCommand -parseShelley envCli = ShelleyCommand <$> parseShelleyCommands envCli - --- Yes! A --version flag or version command. Either guess is right! -parseDisplayVersion :: ParserInfo a -> Parser ClientCommand -parseDisplayVersion allParserInfo = - subparser - (mconcat - [ commandGroup "Miscellaneous commands" - , metavar "Miscellaneous commands" - , command' - "help" - "Show all help" - (pure (Help pref allParserInfo)) - , command' - "version" - "Show the cardano-cli version" - (pure DisplayVersion) - ] - ) - <|> flag' DisplayVersion - ( long "version" - <> help "Show the cardano-cli version" - <> hidden - ) diff --git a/cardano-cli/src/Cardano/CLI/Ping.hs b/cardano-cli/src/Cardano/CLI/Ping.hs deleted file mode 100644 index 562ec471762..00000000000 --- a/cardano-cli/src/Cardano/CLI/Ping.hs +++ /dev/null @@ -1,198 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeApplications #-} - -{- HLINT ignore "Move brackets to avoid $" -} - -module Cardano.CLI.Ping - ( PingCmd(..) - , PingClientCmdError(..) - , renderPingClientCmdError - , runPingCmd - , parsePingCmd - ) where - -import Control.Applicative ((<|>)) -import Control.Concurrent.Class.MonadSTM.Strict (StrictTMVar) -import qualified Control.Concurrent.Class.MonadSTM.Strict as STM -import Control.Exception (SomeException) -import Control.Monad (forM, unless) -import Control.Monad.Class.MonadAsync (MonadAsync (async, wait, waitCatch)) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (left) -import Control.Tracer (Tracer (..)) -import Data.List (foldl') -import qualified Data.List as L -import Data.Text (Text) -import qualified Data.Text as T -import Data.Word (Word32) -import Network.Socket (AddrInfo) -import qualified Network.Socket as Socket -import qualified Options.Applicative as Opt -import qualified Prettyprinter as PP -import qualified System.Exit as IO -import qualified System.IO as IO - -import qualified Cardano.Network.Ping as CNP - -newtype PingClientCmdError = PingClientCmdError [(AddrInfo, SomeException)] - -data EndPoint = HostEndPoint String | UnixSockEndPoint String deriving (Eq, Show) - -maybeHostEndPoint :: EndPoint -> Maybe String -maybeHostEndPoint = \case - HostEndPoint host -> Just host - UnixSockEndPoint _ -> Nothing - -maybeUnixSockEndPoint :: EndPoint -> Maybe String -maybeUnixSockEndPoint = \case - HostEndPoint _ -> Nothing - UnixSockEndPoint sock -> Just sock - -data PingCmd = PingCmd - { pingCmdCount :: !Word32 - , pingCmdEndPoint :: !EndPoint - , pingCmdPort :: !String - , pingCmdMagic :: !Word32 - , pingCmdJson :: !Bool - , pingCmdQuiet :: !Bool - } deriving (Eq, Show) - -pingClient :: Tracer IO CNP.LogMsg -> Tracer IO String -> PingCmd -> [CNP.NodeVersion] -> AddrInfo -> IO () -pingClient stdout stderr cmd = CNP.pingClient stdout stderr opts - where opts = CNP.PingOpts - { CNP.pingOptsQuiet = pingCmdQuiet cmd - , CNP.pingOptsJson = pingCmdJson cmd - , CNP.pingOptsCount = pingCmdCount cmd - , CNP.pingOptsHost = maybeHostEndPoint (pingCmdEndPoint cmd) - , CNP.pingOptsUnixSock = maybeUnixSockEndPoint (pingCmdEndPoint cmd) - , CNP.pingOptsPort = pingCmdPort cmd - , CNP.pingOptsMagic = pingCmdMagic cmd - } - -runPingCmd :: PingCmd -> ExceptT PingClientCmdError IO () -runPingCmd options = do - let hints = Socket.defaultHints { Socket.addrSocketType = Socket.Stream } - - msgQueue <- liftIO STM.newEmptyTMVarIO - - -- 'addresses' are all the endpoints to connect to and 'versions' are the node protocol versions - -- to ping with. - (addresses, versions) <- case pingCmdEndPoint options of - HostEndPoint host -> do - addrs <- liftIO $ Socket.getAddrInfo (Just hints) (Just host) (Just (pingCmdPort options)) - return (addrs, CNP.supportedNodeToNodeVersions $ pingCmdMagic options) - UnixSockEndPoint fname -> do - let addr = Socket.AddrInfo - [] Socket.AF_UNIX Socket.Stream - Socket.defaultProtocol (Socket.SockAddrUnix fname) Nothing - return ([addr], CNP.supportedNodeToClientVersions $ pingCmdMagic options) - - -- Logger async thread handle - laid <- liftIO . async $ CNP.logger msgQueue $ pingCmdJson options - -- Ping client thread handles - caids <- forM addresses $ liftIO . async . pingClient (Tracer $ doLog msgQueue) (Tracer doErrLog) options versions - res <- L.zip addresses <$> mapM (liftIO . waitCatch) caids - liftIO $ doLog msgQueue CNP.LogEnd - liftIO $ wait laid - - -- Collect errors 'es' from failed pings and 'addrs' from successful pings. - let (es, addrs) = foldl' partition ([],[]) res - - -- Report any errors - case (es, addrs) of - ([], _) -> liftIO IO.exitSuccess - (_, []) -> left $ PingClientCmdError es - (_, _) -> do - unless (pingCmdQuiet options) $ mapM_ (liftIO . IO.hPrint IO.stderr) es - liftIO IO.exitSuccess - - where - partition :: ([(AddrInfo, SomeException)], [AddrInfo]) - -> (AddrInfo, Either SomeException ()) - -> ([(AddrInfo, SomeException)], [AddrInfo]) - partition (es, as) (a, Left e) = ((a, e) : es, as) - partition (es, as) (a, Right _) = (es, a : as) - - doLog :: StrictTMVar IO CNP.LogMsg -> CNP.LogMsg -> IO () - doLog msgQueue msg = STM.atomically $ STM.putTMVar msgQueue msg - - doErrLog :: String -> IO () - doErrLog = IO.hPutStrLn IO.stderr - -renderPingClientCmdError :: PingClientCmdError -> Text -renderPingClientCmdError = \case - PingClientCmdError es -> T.intercalate "\n" $ T.pack . show <$> es - -parsePingCmd :: Opt.Parser PingCmd -parsePingCmd = Opt.hsubparser $ mconcat - [ Opt.metavar "ping" - , Opt.command "ping" $ Opt.info pPing $ Opt.progDescDoc $ Just $ mconcat - [ PP.pretty @String "Ping a cardano node either using node-to-node or node-to-client protocol. " - , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages." - ] - ] - -pHost :: Opt.Parser String -pHost = - Opt.strOption $ mconcat - [ Opt.long "host" - , Opt.short 'h' - , Opt.metavar "HOST" - , Opt.help "Hostname/IP, e.g. relay.iohk.example." - ] - -pUnixSocket :: Opt.Parser String -pUnixSocket = - Opt.strOption $ mconcat - [ Opt.long "unixsock" - , Opt.short 'u' - , Opt.metavar "SOCKET" - , Opt.help "Unix socket, e.g. file.socket." - ] - -pEndPoint :: Opt.Parser EndPoint -pEndPoint = fmap HostEndPoint pHost <|> fmap UnixSockEndPoint pUnixSocket - -pPing :: Opt.Parser PingCmd -pPing = PingCmd - <$> ( Opt.option Opt.auto $ mconcat - [ Opt.long "count" - , Opt.short 'c' - , Opt.metavar "COUNT" - , Opt.help $ mconcat - [ "Stop after sending count requests and receiving count responses. " - , "If this option is not specified, ping will operate until interrupted. " - ] - , Opt.value maxBound - ] - ) - <*> pEndPoint - <*> ( Opt.strOption $ mconcat - [ Opt.long "port" - , Opt.short 'p' - , Opt.metavar "PORT" - , Opt.help "Port number, e.g. 1234." - , Opt.value "3001" - ] - ) - <*> ( Opt.option Opt.auto $ mconcat - [ Opt.long "magic" - , Opt.short 'm' - , Opt.metavar "MAGIC" - , Opt.help "Network magic." - , Opt.value CNP.mainnetMagic - ] - ) - <*> ( Opt.switch $ mconcat - [ Opt.long "json" - , Opt.short 'j' - , Opt.help "JSON output flag." - ] - ) - <*> ( Opt.switch $ mconcat - [ Opt.long "quiet" - , Opt.short 'q' - , Opt.help "Quiet flag, CSV/JSON only output" - ] - ) diff --git a/cardano-cli/src/Cardano/CLI/Pretty.hs b/cardano-cli/src/Cardano/CLI/Pretty.hs deleted file mode 100644 index e0a064d5296..00000000000 --- a/cardano-cli/src/Cardano/CLI/Pretty.hs +++ /dev/null @@ -1,72 +0,0 @@ -module Cardano.CLI.Pretty - ( Ann, - putLn, - hPutLn, - renderDefault, - renderStringDefault, - - black, - red, - green, - yellow, - blue, - magenta, - cyan, - white, - ) where - -import Control.Exception (bracket_) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Prettyprinter -import Prettyprinter.Render.Terminal - -import qualified Control.Concurrent.QSem as IO -import qualified Data.Text.Lazy as TextLazy -import qualified Data.Text.Lazy.IO as TextLazy -import qualified System.IO as IO -import qualified System.IO.Unsafe as IO - -type Ann = AnsiStyle - -sem :: IO.QSem -sem = IO.unsafePerformIO $ IO.newQSem 1 -{-# NOINLINE sem #-} - -consoleBracket :: IO a -> IO a -consoleBracket = bracket_ (IO.waitQSem sem) (IO.signalQSem sem) - -putLn :: MonadIO m => Doc AnsiStyle -> m () -putLn = liftIO . consoleBracket . TextLazy.putStrLn . renderDefault - -hPutLn :: MonadIO m => IO.Handle -> Doc AnsiStyle -> m () -hPutLn h = liftIO . consoleBracket . TextLazy.hPutStr h . renderDefault - -renderStringDefault :: Doc AnsiStyle -> String -renderStringDefault = TextLazy.unpack . renderDefault - -renderDefault :: Doc AnsiStyle -> TextLazy.Text -renderDefault = renderLazy . layoutPretty defaultLayoutOptions - -black :: Doc AnsiStyle -> Doc AnsiStyle -black = annotate (color Black) - -red :: Doc AnsiStyle -> Doc AnsiStyle -red = annotate (color Red) - -green :: Doc AnsiStyle -> Doc AnsiStyle -green = annotate (color Green) - -yellow :: Doc AnsiStyle -> Doc AnsiStyle -yellow = annotate (color Yellow) - -blue :: Doc AnsiStyle -> Doc AnsiStyle -blue = annotate (color Blue) - -magenta :: Doc AnsiStyle -> Doc AnsiStyle -magenta = annotate (color Magenta) - -cyan :: Doc AnsiStyle -> Doc AnsiStyle -cyan = annotate (color Cyan) - -white :: Doc AnsiStyle -> Doc AnsiStyle -white = annotate (color White) diff --git a/cardano-cli/src/Cardano/CLI/Render.hs b/cardano-cli/src/Cardano/CLI/Render.hs deleted file mode 100644 index 7d6b8b339ee..00000000000 --- a/cardano-cli/src/Cardano/CLI/Render.hs +++ /dev/null @@ -1,61 +0,0 @@ -{- HLINT ignore "Redundant id" -} - -module Cardano.CLI.Render - ( customRenderHelp - ) where - -import Data.Text (Text) -import Options.Applicative -import Options.Applicative.Help.Ann -import Options.Applicative.Help.Types (helpText, renderHelp) -import Prettyprinter -import Prettyprinter.Render.Util.SimpleDocTree - -import qualified Data.Text as T -import qualified System.Environment as IO -import qualified System.IO.Unsafe as IO - -import Cardano.Api (textShow) - -cliHelpTraceEnabled :: Bool -cliHelpTraceEnabled = IO.unsafePerformIO $ do - mValue <- IO.lookupEnv "CLI_HELP_TRACE" - return $ mValue == Just "1" -{-# NOINLINE cliHelpTraceEnabled #-} - --- | Convert a help text to 'String'. When the CLI_HELP_TRACE environment variable is set --- to '1', the output will be in HTML so that it can be viewed in a browser where developer --- tools can be used to inspect tracing that aids in describing the structure of the output --- document. -customRenderHelp :: Int -> ParserHelp -> String -customRenderHelp = if cliHelpTraceEnabled - then customRenderHelpAsHtml - else customRenderHelpAsAnsi - -customRenderHelpAsHtml :: Int -> ParserHelp -> String -customRenderHelpAsHtml cols - = T.unpack - . wrapper - . renderSimplyDecorated id renderElement - . treeForm - . layoutSmart (LayoutOptions (AvailablePerLine cols 1.0)) - . helpText - where - renderElement :: Ann -> Text -> Text - renderElement ann x = if cliHelpTraceEnabled - then case ann of - AnnTrace _ name -> "" <> x <> "" - AnnStyle _ -> x - else x - wrapper = if cliHelpTraceEnabled - then id - . ("\n" <>) - . ("\n" <>) - . ("
\n" <>)
-        . (<> "\n")
-        . (<> "\n")
-        . (<> "\n
") - else id - -customRenderHelpAsAnsi :: Int -> ParserHelp -> String -customRenderHelpAsAnsi = renderHelp diff --git a/cardano-cli/src/Cardano/CLI/Run.hs b/cardano-cli/src/Cardano/CLI/Run.hs deleted file mode 100644 index 748c88f43e5..00000000000 --- a/cardano-cli/src/Cardano/CLI/Run.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE GADTs #-} - --- | Dispatch for running all the CLI commands -module Cardano.CLI.Run - ( ClientCommand(..) - , ClientCommandErrors - , renderClientCommandError - , runClientCommand - ) where - -import Control.Monad (forM_) -import Control.Monad.IO.Unlift (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT) -import qualified Data.List as L -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import qualified System.IO as IO - -import Cardano.CLI.Byron.Commands (ByronCommand) -import Cardano.CLI.Byron.Run (ByronClientCmdError, renderByronClientCmdError, - runByronClientCommand) -import Cardano.CLI.Ping (PingCmd (..), PingClientCmdError (..), renderPingClientCmdError, runPingCmd) -import Cardano.CLI.Shelley.Commands (ShelleyCommand) -import Cardano.CLI.Shelley.Run (ShelleyClientCmdError, renderShelleyClientCmdError, - runShelleyClientCommand) - -import Cardano.CLI.Render (customRenderHelp) - -import Cardano.Git.Rev (gitRev) -import Data.Version (showVersion) -import Options.Applicative.Help.Core -import Options.Applicative.Types (OptReader (..), Option (..), Parser (..), - ParserInfo (..), ParserPrefs (..)) -import Paths_cardano_cli (version) -import System.Info (arch, compilerName, compilerVersion, os) - --- | Sub-commands of 'cardano-cli'. -data ClientCommand = - - -- | Byron Related Commands - ByronCommand ByronCommand - - -- | Shelley Related Commands - | ShelleyCommand ShelleyCommand - - -- | Shelley-related commands that have been parsed under the - -- now-deprecated \"shelley\" subcommand. - | DeprecatedShelleySubcommand ShelleyCommand - - | CliPingCommand PingCmd - - | forall a. Help ParserPrefs (ParserInfo a) - | DisplayVersion - -data ClientCommandErrors - = ByronClientError ByronClientCmdError - | ShelleyClientError ShelleyCommand ShelleyClientCmdError - | PingClientError PingClientCmdError - -runClientCommand :: ClientCommand -> ExceptT ClientCommandErrors IO () -runClientCommand (ByronCommand c) = firstExceptT ByronClientError $ runByronClientCommand c -runClientCommand (ShelleyCommand c) = firstExceptT (ShelleyClientError c) $ runShelleyClientCommand c -runClientCommand (CliPingCommand c) = firstExceptT PingClientError $ runPingCmd c -runClientCommand (DeprecatedShelleySubcommand c) = - firstExceptT (ShelleyClientError c) - $ runShelleyClientCommandWithDeprecationWarning - $ runShelleyClientCommand c -runClientCommand (Help pprefs allParserInfo) = runHelp pprefs allParserInfo -runClientCommand DisplayVersion = runDisplayVersion - -renderClientCommandError :: ClientCommandErrors -> Text -renderClientCommandError (ByronClientError err) = - renderByronClientCmdError err -renderClientCommandError (ShelleyClientError cmd err) = - renderShelleyClientCmdError cmd err -renderClientCommandError (PingClientError err) = - renderPingClientCmdError err - --- | Combine an 'ExceptT' that will write a warning message to @stderr@ with --- the provided 'ExceptT'. -ioExceptTWithWarning :: MonadIO m => Text -> ExceptT e m () -> ExceptT e m () -ioExceptTWithWarning warningMsg e = - liftIO (Text.hPutStrLn IO.stderr warningMsg) >> e - --- | Used in the event that Shelley-related commands are run using the --- now-deprecated \"shelley\" subcommand. -runShelleyClientCommandWithDeprecationWarning - :: MonadIO m - => ExceptT e m () - -> ExceptT e m () -runShelleyClientCommandWithDeprecationWarning = - ioExceptTWithWarning warningMsg - where - warningMsg :: Text - warningMsg = - "WARNING: The \"shelley\" subcommand is now deprecated and will be " - <> "removed in the future. Please use the top-level commands instead." - -runDisplayVersion :: ExceptT ClientCommandErrors IO () -runDisplayVersion = do - liftIO . Text.putStrLn $ mconcat - [ "cardano-cli ", renderVersion version - , " - ", Text.pack os, "-", Text.pack arch - , " - ", Text.pack compilerName, "-", renderVersion compilerVersion - , "\ngit rev ", gitRev - ] - where - renderVersion = Text.pack . showVersion - - -helpAll :: ParserPrefs -> String -> [String] -> ParserInfo a -> IO () -helpAll pprefs progn rnames parserInfo = do - IO.putStrLn $ customRenderHelp 80 (usage_help parserInfo) - IO.putStrLn "" - go (infoParser parserInfo) - where go :: Parser a -> IO () - go p = case p of - NilP _ -> return () - OptP optP -> case optMain optP of - CmdReader _ cs f -> do - forM_ cs $ \c -> - forM_ (f c) $ \subParserInfo -> - helpAll pprefs progn (c:rnames) subParserInfo - _ -> return () - AltP pa pb -> go pa >> go pb - MultP pf px -> go pf >> go px - BindP pa _ -> go pa - usage_help i = - mconcat - [ usageHelp (pure . parserUsage pprefs (infoParser i) . L.unwords $ progn : reverse rnames) - , descriptionHelp (infoProgDesc i) - ] - -runHelp :: ParserPrefs -> ParserInfo a -> ExceptT ClientCommandErrors IO () -runHelp pprefs allParserInfo = liftIO $ helpAll pprefs "cardano-cli" [] allParserInfo diff --git a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs deleted file mode 100644 index 70c02f8353a..00000000000 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ /dev/null @@ -1,488 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- | User-friendly pretty-printing for textual user interfaces (TUI) -module Cardano.CLI.Run.Friendly (friendlyTxBS, friendlyTxBodyBS) where - -import Data.Aeson (Value (..), object, toJSON, (.=)) -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Key as Aeson -import qualified Data.Aeson.Types as Aeson -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as BSC -import Data.Char (isAscii) -import Data.Function ((&)) -import Data.Functor ((<&>)) -import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, isJust) -import Data.Ratio (numerator) -import qualified Data.Text as Text -import Data.Yaml (array) -import Data.Yaml.Pretty (setConfCompare) -import qualified Data.Yaml.Pretty as Yaml -import GHC.Real (denominator) -import GHC.Unicode (isAlphaNum) - -import Cardano.Api as Api -import Cardano.Api.Byron (KeyWitness (ByronKeyWitness)) -import Cardano.Api.Shelley (Address (ShelleyAddress), - KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..), - StakeCredential (..), StakePoolParameters (..), fromShelleyPaymentCredential, - fromShelleyStakeCredential, fromShelleyStakeReference) -import qualified Cardano.Ledger.Shelley.API as Shelley - -yamlConfig :: Yaml.Config -yamlConfig = Yaml.defConfig & setConfCompare compare - -friendlyTxBS :: IsCardanoEra era => CardanoEra era -> Tx era -> ByteString -friendlyTxBS era = Yaml.encodePretty yamlConfig . object . friendlyTx era - -friendlyTx :: IsCardanoEra era => CardanoEra era -> Tx era -> [Aeson.Pair] -friendlyTx era (Tx body witnesses) = - ("witnesses" .= map friendlyKeyWitness witnesses) : friendlyTxBody era body - -friendlyKeyWitness :: KeyWitness era -> Aeson.Value -friendlyKeyWitness = - object - . \case - ByronKeyWitness txInWitness -> ["Byron witness" .= textShow txInWitness] - ShelleyBootstrapWitness _era bootstrapWitness -> - ["bootstrap witness" .= textShow bootstrapWitness] - ShelleyKeyWitness _era (Shelley.WitVKey key signature) -> - ["key" .= textShow key, "signature" .= textShow signature] - -friendlyTxBodyBS - :: IsCardanoEra era => CardanoEra era -> TxBody era -> ByteString -friendlyTxBodyBS era = - Yaml.encodePretty yamlConfig . object . friendlyTxBody era - -friendlyTxBody - :: IsCardanoEra era => CardanoEra era -> TxBody era -> [Aeson.Pair] -friendlyTxBody - era - (TxBody - TxBodyContent - { txAuxScripts - , txCertificates - , txExtraKeyWits - , txFee - , txIns - , txInsCollateral - , txMetadata - , txMintValue - , txOuts - , txTotalCollateral - , txReturnCollateral - , txInsReference - , txUpdateProposal - , txValidityRange - , txWithdrawals - }) = - [ "auxiliary scripts" .= friendlyAuxScripts txAuxScripts - , "certificates" .= friendlyCertificates txCertificates - , "collateral inputs" .= friendlyCollateralInputs txInsCollateral - , "era" .= era - , "fee" .= friendlyFee txFee - , "inputs" .= friendlyInputs txIns - , "metadata" .= friendlyMetadata txMetadata - , "mint" .= friendlyMintValue txMintValue - , "outputs" .= map friendlyTxOut txOuts - , "reference inputs" .= friendlyReferenceInputs txInsReference - , "total collateral" .= friendlyTotalCollateral txTotalCollateral - , "return collateral" .= friendlyReturnCollateral txReturnCollateral - , "required signers (payment key hashes needed for scripts)" .= - friendlyExtraKeyWits txExtraKeyWits - , "update proposal" .= friendlyUpdateProposal txUpdateProposal - , "validity range" .= friendlyValidityRange era txValidityRange - , "withdrawals" .= friendlyWithdrawals txWithdrawals - ] - -friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value -friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null -friendlyTotalCollateral (TxTotalCollateral _ coll) = toJSON coll - -friendlyReturnCollateral - :: IsCardanoEra era => TxReturnCollateral CtxTx era -> Aeson.Value -friendlyReturnCollateral TxReturnCollateralNone = Aeson.Null -friendlyReturnCollateral (TxReturnCollateral _ collOut) = friendlyTxOut collOut - -friendlyExtraKeyWits :: TxExtraKeyWitnesses era -> Aeson.Value -friendlyExtraKeyWits = \case - TxExtraKeyWitnessesNone -> Null - TxExtraKeyWitnesses _supported paymentKeyHashes -> - toJSON $ map serialiseToRawBytesHexText paymentKeyHashes - --- | Special case of validity range: --- in Shelley, upper bound is TTL, and no lower bound -pattern ShelleyTtl - :: SlotNo -> (TxValidityLowerBound era, TxValidityUpperBound era) -pattern ShelleyTtl ttl <- - ( TxValidityNoLowerBound - , TxValidityUpperBound ValidityUpperBoundInShelleyEra ttl - ) - -friendlyValidityRange - :: CardanoEra era - -> (TxValidityLowerBound era, TxValidityUpperBound era) - -> Aeson.Value -friendlyValidityRange era = \case - ShelleyTtl ttl -> object ["time to live" .= ttl] - (lowerBound, upperBound) - | isLowerBoundSupported || isUpperBoundSupported -> - object - [ "lower bound" .= - case lowerBound of - TxValidityNoLowerBound -> Null - TxValidityLowerBound _ s -> toJSON s - , "upper bound" .= - case upperBound of - TxValidityNoUpperBound _ -> Null - TxValidityUpperBound _ s -> toJSON s - ] - | otherwise -> Null - where - isLowerBoundSupported = isJust $ validityLowerBoundSupportedInEra era - isUpperBoundSupported = isJust $ validityUpperBoundSupportedInEra era - -friendlyWithdrawals :: TxWithdrawals ViewTx era -> Aeson.Value -friendlyWithdrawals TxWithdrawalsNone = Null -friendlyWithdrawals (TxWithdrawals _ withdrawals) = - array - [ object $ - "address" .= serialiseAddress addr : - "amount" .= friendlyLovelace amount : - friendlyStakeAddress addr - | (addr, amount, _) <- withdrawals - ] - -friendlyStakeAddress :: StakeAddress -> [Aeson.Pair] -friendlyStakeAddress (StakeAddress net cred) = - [ "network" .= net - , friendlyStakeCredential $ fromShelleyStakeCredential cred - ] - -friendlyTxOut :: IsCardanoEra era => TxOut CtxTx era -> Aeson.Value -friendlyTxOut (TxOut addr amount mdatum script) = - object $ - case addr of - AddressInEra ByronAddressInAnyEra byronAdr -> - [ "address era" .= String "Byron" - , "address" .= serialiseAddress byronAdr - , "amount" .= friendlyTxOutValue amount - ] - AddressInEra (ShelleyAddressInEra sbe) saddr@(ShelleyAddress net cred stake) -> - let preAlonzo = - friendlyPaymentCredential (fromShelleyPaymentCredential cred) : - [ "address era" .= Aeson.String "Shelley" - , "network" .= net - , "address" .= serialiseAddress saddr - , "amount" .= friendlyTxOutValue amount - , "stake reference" .= - friendlyStakeReference (fromShelleyStakeReference stake) - ] - datum = - [ "datum" .= renderDatum mdatum - | isJust $ scriptDataSupportedInEra $ shelleyBasedToCardanoEra sbe - ] - sinceAlonzo = ["reference script" .= script] - in preAlonzo ++ datum ++ sinceAlonzo - where - renderDatum :: TxOutDatum CtxTx era -> Aeson.Value - renderDatum TxOutDatumNone = Aeson.Null - renderDatum (TxOutDatumHash _ h) = - Aeson.String $ serialiseToRawBytesHexText h - renderDatum (TxOutDatumInTx _ sData) = - scriptDataToJson ScriptDataJsonDetailedSchema sData - renderDatum (TxOutDatumInline _ sData) = - scriptDataToJson ScriptDataJsonDetailedSchema sData - - -friendlyStakeReference :: StakeAddressReference -> Aeson.Value -friendlyStakeReference = \case - NoStakeAddress -> Null - StakeAddressByPointer ptr -> String (textShow ptr) - StakeAddressByValue cred -> object [friendlyStakeCredential cred] - -friendlyUpdateProposal :: TxUpdateProposal era -> Aeson.Value -friendlyUpdateProposal = \case - TxUpdateProposalNone -> Null - TxUpdateProposal _ (UpdateProposal parameterUpdates epoch) -> - object - [ "epoch" .= epoch - , "updates" .= - [ object - [ "genesis key hash" .= serialiseToRawBytesHexText genesisKeyHash - , "update" .= friendlyProtocolParametersUpdate parameterUpdate - ] - | (genesisKeyHash, parameterUpdate) <- Map.assocs parameterUpdates - ] - ] - -friendlyProtocolParametersUpdate :: ProtocolParametersUpdate -> Aeson.Value -friendlyProtocolParametersUpdate - ProtocolParametersUpdate - { protocolUpdateProtocolVersion - , protocolUpdateDecentralization - , protocolUpdateExtraPraosEntropy - , protocolUpdateMaxBlockHeaderSize - , protocolUpdateMaxBlockBodySize - , protocolUpdateMaxTxSize - , protocolUpdateTxFeeFixed - , protocolUpdateTxFeePerByte - , protocolUpdateMinUTxOValue - , protocolUpdateStakeAddressDeposit - , protocolUpdateStakePoolDeposit - , protocolUpdateMinPoolCost - , protocolUpdatePoolRetireMaxEpoch - , protocolUpdateStakePoolTargetNum - , protocolUpdatePoolPledgeInfluence - , protocolUpdateMonetaryExpansion - , protocolUpdateTreasuryCut - , protocolUpdateUTxOCostPerWord - , protocolUpdateCollateralPercent - , protocolUpdateMaxBlockExUnits - , protocolUpdateMaxCollateralInputs - , protocolUpdateMaxTxExUnits - , protocolUpdateMaxValueSize - , protocolUpdatePrices - , protocolUpdateUTxOCostPerByte - } = - object . catMaybes $ - [ protocolUpdateProtocolVersion <&> \(major, minor) -> - "protocol version" .= (textShow major <> "." <> textShow minor) - , protocolUpdateDecentralization <&> - ("decentralization parameter" .=) . friendlyRational - , protocolUpdateExtraPraosEntropy <&> - ("extra entropy" .=) . maybe "reset" toJSON - , protocolUpdateMaxBlockHeaderSize <&> ("max block header size" .=) - , protocolUpdateMaxBlockBodySize<&> ("max block body size" .=) - , protocolUpdateMaxTxSize <&> ("max transaction size" .=) - , protocolUpdateTxFeeFixed <&> ("transaction fee constant" .=) - , protocolUpdateTxFeePerByte <&> ("transaction fee linear per byte" .=) - , protocolUpdateMinUTxOValue <&> ("min UTxO value" .=) . friendlyLovelace - , protocolUpdateStakeAddressDeposit <&> - ("key registration deposit" .=) . friendlyLovelace - , protocolUpdateStakePoolDeposit <&> - ("pool registration deposit" .=) . friendlyLovelace - , protocolUpdateMinPoolCost <&> ("min pool cost" .=) . friendlyLovelace - , protocolUpdatePoolRetireMaxEpoch <&> ("pool retirement epoch boundary" .=) - , protocolUpdateStakePoolTargetNum <&> ("number of pools" .=) - , protocolUpdatePoolPledgeInfluence <&> - ("pool influence" .=) . friendlyRational - , protocolUpdateMonetaryExpansion <&> - ("monetary expansion" .=) . friendlyRational - , protocolUpdateTreasuryCut <&> ("treasury expansion" .=) . friendlyRational - , protocolUpdateUTxOCostPerWord <&> - ("UTxO storage cost per word" .=) . friendlyLovelace - , protocolUpdateCollateralPercent <&> - ("collateral inputs share" .=) . (<> "%") . textShow - , protocolUpdateMaxBlockExUnits <&> ("max block execution units" .=) - , protocolUpdateMaxCollateralInputs <&> ("max collateral inputs" .=) - , protocolUpdateMaxTxExUnits <&> ("max transaction execution units" .=) - , protocolUpdateMaxValueSize <&> ("max value size" .=) - , protocolUpdatePrices <&> ("execution prices" .=) . friendlyPrices - , protocolUpdateUTxOCostPerByte <&> - ("UTxO storage cost per byte" .=) . friendlyLovelace - ] - -friendlyPrices :: ExecutionUnitPrices -> Aeson.Value -friendlyPrices ExecutionUnitPrices{priceExecutionMemory, priceExecutionSteps} = - object - [ "memory" .= friendlyRational priceExecutionMemory - , "steps" .= friendlyRational priceExecutionSteps - ] - -friendlyCertificates :: TxCertificates ViewTx era -> Aeson.Value -friendlyCertificates = \case - TxCertificatesNone -> Null - TxCertificates _ cs _ -> array $ map friendlyCertificate cs - -friendlyCertificate :: Certificate -> Aeson.Value -friendlyCertificate = - object - . (: []) - . \case - -- Stake address certificates - StakeAddressRegistrationCertificate credential -> - "stake address registration" - .= object [friendlyStakeCredential credential] - StakeAddressDeregistrationCertificate credential -> - "stake address deregistration" - .= object [friendlyStakeCredential credential] - StakeAddressPoolDelegationCertificate credential poolId -> - "stake address delegation" - .= object [friendlyStakeCredential credential, "pool" .= poolId] - - -- Stake pool certificates - StakePoolRegistrationCertificate parameters -> - "stake pool registration" .= friendlyStakePoolParameters parameters - StakePoolRetirementCertificate poolId epochNo -> - "stake pool retirement" .= object ["pool" .= poolId, "epoch" .= epochNo] - - -- Special certificates - GenesisKeyDelegationCertificate - genesisKeyHash - delegateKeyHash - vrfKeyHash -> - "genesis key delegation" - .= object - [ "genesis key hash" - .= serialiseToRawBytesHexText genesisKeyHash, - "delegate key hash" - .= serialiseToRawBytesHexText delegateKeyHash, - "VRF key hash" .= serialiseToRawBytesHexText vrfKeyHash - ] - MIRCertificate pot target -> - "MIR" .= object ["pot" .= friendlyMirPot pot, friendlyMirTarget target] - -friendlyMirTarget :: MIRTarget -> Aeson.Pair -friendlyMirTarget = \case - StakeAddressesMIR addresses -> - "target stake addresses" .= - [ object - [ friendlyStakeCredential credential - , "amount" .= friendlyLovelace lovelace - ] - | (credential, lovelace) <- addresses - ] - SendToReservesMIR amount -> "send to reserves" .= friendlyLovelace amount - SendToTreasuryMIR amount -> "send to treasury" .= friendlyLovelace amount - -friendlyStakeCredential :: StakeCredential -> Aeson.Pair -friendlyStakeCredential = \case - StakeCredentialByKey keyHash -> - "stake credential key hash" .= serialiseToRawBytesHexText keyHash - StakeCredentialByScript scriptHash -> - "stake credential script hash" .= serialiseToRawBytesHexText scriptHash - -friendlyPaymentCredential :: PaymentCredential -> Aeson.Pair -friendlyPaymentCredential = \case - PaymentCredentialByKey keyHash -> - "payment credential key hash" .= serialiseToRawBytesHexText keyHash - PaymentCredentialByScript scriptHash -> - "payment credential script hash" .= serialiseToRawBytesHexText scriptHash - -friendlyMirPot :: Shelley.MIRPot -> Aeson.Value -friendlyMirPot = \case - Shelley.ReservesMIR -> "reserves" - Shelley.TreasuryMIR -> "treasury" - -friendlyStakePoolParameters :: StakePoolParameters -> Aeson.Value -friendlyStakePoolParameters - StakePoolParameters - { stakePoolId - , stakePoolVRF - , stakePoolCost - , stakePoolMargin - , stakePoolRewardAccount - , stakePoolPledge - , stakePoolOwners - , stakePoolRelays - , stakePoolMetadata - } = - object - [ "pool" .= stakePoolId - , "VRF key hash" .= serialiseToRawBytesHexText stakePoolVRF - , "cost" .= friendlyLovelace stakePoolCost - , "margin" .= friendlyRational stakePoolMargin - , "reward account" .= object (friendlyStakeAddress stakePoolRewardAccount) - , "pledge" .= friendlyLovelace stakePoolPledge - , "owners (stake key hashes)" - .= map serialiseToRawBytesHexText stakePoolOwners - , "relays" .= map textShow stakePoolRelays - , "metadata" .= fmap textShow stakePoolMetadata - ] - -friendlyRational :: Rational -> Aeson.Value -friendlyRational r = - String $ - case d of - 1 -> textShow n - _ -> textShow n <> "/" <> textShow d - where - n = numerator r - d = denominator r - -friendlyFee :: TxFee era -> Aeson.Value -friendlyFee = \case - TxFeeImplicit _ -> "implicit" - TxFeeExplicit _ fee -> friendlyLovelace fee - -friendlyLovelace :: Lovelace -> Aeson.Value -friendlyLovelace (Lovelace value) = String $ textShow value <> " Lovelace" - -friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value -friendlyMintValue = \case - TxMintNone -> Null - TxMintValue _ v _ -> friendlyValue v - -friendlyTxOutValue :: TxOutValue era -> Aeson.Value -friendlyTxOutValue = \case - TxOutAdaOnly _ lovelace -> friendlyLovelace lovelace - TxOutValue _ v -> friendlyValue v - -friendlyValue :: Api.Value -> Aeson.Value -friendlyValue v = - object - [ case bundle of - ValueNestedBundleAda q -> "lovelace" .= q - ValueNestedBundle policy assets -> - Aeson.fromText (friendlyPolicyId policy) .= friendlyAssets assets - | bundle <- bundles - ] - where - - ValueNestedRep bundles = valueToNestedRep v - - friendlyPolicyId = ("policy " <>) . serialiseToRawBytesHexText - - friendlyAssets = Map.mapKeys friendlyAssetName - - friendlyAssetName = \case - "" -> "default asset" - name@(AssetName nameBS) -> - "asset " <> serialiseToRawBytesHexText name <> nameAsciiSuffix - where - nameAsciiSuffix - | nameIsAscii = " (" <> nameAscii <> ")" - | otherwise = "" - nameIsAscii = BSC.all (\c -> isAscii c && isAlphaNum c) nameBS - nameAscii = Text.pack $ BSC.unpack nameBS - -friendlyMetadata :: TxMetadataInEra era -> Aeson.Value -friendlyMetadata = \case - TxMetadataNone -> Null - TxMetadataInEra _ (TxMetadata m) -> toJSON $ friendlyMetadataValue <$> m - -friendlyMetadataValue :: TxMetadataValue -> Aeson.Value -friendlyMetadataValue = \case - TxMetaNumber int -> toJSON int - TxMetaBytes bytes -> String $ textShow bytes - TxMetaList lst -> array $ map friendlyMetadataValue lst - TxMetaMap m -> - array - [array [friendlyMetadataValue k, friendlyMetadataValue v] | (k, v) <- m] - TxMetaText text -> toJSON text - -friendlyAuxScripts :: TxAuxScripts era -> Aeson.Value -friendlyAuxScripts = \case - TxAuxScriptsNone -> Null - TxAuxScripts _ scripts -> String $ textShow scripts - -friendlyReferenceInputs :: TxInsReference build era -> Aeson.Value -friendlyReferenceInputs TxInsReferenceNone = Null -friendlyReferenceInputs (TxInsReference _ txins) = toJSON txins - -friendlyInputs :: [(TxIn, build)] -> Aeson.Value -friendlyInputs = toJSON . map fst - -friendlyCollateralInputs :: TxInsCollateral era -> Aeson.Value -friendlyCollateralInputs = \case - TxInsCollateralNone -> Null - TxInsCollateral _ txins -> toJSON txins diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs deleted file mode 100644 index 5f035720464..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ /dev/null @@ -1,605 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} - --- | Shelley CLI command types -module Cardano.CLI.Shelley.Commands - ( -- * CLI command types - ShelleyCommand (..) - , AddressCmd (..) - , StakeAddressCmd (..) - , KeyCmd (..) - , TransactionCmd (..) - , NodeCmd (..) - , PoolCmd (..) - , QueryCmd (..) - , GovernanceCmd (..) - , GenesisCmd (..) - , TextViewCmd (..) - , renderShelleyCommand - - -- * CLI flag types - , AddressKeyType (..) - , ByronKeyType (..) - , ByronKeyFormat (..) - , CardanoAddressKeyType (..) - , GenesisDir (..) - , OpCertCounter - , TxInCount (..) - , TxOutCount (..) - , TxShelleyWitnessCount (..) - , TxByronWitnessCount (..) - , SomeKeyFile (..) - , OpCertCounterFile - , ProtocolParamsFile (..) - , WitnessFile (..) - , TxFile - , InputTxBodyOrTxFile (..) - , VerificationKeyBase64 (..) - , GenesisKeyFile (..) - , MetadataFile (..) - , PrivKeyFile (..) - , BlockId (..) - , WitnessSigningData (..) - , ColdVerificationKeyOrFile (..) - ) where - -import Prelude - -import Cardano.Api.Shelley - -import Data.Text (Text) -import Data.Time.Clock - -import Cardano.CLI.Shelley.Key (DelegationTarget, PaymentVerifier, StakeIdentifier, - StakeVerifier, VerificationKeyOrFile, VerificationKeyOrHashOrFile, - VerificationKeyTextOrFile) -import Cardano.CLI.Types - -import Cardano.Chain.Common (BlockCount) -import Cardano.Ledger.Shelley.TxBody (MIRPot) --- --- Shelley CLI command data types --- - --- | All the CLI subcommands under \"shelley\". --- -data ShelleyCommand - = AddressCmd AddressCmd - | StakeAddressCmd StakeAddressCmd - | KeyCmd KeyCmd - | TransactionCmd TransactionCmd - | NodeCmd NodeCmd - | PoolCmd PoolCmd - | QueryCmd QueryCmd - | GovernanceCmd GovernanceCmd - | GenesisCmd GenesisCmd - | TextViewCmd TextViewCmd - -renderShelleyCommand :: ShelleyCommand -> Text -renderShelleyCommand sc = - case sc of - AddressCmd cmd -> renderAddressCmd cmd - StakeAddressCmd cmd -> renderStakeAddressCmd cmd - KeyCmd cmd -> renderKeyCmd cmd - TransactionCmd cmd -> renderTransactionCmd cmd - NodeCmd cmd -> renderNodeCmd cmd - PoolCmd cmd -> renderPoolCmd cmd - QueryCmd cmd -> renderQueryCmd cmd - GovernanceCmd cmd -> renderGovernanceCmd cmd - GenesisCmd cmd -> renderGenesisCmd cmd - TextViewCmd cmd -> renderTextViewCmd cmd - -data AddressCmd - = AddressKeyGen AddressKeyType (VerificationKeyFile Out) (SigningKeyFile Out) - | AddressKeyHash VerificationKeyTextOrFile (Maybe (File () Out)) - | AddressBuild - PaymentVerifier - (Maybe StakeIdentifier) - NetworkId - (Maybe (File () Out)) - | AddressInfo Text (Maybe (File () Out)) - deriving Show - - -renderAddressCmd :: AddressCmd -> Text -renderAddressCmd cmd = - case cmd of - AddressKeyGen {} -> "address key-gen" - AddressKeyHash {} -> "address key-hash" - AddressBuild {} -> "address build" - AddressInfo {} -> "address info" - -data StakeAddressCmd - = StakeAddressKeyGen (VerificationKeyFile Out) (SigningKeyFile Out) - | StakeAddressKeyHash (VerificationKeyOrFile StakeKey) (Maybe (File () Out)) - | StakeAddressBuild StakeVerifier NetworkId (Maybe (File () Out)) - | StakeRegistrationCert StakeIdentifier (File () Out) - | StakeCredentialDelegationCert - StakeIdentifier - DelegationTarget - (File () Out) - | StakeCredentialDeRegistrationCert StakeIdentifier (File () Out) - deriving Show - -renderStakeAddressCmd :: StakeAddressCmd -> Text -renderStakeAddressCmd cmd = - case cmd of - StakeAddressKeyGen {} -> "stake-address key-gen" - StakeAddressKeyHash {} -> "stake-address key-hash" - StakeAddressBuild {} -> "stake-address build" - StakeRegistrationCert {} -> "stake-address registration-certificate" - StakeCredentialDelegationCert {} -> "stake-address delegation-certificate" - StakeCredentialDeRegistrationCert {} -> "stake-address deregistration-certificate" - -data KeyCmd - = KeyGetVerificationKey (SigningKeyFile In) (VerificationKeyFile Out) - | KeyNonExtendedKey (VerificationKeyFile In) (VerificationKeyFile Out) - | KeyConvertByronKey (Maybe Text) ByronKeyType (SomeKeyFile In) (File () Out) - | KeyConvertByronGenesisVKey VerificationKeyBase64 (File () Out) - | KeyConvertITNStakeKey (SomeKeyFile In) (File () Out) - | KeyConvertITNExtendedToStakeKey (SomeKeyFile In) (File () Out) - | KeyConvertITNBip32ToStakeKey (SomeKeyFile In) (File () Out) - | KeyConvertCardanoAddressSigningKey CardanoAddressKeyType (SigningKeyFile In) (File () Out) - deriving Show - -renderKeyCmd :: KeyCmd -> Text -renderKeyCmd cmd = - case cmd of - KeyGetVerificationKey {} -> "key verification-key" - KeyNonExtendedKey {} -> "key non-extended-key" - KeyConvertByronKey {} -> "key convert-byron-key" - KeyConvertByronGenesisVKey {} -> "key convert-byron-genesis-key" - KeyConvertITNStakeKey {} -> "key convert-itn-key" - KeyConvertITNExtendedToStakeKey {} -> "key convert-itn-extended-key" - KeyConvertITNBip32ToStakeKey {} -> "key convert-itn-bip32-key" - KeyConvertCardanoAddressSigningKey {} -> "key convert-cardano-address-signing-key" - -data TransactionCmd - = TxBuildRaw - AnyCardanoEra - (Maybe ScriptValidity) -- ^ Mark script as expected to pass or fail validation - [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] - -- ^ Transaction inputs with optional spending scripts - [TxIn] - -- ^ Read only reference inputs - [TxIn] - -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - (Maybe TxOutAnyEra) - -- ^ Return collateral - (Maybe Lovelace) - -- ^ Total collateral - [RequiredSigner] - -- ^ Required signers - [TxOutAnyEra] - (Maybe (Value, [ScriptWitnessFiles WitCtxMint])) - -- ^ Multi-Asset value with script witness - (Maybe SlotNo) - -- ^ Transaction lower bound - (Maybe SlotNo) - -- ^ Transaction upper bound - (Maybe Lovelace) - -- ^ Tx fee - [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))] - -- ^ Certificates with potential script witness - [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))] - TxMetadataJsonSchema - [ScriptFile] - -- ^ Auxiliary scripts - [MetadataFile] - (Maybe ProtocolParamsFile) - (Maybe UpdateProposalFile) - (TxBodyFile Out) - - -- | Like 'TxBuildRaw' but without the fee, and with a change output. - | TxBuild - SocketPath - AnyCardanoEra - AnyConsensusModeParams - NetworkId - (Maybe ScriptValidity) -- ^ Mark script as expected to pass or fail validation - (Maybe Word) - -- ^ Override the required number of tx witnesses - [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] - -- ^ Transaction inputs with optional spending scripts - [TxIn] - -- ^ Read only reference inputs - [RequiredSigner] - -- ^ Required signers - [TxIn] - -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - (Maybe TxOutAnyEra) - -- ^ Return collateral - (Maybe Lovelace) - -- ^ Total collateral - [TxOutAnyEra] - -- ^ Normal outputs - TxOutChangeAddress - -- ^ A change output - (Maybe (Value, [ScriptWitnessFiles WitCtxMint])) - -- ^ Multi-Asset value with script witness - (Maybe SlotNo) - -- ^ Transaction lower bound - (Maybe SlotNo) - -- ^ Transaction upper bound - [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))] - -- ^ Certificates with potential script witness - [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))] - -- ^ Withdrawals with potential script witness - TxMetadataJsonSchema - [ScriptFile] - -- ^ Auxiliary scripts - [MetadataFile] - (Maybe ProtocolParamsFile) - (Maybe UpdateProposalFile) - TxBuildOutputOptions - | TxSign InputTxBodyOrTxFile [WitnessSigningData] (Maybe NetworkId) (TxFile Out) - | TxCreateWitness (TxBodyFile In) WitnessSigningData (Maybe NetworkId) (File () Out) - | TxAssembleTxBodyWitness (TxBodyFile In) [WitnessFile] (File () Out) - | TxSubmit SocketPath AnyConsensusModeParams NetworkId FilePath - | TxMintedPolicyId ScriptFile - | TxCalculateMinFee - (TxBodyFile In) - NetworkId - ProtocolParamsFile - TxInCount - TxOutCount - TxShelleyWitnessCount - TxByronWitnessCount - | TxCalculateMinRequiredUTxO - AnyCardanoEra - ProtocolParamsFile - TxOutAnyEra - | TxHashScriptData - ScriptDataOrFile - | TxGetTxId InputTxBodyOrTxFile - | TxView InputTxBodyOrTxFile - -data InputTxBodyOrTxFile = InputTxBodyFile (TxBodyFile In) | InputTxFile (TxFile In) - deriving Show - -renderTransactionCmd :: TransactionCmd -> Text -renderTransactionCmd cmd = - case cmd of - TxBuild {} -> "transaction build" - TxBuildRaw {} -> "transaction build-raw" - TxSign {} -> "transaction sign" - TxCreateWitness {} -> "transaction witness" - TxAssembleTxBodyWitness {} -> "transaction sign-witness" - TxSubmit {} -> "transaction submit" - TxMintedPolicyId {} -> "transaction policyid" - TxCalculateMinFee {} -> "transaction calculate-min-fee" - TxCalculateMinRequiredUTxO {} -> "transaction calculate-min-value" - TxHashScriptData {} -> "transaction hash-script-data" - TxGetTxId {} -> "transaction txid" - TxView {} -> "transaction view" - -data NodeCmd - = NodeKeyGenCold (VerificationKeyFile Out) (SigningKeyFile Out) (OpCertCounterFile Out) - | NodeKeyGenKES (VerificationKeyFile Out) (SigningKeyFile Out) - | NodeKeyGenVRF (VerificationKeyFile Out) (SigningKeyFile Out) - | NodeKeyHashVRF (VerificationKeyOrFile VrfKey) (Maybe (File () Out)) - | NodeNewCounter ColdVerificationKeyOrFile Word (OpCertCounterFile InOut) - | NodeIssueOpCert (VerificationKeyOrFile KesKey) (SigningKeyFile In) (OpCertCounterFile InOut) - KESPeriod (File () Out) - deriving Show - -renderNodeCmd :: NodeCmd -> Text -renderNodeCmd cmd = do - case cmd of - NodeKeyGenCold {} -> "node key-gen" - NodeKeyGenKES {} -> "node key-gen-KES" - NodeKeyGenVRF {} -> "node key-gen-VRF" - NodeKeyHashVRF {} -> "node key-hash-VRF" - NodeNewCounter {} -> "node new-counter" - NodeIssueOpCert{} -> "node issue-op-cert" - - -data PoolCmd - = PoolRegistrationCert - (VerificationKeyOrFile StakePoolKey) - -- ^ Stake pool verification key. - (VerificationKeyOrFile VrfKey) - -- ^ VRF Verification key. - Lovelace - -- ^ Pool pledge. - Lovelace - -- ^ Pool cost. - Rational - -- ^ Pool margin. - (VerificationKeyOrFile StakeKey) - -- ^ Reward account verification staking key. - [VerificationKeyOrFile StakeKey] - -- ^ Pool owner verification staking key(s). - [StakePoolRelay] - -- ^ Stake pool relays. - (Maybe StakePoolMetadataReference) - -- ^ Stake pool metadata. - NetworkId - (File () Out) - | PoolRetirementCert - (VerificationKeyOrFile StakePoolKey) - -- ^ Stake pool verification key. - EpochNo - -- ^ Epoch in which to retire the stake pool. - (File Certificate Out) - | PoolGetId (VerificationKeyOrFile StakePoolKey) OutputFormat - | PoolMetadataHash (File StakePoolMetadata In) (Maybe (File () Out)) - deriving Show - -renderPoolCmd :: PoolCmd -> Text -renderPoolCmd cmd = - case cmd of - PoolRegistrationCert {} -> "stake-pool registration-certificate" - PoolRetirementCert {} -> "stake-pool deregistration-certificate" - PoolGetId {} -> "stake-pool id" - PoolMetadataHash {} -> "stake-pool metadata-hash" - -data QueryCmd = - QueryLeadershipSchedule - SocketPath - AnyConsensusModeParams - NetworkId - GenesisFile - (VerificationKeyOrHashOrFile StakePoolKey) - (SigningKeyFile In) - EpochLeadershipSchedule - (Maybe (File () Out)) - | QueryProtocolParameters' SocketPath AnyConsensusModeParams NetworkId (Maybe (File () Out)) - | QueryTip SocketPath AnyConsensusModeParams NetworkId (Maybe (File () Out)) - | QueryStakePools' SocketPath AnyConsensusModeParams NetworkId (Maybe (File () Out)) - | QueryStakeDistribution' SocketPath AnyConsensusModeParams NetworkId (Maybe (File () Out)) - | QueryStakeAddressInfo SocketPath AnyConsensusModeParams StakeAddress NetworkId (Maybe (File () Out)) - | QueryUTxO' SocketPath AnyConsensusModeParams QueryUTxOFilter NetworkId (Maybe (File () Out)) - | QueryDebugLedgerState' SocketPath AnyConsensusModeParams NetworkId (Maybe (File () Out)) - | QueryProtocolState' SocketPath AnyConsensusModeParams NetworkId (Maybe (File () Out)) - | QueryStakeSnapshot' - SocketPath - AnyConsensusModeParams - NetworkId - (AllOrOnly [Hash StakePoolKey]) - (Maybe (File () Out)) - | QueryKesPeriodInfo - SocketPath - AnyConsensusModeParams - NetworkId - (File () In) - -- ^ Node operational certificate - (Maybe (File () Out)) - | QueryPoolState' SocketPath AnyConsensusModeParams NetworkId [Hash StakePoolKey] - | QueryTxMempool SocketPath AnyConsensusModeParams NetworkId TxMempoolQuery (Maybe (File () Out)) - | QuerySlotNumber SocketPath AnyConsensusModeParams NetworkId UTCTime - deriving Show - -renderQueryCmd :: QueryCmd -> Text -renderQueryCmd cmd = - case cmd of - QueryLeadershipSchedule {} -> "query leadership-schedule" - QueryProtocolParameters' {} -> "query protocol-parameters " - QueryTip {} -> "query tip" - QueryStakePools' {} -> "query stake-pools" - QueryStakeDistribution' {} -> "query stake-distribution" - QueryStakeAddressInfo {} -> "query stake-address-info" - QueryUTxO' {} -> "query utxo" - QueryDebugLedgerState' {} -> "query ledger-state" - QueryProtocolState' {} -> "query protocol-state" - QueryStakeSnapshot' {} -> "query stake-snapshot" - QueryKesPeriodInfo {} -> "query kes-period-info" - QueryPoolState' {} -> "query pool-state" - QueryTxMempool _ _ _ query _ -> "query tx-mempool" <> renderTxMempoolQuery query - QuerySlotNumber {} -> "query slot-number" - where - renderTxMempoolQuery query = - case query of - TxMempoolQueryTxExists tx -> "tx-exists " <> serialiseToRawBytesHexText tx - TxMempoolQueryNextTx -> "next-tx" - TxMempoolQueryInfo -> "info" - - -data GovernanceCmd - = GovernanceMIRPayStakeAddressesCertificate - MIRPot - [StakeAddress] - [Lovelace] - (File () Out) - | GovernanceMIRTransfer Lovelace (File () Out) TransferDirection - | GovernanceGenesisKeyDelegationCertificate - (VerificationKeyOrHashOrFile GenesisKey) - (VerificationKeyOrHashOrFile GenesisDelegateKey) - (VerificationKeyOrHashOrFile VrfKey) - (File () Out) - | GovernanceUpdateProposal (File () Out) EpochNo - [VerificationKeyFile In] - ProtocolParametersUpdate - (Maybe FilePath) - | GovernanceCreatePoll - Text -- Prompt - [Text] -- Choices - (Maybe Word) -- Nonce - (File GovernancePoll Out) - | GovernanceAnswerPoll - (File GovernancePoll In) -- Poll file - (Maybe Word) -- Answer index - (Maybe (File () Out)) -- Tx file - | GovernanceVerifyPoll - (File GovernancePoll In) -- Poll file - (File (Tx ()) In) -- Tx file - (Maybe (File () Out)) -- Tx file - deriving Show - -renderGovernanceCmd :: GovernanceCmd -> Text -renderGovernanceCmd cmd = - case cmd of - GovernanceGenesisKeyDelegationCertificate {} -> "governance create-genesis-key-delegation-certificate" - GovernanceMIRPayStakeAddressesCertificate {} -> "governance create-mir-certificate stake-addresses" - GovernanceMIRTransfer _ _ TransferToTreasury -> "governance create-mir-certificate transfer-to-treasury" - GovernanceMIRTransfer _ _ TransferToReserves -> "governance create-mir-certificate transfer-to-reserves" - GovernanceUpdateProposal {} -> "governance create-update-proposal" - GovernanceCreatePoll{} -> "governance create-poll" - GovernanceAnswerPoll{} -> "governance answer-poll" - GovernanceVerifyPoll{} -> "governance verify-poll" - -data TextViewCmd - = TextViewInfo !FilePath (Maybe (File () Out)) - deriving Show - - -renderTextViewCmd :: TextViewCmd -> Text -renderTextViewCmd (TextViewInfo _ _) = "text-view decode-cbor" - -data GenesisCmd - = GenesisCreate GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) NetworkId - | GenesisCreateCardano GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) BlockCount Word Rational NetworkId FilePath FilePath FilePath FilePath (Maybe FilePath) - | GenesisCreateStaked - GenesisDir - Word - Word - Word - Word - (Maybe SystemStart) - (Maybe Lovelace) - Lovelace - NetworkId - Word - Word - Word - (Maybe FilePath) -- ^ Relay specification filepath - | GenesisKeyGenGenesis (VerificationKeyFile Out) (SigningKeyFile Out) - | GenesisKeyGenDelegate (VerificationKeyFile Out) (SigningKeyFile Out) (OpCertCounterFile Out) - | GenesisKeyGenUTxO (VerificationKeyFile Out) (SigningKeyFile Out) - | GenesisCmdKeyHash (VerificationKeyFile In) - | GenesisVerKey (VerificationKeyFile Out) (SigningKeyFile In) - | GenesisTxIn (VerificationKeyFile In) NetworkId (Maybe (File () Out)) - | GenesisAddr (VerificationKeyFile In) NetworkId (Maybe (File () Out)) - | GenesisHashFile GenesisFile - deriving Show - -renderGenesisCmd :: GenesisCmd -> Text -renderGenesisCmd cmd = - case cmd of - GenesisCreate {} -> "genesis create" - GenesisCreateCardano {} -> "genesis create-cardano" - GenesisCreateStaked {} -> "genesis create-staked" - GenesisKeyGenGenesis {} -> "genesis key-gen-genesis" - GenesisKeyGenDelegate {} -> "genesis key-gen-delegate" - GenesisKeyGenUTxO {} -> "genesis key-gen-utxo" - GenesisCmdKeyHash {} -> "genesis key-hash" - GenesisVerKey {} -> "genesis get-ver-key" - GenesisTxIn {} -> "genesis initial-txin" - GenesisAddr {} -> "genesis initial-addr" - GenesisHashFile {} -> "genesis hash" - --- --- Shelley CLI flag/option data types --- - -newtype ProtocolParamsFile - = ProtocolParamsFile FilePath - deriving (Show, Eq) - -newtype TxInCount - = TxInCount Int - deriving Show - -newtype TxOutCount - = TxOutCount Int - deriving Show - -newtype TxShelleyWitnessCount - = TxShelleyWitnessCount Int - deriving Show - -newtype TxByronWitnessCount - = TxByronWitnessCount Int - deriving Show - -newtype BlockId - = BlockId String -- Probably not a String - deriving Show - -newtype GenesisKeyFile - = GenesisKeyFile FilePath - deriving Show - -data MetadataFile = MetadataFileJSON (File () In) - | MetadataFileCBOR (File () In) - - deriving Show - -newtype GenesisDir - = GenesisDir FilePath - deriving Show - --- | Either a verification or signing key, used for conversions and other --- commands that make sense for both. --- -data SomeKeyFile direction - = AVerificationKeyFile (VerificationKeyFile direction) - | ASigningKeyFile (SigningKeyFile direction) - deriving Show - -data AddressKeyType - = AddressKeyShelley - | AddressKeyShelleyExtended - | AddressKeyByron - deriving Show - -data ByronKeyType - = ByronPaymentKey ByronKeyFormat - | ByronGenesisKey ByronKeyFormat - | ByronDelegateKey ByronKeyFormat - deriving Show - -data ByronKeyFormat = NonLegacyByronKeyFormat - | LegacyByronKeyFormat - deriving Show - --- | The type of @cardano-address@ key. -data CardanoAddressKeyType - = CardanoAddressShelleyPaymentKey - | CardanoAddressShelleyStakeKey - | CardanoAddressIcarusPaymentKey - | CardanoAddressByronPaymentKey - deriving Show - -data OpCertCounter - -type OpCertCounterFile = File OpCertCounter - -newtype PrivKeyFile - = PrivKeyFile FilePath - deriving Show - -newtype WitnessFile - = WitnessFile FilePath - deriving Show - --- | A raw verification key given in Base64, and decoded into a ByteString. -newtype VerificationKeyBase64 - = VerificationKeyBase64 String - deriving Show - --- | Data required to construct a witness. -data WitnessSigningData - = KeyWitnessSigningData - !(SigningKeyFile In) - -- ^ Path to a file that should contain a signing key. - !(Maybe (Address ByronAddr)) - -- ^ An optionally specified Byron address. - -- - -- If specified, both the network ID and derivation path are extracted - -- from the address and used in the construction of the Byron witness. - deriving Show - --- | Either a stake pool verification key, genesis delegate verification key, --- or a path to a cold verification key file. --- --- Note that a "cold verification key" refers to either a stake pool or --- genesis delegate verification key. --- --- TODO: A genesis delegate extended key should also be valid here. -data ColdVerificationKeyOrFile - = ColdStakePoolVerificationKey !(VerificationKey StakePoolKey) - | ColdGenesisDelegateVerificationKey !(VerificationKey GenesisDelegateKey) - | ColdVerificationKeyFile !(VerificationKeyFile In) - deriving Show diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Key.hs b/cardano-cli/src/Cardano/CLI/Shelley/Key.hs deleted file mode 100644 index 1157f42f7a9..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Key.hs +++ /dev/null @@ -1,211 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances #-} - --- | Shelley CLI option data types and functions for cryptographic keys. -module Cardano.CLI.Shelley.Key - ( VerificationKeyOrFile (..) - , readVerificationKeyOrFile - , readVerificationKeyOrTextEnvFile - - , VerificationKeyTextOrFile (..) - , VerificationKeyTextOrFileError (..) - , readVerificationKeyTextOrFileAnyOf - , renderVerificationKeyTextOrFileError - - , VerificationKeyOrHashOrFile (..) - , readVerificationKeyOrHashOrFile - , readVerificationKeyOrHashOrTextEnvFile - - , PaymentVerifier(..) - , StakeIdentifier(..) - , StakeVerifier(..) - - , generateKeyPair - - , DelegationTarget(..) - ) where - -import Cardano.Api - -import Control.Monad.IO.Class (MonadIO (..)) -import Data.Bifunctor (Bifunctor (..)) -import qualified Data.ByteString as BS -import qualified Data.List.NonEmpty as NE -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text - -import Cardano.Api.Shelley (StakePoolKey) -import Cardano.CLI.Types - - ------------------------------------------------------------------------------- --- Verification key deserialisation ------------------------------------------------------------------------------- - --- | Either a verification key or path to a verification key file. -data VerificationKeyOrFile keyrole - = VerificationKeyValue !(VerificationKey keyrole) - -- ^ A verification key. - | VerificationKeyFilePath !(VerificationKeyFile In) - -- ^ A path to a verification key file. - -- Note that this file hasn't been validated at all (whether it exists, - -- contains a key of the correct type, etc.) - -deriving instance Show (VerificationKey keyrole) - => Show (VerificationKeyOrFile keyrole) - -deriving instance Eq (VerificationKey keyrole) - => Eq (VerificationKeyOrFile keyrole) - --- | Read a verification key or verification key file and return a --- verification key. --- --- If a filepath is provided, the file can either be formatted as Bech32, hex, --- or text envelope. -readVerificationKeyOrFile - :: ( HasTextEnvelope (VerificationKey keyrole) - , SerialiseAsBech32 (VerificationKey keyrole) - ) - => AsType keyrole - -> VerificationKeyOrFile keyrole - -> IO (Either (FileError InputDecodeError) (VerificationKey keyrole)) -readVerificationKeyOrFile asType verKeyOrFile = - case verKeyOrFile of - VerificationKeyValue vk -> pure (Right vk) - VerificationKeyFilePath (File fp) -> - readKeyFile - (AsVerificationKey asType) - (NE.fromList [InputFormatBech32, InputFormatHex, InputFormatTextEnvelope]) - fp - --- | Read a verification key or verification key file and return a --- verification key. --- --- If a filepath is provided, it will be interpreted as a text envelope --- formatted file. -readVerificationKeyOrTextEnvFile - :: HasTextEnvelope (VerificationKey keyrole) - => AsType keyrole - -> VerificationKeyOrFile keyrole - -> IO (Either (FileError InputDecodeError) (VerificationKey keyrole)) -readVerificationKeyOrTextEnvFile asType verKeyOrFile = - case verKeyOrFile of - VerificationKeyValue vk -> pure (Right vk) - VerificationKeyFilePath fp -> readKeyFileTextEnvelope (AsVerificationKey asType) fp - -data PaymentVerifier - = PaymentVerifierKey VerificationKeyTextOrFile - | PaymentVerifierScriptFile ScriptFile - deriving (Eq, Show) - -data StakeVerifier - = StakeVerifierKey (VerificationKeyOrFile StakeKey) - | StakeVerifierScriptFile ScriptFile - deriving (Eq, Show) - -data StakeIdentifier - = StakeIdentifierVerifier StakeVerifier - | StakeIdentifierAddress StakeAddress - deriving (Eq, Show) - --- | A resource that identifies the delegation target. At the moment a delegation --- target can only be a stake pool. -newtype DelegationTarget - = StakePoolDelegationTarget (VerificationKeyOrHashOrFile StakePoolKey) - deriving Show - --- | Either an unvalidated text representation of a verification key or a path --- to a verification key file. -data VerificationKeyTextOrFile - = VktofVerificationKeyText !Text - | VktofVerificationKeyFile !(VerificationKeyFile In) - deriving (Eq, Show) - --- | An error in deserialising a 'VerificationKeyTextOrFile' to a --- 'VerificationKey'. -data VerificationKeyTextOrFileError - = VerificationKeyTextError !InputDecodeError - | VerificationKeyFileError !(FileError InputDecodeError) - deriving Show - --- | Render an error message for a 'VerificationKeyTextOrFileError'. -renderVerificationKeyTextOrFileError :: VerificationKeyTextOrFileError -> Text -renderVerificationKeyTextOrFileError vkTextOrFileErr = - case vkTextOrFileErr of - VerificationKeyTextError err -> renderInputDecodeError err - VerificationKeyFileError err -> Text.pack (displayError err) - --- | Deserialise a verification key from text or a verification key file. --- If a filepath is provided, the file can either be formatted as Bech32, hex, --- or text envelope. -readVerificationKeyTextOrFileAnyOf - :: VerificationKeyTextOrFile - -> IO (Either VerificationKeyTextOrFileError SomeAddressVerificationKey) -readVerificationKeyTextOrFileAnyOf verKeyTextOrFile = - case verKeyTextOrFile of - VktofVerificationKeyText vkText -> - pure $ first VerificationKeyTextError $ - deserialiseAnyVerificationKey (Text.encodeUtf8 vkText) - VktofVerificationKeyFile (File fp) -> do - vkBs <- liftIO $ BS.readFile fp - pure $ first VerificationKeyTextError $ - deserialiseAnyVerificationKey vkBs - - --- | Verification key, verification key hash, or path to a verification key --- file. -data VerificationKeyOrHashOrFile keyrole - = VerificationKeyOrFile !(VerificationKeyOrFile keyrole) - -- ^ Either a verification key or path to a verification key file. - | VerificationKeyHash !(Hash keyrole) - -- ^ A verification key hash. - -deriving instance (Show (VerificationKeyOrFile keyrole), Show (Hash keyrole)) - => Show (VerificationKeyOrHashOrFile keyrole) - -deriving instance (Eq (VerificationKeyOrFile keyrole), Eq (Hash keyrole)) - => Eq (VerificationKeyOrHashOrFile keyrole) - --- | Read a verification key or verification key hash or verification key file --- and return a verification key hash. --- --- If a filepath is provided, the file can either be formatted as Bech32, hex, --- or text envelope. -readVerificationKeyOrHashOrFile - :: (Key keyrole, SerialiseAsBech32 (VerificationKey keyrole)) - => AsType keyrole - -> VerificationKeyOrHashOrFile keyrole - -> IO (Either (FileError InputDecodeError) (Hash keyrole)) -readVerificationKeyOrHashOrFile asType verKeyOrHashOrFile = - case verKeyOrHashOrFile of - VerificationKeyOrFile vkOrFile -> do - eitherVk <- readVerificationKeyOrFile asType vkOrFile - pure (verificationKeyHash <$> eitherVk) - VerificationKeyHash vkHash -> pure (Right vkHash) - --- | Read a verification key or verification key hash or verification key file --- and return a verification key hash. --- --- If a filepath is provided, it will be interpreted as a text envelope --- formatted file. -readVerificationKeyOrHashOrTextEnvFile - :: Key keyrole - => AsType keyrole - -> VerificationKeyOrHashOrFile keyrole - -> IO (Either (FileError InputDecodeError) (Hash keyrole)) -readVerificationKeyOrHashOrTextEnvFile asType verKeyOrHashOrFile = - case verKeyOrHashOrFile of - VerificationKeyOrFile vkOrFile -> do - eitherVk <- readVerificationKeyOrTextEnvFile asType vkOrFile - pure (verificationKeyHash <$> eitherVk) - VerificationKeyHash vkHash -> pure (Right vkHash) - -generateKeyPair :: Key keyrole => AsType keyrole -> IO (VerificationKey keyrole, SigningKey keyrole) -generateKeyPair asType = do - skey <- generateSigningKey asType - return (getVerificationKey skey, skey) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs b/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs deleted file mode 100644 index f869435f3f2..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - -{-# OPTIONS_GHC -Wno-orphans #-} - -module Cardano.CLI.Shelley.Orphans () where - -import qualified Cardano.Ledger.Crypto as CC (Crypto) -import qualified Cardano.Protocol.TPraos.API as Ledger -import Cardano.Protocol.TPraos.BHeader (HashHeader (..)) -import qualified Cardano.Protocol.TPraos.Rules.Prtcl as Ledger -import qualified Cardano.Protocol.TPraos.Rules.Tickn as Ledger -import Data.Aeson (KeyValue ((.=)), ToJSON (..)) -import qualified Data.Aeson as Aeson -import qualified Data.ByteString.Base16 as Base16 -import qualified Data.ByteString.Short as SBS -import qualified Data.Text.Encoding as Text -import Ouroboros.Consensus.Byron.Ledger.Block (ByronHash (..)) -import Ouroboros.Consensus.HardFork.Combinator (OneEraHash (..)) -import Ouroboros.Consensus.Protocol.Praos (PraosState) -import qualified Ouroboros.Consensus.Protocol.Praos as Consensus -import Ouroboros.Consensus.Protocol.TPraos (TPraosState) -import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus -import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) -import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..)) -import Ouroboros.Network.Block (HeaderHash, Tip (..)) - -instance ToJSON (OneEraHash xs) where - toJSON = toJSON - . Text.decodeLatin1 - . Base16.encode - . SBS.fromShort - . getOneEraHash - -deriving newtype instance ToJSON ByronHash - --- This instance is temporarily duplicated in cardano-config - -instance ToJSON (HeaderHash blk) => ToJSON (Tip blk) where - toJSON TipGenesis = Aeson.object [ "genesis" .= True ] - toJSON (Tip slotNo headerHash blockNo) = - Aeson.object - [ "slotNo" .= slotNo - , "headerHash" .= headerHash - , "blockNo" .= blockNo - ] - --- --- Simple newtype wrappers JSON conversion --- - -deriving newtype instance CC.Crypto crypto => ToJSON (ShelleyHash crypto) -deriving newtype instance CC.Crypto crypto => ToJSON (HashHeader crypto) - -deriving instance ToJSON (Ledger.PrtclState StandardCrypto) -deriving instance ToJSON Ledger.TicknState -deriving instance ToJSON (Ledger.ChainDepState StandardCrypto) - -instance ToJSON (TPraosState StandardCrypto) where - toJSON s = Aeson.object - [ "lastSlot" .= Consensus.tpraosStateLastSlot s - , "chainDepState" .= Consensus.tpraosStateChainDepState s - ] - -instance ToJSON (PraosState StandardCrypto) where - toJSON s = Aeson.object - [ "lastSlot" .= Consensus.praosStateLastSlot s - , "oCertCounters" .= Consensus.praosStateOCertCounters s - , "evolvingNonce" .= Consensus.praosStateEvolvingNonce s - , "candidateNonce" .= Consensus.praosStateCandidateNonce s - , "epochNonce" .= Consensus.praosStateEpochNonce s - , "labNonce" .= Consensus.praosStateLabNonce s - , "lastEpochBlockNonce" .= Consensus.praosStateLastEpochBlockNonce s - ] diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Output.hs b/cardano-cli/src/Cardano/CLI/Shelley/Output.hs deleted file mode 100644 index 9cc7b5820e1..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Output.hs +++ /dev/null @@ -1,334 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleInstances #-} - -module Cardano.CLI.Shelley.Output - ( PlutusScriptCostError - , QueryKesPeriodInfoOutput (..) - , QueryTipLocalState(..) - , QueryTipLocalStateOutput(..) - , ScriptCostOutput (..) - , createOpCertIntervalInfo - , renderScriptCosts - ) where - -import Prelude - -import Cardano.Api -import Cardano.Api.Shelley -import Data.Aeson -import qualified Data.Aeson.Key as Aeson -import qualified Data.List as List -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Time.Clock (UTCTime) -import Data.Word - -import Cardano.CLI.Shelley.Orphans () -import Cardano.CLI.Types -import Cardano.Ledger.Shelley.Scripts () - -data QueryKesPeriodInfoOutput = - QueryKesPeriodInfoOutput - { qKesOpCertIntervalInformation :: OpCertIntervalInformation - -- | Date of KES key expiry. - , qKesInfoKesKeyExpiry :: Maybe UTCTime - -- | The latest operational certificate number in the node's state - -- i.e how many times a new KES key has been generated. - , qKesInfoNodeStateOperationalCertNo :: Maybe OpCertNodeStateCounter - -- | The on disk operational certificate number. - , qKesInfoOnDiskOperationalCertNo :: OpCertOnDiskCounter - -- | The maximum number of KES key evolutions permitted per KES period. - , qKesInfoMaxKesKeyEvolutions :: Word64 - , qKesInfoSlotsPerKesPeriod :: Word64 - } deriving (Eq, Show) - -instance ToJSON QueryKesPeriodInfoOutput where - toJSON (QueryKesPeriodInfoOutput opCertIntervalInfo - kesKeyExpiryTime - nodeStateOpCertNo - (OpCertOnDiskCounter onDiskOpCertNo) - maxKesKeyOps - slotsPerKesPeriod) = do - let (sKes, eKes, cKes, slotsTillExp) = - case opCertIntervalInfo of - OpCertWithinInterval startKes endKes currKes sUntilExp -> - ( unOpCertStartingKesPeriod startKes - , unOpCertEndingKesPeriod endKes - , unCurrentKesPeriod currKes - , Just sUntilExp - ) - OpCertStartingKesPeriodIsInTheFuture startKes endKes currKes -> - ( unOpCertStartingKesPeriod startKes - , unOpCertEndingKesPeriod endKes - , unCurrentKesPeriod currKes - , Nothing - ) - OpCertExpired startKes endKes currKes -> - ( unOpCertStartingKesPeriod startKes - , unOpCertEndingKesPeriod endKes - , unCurrentKesPeriod currKes - , Nothing - ) - OpCertSomeOtherError startKes endKes currKes -> - ( unOpCertStartingKesPeriod startKes - , unOpCertEndingKesPeriod endKes - , unCurrentKesPeriod currKes - , Nothing - ) - - object [ "qKesCurrentKesPeriod" .= cKes - , "qKesStartKesInterval" .= sKes - , "qKesEndKesInterval" .= eKes - , "qKesRemainingSlotsInKesPeriod" .= slotsTillExp - , "qKesOnDiskOperationalCertificateNumber" .= onDiskOpCertNo - , "qKesNodeStateOperationalCertificateNumber" .= nodeStateOpCertNo - , "qKesMaxKESEvolutions" .= maxKesKeyOps - , "qKesSlotsPerKesPeriod" .= slotsPerKesPeriod - , "qKesKesKeyExpiry" .= kesKeyExpiryTime - ] - -instance FromJSON QueryKesPeriodInfoOutput where - parseJSON = withObject "QueryKesPeriodInfoOutput" $ \o -> do - currentKesPeriod <- o .: "qKesCurrentKesPeriod" - startKesInterval <- o .: "qKesStartKesInterval" - endKesInterval <- o .: "qKesEndKesInterval" - remainingSlotsInKesPeriod <- o .: "qKesRemainingSlotsInKesPeriod" - onDiskOperationalCertificateNumber <- o .: "qKesOnDiskOperationalCertificateNumber" - nodeStateOperationalCertificateNumber <- o .: "qKesNodeStateOperationalCertificateNumber" - maxKESEvolutions <- o .: "qKesMaxKESEvolutions" - slotsPerKesPeriod <- o .: "qKesSlotsPerKesPeriod" - kesKeyExpiry <- o .: "qKesKesKeyExpiry" - let opCertIntervalInfo = createOpCertIntervalInfo - currentKesPeriod - startKesInterval - endKesInterval - remainingSlotsInKesPeriod - return $ QueryKesPeriodInfoOutput - { qKesOpCertIntervalInformation = opCertIntervalInfo - , qKesInfoKesKeyExpiry = kesKeyExpiry - , qKesInfoNodeStateOperationalCertNo = nodeStateOperationalCertificateNumber - , qKesInfoOnDiskOperationalCertNo = onDiskOperationalCertificateNumber - , qKesInfoMaxKesKeyEvolutions = maxKESEvolutions - , qKesInfoSlotsPerKesPeriod = slotsPerKesPeriod - } - - -createOpCertIntervalInfo - :: CurrentKesPeriod - -> OpCertStartingKesPeriod - -> OpCertEndingKesPeriod - -> Maybe SlotsTillKesKeyExpiry - -> OpCertIntervalInformation -createOpCertIntervalInfo c@(CurrentKesPeriod cKesPeriod) - s@(OpCertStartingKesPeriod oCertStart) - e@(OpCertEndingKesPeriod oCertEnd) - (Just tillExp) - | oCertStart <= cKesPeriod && cKesPeriod < oCertEnd = - OpCertWithinInterval s e c tillExp - | oCertStart > cKesPeriod = OpCertStartingKesPeriodIsInTheFuture s e c - | cKesPeriod >= oCertEnd = OpCertExpired s e c - | otherwise = OpCertSomeOtherError s e c -createOpCertIntervalInfo c@(CurrentKesPeriod cKesPeriod) - s@(OpCertStartingKesPeriod oCertStart) - e@(OpCertEndingKesPeriod oCertEnd) - Nothing - | oCertStart > cKesPeriod = OpCertStartingKesPeriodIsInTheFuture s e c - | cKesPeriod >= oCertEnd = OpCertExpired s e c - | otherwise = OpCertSomeOtherError s e c - - -data QueryTipLocalState mode = QueryTipLocalState - { era :: AnyCardanoEra - , eraHistory :: EraHistory CardanoMode - , mSystemStart :: Maybe SystemStart - , mChainTip :: Maybe ChainTip - } - -data QueryTipLocalStateOutput = QueryTipLocalStateOutput - { localStateChainTip :: ChainTip - , mEra :: Maybe AnyCardanoEra - , mEpoch :: Maybe EpochNo - , mSlotInEpoch :: Maybe Word64 - , mSlotsToEpochEnd :: Maybe Word64 - , mSyncProgress :: Maybe Text - } deriving Show - --- | A key-value pair difference list for encoding a JSON object. -(..=) :: (KeyValue kv, ToJSON v) => Aeson.Key -> v -> [kv] -> [kv] -(..=) n v = (n .= v:) - --- | A key-value pair difference list for encoding a JSON object where Nothing encodes absence of the key-value pair. -(..=?) :: (KeyValue kv, ToJSON v) => Aeson.Key -> Maybe v -> [kv] -> [kv] -(..=?) n mv = case mv of - Just v -> (n .= v:) - Nothing -> id - -instance ToJSON QueryTipLocalStateOutput where - toJSON a = case localStateChainTip a of - ChainTipAtGenesis -> - object $ - ( ("era" ..=? mEra a) - . ("epoch" ..=? mEpoch a) - . ("slotInEpoch" ..=? mSlotInEpoch a) - . ("slotsToEpochEnd" ..=? mSlotsToEpochEnd a) - . ("syncProgress" ..=? mSyncProgress a) - ) [] - ChainTip slotNo blockHeader blockNo -> - object $ - ( ("slot" ..= slotNo) - . ("hash" ..= serialiseToRawBytesHexText blockHeader) - . ("block" ..= blockNo) - . ("era" ..=? mEra a) - . ("epoch" ..=? mEpoch a) - . ("slotInEpoch" ..=? mSlotInEpoch a) - . ("slotsToEpochEnd" ..=? mSlotsToEpochEnd a) - . ("syncProgress" ..=? mSyncProgress a) - ) [] - toEncoding a = case localStateChainTip a of - ChainTipAtGenesis -> - pairs $ mconcat $ - ( ("era" ..=? mEra a) - . ("epoch" ..=? mEpoch a) - . ("slotInEpoch" ..=? mSlotInEpoch a) - . ("slotsToEpochEnd" ..=? mSlotsToEpochEnd a) - . ("syncProgress" ..=? mSyncProgress a) - ) [] - ChainTip slotNo blockHeader blockNo -> - pairs $ mconcat $ - ( ("slot" ..= slotNo) - . ("hash" ..= serialiseToRawBytesHexText blockHeader) - . ("block" ..= blockNo) - . ("era" ..=? mEra a) - . ("epoch" ..=? mEpoch a) - . ("slotInEpoch" ..=? mSlotInEpoch a) - . ("slotsToEpochEnd" ..=? mSlotsToEpochEnd a) - . ("syncProgress" ..=? mSyncProgress a) - ) [] - -instance FromJSON QueryTipLocalStateOutput where - parseJSON = withObject "QueryTipLocalStateOutput" $ \o -> do - mEra' <- o .:? "era" - mEpoch' <- o .:? "epoch" - mSyncProgress' <- o .:? "syncProgress" - - mSlot <- o .:? "slot" - mHash <- o .:? "hash" - mBlock <- o .:? "block" - mSlotInEpoch' <- o .:? "slotInEpoch" - mSlotsToEpochEnd' <- o .:? "slotsToEpochEnd" - case (mSlot, mHash, mBlock) of - (Nothing, Nothing, Nothing) -> - pure $ QueryTipLocalStateOutput - ChainTipAtGenesis - mEra' - mEpoch' - mSlotInEpoch' - mSlotsToEpochEnd' - mSyncProgress' - (Just slot, Just hash, Just block) -> - pure $ QueryTipLocalStateOutput - (ChainTip slot hash block) - mEra' - mEpoch' - mSlotInEpoch' - mSlotsToEpochEnd' - mSyncProgress' - (_,_,_) -> - fail $ mconcat - [ "QueryTipLocalStateOutput was incorrectly JSON encoded." - , " Expected slot, header hash and block number (ChainTip)" - , " or none (ChainTipAtGenesis)" - ] - -data ScriptCostOutput = - ScriptCostOutput - { scScriptHash :: ScriptHash - , scExecutionUnits :: ExecutionUnits - , scAda :: Lovelace - } - -instance ToJSON ScriptCostOutput where - toJSON (ScriptCostOutput sHash execUnits llCost) = - object [ "scriptHash" .= sHash - , "executionUnits" .= execUnits - , "lovelaceCost" .= llCost - ] - -data PlutusScriptCostError - = PlutusScriptCostErrPlutusScriptNotFound ScriptWitnessIndex - | PlutusScriptCostErrExecError ScriptWitnessIndex (Maybe ScriptHash) ScriptExecutionError - | PlutusScriptCostErrRationalExceedsBound ExecutionUnitPrices ExecutionUnits - | PlutusScriptCostErrRefInputNoScript TxIn - | PlutusScriptCostErrRefInputNotInUTxO TxIn - deriving Show - - -instance Error PlutusScriptCostError where - displayError (PlutusScriptCostErrPlutusScriptNotFound sWitIndex) = - "No Plutus script was found at: " <> show sWitIndex - displayError (PlutusScriptCostErrExecError sWitIndex sHash sExecErro) = - "Plutus script at: " <> show sWitIndex <> " with hash: " <> show sHash <> - " errored with: " <> displayError sExecErro - displayError (PlutusScriptCostErrRationalExceedsBound eUnitPrices eUnits) = - "Either the execution unit prices: " <> show eUnitPrices <> " or the execution units: " <> - show eUnits <> " or both are either too precise or not within bounds" - displayError (PlutusScriptCostErrRefInputNoScript txin) = - "No reference script found at input: " <> Text.unpack (renderTxIn txin) - displayError (PlutusScriptCostErrRefInputNotInUTxO txin) = - "Reference input was not found in utxo: " <> Text.unpack (renderTxIn txin) - -renderScriptCosts - :: UTxO era - -> ExecutionUnitPrices - -> [(ScriptWitnessIndex, AnyScriptWitness era)] - -- ^ Initial mapping of script witness index to actual script. - -- We need this in order to know which script corresponds to the - -- calculated execution units. - -> Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits) - -- ^ Post execution cost calculation mapping of script witness - -- index to execution units. - -> Either PlutusScriptCostError [ScriptCostOutput] -renderScriptCosts (UTxO utxo) eUnitPrices scriptMapping executionCostMapping = - sequenceA $ Map.foldlWithKey - (\accum sWitInd eExecUnits -> do - case List.lookup sWitInd scriptMapping of - Just (AnyScriptWitness SimpleScriptWitness{}) -> accum - - Just (AnyScriptWitness (PlutusScriptWitness _ pVer (PScript pScript) _ _ _)) -> do - let scriptHash = hashScript $ PlutusScript pVer pScript - case eExecUnits of - Right execUnits -> - case calculateExecutionUnitsLovelace eUnitPrices execUnits of - Just llCost -> - Right (ScriptCostOutput scriptHash execUnits llCost) - : accum - Nothing -> - Left (PlutusScriptCostErrRationalExceedsBound eUnitPrices execUnits) - : accum - Left err -> Left (PlutusScriptCostErrExecError sWitInd (Just scriptHash) err) : accum - -- TODO: Create a new sum type to encapsulate the fact that we can also - -- have a txin and render the txin in the case of reference scripts. - Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn _) _ _ _)) -> - case Map.lookup refTxIn utxo of - Nothing -> Left (PlutusScriptCostErrRefInputNotInUTxO refTxIn) : accum - Just (TxOut _ _ _ refScript) -> - case refScript of - ReferenceScriptNone -> Left (PlutusScriptCostErrRefInputNoScript refTxIn) : accum - ReferenceScript _ (ScriptInAnyLang _ script) -> - case eExecUnits of - Right execUnits -> - case calculateExecutionUnitsLovelace eUnitPrices execUnits of - Just llCost -> - Right (ScriptCostOutput (hashScript script) execUnits llCost) - : accum - Nothing -> - Left (PlutusScriptCostErrRationalExceedsBound eUnitPrices execUnits) - : accum - Left err -> Left (PlutusScriptCostErrExecError sWitInd Nothing err) : accum - - - Nothing -> Left (PlutusScriptCostErrPlutusScriptNotFound sWitInd) : accum - - ) [] executionCostMapping diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs deleted file mode 100644 index 5741a2b9978..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ /dev/null @@ -1,3446 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} - -module Cardano.CLI.Shelley.Parsers - ( -- * CLI command parser - parseShelleyCommands - - -- * CLI command and flag types - , module Cardano.CLI.Shelley.Commands - - -- * Field parser and renderers - , parseTxIn - ) where - -import Cardano.Prelude (ConvertText (..)) - -import qualified Data.Aeson as Aeson -import qualified Data.Attoparsec.ByteString.Char8 as Atto -import Data.Bifunctor -import Data.ByteString (ByteString) -import qualified Data.ByteString.Base16 as B16 -import qualified Data.ByteString.Char8 as BSC -import Data.Foldable -import Data.Functor (($>)) -import qualified Data.IP as IP -import Data.List.NonEmpty (NonEmpty) -import qualified Data.List.NonEmpty as NE -import Data.Maybe (fromMaybe) -import Data.Ratio ((%)) -import qualified Data.Set as Set -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import Data.Time.Clock (UTCTime) -import Data.Time.Format (defaultTimeLocale, parseTimeOrError) -import Data.Word (Word64) -import GHC.Natural (Natural) -import Network.Socket (PortNumber) -import Options.Applicative hiding (help, str) -import qualified Options.Applicative as Opt -import qualified Options.Applicative.Help as H -import Prettyprinter (line, pretty) -import qualified Text.Parsec as Parsec -import Text.Parsec (()) -import qualified Text.Parsec.Error as Parsec -import qualified Text.Parsec.Language as Parsec -import qualified Text.Parsec.String as Parsec -import qualified Text.Parsec.Token as Parsec -import Text.Read (readEither, readMaybe) - -import qualified Cardano.Ledger.BaseTypes as Shelley -import qualified Cardano.Ledger.Shelley.TxBody as Shelley - -import Cardano.Api -import Cardano.Api.Shelley - -import Cardano.Chain.Common (BlockCount (BlockCount)) - -import Cardano.CLI.Common.Parsers -import Cardano.CLI.Environment (EnvCli (..)) -import Cardano.CLI.Shelley.Commands -import Cardano.CLI.Shelley.Key (DelegationTarget (..), PaymentVerifier (..), - StakeIdentifier (..), StakeVerifier (..), VerificationKeyOrFile (..), - VerificationKeyOrHashOrFile (..), VerificationKeyTextOrFile (..)) -import Cardano.CLI.Types - -{- HLINT ignore "Use <$>" -} -{- HLINT ignore "Move brackets to avoid $" -} - --- --- Shelley CLI command parsers --- - -parseShelleyCommands :: EnvCli -> Parser ShelleyCommand -parseShelleyCommands envCli = - Opt.hsubparser $ mconcat - [ Opt.metavar "Era based commands" - , Opt.commandGroup "Era based commands" - , Opt.command "address" $ - Opt.info (AddressCmd <$> pAddressCmd envCli) $ Opt.progDesc "Payment address commands" - , Opt.command "stake-address" $ - Opt.info (StakeAddressCmd <$> pStakeAddressCmd envCli) $ Opt.progDesc "Stake address commands" - , Opt.command "key" $ - Opt.info (KeyCmd <$> pKeyCmd) $ Opt.progDesc "Key utility commands" - , Opt.command "transaction" $ - Opt.info (TransactionCmd <$> pTransaction envCli) $ Opt.progDesc "Transaction commands" - , Opt.command "node" $ - Opt.info (NodeCmd <$> pNodeCmd) $ Opt.progDesc "Node operation commands" - , Opt.command "stake-pool" $ - Opt.info (PoolCmd <$> pPoolCmd envCli) $ Opt.progDesc "Stake pool commands" - , Opt.command "query" $ - Opt.info (QueryCmd <$> pQueryCmd envCli) . Opt.progDesc $ mconcat - [ "Node query commands. Will query the local node whose Unix domain socket " - , "is obtained from the CARDANO_NODE_SOCKET_PATH environment variable." - ] - , Opt.command "genesis" $ - Opt.info (GenesisCmd <$> pGenesisCmd envCli) $ Opt.progDesc "Genesis block commands" - , Opt.command "governance" $ - Opt.info (GovernanceCmd <$> pGovernanceCmd) $ Opt.progDesc "Governance commands" - , Opt.command "text-view" $ - Opt.info (TextViewCmd <$> pTextViewCmd) . Opt.progDesc $ mconcat - [ "Commands for dealing with Shelley TextView files. " - , "Transactions, addresses etc are stored on disk as TextView files." - ] - ] - -pTextViewCmd :: Parser TextViewCmd -pTextViewCmd = - asum - [ subParser "decode-cbor" - (Opt.info (TextViewInfo <$> pCBORInFile <*> pMaybeOutputFile) - $ Opt.progDesc "Print a TextView file as decoded CBOR." - ) - ] - -pCBORInFile :: Parser FilePath -pCBORInFile = - Opt.strOption - ( Opt.long "in-file" - <> Opt.metavar "FILE" - <> Opt.help "CBOR input file." - <> Opt.completer (Opt.bashCompleter "file") - ) - <|> - Opt.strOption - ( Opt.long "file" - <> Opt.internal - ) - -pAddressCmd :: EnvCli -> Parser AddressCmd -pAddressCmd envCli = - asum - [ subParser "key-gen" - (Opt.info pAddressKeyGen $ Opt.progDesc "Create an address key pair.") - , subParser "key-hash" - (Opt.info pAddressKeyHash $ Opt.progDesc "Print the hash of an address key.") - , subParser "build" - (Opt.info pAddressBuild $ Opt.progDesc "Build a Shelley payment address, with optional delegation to a stake address.") - , subParser "info" - (Opt.info pAddressInfo $ Opt.progDesc "Print information about an address.") - ] - where - pAddressKeyGen :: Parser AddressCmd - pAddressKeyGen = AddressKeyGen - <$> pAddressKeyType - <*> pVerificationKeyFileOut - <*> pSigningKeyFileOut - - pAddressKeyHash :: Parser AddressCmd - pAddressKeyHash = - AddressKeyHash - <$> pPaymentVerificationKeyTextOrFile - <*> pMaybeOutputFile - - pAddressBuild :: Parser AddressCmd - pAddressBuild = AddressBuild - <$> pPaymentVerifier - <*> Opt.optional pStakeIdentifier - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pAddressInfo :: Parser AddressCmd - pAddressInfo = AddressInfo <$> pAddress <*> pMaybeOutputFile - -pPaymentVerifier :: Parser PaymentVerifier -pPaymentVerifier = - PaymentVerifierKey <$> pPaymentVerificationKeyTextOrFile - <|> PaymentVerifierScriptFile <$> - pScriptFor "payment-script-file" Nothing - "Filepath of the payment script." - -pStakeIdentifier :: Parser StakeIdentifier -pStakeIdentifier = asum - [ StakeIdentifierVerifier <$> pStakeVerifier - , StakeIdentifierAddress <$> pStakeAddress - ] - -pStakeVerifier :: Parser StakeVerifier -pStakeVerifier = asum - [ StakeVerifierKey <$> pStakeVerificationKeyOrFile - , StakeVerifierScriptFile <$> pScriptFor "stake-script-file" Nothing "Filepath of the staking script." - ] - -pPaymentVerificationKeyTextOrFile :: Parser VerificationKeyTextOrFile -pPaymentVerificationKeyTextOrFile = - VktofVerificationKeyText <$> pPaymentVerificationKeyText - <|> VktofVerificationKeyFile <$> pPaymentVerificationKeyFile - -pPaymentVerificationKeyText :: Parser Text -pPaymentVerificationKeyText = - Text.pack <$> - Opt.strOption - ( Opt.long "payment-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "Payment verification key (Bech32-encoded)" - ) - -pPaymentVerificationKeyFile :: Parser (VerificationKeyFile In) -pPaymentVerificationKeyFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "payment-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the payment verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "verification-key-file" - , Opt.internal - ] - ] - -pScript :: Parser ScriptFile -pScript = pScriptFor "script-file" Nothing "Filepath of the script." - -pScriptFor :: String -> Maybe String -> String -> Parser ScriptFile -pScriptFor name Nothing help = - ScriptFile <$> Opt.strOption - ( Opt.long name - <> Opt.metavar "FILE" - <> Opt.help help - <> Opt.completer (Opt.bashCompleter "file") - ) - -pScriptFor name (Just deprecated) help = - pScriptFor name Nothing help - <|> ScriptFile <$> Opt.strOption - ( Opt.long deprecated - <> Opt.internal - ) - -pReferenceTxIn :: String -> String -> Parser TxIn -pReferenceTxIn prefix scriptType = - Opt.option (readerFromParsecParser parseTxIn) $ mconcat - [ Opt.long (prefix ++ "tx-in-reference") - , Opt.metavar "TX-IN" - , Opt.help $ mconcat - [ "TxId#TxIx - Specify a reference input. The reference input must have" - , " a " <> scriptType <> " reference script attached." - ] - ] - -pReadOnlyReferenceTxIn :: Parser TxIn -pReadOnlyReferenceTxIn = - Opt.option (readerFromParsecParser parseTxIn) $ mconcat - [ Opt.long "read-only-tx-in-reference" - , Opt.metavar "TX-IN" - , Opt.help $ mconcat - [ "Specify a read only reference input. This reference input is not witnessing anything " - , "it is simply provided in the plutus script context." - ] - ] - - -pScriptWitnessFiles :: forall witctx. - WitCtx witctx - -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag. - -> String -- ^ Script flag prefix - -> Maybe String - -> String - -> Parser (ScriptWitnessFiles witctx) -pScriptWitnessFiles witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help = - toScriptWitnessFiles - <$> pScriptFor (scriptFlagPrefix ++ "-script-file") - ((++ "-script-file") <$> scriptFlagPrefixDeprecated) - ("The file containing the script to witness " ++ help) - <*> optional ((,,) <$> pScriptDatumOrFile scriptFlagPrefix witctx - <*> pScriptRedeemerOrFile scriptFlagPrefix - <*> (case autoBalanceExecUnits of - AutoBalance -> pure (ExecutionUnits 0 0) - ManualBalance -> pExecutionUnits scriptFlagPrefix) - ) - where - toScriptWitnessFiles :: ScriptFile - -> Maybe (ScriptDatumOrFile witctx, - ScriptRedeemerOrFile, - ExecutionUnits) - -> ScriptWitnessFiles witctx - toScriptWitnessFiles sf Nothing = SimpleScriptWitnessFile sf - toScriptWitnessFiles sf (Just (d,r, e)) = PlutusScriptWitnessFiles sf d r e - - -pExecutionUnits :: String -> Parser ExecutionUnits -pExecutionUnits scriptFlagPrefix = - uncurry ExecutionUnits <$> - Opt.option Opt.auto - ( Opt.long (scriptFlagPrefix ++ "-execution-units") - <> Opt.metavar "(INT, INT)" - <> Opt.help "The time and space units needed by the script." - ) - -pScriptRedeemerOrFile :: String -> Parser ScriptDataOrFile -pScriptRedeemerOrFile scriptFlagPrefix = - pScriptDataOrFile (scriptFlagPrefix ++ "-redeemer") - "The script redeemer, in JSON syntax." - "The script redeemer, in the given JSON file." - - -pScriptDatumOrFile :: String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx) -pScriptDatumOrFile scriptFlagPrefix witctx = - case witctx of - WitCtxTxIn -> (ScriptDatumOrFileForTxIn <$> - pScriptDataOrFile - (scriptFlagPrefix ++ "-datum") - "The script datum, in JSON syntax." - "The script datum, in the given JSON file.") <|> - pInlineDatumPresent - WitCtxMint -> pure NoScriptDatumOrFileForMint - WitCtxStake -> pure NoScriptDatumOrFileForStake - where - pInlineDatumPresent :: Parser (ScriptDatumOrFile WitCtxTxIn) - pInlineDatumPresent = - flag' InlineDatumPresentAtTxIn - ( long (scriptFlagPrefix ++ "-inline-datum-present") - <> Opt.help "Inline datum present at transaction input." - ) - -pScriptDataOrFile :: String -> String -> String -> Parser ScriptDataOrFile -pScriptDataOrFile dataFlagPrefix helpTextForValue helpTextForFile = - pScriptDataCborFile - <|> pScriptDataFile - <|> pScriptDataValue - where - pScriptDataCborFile = fmap ScriptDataCborFile . Opt.strOption $ mconcat - [ Opt.long (dataFlagPrefix ++ "-cbor-file") - , Opt.metavar "CBOR FILE" - , Opt.help $ mconcat - [ helpTextForFile - , " The file must follow the special JSON schema for script data." - ] - ] - - pScriptDataFile = fmap ScriptDataJsonFile . Opt.strOption $ mconcat - [ Opt.long (dataFlagPrefix ++ "-file") - , Opt.metavar "JSON FILE" - , Opt.help $ mconcat - [ helpTextForFile ++ " The file must follow the special " - , "JSON schema for script data." - ] - ] - - pScriptDataValue = fmap ScriptDataValue . Opt.option readerScriptData $ mconcat - [ Opt.long (dataFlagPrefix ++ "-value") - , Opt.metavar "JSON VALUE" - , Opt.help $ mconcat - [ helpTextForValue - , " There is no schema: (almost) any JSON value is supported, including " - , "top-level strings and numbers." - ] - ] - - readerScriptData :: ReadM HashableScriptData - readerScriptData = do - v <- Opt.str - case Aeson.eitherDecode v of - Left e -> fail $ "readerScriptData: " <> e - Right sDataValue -> - case scriptDataJsonToHashable ScriptDataJsonNoSchema sDataValue of - Left err -> fail (displayError err) - Right sd -> return sd - -pStakeAddressCmd :: EnvCli -> Parser StakeAddressCmd -pStakeAddressCmd envCli = - asum - [ subParser "key-gen" - (Opt.info pStakeAddressKeyGen $ Opt.progDesc "Create a stake address key pair") - , subParser "build" - (Opt.info pStakeAddressBuild $ Opt.progDesc "Build a stake address") - , subParser "key-hash" - (Opt.info pStakeAddressKeyHash $ Opt.progDesc "Print the hash of a stake address key.") - , subParser "registration-certificate" - (Opt.info pStakeAddressRegistrationCert $ Opt.progDesc "Create a stake address registration certificate") - , subParser "deregistration-certificate" - (Opt.info pStakeAddressDeregistrationCert $ Opt.progDesc "Create a stake address deregistration certificate") - , subParser "delegation-certificate" - (Opt.info pStakeAddressPoolDelegationCert $ Opt.progDesc "Create a stake address pool delegation certificate") - ] - where - pStakeAddressKeyGen :: Parser StakeAddressCmd - pStakeAddressKeyGen = - StakeAddressKeyGen - <$> pVerificationKeyFileOut - <*> pSigningKeyFileOut - - pStakeAddressKeyHash :: Parser StakeAddressCmd - pStakeAddressKeyHash = StakeAddressKeyHash <$> pStakeVerificationKeyOrFile <*> pMaybeOutputFile - - pStakeAddressBuild :: Parser StakeAddressCmd - pStakeAddressBuild = - StakeAddressBuild - <$> pStakeVerifier - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pStakeAddressRegistrationCert :: Parser StakeAddressCmd - pStakeAddressRegistrationCert = - StakeRegistrationCert - <$> pStakeIdentifier - <*> pOutputFile - - pStakeAddressDeregistrationCert :: Parser StakeAddressCmd - pStakeAddressDeregistrationCert = - StakeCredentialDeRegistrationCert - <$> pStakeIdentifier - <*> pOutputFile - - pStakeAddressPoolDelegationCert :: Parser StakeAddressCmd - pStakeAddressPoolDelegationCert = - StakeCredentialDelegationCert - <$> pStakeIdentifier - <*> pDelegationTarget - <*> pOutputFile - -pKeyCmd :: Parser KeyCmd -pKeyCmd = - asum - [ subParser "verification-key" $ - Opt.info pKeyGetVerificationKey $ - Opt.progDesc $ "Get a verification key from a signing key. This " - ++ " supports all key types." - , subParser "non-extended-key" $ - Opt.info pKeyNonExtendedKey $ - Opt.progDesc $ "Get a non-extended verification key from an " - ++ "extended verification key. This supports all " - ++ "extended key types." - , subParser "convert-byron-key" $ - Opt.info pKeyConvertByronKey $ - Opt.progDesc $ "Convert a Byron payment, genesis or genesis " - ++ "delegate key (signing or verification) to a " - ++ "corresponding Shelley-format key." - , subParser "convert-byron-genesis-vkey" $ - Opt.info pKeyConvertByronGenesisVKey $ - Opt.progDesc $ "Convert a Base64-encoded Byron genesis " - ++ "verification key to a Shelley genesis " - ++ "verification key" - , subParser "convert-itn-key" $ - Opt.info pKeyConvertITNKey $ - Opt.progDesc $ "Convert an Incentivized Testnet (ITN) non-extended " - ++ "(Ed25519) signing or verification key to a " - ++ "corresponding Shelley stake key" - , subParser "convert-itn-extended-key" $ - Opt.info pKeyConvertITNExtendedKey $ - Opt.progDesc $ "Convert an Incentivized Testnet (ITN) extended " - ++ "(Ed25519Extended) signing key to a corresponding " - ++ "Shelley stake signing key" - , subParser "convert-itn-bip32-key" $ - Opt.info pKeyConvertITNBip32Key $ - Opt.progDesc $ "Convert an Incentivized Testnet (ITN) BIP32 " - ++ "(Ed25519Bip32) signing key to a corresponding " - ++ "Shelley stake signing key" - , subParser "convert-cardano-address-key" $ - Opt.info pKeyConvertCardanoAddressSigningKey $ - Opt.progDesc $ "Convert a cardano-address extended signing key " - ++ "to a corresponding Shelley-format key." - ] - where - pKeyGetVerificationKey :: Parser KeyCmd - pKeyGetVerificationKey = - KeyGetVerificationKey - <$> pSigningKeyFileIn - <*> pVerificationKeyFileOut - - pKeyNonExtendedKey :: Parser KeyCmd - pKeyNonExtendedKey = - KeyNonExtendedKey - <$> pExtendedVerificationKeyFileIn - <*> pVerificationKeyFileOut - - pKeyConvertByronKey :: Parser KeyCmd - pKeyConvertByronKey = - KeyConvertByronKey - <$> optional pPassword - <*> pByronKeyType - <*> pByronKeyFile - <*> pOutputFile - - pPassword :: Parser Text - pPassword = Opt.strOption - ( Opt.long "password" - <> Opt.metavar "TEXT" - <> Opt.help "Password for signing key (if applicable)." - ) - - pByronKeyType :: Parser ByronKeyType - pByronKeyType = - Opt.flag' (ByronPaymentKey NonLegacyByronKeyFormat) - ( Opt.long "byron-payment-key-type" - <> Opt.help "Use a Byron-era payment key." - ) - <|> Opt.flag' (ByronPaymentKey LegacyByronKeyFormat) - ( Opt.long "legacy-byron-payment-key-type" - <> Opt.help "Use a Byron-era payment key, in legacy SL format." - ) - <|> Opt.flag' (ByronGenesisKey NonLegacyByronKeyFormat) - ( Opt.long "byron-genesis-key-type" - <> Opt.help "Use a Byron-era genesis key." - ) - <|> Opt.flag' (ByronGenesisKey LegacyByronKeyFormat) - ( Opt.long "legacy-byron-genesis-key-type" - <> Opt.help "Use a Byron-era genesis key, in legacy SL format." - ) - <|> Opt.flag' (ByronDelegateKey NonLegacyByronKeyFormat) - ( Opt.long "byron-genesis-delegate-key-type" - <> Opt.help "Use a Byron-era genesis delegate key." - ) - <|> Opt.flag' (ByronDelegateKey LegacyByronKeyFormat) - ( Opt.long "legacy-byron-genesis-delegate-key-type" - <> Opt.help "Use a Byron-era genesis delegate key, in legacy SL format." - ) - - pByronKeyFile :: Parser (SomeKeyFile In) - pByronKeyFile = - (ASigningKeyFile <$> pByronSigningKeyFile) - <|> (AVerificationKeyFile <$> pByronVerificationKeyFile) - - pByronSigningKeyFile :: Parser (SigningKeyFile In) - pByronSigningKeyFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "byron-signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the Byron-format signing key." - , Opt.completer (Opt.bashCompleter "file") - ] - - pByronVerificationKeyFile :: Parser (VerificationKeyFile In) - pByronVerificationKeyFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "byron-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the Byron-format verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - - pKeyConvertByronGenesisVKey :: Parser KeyCmd - pKeyConvertByronGenesisVKey = - KeyConvertByronGenesisVKey - <$> pByronGenesisVKeyBase64 - <*> pOutputFile - - pByronGenesisVKeyBase64 :: Parser VerificationKeyBase64 - pByronGenesisVKeyBase64 = - VerificationKeyBase64 <$> - Opt.strOption - ( Opt.long "byron-genesis-verification-key" - <> Opt.metavar "BASE64" - <> Opt.help "Base64 string for the Byron genesis verification key." - ) - - pKeyConvertITNKey :: Parser KeyCmd - pKeyConvertITNKey = - KeyConvertITNStakeKey - <$> pITNKeyFIle - <*> pOutputFile - - pKeyConvertITNExtendedKey :: Parser KeyCmd - pKeyConvertITNExtendedKey = - KeyConvertITNExtendedToStakeKey - <$> pITNSigningKeyFile - <*> pOutputFile - - pKeyConvertITNBip32Key :: Parser KeyCmd - pKeyConvertITNBip32Key = - KeyConvertITNBip32ToStakeKey - <$> pITNSigningKeyFile - <*> pOutputFile - - pITNKeyFIle :: Parser (SomeKeyFile direction) - pITNKeyFIle = pITNSigningKeyFile - <|> pITNVerificationKeyFile - - pITNSigningKeyFile :: Parser (SomeKeyFile direction) - pITNSigningKeyFile = - fmap (ASigningKeyFile . File) $ Opt.strOption $ mconcat - [ Opt.long "itn-signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the ITN signing key." - , Opt.completer (Opt.bashCompleter "file") - ] - - pITNVerificationKeyFile :: Parser (SomeKeyFile direction) - pITNVerificationKeyFile = - fmap (AVerificationKeyFile . File) $ Opt.strOption $ mconcat - [ Opt.long "itn-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the ITN verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - - pKeyConvertCardanoAddressSigningKey :: Parser KeyCmd - pKeyConvertCardanoAddressSigningKey = - KeyConvertCardanoAddressSigningKey - <$> pCardanoAddressKeyType - <*> pSigningKeyFileIn - <*> pOutputFile - - pCardanoAddressKeyType :: Parser CardanoAddressKeyType - pCardanoAddressKeyType = - Opt.flag' CardanoAddressShelleyPaymentKey - ( Opt.long "shelley-payment-key" - <> Opt.help "Use a Shelley-era extended payment key." - ) - <|> Opt.flag' CardanoAddressShelleyStakeKey - ( Opt.long "shelley-stake-key" - <> Opt.help "Use a Shelley-era extended stake key." - ) - <|> Opt.flag' CardanoAddressIcarusPaymentKey - ( Opt.long "icarus-payment-key" - <> Opt.help "Use a Byron-era extended payment key formatted in the Icarus style." - ) - <|> Opt.flag' CardanoAddressByronPaymentKey - ( Opt.long "byron-payment-key" - <> Opt.help "Use a Byron-era extended payment key formatted in the deprecated Byron style." - ) - -pTransaction :: EnvCli -> Parser TransactionCmd -pTransaction envCli = - asum - [ subParser "build-raw" - $ Opt.info pTransactionBuildRaw $ Opt.progDescDoc $ Just $ mconcat - [ pretty @String "Build a transaction (low-level, inconvenient)" - , line - , line - , H.yellow $ mconcat - [ "Please note the order of some cmd options is crucial. If used incorrectly may produce " - , "undesired tx body. See nested [] notation above for details." - ] - ] - , subParser "build" - $ Opt.info pTransactionBuild $ Opt.progDescDoc $ Just $ mconcat - [ pretty @String "Build a balanced transaction (automatically calculates fees)" - , line - , line - , H.yellow $ mconcat - [ "Please note " - , H.underline "the order" - , " of some cmd options is crucial. If used incorrectly may produce " - , "undesired tx body. See nested [] notation above for details." - ] - ] - , subParser "sign" - (Opt.info pTransactionSign $ Opt.progDesc "Sign a transaction") - , subParser "witness" - (Opt.info pTransactionCreateWitness $ Opt.progDesc "Create a transaction witness") - , subParser "assemble" - (Opt.info pTransactionAssembleTxBodyWit - $ Opt.progDesc "Assemble a tx body and witness(es) to form a transaction") - , pSignWitnessBackwardCompatible - , subParser "submit" - (Opt.info pTransactionSubmit . Opt.progDesc $ - mconcat - [ "Submit a transaction to the local node whose Unix domain socket " - , "is obtained from the CARDANO_NODE_SOCKET_PATH environment variable." - ] - ) - , subParser "policyid" - (Opt.info pTransactionPolicyId $ Opt.progDesc "Calculate the PolicyId from the monetary policy script.") - , subParser "calculate-min-fee" - (Opt.info pTransactionCalculateMinFee $ Opt.progDesc "Calculate the minimum fee for a transaction.") - , subParser "calculate-min-required-utxo" - (Opt.info pTransactionCalculateMinReqUTxO $ Opt.progDesc "Calculate the minimum required UTxO for a transaction output.") - , pCalculateMinRequiredUtxoBackwardCompatible - , subParser "hash-script-data" - (Opt.info pTxHashScriptData $ Opt.progDesc "Calculate the hash of script data.") - , subParser "txid" - (Opt.info pTransactionId $ Opt.progDesc "Print a transaction identifier.") - , subParser "view" $ - Opt.info pTransactionView $ Opt.progDesc "Print a transaction." - ] - where - -- Backwards compatible parsers - calcMinValueInfo :: ParserInfo TransactionCmd - calcMinValueInfo = - Opt.info pTransactionCalculateMinReqUTxO - $ Opt.progDesc "DEPRECATED: Use 'calculate-min-required-utxo' instead." - - pCalculateMinRequiredUtxoBackwardCompatible :: Parser TransactionCmd - pCalculateMinRequiredUtxoBackwardCompatible = - Opt.subparser - $ Opt.command "calculate-min-value" calcMinValueInfo <> Opt.internal - - assembleInfo :: ParserInfo TransactionCmd - assembleInfo = - Opt.info pTransactionAssembleTxBodyWit - $ Opt.progDesc "Assemble a tx body and witness(es) to form a transaction" - - pSignWitnessBackwardCompatible :: Parser TransactionCmd - pSignWitnessBackwardCompatible = - Opt.subparser - $ Opt.command "sign-witness" assembleInfo <> Opt.internal - - pScriptValidity :: Parser ScriptValidity - pScriptValidity = asum - [ Opt.flag' ScriptValid $ mconcat - [ Opt.long "script-valid" - , Opt.help "Assertion that the script is valid. (default)" - ] - , Opt.flag' ScriptInvalid $ mconcat - [ Opt.long "script-invalid" - , Opt.help $ mconcat - [ "Assertion that the script is invalid. " - , "If a transaction is submitted with such a script, " - , "the script will fail and the collateral will be taken." - ] - ] - ] - - pTransactionBuild :: Parser TransactionCmd - pTransactionBuild = - TxBuild <$> pSocketPath envCli - <*> pCardanoEra - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> optional pScriptValidity - <*> optional pWitnessOverride - <*> some (pTxIn AutoBalance) - <*> many pReadOnlyReferenceTxIn - <*> many pRequiredSigner - <*> many pTxInCollateral - <*> optional pReturnCollateral - <*> optional pTotalCollateral - <*> many pTxOut - <*> pChangeAddress - <*> optional (pMintMultiAsset AutoBalance) - <*> optional pInvalidBefore - <*> optional pInvalidHereafter - <*> many (pCertificateFile AutoBalance) - <*> many (pWithdrawal AutoBalance) - <*> pTxMetadataJsonSchema - <*> many (pScriptFor - "auxiliary-script-file" - Nothing - "Filepath of auxiliary script(s)") - <*> many pMetadataFile - <*> optional pProtocolParamsFile - <*> optional pUpdateProposalFile - <*> (OutputTxBodyOnly <$> pTxBodyFileOut <|> pCalculatePlutusScriptCost) - - pChangeAddress :: Parser TxOutChangeAddress - pChangeAddress = - TxOutChangeAddress <$> - Opt.option (readerFromParsecParser parseAddressAny) - ( Opt.long "change-address" - <> Opt.metavar "ADDRESS" - <> Opt.help "Address where ADA in excess of the tx fee will go to." - ) - - pTransactionBuildRaw :: Parser TransactionCmd - pTransactionBuildRaw = - TxBuildRaw - <$> pCardanoEra - <*> optional pScriptValidity - <*> some (pTxIn ManualBalance) - <*> many pReadOnlyReferenceTxIn - <*> many pTxInCollateral - <*> optional pReturnCollateral - <*> optional pTotalCollateral - <*> many pRequiredSigner - <*> many pTxOut - <*> optional (pMintMultiAsset ManualBalance) - <*> optional pInvalidBefore - <*> optional pInvalidHereafter - <*> optional pTxFee - <*> many (pCertificateFile ManualBalance ) - <*> many (pWithdrawal ManualBalance) - <*> pTxMetadataJsonSchema - <*> many (pScriptFor "auxiliary-script-file" Nothing "Filepath of auxiliary script(s)") - <*> many pMetadataFile - <*> optional pProtocolParamsFile - <*> optional pUpdateProposalFile - <*> pTxBodyFileOut - - pTransactionSign :: Parser TransactionCmd - pTransactionSign = - TxSign - <$> pInputTxOrTxBodyFile - <*> many pWitnessSigningData - <*> optional (pNetworkId envCli) - <*> pTxFileOut - - pTransactionCreateWitness :: Parser TransactionCmd - pTransactionCreateWitness = - TxCreateWitness - <$> pTxBodyFileIn - <*> pWitnessSigningData - <*> optional (pNetworkId envCli) - <*> pOutputFile - - pTransactionAssembleTxBodyWit :: Parser TransactionCmd - pTransactionAssembleTxBodyWit = - TxAssembleTxBodyWitness - <$> pTxBodyFileIn - <*> many pWitnessFile - <*> pOutputFile - - pTransactionSubmit :: Parser TransactionCmd - pTransactionSubmit = - TxSubmit - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pTxSubmitFile - - pTransactionPolicyId :: Parser TransactionCmd - pTransactionPolicyId = TxMintedPolicyId <$> pScript - - pTransactionCalculateMinFee :: Parser TransactionCmd - pTransactionCalculateMinFee = - TxCalculateMinFee - <$> pTxBodyFileIn - <*> pNetworkId envCli - <*> pProtocolParamsFile - <*> pTxInCount - <*> pTxOutCount - <*> pTxShelleyWitnessCount - <*> pTxByronWitnessCount - - pTransactionCalculateMinReqUTxO :: Parser TransactionCmd - pTransactionCalculateMinReqUTxO = TxCalculateMinRequiredUTxO - <$> pCardanoEra - <*> pProtocolParamsFile - <*> pTxOut - - pTxHashScriptData :: Parser TransactionCmd - pTxHashScriptData = TxHashScriptData <$> - pScriptDataOrFile - "script-data" - "The script data, in JSON syntax." - "The script data, in the given JSON file." - - pTransactionId :: Parser TransactionCmd - pTransactionId = TxGetTxId <$> pInputTxOrTxBodyFile - - pTransactionView :: Parser TransactionCmd - pTransactionView = TxView <$> pInputTxOrTxBodyFile - -pNodeCmd :: Parser NodeCmd -pNodeCmd = - asum - [ subParser "key-gen" . Opt.info pKeyGenOperator . Opt.progDesc $ mconcat - [ "Create a key pair for a node operator's offline " - , "key and a new certificate issue counter" - ] - , subParser "key-gen-KES" . Opt.info pKeyGenKES . Opt.progDesc $ mconcat - [ "Create a key pair for a node KES operational key" - ] - , subParser "key-gen-VRF" . Opt.info pKeyGenVRF . Opt.progDesc $ mconcat - [ "Create a key pair for a node VRF operational key" - ] - , subParser "key-hash-VRF". Opt.info pKeyHashVRF . Opt.progDesc $ mconcat - [ "Print hash of a node's operational VRF key." - ] - , subParser "new-counter" . Opt.info pNewCounter . Opt.progDesc $ mconcat - [ "Create a new certificate issue counter" - ] - , subParser "issue-op-cert" . Opt.info pIssueOpCert . Opt.progDesc $ mconcat - [ "Issue a node operational certificate" - ] - ] - where - pKeyGenOperator :: Parser NodeCmd - pKeyGenOperator = - NodeKeyGenCold - <$> pColdVerificationKeyFile - <*> pColdSigningKeyFile - <*> pOperatorCertIssueCounterFile - - pKeyGenKES :: Parser NodeCmd - pKeyGenKES = - NodeKeyGenKES <$> pVerificationKeyFileOut <*> pSigningKeyFileOut - - pKeyGenVRF :: Parser NodeCmd - pKeyGenVRF = - NodeKeyGenVRF <$> pVerificationKeyFileOut <*> pSigningKeyFileOut - - pKeyHashVRF :: Parser NodeCmd - pKeyHashVRF = - NodeKeyHashVRF <$> pVerificationKeyOrFile AsVrfKey <*> pMaybeOutputFile - - pNewCounter :: Parser NodeCmd - pNewCounter = - NodeNewCounter <$> pColdVerificationKeyOrFile - <*> pCounterValue - <*> pOperatorCertIssueCounterFile - - pCounterValue :: Parser Word - pCounterValue = - Opt.option Opt.auto - ( Opt.long "counter-value" - <> Opt.metavar "INT" - <> Opt.help "The next certificate issue counter value to use." - ) - - pIssueOpCert :: Parser NodeCmd - pIssueOpCert = - NodeIssueOpCert <$> pKesVerificationKeyOrFile - <*> pColdSigningKeyFile - <*> pOperatorCertIssueCounterFile - <*> pKesPeriod - <*> pOutputFile - - -pPoolCmd :: EnvCli -> Parser PoolCmd -pPoolCmd envCli = - asum - [ subParser "registration-certificate" - (Opt.info (pStakePoolRegistrationCert envCli) $ Opt.progDesc "Create a stake pool registration certificate") - , subParser "deregistration-certificate" - (Opt.info pStakePoolRetirementCert $ Opt.progDesc "Create a stake pool deregistration certificate") - , subParser "id" - (Opt.info pId $ Opt.progDesc "Build pool id from the offline key") - , subParser "metadata-hash" - (Opt.info pPoolMetadataHashSubCmd $ Opt.progDesc "Print the hash of pool metadata.") - ] - where - pId :: Parser PoolCmd - pId = PoolGetId <$> pStakePoolVerificationKeyOrFile <*> pOutputFormat - - pPoolMetadataHashSubCmd :: Parser PoolCmd - pPoolMetadataHashSubCmd = PoolMetadataHash <$> pPoolMetadataFile <*> pMaybeOutputFile - -pQueryCmd :: EnvCli -> Parser QueryCmd -pQueryCmd envCli = - asum - [ subParser "protocol-parameters" - (Opt.info pQueryProtocolParameters $ Opt.progDesc "Get the node's current protocol parameters") - , subParser "tip" - (Opt.info pQueryTip $ Opt.progDesc "Get the node's current tip (slot no, hash, block no)") - , subParser "stake-pools" - (Opt.info pQueryStakePools $ Opt.progDesc "Get the node's current set of stake pool ids") - , subParser "stake-distribution" - (Opt.info pQueryStakeDistribution $ Opt.progDesc "Get the node's current aggregated stake distribution") - , subParser "stake-address-info" - (Opt.info pQueryStakeAddressInfo $ Opt.progDesc "Get the current delegations and \ - \reward accounts filtered by stake \ - \address.") - , subParser "utxo" - (Opt.info pQueryUTxO $ Opt.progDesc "Get a portion of the current UTxO: \ - \by tx in, by address or the whole.") - , subParser "ledger-state" - (Opt.info pQueryLedgerState $ Opt.progDesc "Dump the current ledger state of the node (Ledger.NewEpochState -- advanced command)") - , subParser "protocol-state" - (Opt.info pQueryProtocolState $ Opt.progDesc "Dump the current protocol state of the node (Ledger.ChainDepState -- advanced command)") - , subParser "stake-snapshot" - (Opt.info pQueryStakeSnapshot $ Opt.progDesc "Obtain the three stake snapshots for a pool, plus the total active stake (advanced command)") - , hiddenSubParser "pool-params" - (Opt.info pQueryPoolState $ Opt.progDesc "DEPRECATED. Use query pool-state instead. Dump the pool parameters (Ledger.NewEpochState.esLState._delegationState._pState._pParams -- advanced command)") - , subParser "leadership-schedule" - (Opt.info pLeadershipSchedule $ Opt.progDesc "Get the slots the node is expected to mint a block in (advanced command)") - , subParser "kes-period-info" - (Opt.info pKesPeriodInfo $ Opt.progDesc "Get information about the current KES period and your node's operational certificate.") - , subParser "pool-state" - (Opt.info pQueryPoolState $ Opt.progDesc "Dump the pool state") - , subParser "tx-mempool" - (Opt.info pQueryTxMempool $ Opt.progDesc "Local Mempool info") - , subParser "slot-number" - (Opt.info pQuerySlotNumber $ Opt.progDesc "Query slot number for UTC timestamp") - ] - where - pQueryProtocolParameters :: Parser QueryCmd - pQueryProtocolParameters = - QueryProtocolParameters' - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pQueryTip :: Parser QueryCmd - pQueryTip = - QueryTip - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pQueryUTxO :: Parser QueryCmd - pQueryUTxO = - QueryUTxO' - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pQueryUTxOFilter - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pQueryStakePools :: Parser QueryCmd - pQueryStakePools = - QueryStakePools' - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pQueryStakeDistribution :: Parser QueryCmd - pQueryStakeDistribution = - QueryStakeDistribution' - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pQueryStakeAddressInfo :: Parser QueryCmd - pQueryStakeAddressInfo = - QueryStakeAddressInfo - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pFilterByStakeAddress - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pQueryLedgerState :: Parser QueryCmd - pQueryLedgerState = - QueryDebugLedgerState' - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pQueryProtocolState :: Parser QueryCmd - pQueryProtocolState = - QueryProtocolState' - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pAllStakePoolsOrOnly :: Parser (AllOrOnly [Hash StakePoolKey]) - pAllStakePoolsOrOnly = pAll <|> pOnly - where pAll :: Parser (AllOrOnly [Hash StakePoolKey]) - pAll = Opt.flag' All - ( Opt.long "all-stake-pools" - <> Opt.help "Query for all stake pools" - ) - pOnly :: Parser (AllOrOnly [Hash StakePoolKey]) - pOnly = Only <$> many pStakePoolVerificationKeyHash - - pQueryStakeSnapshot :: Parser QueryCmd - pQueryStakeSnapshot = - QueryStakeSnapshot' - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pAllStakePoolsOrOnly - <*> pMaybeOutputFile - - pQueryPoolState :: Parser QueryCmd - pQueryPoolState = - QueryPoolState' - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> many pStakePoolVerificationKeyHash - - pQueryTxMempool :: Parser QueryCmd - pQueryTxMempool = - QueryTxMempool - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pTxMempoolQuery - <*> pMaybeOutputFile - where - pTxMempoolQuery :: Parser TxMempoolQuery - pTxMempoolQuery = asum - [ subParser "info" - (Opt.info (pure TxMempoolQueryInfo) $ - Opt.progDesc "Ask the node about the current mempool's capacity and sizes") - , subParser "next-tx" - (Opt.info (pure TxMempoolQueryNextTx) $ - Opt.progDesc "Requests the next transaction from the mempool's current list") - , subParser "tx-exists" - (Opt.info (TxMempoolQueryTxExists <$> argument Opt.str (metavar "TX_ID")) $ - Opt.progDesc "Query if a particular transaction exists in the mempool") - ] - pLeadershipSchedule :: Parser QueryCmd - pLeadershipSchedule = - QueryLeadershipSchedule - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pGenesisFile "Shelley genesis filepath" - <*> pStakePoolVerificationKeyOrHashOrFile - <*> pVrfSigningKeyFile - <*> pWhichLeadershipSchedule - <*> pMaybeOutputFile - - pKesPeriodInfo :: Parser QueryCmd - pKesPeriodInfo = - QueryKesPeriodInfo - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pOperationalCertificateFile - <*> pMaybeOutputFile - - pQuerySlotNumber :: Parser QueryCmd - pQuerySlotNumber = - QuerySlotNumber - <$> pSocketPath envCli - <*> pConsensusModeParams - <*> pNetworkId envCli - <*> pUtcTimestamp - where - pUtcTimestamp = - convertTime <$> (Opt.strArgument . mconcat) - [ Opt.metavar "TIMESTAMP" - , Opt.help "UTC timestamp in YYYY-MM-DDThh:mm:ssZ format" - ] - -pGovernanceCmd :: Parser GovernanceCmd -pGovernanceCmd = - asum - [ subParser "create-mir-certificate" - $ Opt.info (pMIRPayStakeAddresses <|> mirCertParsers) - $ Opt.progDesc "Create an MIR (Move Instantaneous Rewards) certificate" - , subParser "create-genesis-key-delegation-certificate" - $ Opt.info pGovernanceGenesisKeyDelegationCertificate - $ Opt.progDesc "Create a genesis key delegation certificate" - , subParser "create-update-proposal" - $ Opt.info pUpdateProposal - $ Opt.progDesc "Create an update proposal" - , subParser "create-poll" - $ Opt.info pGovernanceCreatePoll - $ Opt.progDesc "Create an SPO poll" - , subParser "answer-poll" - $ Opt.info pGovernanceAnswerPoll - $ Opt.progDesc "Answer an SPO poll" - , subParser "verify-poll" - $ Opt.info pGovernanceVerifyPoll - $ Opt.progDesc "Verify an answer to a given SPO poll" - ] - where - mirCertParsers :: Parser GovernanceCmd - mirCertParsers = asum - [ subParser "stake-addresses" - $ Opt.info pMIRPayStakeAddresses - $ Opt.progDesc "Create an MIR certificate to pay stake addresses" - , subParser "transfer-to-treasury" - $ Opt.info pMIRTransferToTreasury - $ Opt.progDesc "Create an MIR certificate to transfer from the reserves pot to the treasury pot" - , subParser "transfer-to-rewards" - $ Opt.info pMIRTransferToReserves - $ Opt.progDesc "Create an MIR certificate to transfer from the treasury pot to the reserves pot" - ] - - pMIRPayStakeAddresses :: Parser GovernanceCmd - pMIRPayStakeAddresses = GovernanceMIRPayStakeAddressesCertificate - <$> pMIRPot - <*> some pStakeAddress - <*> some pRewardAmt - <*> pOutputFile - - pMIRTransferToTreasury :: Parser GovernanceCmd - pMIRTransferToTreasury = GovernanceMIRTransfer - <$> pTransferAmt - <*> pOutputFile - <*> pure TransferToTreasury - - pMIRTransferToReserves :: Parser GovernanceCmd - pMIRTransferToReserves = GovernanceMIRTransfer - <$> pTransferAmt - <*> pOutputFile - <*> pure TransferToReserves - - pGovernanceGenesisKeyDelegationCertificate :: Parser GovernanceCmd - pGovernanceGenesisKeyDelegationCertificate = - GovernanceGenesisKeyDelegationCertificate - <$> pGenesisVerificationKeyOrHashOrFile - <*> pGenesisDelegateVerificationKeyOrHashOrFile - <*> pVrfVerificationKeyOrHashOrFile - <*> pOutputFile - - pMIRPot :: Parser Shelley.MIRPot - pMIRPot = - Opt.flag' Shelley.ReservesMIR - ( Opt.long "reserves" - <> Opt.help "Use the reserves pot." - ) - <|> Opt.flag' Shelley.TreasuryMIR - ( Opt.long "treasury" - <> Opt.help "Use the treasury pot." - ) - - pUpdateProposal :: Parser GovernanceCmd - pUpdateProposal = GovernanceUpdateProposal - <$> pOutputFile - <*> pEpochNoUpdateProp - <*> some pGenesisVerificationKeyFile - <*> pProtocolParametersUpdate - <*> optional pCostModels - - pGovernanceCreatePoll :: Parser GovernanceCmd - pGovernanceCreatePoll = - GovernanceCreatePoll - <$> pPollQuestion - <*> some pPollAnswer - <*> optional pPollNonce - <*> pOutputFile - - pGovernanceAnswerPoll :: Parser GovernanceCmd - pGovernanceAnswerPoll = - GovernanceAnswerPoll - <$> pPollFile - <*> optional pPollAnswerIndex - <*> optional pOutputFile - - pGovernanceVerifyPoll :: Parser GovernanceCmd - pGovernanceVerifyPoll = - GovernanceVerifyPoll - <$> pPollFile - <*> pPollTxFile - <*> optional pOutputFile - -pPollQuestion :: Parser Text -pPollQuestion = - Opt.strOption - ( Opt.long "question" - <> Opt.metavar "STRING" - <> Opt.help "The question for the poll." - ) - -pPollAnswer :: Parser Text -pPollAnswer = - Opt.strOption - ( Opt.long "answer" - <> Opt.metavar "STRING" - <> Opt.help "A possible choice for the poll. The option is repeatable." - ) - -pPollAnswerIndex :: Parser Word -pPollAnswerIndex = - Opt.option auto - ( Opt.long "answer" - <> Opt.metavar "INT" - <> Opt.help "The index of the chosen answer in the poll. Optional. Asked interactively if omitted." - ) - -pPollFile :: Parser (File GovernancePoll In) -pPollFile = - Opt.strOption - ( Opt.long "poll-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath to the ongoing poll." - <> Opt.completer (Opt.bashCompleter "file") - ) - -pPollTxFile :: Parser (TxFile In) -pPollTxFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "tx-file" - , Opt.metavar "FILE" - , Opt.help "Filepath to the JSON TxBody or JSON Tx carrying a valid poll answer." - , Opt.completer (Opt.bashCompleter "file") - ] - -pPollNonce :: Parser Word -pPollNonce = - Opt.option auto - ( Opt.long "nonce" - <> Opt.metavar "UINT" - <> Opt.help "An (optional) nonce for non-replayability." - ) - -pTransferAmt :: Parser Lovelace -pTransferAmt = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "transfer" - <> Opt.metavar "LOVELACE" - <> Opt.help "The amount to transfer." - ) - -pRewardAmt :: Parser Lovelace -pRewardAmt = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "reward" - <> Opt.metavar "LOVELACE" - <> Opt.help "The reward for the relevant reward account." - ) - -pGenesisCmd :: EnvCli -> Parser GenesisCmd -pGenesisCmd envCli = - asum - [ subParser "key-gen-genesis" - (Opt.info pGenesisKeyGen $ - Opt.progDesc "Create a Shelley genesis key pair") - , subParser "key-gen-delegate" - (Opt.info pGenesisDelegateKeyGen $ - Opt.progDesc "Create a Shelley genesis delegate key pair") - , subParser "key-gen-utxo" - (Opt.info pGenesisUTxOKeyGen $ - Opt.progDesc "Create a Shelley genesis UTxO key pair") - , subParser "key-hash" - (Opt.info pGenesisKeyHash $ - Opt.progDesc "Print the identifier (hash) of a public key") - , subParser "get-ver-key" - (Opt.info pGenesisVerKey $ - Opt.progDesc "Derive the verification key from a signing key") - , subParser "initial-addr" - (Opt.info pGenesisAddr $ - Opt.progDesc "Get the address for an initial UTxO based on the verification key") - , subParser "initial-txin" - (Opt.info pGenesisTxIn $ - Opt.progDesc "Get the TxIn for an initial UTxO based on the verification key") - , subParser "create-cardano" - (Opt.info pGenesisCreateCardano $ - Opt.progDesc ("Create a Byron and Shelley genesis file from a genesis " - ++ "template and genesis/delegation/spending keys.")) - , subParser "create" - (Opt.info pGenesisCreate $ - Opt.progDesc ("Create a Shelley genesis file from a genesis " - ++ "template and genesis/delegation/spending keys.")) - , subParser "create-staked" - (Opt.info pGenesisCreateStaked $ - Opt.progDesc ("Create a staked Shelley genesis file from a genesis " - ++ "template and genesis/delegation/spending keys.")) - , subParser "hash" - (Opt.info pGenesisHash $ - Opt.progDesc "Compute the hash of a genesis file") - ] - where - pGenesisKeyGen :: Parser GenesisCmd - pGenesisKeyGen = - GenesisKeyGenGenesis <$> pVerificationKeyFileOut <*> pSigningKeyFileOut - - pGenesisDelegateKeyGen :: Parser GenesisCmd - pGenesisDelegateKeyGen = - GenesisKeyGenDelegate - <$> pVerificationKeyFileOut - <*> pSigningKeyFileOut - <*> pOperatorCertIssueCounterFile - - pGenesisUTxOKeyGen :: Parser GenesisCmd - pGenesisUTxOKeyGen = - GenesisKeyGenUTxO <$> pVerificationKeyFileOut <*> pSigningKeyFileOut - - pGenesisKeyHash :: Parser GenesisCmd - pGenesisKeyHash = - GenesisCmdKeyHash <$> pVerificationKeyFileIn - - pGenesisVerKey :: Parser GenesisCmd - pGenesisVerKey = - GenesisVerKey - <$> pVerificationKeyFileOut - <*> pSigningKeyFileIn - - pGenesisAddr :: Parser GenesisCmd - pGenesisAddr = - GenesisAddr - <$> pVerificationKeyFileIn - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pGenesisTxIn :: Parser GenesisCmd - pGenesisTxIn = - GenesisTxIn - <$> pVerificationKeyFileIn - <*> pNetworkId envCli - <*> pMaybeOutputFile - - pGenesisCreateCardano :: Parser GenesisCmd - pGenesisCreateCardano = - GenesisCreateCardano - <$> pGenesisDir - <*> pGenesisNumGenesisKeys - <*> pGenesisNumUTxOKeys - <*> pMaybeSystemStart - <*> pInitialSupplyNonDelegated - <*> (BlockCount <$> pSecurityParam) - <*> pSlotLength - <*> pSlotCoefficient - <*> pNetworkId envCli - <*> parseFilePath - "byron-template" - "JSON file with genesis defaults for each byron." - <*> parseFilePath - "shelley-template" - "JSON file with genesis defaults for each shelley." - <*> parseFilePath - "alonzo-template" - "JSON file with genesis defaults for alonzo." - <*> parseFilePath - "conway-template" - "JSON file with genesis defaults for conway." - <*> pNodeConfigTemplate - - pGenesisCreate :: Parser GenesisCmd - pGenesisCreate = - GenesisCreate - <$> pGenesisDir - <*> pGenesisNumGenesisKeys - <*> pGenesisNumUTxOKeys - <*> pMaybeSystemStart - <*> pInitialSupplyNonDelegated - <*> pNetworkId envCli - - pGenesisCreateStaked :: Parser GenesisCmd - pGenesisCreateStaked = - GenesisCreateStaked - <$> pGenesisDir - <*> pGenesisNumGenesisKeys - <*> pGenesisNumUTxOKeys - <*> pGenesisNumPools - <*> pGenesisNumStDelegs - <*> pMaybeSystemStart - <*> pInitialSupplyNonDelegated - <*> pInitialSupplyDelegated - <*> pNetworkId envCli - <*> pBulkPoolCredFiles - <*> pBulkPoolsPerFile - <*> pStuffedUtxoCount - <*> Opt.optional pRelayJsonFp - - pGenesisHash :: Parser GenesisCmd - pGenesisHash = - GenesisHashFile <$> pGenesisFile "The genesis file." - - pGenesisDir :: Parser GenesisDir - pGenesisDir = - GenesisDir <$> - Opt.strOption - ( Opt.long "genesis-dir" - <> Opt.metavar "DIR" - <> Opt.help "The genesis directory containing the genesis template and required genesis/delegation/spending keys." - ) - - pMaybeSystemStart :: Parser (Maybe SystemStart) - pMaybeSystemStart = - Opt.optional $ - SystemStart . convertTime <$> - Opt.strOption - ( Opt.long "start-time" - <> Opt.metavar "UTC-TIME" - <> Opt.help "The genesis start time in YYYY-MM-DDThh:mm:ssZ format. If unspecified, will be the current time +30 seconds." - ) - - pGenesisNumGenesisKeys :: Parser Word - pGenesisNumGenesisKeys = - Opt.option Opt.auto - ( Opt.long "gen-genesis-keys" - <> Opt.metavar "INT" - <> Opt.help "The number of genesis keys to make [default is 3]." - <> Opt.value 3 - ) - - pNodeConfigTemplate :: Parser (Maybe FilePath) - pNodeConfigTemplate = optional $ parseFilePath "node-config-template" "the node config template" - - pGenesisNumUTxOKeys :: Parser Word - pGenesisNumUTxOKeys = - Opt.option Opt.auto - ( Opt.long "gen-utxo-keys" - <> Opt.metavar "INT" - <> Opt.help "The number of UTxO keys to make [default is 0]." - <> Opt.value 0 - ) - - pGenesisNumPools :: Parser Word - pGenesisNumPools = - Opt.option Opt.auto - ( Opt.long "gen-pools" - <> Opt.metavar "INT" - <> Opt.help "The number of stake pool credential sets to make [default is 0]." - <> Opt.value 0 - ) - - pGenesisNumStDelegs :: Parser Word - pGenesisNumStDelegs = - Opt.option Opt.auto - ( Opt.long "gen-stake-delegs" - <> Opt.metavar "INT" - <> Opt.help "The number of stake delegator credential sets to make [default is 0]." - <> Opt.value 0 - ) - - pStuffedUtxoCount :: Parser Word - pStuffedUtxoCount = - Opt.option Opt.auto - ( Opt.long "num-stuffed-utxo" - <> Opt.metavar "INT" - <> Opt.help "The number of fake UTxO entries to generate [default is 0]." - <> Opt.value 0 - ) - - pRelayJsonFp :: Parser FilePath - pRelayJsonFp = - Opt.strOption - ( Opt.long "relay-specification-file" - <> Opt.metavar "FILE" - <> Opt.help "JSON file specified the relays of each stake pool." - <> Opt.completer (Opt.bashCompleter "file") - ) - - pInitialSupplyNonDelegated :: Parser (Maybe Lovelace) - pInitialSupplyNonDelegated = - Opt.optional $ - Lovelace <$> - Opt.option Opt.auto - ( Opt.long "supply" - <> Opt.metavar "LOVELACE" - <> Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial, non-delegating stake holders." - ) - - pInitialSupplyDelegated :: Parser Lovelace - pInitialSupplyDelegated = - fmap (Lovelace . fromMaybe 0) $ Opt.optional $ - Opt.option Opt.auto - ( Opt.long "supply-delegated" - <> Opt.metavar "LOVELACE" - <> Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial, delegating stake holders." - <> Opt.value 0 - ) - - pSecurityParam :: Parser Word64 - pSecurityParam = - Opt.option Opt.auto - ( Opt.long "security-param" - <> Opt.metavar "INT" - <> Opt.help "Security parameter for genesis file [default is 108]." - <> Opt.value 108 - ) - - pSlotLength :: Parser Word - pSlotLength = - Opt.option Opt.auto - ( Opt.long "slot-length" - <> Opt.metavar "INT" - <> Opt.help "slot length (ms) parameter for genesis file [default is 1000]." - <> Opt.value 1000 - ) - - - pSlotCoefficient :: Parser Rational - pSlotCoefficient = - Opt.option readRationalUnitInterval - ( Opt.long "slot-coefficient" - <> Opt.metavar "RATIONAL" - <> Opt.help "Slot Coefficient for genesis file [default is .05]." - <> Opt.value 0.05 - ) - - pBulkPoolCredFiles :: Parser Word - pBulkPoolCredFiles = - Opt.option Opt.auto - ( Opt.long "bulk-pool-cred-files" - <> Opt.metavar "INT" - <> Opt.help "Generate bulk pool credential files [default is 0]." - <> Opt.value 0 - ) - - pBulkPoolsPerFile :: Parser Word - pBulkPoolsPerFile = - Opt.option Opt.auto - ( Opt.long "bulk-pools-per-file" - <> Opt.metavar "INT" - <> Opt.help "Each bulk pool to contain this many pool credential sets [default is 0]." - <> Opt.value 0 - ) - - --- --- Shelley CLI flag parsers --- - -data ParserFileDirection - = Input - | Output - deriving (Eq, Show) - -pAddressKeyType :: Parser AddressKeyType -pAddressKeyType = - Opt.flag' AddressKeyShelley - ( Opt.long "normal-key" - <> Opt.help "Use a normal Shelley-era key (default)." - ) - <|> - Opt.flag' AddressKeyShelleyExtended - ( Opt.long "extended-key" - <> Opt.help "Use an extended ed25519 Shelley-era key." - ) - <|> - Opt.flag' AddressKeyByron - ( Opt.long "byron-key" - <> Opt.help "Use a Byron-era key." - ) - <|> - pure AddressKeyShelley - -pProtocolParamsFile :: Parser ProtocolParamsFile -pProtocolParamsFile = - ProtocolParamsFile <$> - Opt.strOption - ( Opt.long "protocol-params-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath of the JSON-encoded protocol parameters file" - <> Opt.completer (Opt.bashCompleter "file") - ) - -pCalculatePlutusScriptCost :: Parser TxBuildOutputOptions -pCalculatePlutusScriptCost = - OutputScriptCostOnly <$> Opt.strOption - ( Opt.long "calculate-plutus-script-cost" <> - Opt.metavar "FILE" <> - Opt.help "(File () Out) filepath of the script cost information." <> - Opt.completer (Opt.bashCompleter "file") - ) - -pCertificateFile - :: BalanceTxExecUnits - -> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake)) -pCertificateFile balanceExecUnits = - (,) <$> (CertificateFile - <$> ( Opt.strOption - ( Opt.long "certificate-file" - <> Opt.metavar "CERTIFICATEFILE" - <> Opt.help helpText - <> Opt.completer (Opt.bashCompleter "file") - ) - <|> - Opt.strOption (Opt.long "certificate" <> Opt.internal) - ) - ) - <*> optional (pCertifyingScriptOrReferenceScriptWit balanceExecUnits) - where - pCertifyingScriptOrReferenceScriptWit - :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake) - pCertifyingScriptOrReferenceScriptWit bExecUnits = - pScriptWitnessFiles - WitCtxStake - balanceExecUnits - "certificate" Nothing - "the use of the certificate." <|> - pPlutusStakeReferenceScriptWitnessFiles "certificate-" bExecUnits - - helpText = mconcat - [ "Filepath of the certificate. This encompasses all " - , "types of certificates (stake pool certificates, " - , "stake key certificates etc). Optionally specify a script witness." - ] - -pPoolMetadataFile :: Parser (File StakePoolMetadata In) -pPoolMetadataFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "pool-metadata-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the pool metadata." - , Opt.completer (Opt.bashCompleter "file") - ] - -pTxMetadataJsonSchema :: Parser TxMetadataJsonSchema -pTxMetadataJsonSchema = - ( Opt.flag' () - ( Opt.long "json-metadata-no-schema" - <> Opt.help "Use the \"no schema\" conversion from JSON to tx metadata." - ) - $> TxMetadataJsonNoSchema - ) - <|> - ( Opt.flag' () - ( Opt.long "json-metadata-detailed-schema" - <> Opt.help "Use the \"detailed schema\" conversion from JSON to tx metadata." - ) - $> TxMetadataJsonDetailedSchema - ) - <|> - -- Default to the no-schema conversion. - pure TxMetadataJsonNoSchema - -convertTime :: String -> UTCTime -convertTime = - parseTimeOrError False defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" - -pMetadataFile :: Parser MetadataFile -pMetadataFile = - MetadataFileJSON <$> - ( Opt.strOption - ( Opt.long "metadata-json-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath of the metadata file, in JSON format." - <> Opt.completer (Opt.bashCompleter "file") - ) - <|> - Opt.strOption - ( Opt.long "metadata-file" -- backward compat name - <> Opt.internal - ) - ) - <|> - MetadataFileCBOR <$> - Opt.strOption - ( Opt.long "metadata-cbor-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath of the metadata, in raw CBOR format." - <> Opt.completer (Opt.bashCompleter "file") - ) - -pWithdrawal - :: BalanceTxExecUnits - -> Parser (StakeAddress, - Lovelace, - Maybe (ScriptWitnessFiles WitCtxStake)) -pWithdrawal balance = - (\(stakeAddr,lovelace) maybeScriptFp -> (stakeAddr, lovelace, maybeScriptFp)) - <$> Opt.option (readerFromParsecParser parseWithdrawal) - ( Opt.long "withdrawal" - <> Opt.metavar "WITHDRAWAL" - <> Opt.help helpText - ) - <*> optional pWithdrawalScriptOrReferenceScriptWit - where - pWithdrawalScriptOrReferenceScriptWit :: Parser (ScriptWitnessFiles WitCtxStake) - pWithdrawalScriptOrReferenceScriptWit = - pScriptWitnessFiles - WitCtxStake - balance - "withdrawal" Nothing - "the withdrawal of rewards." <|> - pPlutusStakeReferenceScriptWitnessFiles "withdrawal-" balance - - helpText = mconcat - [ "The reward withdrawal as StakeAddress+Lovelace where " - , "StakeAddress is the Bech32-encoded stake address " - , "followed by the amount in Lovelace. Optionally specify " - , "a script witness." - ] - - parseWithdrawal :: Parsec.Parser (StakeAddress, Lovelace) - parseWithdrawal = - (,) <$> parseStakeAddress <* Parsec.char '+' <*> parseLovelace - -pPlutusStakeReferenceScriptWitnessFiles - :: String - -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag. - -> Parser (ScriptWitnessFiles WitCtxStake) -pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits = - PlutusReferenceScriptWitnessFiles - <$> pReferenceTxIn prefix "plutus" - <*> pPlutusScriptLanguage prefix - <*> pure NoScriptDatumOrFileForStake - <*> pScriptRedeemerOrFile (prefix ++ "reference-tx-in") - <*> (case autoBalanceExecUnits of - AutoBalance -> pure (ExecutionUnits 0 0) - ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in") - <*> pure Nothing - -pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage -pPlutusScriptLanguage prefix = - Opt.flag' (AnyScriptLanguage $ PlutusScriptLanguage PlutusScriptV2) - ( Opt.long (prefix ++ "plutus-script-v2") - <> Opt.help "Specify a plutus script v2 reference script." - ) - -pUpdateProposalFile :: Parser UpdateProposalFile -pUpdateProposalFile = - UpdateProposalFile <$> - ( Opt.strOption - ( Opt.long "update-proposal-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath of the update proposal." - <> Opt.completer (Opt.bashCompleter "file") - ) - <|> - Opt.strOption - ( Opt.long "update-proposal" - <> Opt.internal - ) - ) - - -pColdSigningKeyFile :: Parser (SigningKeyFile direction) -pColdSigningKeyFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "cold-signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the cold signing key." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "signing-key-file" - , Opt.internal - ] - ] - -pRequiredSigner :: Parser RequiredSigner -pRequiredSigner = - RequiredSignerSkeyFile <$> sKeyFile - <|> RequiredSignerHash <$> sPayKeyHash - where - sKeyFile :: Parser (SigningKeyFile In) - sKeyFile = fmap File $ Opt.strOption $ mconcat - [ Opt.long "required-signer" - , Opt.metavar "FILE" - , Opt.help $ mconcat - [ "Input filepath of the signing key (zero or more) whose " - , "signature is required." - ] - , Opt.completer (Opt.bashCompleter "file") - ] - sPayKeyHash :: Parser (Hash PaymentKey) - sPayKeyHash = - Opt.option (readerFromParsecParser $ parseHash (AsHash AsPaymentKey)) $ mconcat - [ Opt.long "required-signer-hash" - , Opt.metavar "HASH" - , Opt.help $ mconcat - [ "Hash of the verification key (zero or more) whose " - , "signature is required." - ] - ] - -pVrfSigningKeyFile :: Parser (SigningKeyFile In) -pVrfSigningKeyFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "vrf-signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the VRF signing key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pWhichLeadershipSchedule :: Parser EpochLeadershipSchedule -pWhichLeadershipSchedule = pCurrent <|> pNext - where - pCurrent :: Parser EpochLeadershipSchedule - pCurrent = - Opt.flag' CurrentEpoch - ( Opt.long "current" - <> Opt.help "Get the leadership schedule for the current epoch." - ) - - pNext :: Parser EpochLeadershipSchedule - pNext = - Opt.flag' NextEpoch - ( Opt.long "next" - <> Opt.help "Get the leadership schedule for the following epoch." - ) - -pWitnessSigningData :: Parser WitnessSigningData -pWitnessSigningData = - KeyWitnessSigningData - <$> ( fmap File $ Opt.strOption $ mconcat - [ Opt.long "signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the signing key (one or more)." - , Opt.completer (Opt.bashCompleter "file") - ] - ) - <*> optional pByronAddress - -pSigningKeyFileIn :: Parser (SigningKeyFile In) -pSigningKeyFileIn = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the signing key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pSigningKeyFileOut :: Parser (SigningKeyFile Out) -pSigningKeyFileOut = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Output filepath of the signing key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pKesPeriod :: Parser KESPeriod -pKesPeriod = - fmap KESPeriod $ Opt.option (bounded "KES_PERIOD") $ mconcat - [ Opt.long "kes-period" - , Opt.metavar "NATURAL" - , Opt.help "The start of the KES key validity period." - ] - -pEpochNo :: Parser EpochNo -pEpochNo = - fmap EpochNo $ Opt.option (bounded "EPOCH") $ mconcat - [ Opt.long "epoch" - , Opt.metavar "NATURAL" - , Opt.help "The epoch number." - ] - - -pEpochNoUpdateProp :: Parser EpochNo -pEpochNoUpdateProp = - fmap EpochNo $ Opt.option (bounded "EPOCH") $ mconcat - [ Opt.long "epoch" - , Opt.metavar "EPOCH" - , Opt.help "The epoch number in which the update proposal is valid." - ] - -pGenesisFile :: String -> Parser GenesisFile -pGenesisFile desc = - GenesisFile <$> - Opt.strOption - ( Opt.long "genesis" - <> Opt.metavar "FILE" - <> Opt.help desc - <> Opt.completer (Opt.bashCompleter "file") - ) - -pOperatorCertIssueCounterFile :: Parser (OpCertCounterFile direction) -pOperatorCertIssueCounterFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "operational-certificate-issue-counter-file" - , Opt.metavar "FILE" - , Opt.help "The file with the issue counter for the operational certificate." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "operational-certificate-issue-counter" - , Opt.internal - ] - ] - -pOperationalCertificateFile :: Parser (File () direction) -pOperationalCertificateFile = - Opt.strOption - ( Opt.long "op-cert-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath of the node's operational certificate." - <> Opt.completer (Opt.bashCompleter "file") - ) - -pOutputFormat :: Parser OutputFormat -pOutputFormat = - Opt.option readOutputFormat - ( Opt.long "output-format" - <> Opt.metavar "STRING" - <> Opt.help "Optional output format. Accepted output formats are \"hex\" \ - \and \"bech32\" (default is \"bech32\")." - <> Opt.value OutputFormatBech32 - ) - -pMaybeOutputFile :: Parser (Maybe (File content Out)) -pMaybeOutputFile = - optional $ fmap File $ Opt.strOption $ mconcat - [ Opt.long "out-file" - , Opt.metavar "FILE" - , Opt.help "Optional output file. Default is to write to stdout." - , Opt.completer (Opt.bashCompleter "file") - ] - -pOutputFile :: Parser (File content Out) -pOutputFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "out-file" - , Opt.metavar "FILE" - , Opt.help "The output file." - , Opt.completer (Opt.bashCompleter "file") - ] - -pColdVerificationKeyOrFile :: Parser ColdVerificationKeyOrFile -pColdVerificationKeyOrFile = - ColdStakePoolVerificationKey <$> pStakePoolVerificationKey - <|> ColdGenesisDelegateVerificationKey <$> pGenesisDelegateVerificationKey - <|> ColdVerificationKeyFile <$> pColdVerificationKeyFile - -pColdVerificationKeyFile :: Parser (VerificationKeyFile direction) -pColdVerificationKeyFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "cold-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the cold verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "verification-key-file" - , Opt.internal - ] - ] - -pVerificationKey - :: forall keyrole. SerialiseAsBech32 (VerificationKey keyrole) - => AsType keyrole - -> Parser (VerificationKey keyrole) -pVerificationKey asType = - Opt.option - (readVerificationKey asType) - ( Opt.long "verification-key" - <> Opt.metavar "STRING" - <> Opt.help "Verification key (Bech32 or hex-encoded)." - ) - -pVerificationKeyOrFile - :: SerialiseAsBech32 (VerificationKey keyrole) - => AsType keyrole - -> Parser (VerificationKeyOrFile keyrole) -pVerificationKeyOrFile asType = - asum - [ VerificationKeyValue <$> pVerificationKey asType - , VerificationKeyFilePath <$> pVerificationKeyFileIn - ] - -pVerificationKeyFileIn :: Parser (VerificationKeyFile In) -pVerificationKeyFileIn = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pVerificationKeyFileOut :: Parser (VerificationKeyFile Out) -pVerificationKeyFileOut = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Output filepath of the verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pExtendedVerificationKeyFileIn :: Parser (VerificationKeyFile In) -pExtendedVerificationKeyFileIn = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "extended-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the ed25519-bip32 verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pGenesisVerificationKeyFile :: Parser (VerificationKeyFile In) -pGenesisVerificationKeyFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "genesis-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the genesis verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pGenesisVerificationKeyHash :: Parser (Hash GenesisKey) -pGenesisVerificationKeyHash = - Opt.option - (Opt.eitherReader deserialiseFromHex) - ( Opt.long "genesis-verification-key-hash" - <> Opt.metavar "STRING" - <> Opt.help "Genesis verification key hash (hex-encoded)." - ) - where - deserialiseFromHex :: String -> Either String (Hash GenesisKey) - deserialiseFromHex = - first (\e -> "Invalid genesis verification key hash: " ++ displayError e) - . deserialiseFromRawBytesHex (AsHash AsGenesisKey) - . BSC.pack - -pGenesisVerificationKey :: Parser (VerificationKey GenesisKey) -pGenesisVerificationKey = - Opt.option - (Opt.eitherReader deserialiseFromHex) - ( Opt.long "genesis-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "Genesis verification key (hex-encoded)." - ) - where - deserialiseFromHex :: String -> Either String (VerificationKey GenesisKey) - deserialiseFromHex = - first (\e -> "Invalid genesis verification key: " ++ displayError e) - . deserialiseFromRawBytesHex (AsVerificationKey AsGenesisKey) - . BSC.pack - -pGenesisVerificationKeyOrFile :: Parser (VerificationKeyOrFile GenesisKey) -pGenesisVerificationKeyOrFile = - VerificationKeyValue <$> pGenesisVerificationKey - <|> VerificationKeyFilePath <$> pGenesisVerificationKeyFile - -pGenesisVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile GenesisKey) -pGenesisVerificationKeyOrHashOrFile = - VerificationKeyOrFile <$> pGenesisVerificationKeyOrFile - <|> VerificationKeyHash <$> pGenesisVerificationKeyHash - -pGenesisDelegateVerificationKeyFile :: Parser (VerificationKeyFile In) -pGenesisDelegateVerificationKeyFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "genesis-delegate-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the genesis delegate verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pGenesisDelegateVerificationKeyHash :: Parser (Hash GenesisDelegateKey) -pGenesisDelegateVerificationKeyHash = - Opt.option - (Opt.eitherReader deserialiseFromHex) - ( Opt.long "genesis-delegate-verification-key-hash" - <> Opt.metavar "STRING" - <> Opt.help "Genesis delegate verification key hash (hex-encoded)." - ) - where - deserialiseFromHex :: String -> Either String (Hash GenesisDelegateKey) - deserialiseFromHex = - first - (\e -> - "Invalid genesis delegate verification key hash: " ++ displayError e) - . deserialiseFromRawBytesHex (AsHash AsGenesisDelegateKey) - . BSC.pack - -pGenesisDelegateVerificationKey :: Parser (VerificationKey GenesisDelegateKey) -pGenesisDelegateVerificationKey = - Opt.option - (Opt.eitherReader deserialiseFromHex) - ( Opt.long "genesis-delegate-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "Genesis delegate verification key (hex-encoded)." - ) - where - deserialiseFromHex - :: String - -> Either String (VerificationKey GenesisDelegateKey) - deserialiseFromHex = - first - (\e -> "Invalid genesis delegate verification key: " ++ displayError e) - . deserialiseFromRawBytesHex (AsVerificationKey AsGenesisDelegateKey) - . BSC.pack - -pGenesisDelegateVerificationKeyOrFile - :: Parser (VerificationKeyOrFile GenesisDelegateKey) -pGenesisDelegateVerificationKeyOrFile = - VerificationKeyValue <$> pGenesisDelegateVerificationKey - <|> VerificationKeyFilePath <$> pGenesisDelegateVerificationKeyFile - -pGenesisDelegateVerificationKeyOrHashOrFile - :: Parser (VerificationKeyOrHashOrFile GenesisDelegateKey) -pGenesisDelegateVerificationKeyOrHashOrFile = - VerificationKeyOrFile <$> pGenesisDelegateVerificationKeyOrFile - <|> VerificationKeyHash <$> pGenesisDelegateVerificationKeyHash - -pKesVerificationKeyOrFile :: Parser (VerificationKeyOrFile KesKey) -pKesVerificationKeyOrFile = - VerificationKeyValue <$> pKesVerificationKey - <|> VerificationKeyFilePath <$> pKesVerificationKeyFile - -pKesVerificationKey :: Parser (VerificationKey KesKey) -pKesVerificationKey = - Opt.option - (Opt.eitherReader deserialiseVerKey) - ( Opt.long "kes-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "A Bech32 or hex-encoded hot KES verification key." - ) - where - asType :: AsType (VerificationKey KesKey) - asType = AsVerificationKey AsKesKey - - deserialiseVerKey :: String -> Either String (VerificationKey KesKey) - deserialiseVerKey str = - case deserialiseFromBech32 asType (Text.pack str) of - Right res -> Right res - - -- The input was valid Bech32, but some other error occurred. - Left err@(Bech32UnexpectedPrefix _ _) -> Left (displayError err) - Left err@(Bech32DataPartToBytesError _) -> Left (displayError err) - Left err@(Bech32DeserialiseFromBytesError _) -> Left (displayError err) - Left err@(Bech32WrongPrefix _ _) -> Left (displayError err) - - -- The input was not valid Bech32. Attempt to deserialise it as hex. - Left (Bech32DecodingError _) -> - first - (\e -> "Invalid stake pool verification key: " ++ displayError e) $ - deserialiseFromRawBytesHex asType (BSC.pack str) - -pKesVerificationKeyFile :: Parser (VerificationKeyFile In) -pKesVerificationKeyFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "kes-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the hot KES verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "hot-kes-verification-key-file" - , Opt.internal - ] - ] - -pTxSubmitFile :: Parser FilePath -pTxSubmitFile = - Opt.strOption - ( Opt.long "tx-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath of the transaction you intend to submit." - <> Opt.completer (Opt.bashCompleter "file") - ) - -pTxIn :: BalanceTxExecUnits - -> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn)) -pTxIn balance = - (,) <$> Opt.option (readerFromParsecParser parseTxIn) - ( Opt.long "tx-in" - <> Opt.metavar "TX-IN" - <> Opt.help "TxId#TxIx" - ) - <*> optional (pPlutusReferenceScriptWitness balance <|> - pSimpleReferenceSpendingScriptWitess <|> - pEmbeddedPlutusScriptWitness - ) - where - pSimpleReferenceSpendingScriptWitess :: Parser (ScriptWitnessFiles WitCtxTxIn) - pSimpleReferenceSpendingScriptWitess = - createSimpleReferenceScriptWitnessFiles - <$> pReferenceTxIn "simple-script-" "simple" - where - createSimpleReferenceScriptWitnessFiles - :: TxIn - -> ScriptWitnessFiles WitCtxTxIn - createSimpleReferenceScriptWitnessFiles refTxIn = - let simpleLang = AnyScriptLanguage SimpleScriptLanguage - in SimpleReferenceScriptWitnessFiles refTxIn simpleLang Nothing - - pPlutusReferenceScriptWitness :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn) - pPlutusReferenceScriptWitness autoBalanceExecUnits = - createPlutusReferenceScriptWitnessFiles - <$> pReferenceTxIn "spending-" "plutus" - <*> pPlutusScriptLanguage "spending-" - <*> pScriptDatumOrFile "spending-reference-tx-in" WitCtxTxIn - <*> pScriptRedeemerOrFile "spending-reference-tx-in" - <*> (case autoBalanceExecUnits of - AutoBalance -> pure (ExecutionUnits 0 0) - ManualBalance -> pExecutionUnits "spending-reference-tx-in") - where - createPlutusReferenceScriptWitnessFiles - :: TxIn - -> AnyScriptLanguage - -> ScriptDatumOrFile WitCtxTxIn - -> ScriptRedeemerOrFile - -> ExecutionUnits - -> ScriptWitnessFiles WitCtxTxIn - createPlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits = - PlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits Nothing - - pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn) - pEmbeddedPlutusScriptWitness = - pScriptWitnessFiles - WitCtxTxIn - balance - "tx-in" (Just "txin") - "the spending of the transaction input." - -pTxInCollateral :: Parser TxIn -pTxInCollateral = - Opt.option (readerFromParsecParser parseTxIn) - ( Opt.long "tx-in-collateral" - <> Opt.metavar "TX-IN" - <> Opt.help "TxId#TxIx" - ) - -pReturnCollateral :: Parser TxOutAnyEra -pReturnCollateral = - Opt.option (readerFromParsecParser parseTxOutAnyEra) - ( mconcat - [ Opt.long "tx-out-return-collateral" - , Opt.metavar "ADDRESS VALUE" - -- TODO alonzo: Update the help text to describe the new syntax as well. - , Opt.help ( "The transaction output as ADDRESS VALUE where ADDRESS is " <> - "the Bech32-encoded address followed by the value in " <> - "Lovelace. In the situation where your collateral txin " <> - "over collateralizes the transaction, you can optionally " <> - "specify a tx out of your choosing to return the excess Lovelace." - ) - ] - ) - <*> pure TxOutDatumByNone -- TODO: Babbage era - we should be able to return these - <*> pure ReferenceScriptAnyEraNone -- TODO: Babbage era - we should be able to return these - -pTotalCollateral :: Parser Lovelace -pTotalCollateral = - Opt.option (Lovelace <$> readerFromParsecParser decimal) $ mconcat - [ Opt.long "tx-total-collateral" - , Opt.metavar "INTEGER" - , Opt.help $ mconcat - [ "The total amount of collateral that will be collected " - , "as fees in the event of a Plutus script failure. Must be used " - , "in conjuction with \"--tx-out-return-collateral\"." - ] - ] - -pWitnessOverride :: Parser Word -pWitnessOverride = Opt.option Opt.auto $ mconcat - [ Opt.long "witness-override" - , Opt.metavar "WORD" - , Opt.help "Specify and override the number of witnesses the transaction requires." - ] - -parseTxIn :: Parsec.Parser TxIn -parseTxIn = TxIn <$> parseTxId <*> (Parsec.char '#' *> parseTxIx) - -parseTxId :: Parsec.Parser TxId -parseTxId = do - str <- some Parsec.hexDigit "transaction id (hexadecimal)" - case deserialiseFromRawBytesHex AsTxId (BSC.pack str) of - Right addr -> return addr - Left e -> fail $ "Incorrect transaction id format: " ++ displayError e - -parseTxIx :: Parsec.Parser TxIx -parseTxIx = TxIx . fromIntegral <$> decimal - - -pTxOut :: Parser TxOutAnyEra -pTxOut = - Opt.option (readerFromParsecParser parseTxOutAnyEra) - ( Opt.long "tx-out" - <> Opt.metavar "ADDRESS VALUE" - -- TODO alonzo: Update the help text to describe the new syntax as well. - <> Opt.help "The transaction output as ADDRESS VALUE where ADDRESS is \ - \the Bech32-encoded address followed by the value in \ - \the multi-asset syntax (including simply Lovelace)." - ) - <*> pTxOutDatum - <*> pRefScriptFp - - -pTxOutDatum :: Parser TxOutDatumAnyEra -pTxOutDatum = - pTxOutDatumByHashOnly - <|> pTxOutDatumByHashOf - <|> pTxOutDatumByValue - <|> pTxOutInlineDatumByValue - <|> pure TxOutDatumByNone - where - pTxOutDatumByHashOnly = - fmap TxOutDatumByHashOnly - $ Opt.option (readerFromParsecParser $ parseHash (AsHash AsScriptData)) - $ mconcat - [ Opt.long "tx-out-datum-hash" - , Opt.metavar "HASH" - , Opt.help $ mconcat - [ "The script datum hash for this tx output, as " - , "the raw datum hash (in hex)." - ] - ] - - pTxOutDatumByHashOf = TxOutDatumByHashOf <$> - pScriptDataOrFile - "tx-out-datum-hash" - ( mconcat - [ "The script datum hash for this tx output, by hashing the " - , "script datum given here in JSON syntax." - ] - ) - ( mconcat - [ "The script datum hash for this tx output, by hashing the " - , "script datum in the given JSON file." - ] - ) - - pTxOutDatumByValue = - TxOutDatumByValue <$> - pScriptDataOrFile - "tx-out-datum-embed" - ( mconcat - [ "The script datum to embed in the tx for this output, " - , "given here in JSON syntax." - ] - ) - ( mconcat - [ "The script datum to embed in the tx for this output, " - , "in the given JSON file." - ] - ) - - pTxOutInlineDatumByValue = - TxOutInlineDatumByValue <$> - pScriptDataOrFile - "tx-out-inline-datum" - ( mconcat - [ "The script datum to embed in the tx output as an inline datum, " - , "given here in JSON syntax." - ] - ) - ( mconcat - [ "The script datum to embed in the tx output as an inline datum, " - , "in the given JSON file." - ] - ) - -pRefScriptFp :: Parser ReferenceScriptAnyEra -pRefScriptFp = - ReferenceScriptAnyEra <$> Opt.strOption - ( Opt.long "tx-out-reference-script-file" - <> Opt.metavar "FILE" - <> Opt.help "Reference script input file." - <> Opt.completer (Opt.bashCompleter "file") - ) <|> pure ReferenceScriptAnyEraNone - -pMintMultiAsset - :: BalanceTxExecUnits - -> Parser (Value, [ScriptWitnessFiles WitCtxMint]) -pMintMultiAsset balanceExecUnits = - (,) <$> Opt.option - (readerFromParsecParser parseValue) - ( Opt.long "mint" - <> Opt.metavar "VALUE" - <> Opt.help helpText - ) - <*> some (pMintingScriptOrReferenceScriptWit balanceExecUnits <|> - pSimpleReferenceMintingScriptWitness <|> - pPlutusMintReferenceScriptWitnessFiles balanceExecUnits - ) - where - pMintingScriptOrReferenceScriptWit - :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint) - pMintingScriptOrReferenceScriptWit bExecUnits = - pScriptWitnessFiles - WitCtxMint - bExecUnits - "mint" (Just "minting") - "the minting of assets for a particular policy Id." - - pSimpleReferenceMintingScriptWitness :: Parser (ScriptWitnessFiles WitCtxMint) - pSimpleReferenceMintingScriptWitness = - createSimpleMintingReferenceScriptWitnessFiles - <$> pReferenceTxIn "simple-minting-script-" "simple" - <*> pPolicyId - where - createSimpleMintingReferenceScriptWitnessFiles - :: TxIn - -> PolicyId - -> ScriptWitnessFiles WitCtxMint - createSimpleMintingReferenceScriptWitnessFiles refTxIn pid = - let simpleLang = AnyScriptLanguage SimpleScriptLanguage - in SimpleReferenceScriptWitnessFiles refTxIn simpleLang (Just pid) - - pPlutusMintReferenceScriptWitnessFiles - :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint) - pPlutusMintReferenceScriptWitnessFiles autoBalanceExecUnits = - PlutusReferenceScriptWitnessFiles - <$> pReferenceTxIn "mint-" "plutus" - <*> pPlutusScriptLanguage "mint-" - <*> pure NoScriptDatumOrFileForMint - <*> pScriptRedeemerOrFile "mint-reference-tx-in" - <*> (case autoBalanceExecUnits of - AutoBalance -> pure (ExecutionUnits 0 0) - ManualBalance -> pExecutionUnits "mint-reference-tx-in") - <*> (Just <$> pPolicyId) - - helpText = mconcat - [ "Mint multi-asset value(s) with the multi-asset cli syntax. " - , "You must specify a script witness." - ] - -pPolicyId :: Parser PolicyId -pPolicyId = - Opt.option (readerFromParsecParser policyId) - ( Opt.long "policy-id" - <> Opt.metavar "HASH" - <> Opt.help "Policy id of minting script." - ) - - -pInvalidBefore :: Parser SlotNo -pInvalidBefore = fmap SlotNo $ asum - [ Opt.option (bounded "SLOT") $ mconcat - [ Opt.long "invalid-before" - , Opt.metavar "SLOT" - , Opt.help "Time that transaction is valid from (in slots)." - ] - , Opt.option (bounded "SLOT") $ mconcat - [ Opt.long "lower-bound" - , Opt.metavar "SLOT" - , Opt.help $ mconcat - [ "Time that transaction is valid from (in slots) " - , "(deprecated; use --invalid-before instead)." - ] - , Opt.internal - ] - ] - -pInvalidHereafter :: Parser SlotNo -pInvalidHereafter = - fmap SlotNo $ asum - [ Opt.option (bounded "SLOT") $ mconcat - [ Opt.long "invalid-hereafter" - , Opt.metavar "SLOT" - , Opt.help "Time that transaction is valid until (in slots)." - ] - , Opt.option (bounded "SLOT") $ mconcat - [ Opt.long "upper-bound" - , Opt.metavar "SLOT" - , Opt.help $ mconcat - [ "Time that transaction is valid until (in slots) " - , "(deprecated; use --invalid-hereafter instead)." - ] - , Opt.internal - ] - , Opt.option (bounded "SLOT") $ mconcat - [ Opt.long "ttl" - , Opt.metavar "SLOT" - , Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)." - , Opt.internal - ] - ] - -pTxFee :: Parser Lovelace -pTxFee = - Lovelace . (fromIntegral :: Natural -> Integer) <$> - Opt.option Opt.auto - ( Opt.long "fee" - <> Opt.metavar "LOVELACE" - <> Opt.help "The fee amount in Lovelace." - ) - -pWitnessFile :: Parser WitnessFile -pWitnessFile = - WitnessFile <$> - Opt.strOption - ( Opt.long "witness-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath of the witness" - <> Opt.completer (Opt.bashCompleter "file") - ) - -pTxBodyFileIn :: Parser (TxBodyFile In) -pTxBodyFileIn = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "tx-body-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the JSON TxBody." - , Opt.completer (Opt.bashCompleter "file") - ] - -pTxBodyFileOut :: Parser (TxBodyFile Out) -pTxBodyFileOut = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "out-file" - , Opt.metavar "FILE" - , Opt.help "Output filepath of the JSON TxBody." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "tx-body-file" - , Opt.internal - ] - ] - -pTxFileIn :: Parser (TxFile In) -pTxFileIn = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "tx-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the JSON Tx." - , Opt.completer (Opt.bashCompleter "file") - ] - -pTxFileOut :: Parser (TxFile Out) -pTxFileOut = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "out-file" - , Opt.metavar "FILE" - , Opt.help "Output filepath of the JSON Tx." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "tx-file" - , Opt.internal - ] - ] - -pInputTxOrTxBodyFile :: Parser InputTxBodyOrTxFile -pInputTxOrTxBodyFile = - InputTxBodyFile <$> pTxBodyFileIn <|> InputTxFile <$> pTxFileIn - -pTxInCount :: Parser TxInCount -pTxInCount = - TxInCount <$> - Opt.option Opt.auto - ( Opt.long "tx-in-count" - <> Opt.metavar "NATURAL" - <> Opt.help "The number of transaction inputs." - ) - -pTxOutCount :: Parser TxOutCount -pTxOutCount = - TxOutCount <$> - Opt.option Opt.auto - ( Opt.long "tx-out-count" - <> Opt.metavar "NATURAL" - <> Opt.help "The number of transaction outputs." - ) - -pTxShelleyWitnessCount :: Parser TxShelleyWitnessCount -pTxShelleyWitnessCount = - TxShelleyWitnessCount <$> - Opt.option Opt.auto - ( Opt.long "witness-count" - <> Opt.metavar "NATURAL" - <> Opt.help "The number of Shelley key witnesses." - ) - -pTxByronWitnessCount :: Parser TxByronWitnessCount -pTxByronWitnessCount = - TxByronWitnessCount <$> - Opt.option Opt.auto - ( Opt.long "byron-witness-count" - <> Opt.metavar "NATURAL" - <> Opt.help "The number of Byron key witnesses (default is 0)." - <> Opt.value 0 - ) - -pQueryUTxOFilter :: Parser QueryUTxOFilter -pQueryUTxOFilter = - pQueryUTxOWhole - <|> pQueryUTxOByAddress - <|> pQueryUTxOByTxIn - where - pQueryUTxOWhole = - Opt.flag' QueryUTxOWhole - ( Opt.long "whole-utxo" - <> Opt.help "Return the whole UTxO (only appropriate on small testnets)." - ) - - pQueryUTxOByAddress :: Parser QueryUTxOFilter - pQueryUTxOByAddress = QueryUTxOByAddress . Set.fromList <$> some pByAddress - - pByAddress :: Parser AddressAny - pByAddress = - Opt.option (readerFromParsecParser parseAddressAny) - ( Opt.long "address" - <> Opt.metavar "ADDRESS" - <> Opt.help "Filter by Cardano address(es) (Bech32-encoded)." - ) - - pQueryUTxOByTxIn :: Parser QueryUTxOFilter - pQueryUTxOByTxIn = QueryUTxOByTxIn . Set.fromList <$> some pByTxIn - - pByTxIn :: Parser TxIn - pByTxIn = - Opt.option (readerFromParsecParser parseTxIn) - ( Opt.long "tx-in" - <> Opt.metavar "TX-IN" - <> Opt.help "Filter by transaction input (TxId#TxIx)." - ) - -pFilterByStakeAddress :: Parser StakeAddress -pFilterByStakeAddress = - Opt.option (readerFromParsecParser parseStakeAddress) - ( Opt.long "address" - <> Opt.metavar "ADDRESS" - <> Opt.help "Filter by Cardano stake address (Bech32-encoded)." - ) - -pByronAddress :: Parser (Address ByronAddr) -pByronAddress = - Opt.option - (Opt.eitherReader deserialise) - ( Opt.long "address" - <> Opt.metavar "STRING" - <> Opt.help "Byron address (Base58-encoded)." - ) - where - deserialise :: String -> Either String (Address ByronAddr) - deserialise = - maybe (Left "Invalid Byron address.") Right - . deserialiseAddress AsByronAddress - . Text.pack - -pAddress :: Parser Text -pAddress = - Text.pack <$> - Opt.strOption - ( Opt.long "address" - <> Opt.metavar "ADDRESS" - <> Opt.help "A Cardano address" - ) - -pStakeAddress :: Parser StakeAddress -pStakeAddress = - Opt.option (readerFromParsecParser parseStakeAddress) - ( Opt.long "stake-address" - <> Opt.metavar "ADDRESS" - <> Opt.help "Target stake address (bech32 format)." - ) - -pStakeVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey) -pStakeVerificationKeyOrFile = - VerificationKeyValue <$> pStakeVerificationKey - <|> VerificationKeyFilePath <$> pStakeVerificationKeyFile - -pStakeVerificationKey :: Parser (VerificationKey StakeKey) -pStakeVerificationKey = - Opt.option - (readVerificationKey AsStakeKey) - ( Opt.long "stake-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "Stake verification key (Bech32 or hex-encoded)." - ) - -pStakeVerificationKeyFile :: Parser (VerificationKeyFile In) -pStakeVerificationKeyFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "stake-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the staking verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "staking-verification-key-file" - , Opt.internal - ] - ] - - -pStakePoolVerificationKeyFile :: Parser (VerificationKeyFile In) -pStakePoolVerificationKeyFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "cold-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the stake pool verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "stake-pool-verification-key-file" - , Opt.internal - ] - ] - -pStakePoolVerificationKeyHash :: Parser (Hash StakePoolKey) -pStakePoolVerificationKeyHash = - Opt.option - (pBech32StakePoolId <|> pHexStakePoolId) - ( Opt.long "stake-pool-id" - <> Opt.metavar "STAKE_POOL_ID" - <> Opt.help - ( "Stake pool ID/verification key hash (either Bech32-encoded or hex-encoded). " - <> "Zero or more occurences of this option is allowed." - ) - ) - where - pHexStakePoolId :: ReadM (Hash StakePoolKey) - pHexStakePoolId = - Opt.eitherReader $ - first displayError - . deserialiseFromRawBytesHex (AsHash AsStakePoolKey) - . BSC.pack - - pBech32StakePoolId :: ReadM (Hash StakePoolKey) - pBech32StakePoolId = - Opt.eitherReader $ - first displayError - . deserialiseFromBech32 (AsHash AsStakePoolKey) - . Text.pack - -pStakePoolVerificationKey :: Parser (VerificationKey StakePoolKey) -pStakePoolVerificationKey = - Opt.option - (readVerificationKey AsStakePoolKey) - ( Opt.long "stake-pool-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "Stake pool verification key (Bech32 or hex-encoded)." - ) - -pStakePoolVerificationKeyOrFile - :: Parser (VerificationKeyOrFile StakePoolKey) -pStakePoolVerificationKeyOrFile = - VerificationKeyValue <$> pStakePoolVerificationKey - <|> VerificationKeyFilePath <$> pStakePoolVerificationKeyFile - -pDelegationTarget - :: Parser DelegationTarget -pDelegationTarget = StakePoolDelegationTarget <$> pStakePoolVerificationKeyOrHashOrFile - -pStakePoolVerificationKeyOrHashOrFile - :: Parser (VerificationKeyOrHashOrFile StakePoolKey) -pStakePoolVerificationKeyOrHashOrFile = - VerificationKeyOrFile <$> pStakePoolVerificationKeyOrFile - <|> VerificationKeyHash <$> pStakePoolVerificationKeyHash - -pVrfVerificationKeyFile :: Parser (VerificationKeyFile In) -pVrfVerificationKeyFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "vrf-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the VRF verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - -pVrfVerificationKeyHash :: Parser (Hash VrfKey) -pVrfVerificationKeyHash = - Opt.option - (Opt.eitherReader deserialiseFromHex) - ( Opt.long "vrf-verification-key-hash" - <> Opt.metavar "STRING" - <> Opt.help "VRF verification key hash (hex-encoded)." - ) - where - deserialiseFromHex :: String -> Either String (Hash VrfKey) - deserialiseFromHex = - first (\e -> "Invalid VRF verification key hash: " ++ displayError e) - . deserialiseFromRawBytesHex (AsHash AsVrfKey) - . BSC.pack - -pVrfVerificationKey :: Parser (VerificationKey VrfKey) -pVrfVerificationKey = - Opt.option - (readVerificationKey AsVrfKey) - ( Opt.long "vrf-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "VRF verification key (Bech32 or hex-encoded)." - ) - -pVrfVerificationKeyOrFile :: Parser (VerificationKeyOrFile VrfKey) -pVrfVerificationKeyOrFile = - VerificationKeyValue <$> pVrfVerificationKey - <|> VerificationKeyFilePath <$> pVrfVerificationKeyFile - -pVrfVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VrfKey) -pVrfVerificationKeyOrHashOrFile = - VerificationKeyOrFile <$> pVrfVerificationKeyOrFile - <|> VerificationKeyHash <$> pVrfVerificationKeyHash - -pRewardAcctVerificationKeyFile :: Parser (VerificationKeyFile In) -pRewardAcctVerificationKeyFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "pool-reward-account-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the reward account stake verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "reward-account-verification-key-file" - , Opt.internal - ] - ] - -pRewardAcctVerificationKey :: Parser (VerificationKey StakeKey) -pRewardAcctVerificationKey = - Opt.option - (readVerificationKey AsStakeKey) - ( Opt.long "pool-reward-account-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "Reward account stake verification key (Bech32 or hex-encoded)." - ) - -pRewardAcctVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey) -pRewardAcctVerificationKeyOrFile = - VerificationKeyValue <$> pRewardAcctVerificationKey - <|> VerificationKeyFilePath <$> pRewardAcctVerificationKeyFile - -pPoolOwnerVerificationKeyFile :: Parser (VerificationKeyFile In) -pPoolOwnerVerificationKeyFile = - fmap File $ asum - [ Opt.strOption $ mconcat - [ Opt.long "pool-owner-stake-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the pool owner stake verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - , Opt.strOption $ mconcat - [ Opt.long "pool-owner-staking-verification-key" - , Opt.internal - ] - ] - -pPoolOwnerVerificationKey :: Parser (VerificationKey StakeKey) -pPoolOwnerVerificationKey = - Opt.option - (readVerificationKey AsStakeKey) - ( Opt.long "pool-owner-verification-key" - <> Opt.metavar "STRING" - <> Opt.help "Pool owner stake verification key (Bech32 or hex-encoded)." - ) - -pPoolOwnerVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey) -pPoolOwnerVerificationKeyOrFile = - VerificationKeyValue <$> pPoolOwnerVerificationKey - <|> VerificationKeyFilePath <$> pPoolOwnerVerificationKeyFile - -pPoolPledge :: Parser Lovelace -pPoolPledge = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "pool-pledge" - <> Opt.metavar "LOVELACE" - <> Opt.help "The stake pool's pledge." - ) - - -pPoolCost :: Parser Lovelace -pPoolCost = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "pool-cost" - <> Opt.metavar "LOVELACE" - <> Opt.help "The stake pool's cost." - ) - -pPoolMargin :: Parser Rational -pPoolMargin = - Opt.option readRationalUnitInterval - ( Opt.long "pool-margin" - <> Opt.metavar "RATIONAL" - <> Opt.help "The stake pool's margin." - ) - -pPoolRelay :: Parser StakePoolRelay -pPoolRelay = pSingleHostAddress <|> pSingleHostName <|> pMultiHostName - -pMultiHostName :: Parser StakePoolRelay -pMultiHostName = - StakePoolRelayDnsSrvRecord <$> pDNSName - where - pDNSName :: Parser ByteString - pDNSName = Opt.option (Opt.eitherReader eDNSName) - ( Opt.long "multi-host-pool-relay" - <> Opt.metavar "STRING" - <> Opt.help "The stake pool relay's DNS name that corresponds to \ - \an SRV DNS record" - ) - -pSingleHostName :: Parser StakePoolRelay -pSingleHostName = - StakePoolRelayDnsARecord <$> pDNSName <*> optional pPort - where - pDNSName :: Parser ByteString - pDNSName = Opt.option (Opt.eitherReader eDNSName) $ mconcat - [ Opt.long "single-host-pool-relay" - , Opt.metavar "STRING" - , Opt.help $ mconcat - [ "The stake pool relay's DNS name that corresponds to an" - , " A or AAAA DNS record" - ] - ] - -eDNSName :: String -> Either String ByteString -eDNSName str = - -- We're using 'Shelley.textToDns' to validate the string. - case Shelley.textToDns (toS str) of - Nothing -> Left $ "DNS name is more than 64 bytes: " <> str - Just dnsName -> Right . Text.encodeUtf8 . Shelley.dnsToText $ dnsName - -pSingleHostAddress :: Parser StakePoolRelay -pSingleHostAddress = singleHostAddress - <$> optional pIpV4 - <*> optional pIpV6 - <*> pPort - where - singleHostAddress :: Maybe IP.IPv4 -> Maybe IP.IPv6 -> PortNumber -> StakePoolRelay - singleHostAddress ipv4 ipv6 port = - case (ipv4, ipv6) of - (Nothing, Nothing) -> - error "Please enter either an IPv4 or IPv6 address for the pool relay" - (Just i4, Nothing) -> - StakePoolRelayIp (Just i4) Nothing (Just port) - (Nothing, Just i6) -> - StakePoolRelayIp Nothing (Just i6) (Just port) - (Just i4, Just i6) -> - StakePoolRelayIp (Just i4) (Just i6) (Just port) - - - -pIpV4 :: Parser IP.IPv4 -pIpV4 = Opt.option (Opt.maybeReader readMaybe :: Opt.ReadM IP.IPv4) - ( Opt.long "pool-relay-ipv4" - <> Opt.metavar "STRING" - <> Opt.help "The stake pool relay's IPv4 address" - ) - -pIpV6 :: Parser IP.IPv6 -pIpV6 = Opt.option (Opt.maybeReader readMaybe :: Opt.ReadM IP.IPv6) - ( Opt.long "pool-relay-ipv6" - <> Opt.metavar "STRING" - <> Opt.help "The stake pool relay's IPv6 address" - ) - -pPort :: Parser PortNumber -pPort = Opt.option (fromInteger <$> Opt.eitherReader readEither) - ( Opt.long "pool-relay-port" - <> Opt.metavar "INT" - <> Opt.help "The stake pool relay's port" - ) - -pStakePoolMetadataReference :: Parser (Maybe StakePoolMetadataReference) -pStakePoolMetadataReference = - optional $ - StakePoolMetadataReference - <$> pStakePoolMetadataUrl - <*> pStakePoolMetadataHash - -pStakePoolMetadataUrl :: Parser Text -pStakePoolMetadataUrl = - Opt.option (readURIOfMaxLength 64) - ( Opt.long "metadata-url" - <> Opt.metavar "URL" - <> Opt.help "Pool metadata URL (maximum length of 64 characters)." - ) - -pStakePoolMetadataHash :: Parser (Hash StakePoolMetadata) -pStakePoolMetadataHash = - Opt.option - (Opt.eitherReader metadataHash) - ( Opt.long "metadata-hash" - <> Opt.metavar "HASH" - <> Opt.help "Pool metadata hash." - ) - where - metadataHash :: String -> Either String (Hash StakePoolMetadata) - metadataHash = - first displayError - . deserialiseFromRawBytesHex (AsHash AsStakePoolMetadata) - . BSC.pack - -pStakePoolRegistrationCert :: EnvCli -> Parser PoolCmd -pStakePoolRegistrationCert envCli = - PoolRegistrationCert - <$> pStakePoolVerificationKeyOrFile - <*> pVrfVerificationKeyOrFile - <*> pPoolPledge - <*> pPoolCost - <*> pPoolMargin - <*> pRewardAcctVerificationKeyOrFile - <*> some pPoolOwnerVerificationKeyOrFile - <*> many pPoolRelay - <*> pStakePoolMetadataReference - <*> pNetworkId envCli - <*> pOutputFile - -pStakePoolRetirementCert :: Parser PoolCmd -pStakePoolRetirementCert = - PoolRetirementCert - <$> pStakePoolVerificationKeyOrFile - <*> pEpochNo - <*> pOutputFile - - -pProtocolParametersUpdate :: Parser ProtocolParametersUpdate -pProtocolParametersUpdate = - ProtocolParametersUpdate - <$> optional pProtocolVersion - <*> optional pDecentralParam - <*> optional pExtraEntropy - <*> optional pMaxBlockHeaderSize - <*> optional pMaxBodySize - <*> optional pMaxTransactionSize - <*> optional pMinFeeConstantFactor - <*> optional pMinFeePerByteFactor - <*> optional pMinUTxOValue - <*> optional pKeyRegistDeposit - <*> optional pPoolDeposit - <*> optional pMinPoolCost - <*> optional pEpochBoundRetirement - <*> optional pNumberOfPools - <*> optional pPoolInfluence - <*> optional pMonetaryExpansion - <*> optional pTreasuryExpansion - <*> optional pUTxOCostPerWord - <*> pure mempty - <*> optional pExecutionUnitPrices - <*> optional pMaxTxExecutionUnits - <*> optional pMaxBlockExecutionUnits - <*> optional pMaxValueSize - <*> optional pCollateralPercent - <*> optional pMaxCollateralInputs - <*> optional pUTxOCostPerByte - -pCostModels :: Parser FilePath -pCostModels = - Opt.strOption - ( Opt.long "cost-model-file" - <> Opt.metavar "FILE" - <> Opt.help "Filepath of the JSON formatted cost model" - <> Opt.completer (Opt.bashCompleter "file") - ) - -pMinFeePerByteFactor :: Parser Lovelace -pMinFeePerByteFactor = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "min-fee-linear" - <> Opt.metavar "LOVELACE" - <> Opt.help "The linear factor per byte for the minimum fee calculation." - ) - -pMinFeeConstantFactor :: Parser Lovelace -pMinFeeConstantFactor = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "min-fee-constant" - <> Opt.metavar "LOVELACE" - <> Opt.help "The constant factor for the minimum fee calculation." - ) - -pMinUTxOValue :: Parser Lovelace -pMinUTxOValue = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "min-utxo-value" - <> Opt.metavar "NATURAL" - <> Opt.help "The minimum allowed UTxO value (Shelley to Mary eras)." - ) - -pMinPoolCost :: Parser Lovelace -pMinPoolCost = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "min-pool-cost" - <> Opt.metavar "NATURAL" - <> Opt.help "The minimum allowed cost parameter for stake pools." - ) - -pMaxBodySize :: Parser Natural -pMaxBodySize = - Opt.option Opt.auto - ( Opt.long "max-block-body-size" - <> Opt.metavar "NATURAL" - <> Opt.help "Maximal block body size." - ) - -pMaxTransactionSize :: Parser Natural -pMaxTransactionSize = - Opt.option Opt.auto - ( Opt.long "max-tx-size" - <> Opt.metavar "NATURAL" - <> Opt.help "Maximum transaction size." - ) - -pMaxBlockHeaderSize :: Parser Natural -pMaxBlockHeaderSize = - Opt.option Opt.auto - ( Opt.long "max-block-header-size" - <> Opt.metavar "NATURAL" - <> Opt.help "Maximum block header size." - ) - -pKeyRegistDeposit :: Parser Lovelace -pKeyRegistDeposit = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "key-reg-deposit-amt" - <> Opt.metavar "NATURAL" - <> Opt.help "Key registration deposit amount." - ) - -pPoolDeposit :: Parser Lovelace -pPoolDeposit = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "pool-reg-deposit" - <> Opt.metavar "NATURAL" - <> Opt.help "The amount of a pool registration deposit." - ) - -pEpochBoundRetirement :: Parser EpochNo -pEpochBoundRetirement = - fmap EpochNo $ Opt.option (bounded "EPOCH_BOUNDARY") $ mconcat - [ Opt.long "pool-retirement-epoch-boundary" - , Opt.metavar "EPOCH_BOUNDARY" - , Opt.help "Epoch bound on pool retirement." - ] - -pNumberOfPools :: Parser Natural -pNumberOfPools = - Opt.option Opt.auto - ( Opt.long "number-of-pools" - <> Opt.metavar "NATURAL" - <> Opt.help "Desired number of pools." - ) - -pPoolInfluence :: Parser Rational -pPoolInfluence = - Opt.option readRational - ( Opt.long "pool-influence" - <> Opt.metavar "RATIONAL" - <> Opt.help "Pool influence." - ) - -pTreasuryExpansion :: Parser Rational -pTreasuryExpansion = - Opt.option readRationalUnitInterval - ( Opt.long "treasury-expansion" - <> Opt.metavar "RATIONAL" - <> Opt.help "Treasury expansion." - ) - -pMonetaryExpansion :: Parser Rational -pMonetaryExpansion = - Opt.option readRationalUnitInterval - ( Opt.long "monetary-expansion" - <> Opt.metavar "RATIONAL" - <> Opt.help "Monetary expansion." - ) - -pDecentralParam :: Parser Rational -pDecentralParam = - Opt.option readRationalUnitInterval - ( Opt.long "decentralization-parameter" - <> Opt.metavar "RATIONAL" - <> Opt.help "Decentralization parameter." - ) - -pExtraEntropy :: Parser (Maybe PraosNonce) -pExtraEntropy = - Opt.option (Just <$> readerFromParsecParser parsePraosNonce) - ( Opt.long "extra-entropy" - <> Opt.metavar "HEX" - <> Opt.help "Praos extra entropy seed, as a hex byte string." - ) - <|> Opt.flag' Nothing - ( Opt.long "reset-extra-entropy" - <> Opt.help "Reset the Praos extra entropy to none." - ) - where - parsePraosNonce :: Parsec.Parser PraosNonce - parsePraosNonce = makePraosNonce <$> parseEntropyBytes - - parseEntropyBytes :: Parsec.Parser ByteString - parseEntropyBytes = either fail return - . B16.decode . BSC.pack - =<< some Parsec.hexDigit - -pUTxOCostPerWord :: Parser Lovelace -pUTxOCostPerWord = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "utxo-cost-per-word" - <> Opt.metavar "LOVELACE" - <> Opt.help "Cost in lovelace per unit of UTxO storage (from Alonzo era)." - ) - -pUTxOCostPerByte :: Parser Lovelace -pUTxOCostPerByte = - Opt.option (readerFromParsecParser parseLovelace) - ( Opt.long "utxo-cost-per-byte" - <> Opt.metavar "LOVELACE" - <> Opt.help "Cost in lovelace per unit of UTxO storage (from Babbage era)." - ) - -pExecutionUnitPrices :: Parser ExecutionUnitPrices -pExecutionUnitPrices = ExecutionUnitPrices - <$> Opt.option readRational - ( mconcat - [ Opt.long "price-execution-steps" - , Opt.metavar "RATIONAL" - , Opt.help $ mconcat - [ "Step price of execution units for script languages that use " - , "them (from Alonzo era). (Examples: '1.1', '11/10')" - ] - ] - ) - <*> Opt.option readRational - ( mconcat - [ Opt.long "price-execution-memory" - , Opt.metavar "RATIONAL" - , Opt.help $ mconcat - [ "Memory price of execution units for script languages that " - , "use them (from Alonzo era). (Examples: '1.1', '11/10')" - ] - ] - ) - -pMaxTxExecutionUnits :: Parser ExecutionUnits -pMaxTxExecutionUnits = - uncurry ExecutionUnits <$> - Opt.option Opt.auto - ( mconcat - [ Opt.long "max-tx-execution-units" - , Opt.metavar "(INT, INT)" - , Opt.help $ mconcat - [ "Max total script execution resources units allowed per tx " - , "(from Alonzo era). They are denominated as follows (steps, memory)." - ] - ] - ) - -pMaxBlockExecutionUnits :: Parser ExecutionUnits -pMaxBlockExecutionUnits = - uncurry ExecutionUnits <$> - Opt.option Opt.auto - ( mconcat - [ Opt.long "max-block-execution-units" - , Opt.metavar "(INT, INT)" - , Opt.help $ mconcat - [ "Max total script execution resources units allowed per block " - , "(from Alonzo era). They are denominated as follows (steps, memory)." - ] - ] - ) - -pMaxValueSize :: Parser Natural -pMaxValueSize = - Opt.option Opt.auto $ mconcat - [ Opt.long "max-value-size" - , Opt.metavar "INT" - , Opt.help $ mconcat - [ "Max size of a multi-asset value in a tx output (from Alonzo era)." - ] - ] - -pCollateralPercent :: Parser Natural -pCollateralPercent = - Opt.option Opt.auto $ mconcat - [ Opt.long "collateral-percent" - , Opt.metavar "INT" - , Opt.help $ mconcat - [ "The percentage of the script contribution to the txfee that " - , "must be provided as collateral inputs when including Plutus " - , "scripts (from Alonzo era)." - ] - ] - -pMaxCollateralInputs :: Parser Natural -pMaxCollateralInputs = - Opt.option Opt.auto $ mconcat - [ Opt.long "max-collateral-inputs" - , Opt.metavar "INT" - , Opt.help $ mconcat - [ "The maximum number of collateral inputs allowed in a " - , "transaction (from Alonzo era)." - ] - ] - -pProtocolVersion :: Parser (Natural, Natural) -pProtocolVersion = - (,) <$> pProtocolMajorVersion <*> pProtocolMinorVersion - where - pProtocolMajorVersion = - Opt.option Opt.auto - ( Opt.long "protocol-major-version" - <> Opt.metavar "NATURAL" - <> Opt.help "Major protocol version. An increase indicates a hard fork." - ) - pProtocolMinorVersion = - Opt.option Opt.auto $ mconcat - [ Opt.long "protocol-minor-version" - , Opt.metavar "NATURAL" - , Opt.help $ mconcat - [ "Minor protocol version. An increase indicates a soft fork" - , " (old software canvalidate but not produce new blocks)." - ] - ] - --- --- Shelley CLI flag field parsers --- - -parseLovelace :: Parsec.Parser Lovelace -parseLovelace = do - i <- decimal - if i > toInteger (maxBound :: Word64) - then fail $ show i <> " lovelace exceeds the Word64 upper bound" - else return $ Lovelace i - - -parseStakeAddress :: Parsec.Parser StakeAddress -parseStakeAddress = do - str <- lexPlausibleAddressString - case deserialiseAddress AsStakeAddress str of - Nothing -> fail $ "invalid address: " <> Text.unpack str - Just addr -> pure addr - -parseTxOutAnyEra - :: Parsec.Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra) -parseTxOutAnyEra = do - addr <- parseAddressAny - Parsec.spaces - -- Accept the old style of separating the address and value in a - -- transaction output: - Parsec.option () (Parsec.char '+' >> Parsec.spaces) - val <- parseValue - return (TxOutAnyEra addr val) - -decimal :: Parsec.Parser Integer -Parsec.TokenParser { Parsec.decimal = decimal } = Parsec.haskell - --------------------------------------------------------------------------------- --- Helpers --------------------------------------------------------------------------------- - --- | Read a Bech32 or hex-encoded verification key. -readVerificationKey - :: forall keyrole. SerialiseAsBech32 (VerificationKey keyrole) - => AsType keyrole - -> Opt.ReadM (VerificationKey keyrole) -readVerificationKey asType = - Opt.eitherReader deserialiseFromBech32OrHex - where - keyFormats :: NonEmpty (InputFormat (VerificationKey keyrole)) - keyFormats = NE.fromList [InputFormatBech32, InputFormatHex] - - deserialiseFromBech32OrHex - :: String - -> Either String (VerificationKey keyrole) - deserialiseFromBech32OrHex str = - first (Text.unpack . renderInputDecodeError) $ - deserialiseInput (AsVerificationKey asType) keyFormats (BSC.pack str) - -readOutputFormat :: Opt.ReadM OutputFormat -readOutputFormat = do - s <- Opt.str - case s of - "hex" -> pure OutputFormatHex - "bech32" -> pure OutputFormatBech32 - _ -> - fail $ "Invalid output format: \"" - <> s - <> "\". Accepted output formats are \"hex\" and \"bech32\"." - -readURIOfMaxLength :: Int -> Opt.ReadM Text -readURIOfMaxLength maxLen = - Text.pack <$> readStringOfMaxLength maxLen - -readStringOfMaxLength :: Int -> Opt.ReadM String -readStringOfMaxLength maxLen = do - s <- Opt.str - let strLen = length s - if strLen <= maxLen - then pure s - else fail $ - "The provided string must have at most 64 characters, but it has " - <> show strLen - <> " characters." - -readRationalUnitInterval :: Opt.ReadM Rational -readRationalUnitInterval = readRational >>= checkUnitInterval - where - checkUnitInterval :: Rational -> Opt.ReadM Rational - checkUnitInterval q - | q >= 0 && q <= 1 = return q - | otherwise = fail "Please enter a value in the range [0,1]" - -readFractionAsRational :: Opt.ReadM Rational -readFractionAsRational = readerFromAttoParser fractionalAsRational - where fractionalAsRational :: Atto.Parser Rational - fractionalAsRational = (%) <$> (Atto.decimal @Integer <* Atto.char '/') <*> Atto.decimal @Integer - -readRational :: Opt.ReadM Rational -readRational = - (toRational <$> readerFromAttoParser Atto.scientific) - <|> readFractionAsRational - -readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a -readerFromAttoParser p = - Opt.eitherReader (Atto.parseOnly (p <* Atto.endOfInput) . BSC.pack) - -readerFromParsecParser :: Parsec.Parser a -> Opt.ReadM a -readerFromParsecParser p = - Opt.eitherReader (first formatError . Parsec.parse (p <* Parsec.eof) "") - where - formatError err = - Parsec.showErrorMessages "or" "unknown parse error" - "expecting" "unexpected" "end of input" - (Parsec.errorMessages err) - -subParser :: String -> ParserInfo a -> Parser a -subParser availableCommand pInfo = - Opt.hsubparser $ Opt.command availableCommand pInfo <> Opt.metavar availableCommand - -hiddenSubParser :: String -> ParserInfo a -> Parser a -hiddenSubParser availableCommand pInfo = - Opt.hsubparser $ Opt.command availableCommand pInfo <> Opt.metavar availableCommand <> Opt.hidden diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run.hs deleted file mode 100644 index bdab475dd8c..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run.hs +++ /dev/null @@ -1,88 +0,0 @@ -module Cardano.CLI.Shelley.Run - ( ShelleyClientCmdError - , renderShelleyClientCmdError - , runShelleyClientCommand - ) where - -import Control.Monad.Trans.Except (ExceptT) -import Data.Text (Text) - -import Cardano.Api - -import Control.Monad.Trans.Except.Extra (firstExceptT) -import qualified Data.Text as Text - -import Cardano.CLI.Shelley.Parsers - -import Cardano.CLI.Shelley.Run.Address -import Cardano.CLI.Shelley.Run.Governance -import Cardano.CLI.Shelley.Run.Key -import Cardano.CLI.Shelley.Run.Node -import Cardano.CLI.Shelley.Run.Pool -import Cardano.CLI.Shelley.Run.Query -import Cardano.CLI.Shelley.Run.StakeAddress -import Cardano.CLI.Shelley.Run.Transaction - -- Block, System, DevOps -import Cardano.CLI.Shelley.Run.Genesis -import Cardano.CLI.Shelley.Run.TextView - -data ShelleyClientCmdError - = ShelleyCmdAddressError !ShelleyAddressCmdError - | ShelleyCmdGenesisError !ShelleyGenesisCmdError - | ShelleyCmdGovernanceError !ShelleyGovernanceCmdError - | ShelleyCmdNodeError !ShelleyNodeCmdError - | ShelleyCmdPoolError !ShelleyPoolCmdError - | ShelleyCmdStakeAddressError !ShelleyStakeAddressCmdError - | ShelleyCmdTextViewError !ShelleyTextViewFileError - | ShelleyCmdTransactionError !ShelleyTxCmdError - | ShelleyCmdQueryError !ShelleyQueryCmdError - | ShelleyCmdKeyError !ShelleyKeyCmdError - -renderShelleyClientCmdError :: ShelleyCommand -> ShelleyClientCmdError -> Text -renderShelleyClientCmdError cmd err = - case err of - ShelleyCmdAddressError addrCmdErr -> - renderError cmd renderShelleyAddressCmdError addrCmdErr - ShelleyCmdGenesisError genesisCmdErr -> - renderError cmd (Text.pack . displayError) genesisCmdErr - ShelleyCmdGovernanceError govCmdErr -> - renderError cmd renderShelleyGovernanceError govCmdErr - ShelleyCmdNodeError nodeCmdErr -> - renderError cmd renderShelleyNodeCmdError nodeCmdErr - ShelleyCmdPoolError poolCmdErr -> - renderError cmd renderShelleyPoolCmdError poolCmdErr - ShelleyCmdStakeAddressError stakeAddrCmdErr -> - renderError cmd renderShelleyStakeAddressCmdError stakeAddrCmdErr - ShelleyCmdTextViewError txtViewErr -> - renderError cmd renderShelleyTextViewFileError txtViewErr - ShelleyCmdTransactionError txErr -> - renderError cmd renderShelleyTxCmdError txErr - ShelleyCmdQueryError queryErr -> - renderError cmd renderShelleyQueryCmdError queryErr - ShelleyCmdKeyError keyErr -> - renderError cmd renderShelleyKeyCmdError keyErr - where - renderError :: ShelleyCommand -> (a -> Text) -> a -> Text - renderError shelleyCmd renderer shelCliCmdErr = - mconcat [ "Command failed: " - , renderShelleyCommand shelleyCmd - , " Error: " - , renderer shelCliCmdErr - ] - - --- --- CLI shelley command dispatch --- - -runShelleyClientCommand :: ShelleyCommand -> ExceptT ShelleyClientCmdError IO () -runShelleyClientCommand (AddressCmd cmd) = firstExceptT ShelleyCmdAddressError $ runAddressCmd cmd -runShelleyClientCommand (StakeAddressCmd cmd) = firstExceptT ShelleyCmdStakeAddressError $ runStakeAddressCmd cmd -runShelleyClientCommand (KeyCmd cmd) = firstExceptT ShelleyCmdKeyError $ runKeyCmd cmd -runShelleyClientCommand (TransactionCmd cmd) = firstExceptT ShelleyCmdTransactionError $ runTransactionCmd cmd -runShelleyClientCommand (NodeCmd cmd) = firstExceptT ShelleyCmdNodeError $ runNodeCmd cmd -runShelleyClientCommand (PoolCmd cmd) = firstExceptT ShelleyCmdPoolError $ runPoolCmd cmd -runShelleyClientCommand (QueryCmd cmd) = firstExceptT ShelleyCmdQueryError $ runQueryCmd cmd -runShelleyClientCommand (GovernanceCmd cmd) = firstExceptT ShelleyCmdGovernanceError $ runGovernanceCmd cmd -runShelleyClientCommand (GenesisCmd cmd) = firstExceptT ShelleyCmdGenesisError $ runGenesisCmd cmd -runShelleyClientCommand (TextViewCmd cmd) = firstExceptT ShelleyCmdTextViewError $ runTextViewCmd cmd diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs deleted file mode 100644 index 406e1975d70..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs +++ /dev/null @@ -1,208 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Shelley.Run.Address - ( ShelleyAddressCmdError(..) - , SomeAddressVerificationKey(..) - , buildShelleyAddress - , renderShelleyAddressCmdError - , runAddressCmd - , runAddressKeyGenToFile - , makeStakeAddressRef - ) where - -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, left, newExceptT) -import qualified Data.ByteString.Char8 as BS -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text - -import Cardano.Api -import Cardano.Api.Shelley - -import Cardano.CLI.Shelley.Key (PaymentVerifier (..), StakeIdentifier (..), - StakeVerifier (..), VerificationKeyTextOrFile, - VerificationKeyTextOrFileError (..), generateKeyPair, readVerificationKeyOrFile, - readVerificationKeyTextOrFileAnyOf, renderVerificationKeyTextOrFileError) -import Cardano.CLI.Shelley.Parsers (AddressCmd (..), AddressKeyType (..)) -import Cardano.CLI.Shelley.Run.Address.Info (ShelleyAddressInfoError, runAddressInfo) -import Cardano.CLI.Shelley.Run.Read -import Cardano.CLI.Types - -data ShelleyAddressCmdError - = ShelleyAddressCmdAddressInfoError !ShelleyAddressInfoError - | ShelleyAddressCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyAddressCmdReadScriptFileError !(FileError ScriptDecodeError) - | ShelleyAddressCmdVerificationKeyTextOrFileError !VerificationKeyTextOrFileError - | ShelleyAddressCmdWriteFileError !(FileError ()) - | ShelleyAddressCmdExpectedPaymentVerificationKey SomeAddressVerificationKey - deriving Show - -renderShelleyAddressCmdError :: ShelleyAddressCmdError -> Text -renderShelleyAddressCmdError err = - case err of - ShelleyAddressCmdAddressInfoError addrInfoErr -> - Text.pack (displayError addrInfoErr) - ShelleyAddressCmdReadKeyFileError fileErr -> - Text.pack (displayError fileErr) - ShelleyAddressCmdVerificationKeyTextOrFileError vkTextOrFileErr -> - renderVerificationKeyTextOrFileError vkTextOrFileErr - ShelleyAddressCmdReadScriptFileError fileErr -> - Text.pack (displayError fileErr) - ShelleyAddressCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyAddressCmdExpectedPaymentVerificationKey someAddress -> - "Expected payment verification key but got: " <> renderSomeAddressVerificationKey someAddress - -runAddressCmd :: AddressCmd -> ExceptT ShelleyAddressCmdError IO () -runAddressCmd cmd = - case cmd of - AddressKeyGen kt vkf skf -> runAddressKeyGenToFile kt vkf skf - AddressKeyHash vkf mOFp -> runAddressKeyHash vkf mOFp - AddressBuild paymentVerifier mbStakeVerifier nw mOutFp -> runAddressBuild paymentVerifier mbStakeVerifier nw mOutFp - AddressInfo txt mOFp -> firstExceptT ShelleyAddressCmdAddressInfoError $ runAddressInfo txt mOFp - -runAddressKeyGenToFile - :: AddressKeyType - -> VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT ShelleyAddressCmdError IO () -runAddressKeyGenToFile kt vkf skf = case kt of - AddressKeyShelley -> generateAndWriteKeyFiles AsPaymentKey vkf skf - AddressKeyShelleyExtended -> generateAndWriteKeyFiles AsPaymentExtendedKey vkf skf - AddressKeyByron -> generateAndWriteKeyFiles AsByronKey vkf skf - -generateAndWriteKeyFiles - :: Key keyrole - => AsType keyrole - -> VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT ShelleyAddressCmdError IO () -generateAndWriteKeyFiles asType vkf skf = do - uncurry (writePaymentKeyFiles vkf skf) =<< liftIO (generateKeyPair asType) - -writePaymentKeyFiles - :: Key keyrole - => VerificationKeyFile Out - -> SigningKeyFile Out - -> VerificationKey keyrole - -> SigningKey keyrole - -> ExceptT ShelleyAddressCmdError IO () -writePaymentKeyFiles vkeyPath skeyPath vkey skey = do - firstExceptT ShelleyAddressCmdWriteFileError $ do - newExceptT $ writeLazyByteStringFile skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey - newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey - where - skeyDesc, vkeyDesc :: TextEnvelopeDescr - skeyDesc = "Payment Signing Key" - vkeyDesc = "Payment Verification Key" - -runAddressKeyHash :: VerificationKeyTextOrFile - -> Maybe (File () Out) - -> ExceptT ShelleyAddressCmdError IO () -runAddressKeyHash vkeyTextOrFile mOutputFp = do - vkey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $ - newExceptT $ readVerificationKeyTextOrFileAnyOf vkeyTextOrFile - - let hexKeyHash = foldSomeAddressVerificationKey - (serialiseToRawBytesHex . verificationKeyHash) vkey - - case mOutputFp of - Just (File fpath) -> liftIO $ BS.writeFile fpath hexKeyHash - Nothing -> liftIO $ BS.putStrLn hexKeyHash - - -runAddressBuild :: PaymentVerifier - -> Maybe StakeIdentifier - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyAddressCmdError IO () -runAddressBuild paymentVerifier mbStakeVerifier nw mOutFp = do - outText <- case paymentVerifier of - PaymentVerifierKey payVkeyTextOrFile -> do - payVKey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $ - newExceptT $ readVerificationKeyTextOrFileAnyOf payVkeyTextOrFile - - addr <- case payVKey of - AByronVerificationKey vk -> - return (AddressByron (makeByronAddress nw vk)) - - APaymentVerificationKey vk -> - AddressShelley <$> buildShelleyAddress vk mbStakeVerifier nw - - APaymentExtendedVerificationKey vk -> - AddressShelley <$> buildShelleyAddress (castVerificationKey vk) mbStakeVerifier nw - - AGenesisUTxOVerificationKey vk -> - AddressShelley <$> buildShelleyAddress (castVerificationKey vk) mbStakeVerifier nw - nonPaymentKey -> - left $ ShelleyAddressCmdExpectedPaymentVerificationKey nonPaymentKey - return $ serialiseAddress (addr :: AddressAny) - - PaymentVerifierScriptFile (ScriptFile fp) -> do - ScriptInAnyLang _lang script <- - firstExceptT ShelleyAddressCmdReadScriptFileError $ - readFileScriptInAnyLang fp - - let payCred = PaymentCredentialByScript (hashScript script) - - stakeAddressReference <- maybe (return NoStakeAddress) makeStakeAddressRef mbStakeVerifier - - return $ serialiseAddress . makeShelleyAddress nw payCred $ stakeAddressReference - - case mOutFp of - Just (File fpath) -> liftIO $ Text.writeFile fpath outText - Nothing -> liftIO $ Text.putStr outText - -makeStakeAddressRef - :: StakeIdentifier - -> ExceptT ShelleyAddressCmdError IO StakeAddressReference -makeStakeAddressRef stakeIdentifier = - case stakeIdentifier of - StakeIdentifierVerifier stakeVerifier -> - case stakeVerifier of - StakeVerifierKey stkVkeyOrFile -> do - stakeVKey <- firstExceptT ShelleyAddressCmdReadKeyFileError $ - newExceptT $ readVerificationKeyOrFile AsStakeKey stkVkeyOrFile - - return . StakeAddressByValue . StakeCredentialByKey . verificationKeyHash $ stakeVKey - - StakeVerifierScriptFile (ScriptFile fp) -> do - ScriptInAnyLang _lang script <- - firstExceptT ShelleyAddressCmdReadScriptFileError $ - readFileScriptInAnyLang fp - - let stakeCred = StakeCredentialByScript (hashScript script) - return (StakeAddressByValue stakeCred) - StakeIdentifierAddress stakeAddr -> - pure $ StakeAddressByValue $ stakeAddressCredential stakeAddr - -buildShelleyAddress - :: VerificationKey PaymentKey - -> Maybe StakeIdentifier - -> NetworkId - -> ExceptT ShelleyAddressCmdError IO (Address ShelleyAddr) -buildShelleyAddress vkey mbStakeVerifier nw = - makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash vkey)) <$> maybe (return NoStakeAddress) makeStakeAddressRef mbStakeVerifier - - --- --- Handling the variety of address key types --- - - -foldSomeAddressVerificationKey :: (forall keyrole. Key keyrole => - VerificationKey keyrole -> a) - -> SomeAddressVerificationKey -> a -foldSomeAddressVerificationKey f (AByronVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (APaymentVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (APaymentExtendedVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (AGenesisUTxOVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (AKesVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (AGenesisDelegateExtendedVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (AGenesisExtendedVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (AVrfVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (AStakeVerificationKey vk) = f vk -foldSomeAddressVerificationKey f (AStakeExtendedVerificationKey vk) = f vk diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address/Info.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Address/Info.hs deleted file mode 100644 index 45a1df9cbdb..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address/Info.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} - -module Cardano.CLI.Shelley.Run.Address.Info - ( runAddressInfo - , ShelleyAddressInfoError(..) - ) where - -import Cardano.Api - -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (left) -import Data.Aeson (ToJSON (..), object, (.=)) -import Data.Aeson.Encode.Pretty (encodePretty) -import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Text (Text) -import Options.Applicative (Alternative (..)) - -newtype ShelleyAddressInfoError = ShelleyAddressInvalid Text - deriving Show - -instance Error ShelleyAddressInfoError where - displayError (ShelleyAddressInvalid addrTxt) = - "Invalid address: " <> show addrTxt - -data AddressInfo = AddressInfo - { aiType :: !Text - , aiEra :: !Text - , aiEncoding :: !Text - , aiAddress :: !Text - , aiBase16 :: !Text - } - -instance ToJSON AddressInfo where - toJSON addrInfo = - object - [ "type" .= aiType addrInfo - , "era" .= aiEra addrInfo - , "encoding" .= aiEncoding addrInfo - , "address" .= aiAddress addrInfo - , "base16" .= aiBase16 addrInfo - ] - -runAddressInfo :: Text -> Maybe (File () Out) -> ExceptT ShelleyAddressInfoError IO () -runAddressInfo addrTxt mOutputFp = do - addrInfo <- case (Left <$> deserialiseAddress AsAddressAny addrTxt) - <|> (Right <$> deserialiseAddress AsStakeAddress addrTxt) of - - Nothing -> - left $ ShelleyAddressInvalid addrTxt - - Just (Left (AddressByron payaddr)) -> - pure $ AddressInfo - { aiType = "payment" - , aiEra = "byron" - , aiEncoding = "base58" - , aiAddress = addrTxt - , aiBase16 = serialiseToRawBytesHexText payaddr - } - - Just (Left (AddressShelley payaddr)) -> - pure $ AddressInfo - { aiType = "payment" - , aiEra = "shelley" - , aiEncoding = "bech32" - , aiAddress = addrTxt - , aiBase16 = serialiseToRawBytesHexText payaddr - } - - Just (Right addr) -> - pure $ AddressInfo - { aiType = "stake" - , aiEra = "shelley" - , aiEncoding = "bech32" - , aiAddress = addrTxt - , aiBase16 = serialiseToRawBytesHexText addr - } - - case mOutputFp of - Just (File fpath) -> liftIO $ LBS.writeFile fpath $ encodePretty addrInfo - Nothing -> liftIO $ LBS.putStrLn $ encodePretty addrInfo - diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs deleted file mode 100644 index 2006caf14c1..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs +++ /dev/null @@ -1,1392 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} - -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} - -{- HLINT ignore "Reduce duplication" -} -{- HLINT ignore "Redundant <$>" -} -{- HLINT ignore "Use let" -} - -module Cardano.CLI.Shelley.Run.Genesis - ( ShelleyGenesisCmdError(..) - , readShelleyGenesisWithDefault - , readAndDecodeShelleyGenesis - , readAlonzoGenesis - , runGenesisCmd - - -- * Protocol Parameters - , ProtocolParamsError(..) - , renderProtocolParamsError - , readProtocolParameters - ) where - -import Control.DeepSeq (NFData, force) -import Control.Exception (IOException) -import Control.Monad (forM, forM_, unless, when) -import Control.Monad.Except (MonadError (..), runExceptT) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT, throwE, withExceptT) -import Data.Aeson hiding (Key) -import qualified Data.Aeson as Aeson -import Data.Aeson.Encode.Pretty (encodePretty) -import qualified Data.Aeson.KeyMap as Aeson -import Data.Bifunctor (Bifunctor (..)) -import qualified Data.Binary.Get as Bin -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Char (isDigit) -import Data.Coerce (coerce) -import Data.Data (Proxy (..)) -import Data.Either (fromRight) -import Data.Function (on) -import Data.Functor (void) -import Data.Functor.Identity -import qualified Data.List as List -import qualified Data.List.Split as List -import qualified Data.ListMap as ListMap -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe) -import qualified Data.Sequence.Strict as Seq -import Data.String (fromString) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime) -import Data.Word (Word64) -import GHC.Generics (Generic) -import Lens.Micro ((^.)) -import qualified System.IO as IO -import qualified System.Random as Random -import System.Random (StdGen) -import Text.Read (readMaybe) - -import Cardano.Ledger.Binary (Annotated (Annotated), ToCBOR (..)) - -import qualified Cardano.Crypto as CC -import Cardano.Crypto.Hash (HashAlgorithm) -import qualified Cardano.Crypto.Hash as Hash -import qualified Cardano.Crypto.Random as Crypto -import Crypto.Random as Crypto - -import System.Directory (createDirectoryIfMissing, listDirectory) -import System.FilePath (takeExtension, takeExtensions, ()) -import System.IO.Error (isDoesNotExistError) - -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, - newExceptT) - -import qualified Cardano.Crypto.Hash as Crypto - -import Cardano.Api -import Cardano.Api.Byron (toByronLovelace, toByronProtocolMagicId, - toByronRequiresNetworkMagic) -import Cardano.Api.Shelley - -import Ouroboros.Consensus.Shelley.Node (ShelleyGenesisStaking (..)) - -import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo -import qualified Cardano.Ledger.BaseTypes as Ledger -import Cardano.Ledger.Coin (Coin (..)) -import qualified Cardano.Ledger.Conway.Genesis as Conway -import Cardano.Ledger.Core (ppMinUTxOValueL) -import qualified Cardano.Ledger.Keys as Ledger -import qualified Cardano.Ledger.Shelley.API as Ledger -import Cardano.Ledger.Shelley.Genesis (secondsToNominalDiffTimeMicro) - -import Cardano.Ledger.Crypto (ADDRHASH, Crypto, StandardCrypto) -import Cardano.Ledger.Era () - -import Cardano.CLI.Shelley.Commands -import Cardano.CLI.Shelley.Key -import Cardano.CLI.Shelley.Orphans () -import Cardano.CLI.Shelley.Run.Address -import Cardano.CLI.Shelley.Run.Node (ShelleyNodeCmdError (..), renderShelleyNodeCmdError, - runNodeIssueOpCert, runNodeKeyGenCold, runNodeKeyGenKES, runNodeKeyGenVRF) -import Cardano.CLI.Shelley.Run.Pool (ShelleyPoolCmdError (..), renderShelleyPoolCmdError) -import Cardano.CLI.Shelley.Run.StakeAddress (ShelleyStakeAddressCmdError (..), - renderShelleyStakeAddressCmdError, runStakeAddressKeyGenToFile) -import Cardano.CLI.Types - -import qualified Cardano.Chain.Common as Byron (KeyHash, mkKnownLovelace, rationalToLovelacePortion) -import Cardano.Chain.Genesis (FakeAvvmOptions (..), TestnetBalanceOptions (..), - gdProtocolParameters, gsDlgIssuersSecrets, gsPoorSecrets, gsRichSecrets) -import Cardano.CLI.Byron.Delegation -import Cardano.CLI.Byron.Genesis as Byron -import qualified Cardano.CLI.Byron.Key as Byron -import qualified Cardano.Crypto.Signing as Byron - -import Cardano.Chain.Common (BlockCount (unBlockCount)) -import Cardano.Chain.Delegation (delegateVK) -import qualified Cardano.Chain.Delegation as Dlg -import qualified Cardano.Chain.Genesis as Genesis -import Cardano.Chain.Update hiding (ProtocolParameters) -import Cardano.Slotting.Slot (EpochSize (EpochSize)) -import Data.Fixed (Fixed (MkFixed)) -import qualified Data.Yaml as Yaml -import qualified Text.JSON.Canonical (ToJSON) -import Text.JSON.Canonical (parseCanonicalJSON, renderCanonicalJSON) - -import Data.ListMap (ListMap (..)) - -import qualified Cardano.CLI.IO.Lazy as Lazy - -import Cardano.Prelude (canonicalEncodePretty) - -data ShelleyGenesisCmdError - = ShelleyGenesisCmdAesonDecodeError !FilePath !Text - | ShelleyGenesisCmdGenesisFileReadError !(FileError IOException) - | ShelleyGenesisCmdGenesisFileDecodeError !FilePath !Text - | ShelleyGenesisCmdGenesisFileError !(FileError ()) - | ShelleyGenesisCmdFileError !(FileError ()) - | ShelleyGenesisCmdMismatchedGenesisKeyFiles [Int] [Int] [Int] - | ShelleyGenesisCmdFilesNoIndex [FilePath] - | ShelleyGenesisCmdFilesDupIndex [FilePath] - | ShelleyGenesisCmdTextEnvReadFileError !(FileError TextEnvelopeError) - | ShelleyGenesisCmdUnexpectedAddressVerificationKey !(VerificationKeyFile In) !Text !SomeAddressVerificationKey - | ShelleyGenesisCmdTooFewPoolsForBulkCreds !Word !Word !Word - | ShelleyGenesisCmdAddressCmdError !ShelleyAddressCmdError - | ShelleyGenesisCmdNodeCmdError !ShelleyNodeCmdError - | ShelleyGenesisCmdPoolCmdError !ShelleyPoolCmdError - | ShelleyGenesisCmdStakeAddressCmdError !ShelleyStakeAddressCmdError - | ShelleyGenesisCmdCostModelsError !FilePath - | ShelleyGenesisCmdByronError !ByronGenesisError - | ShelleyGenesisStakePoolRelayFileError !FilePath !IOException - | ShelleyGenesisStakePoolRelayJsonDecodeError !FilePath !String - deriving Show - -instance Error ShelleyGenesisCmdError where - displayError err = - case err of - ShelleyGenesisCmdAesonDecodeError fp decErr -> - "Error while decoding Shelley genesis at: " <> fp <> " Error: " <> Text.unpack decErr - ShelleyGenesisCmdGenesisFileError fe -> displayError fe - ShelleyGenesisCmdFileError fe -> displayError fe - ShelleyGenesisCmdMismatchedGenesisKeyFiles gfiles dfiles vfiles -> - "Mismatch between the files found:\n" - <> "Genesis key file indexes: " <> show gfiles <> "\n" - <> "Delegate key file indexes: " <> show dfiles <> "\n" - <> "Delegate VRF key file indexes: " <> show vfiles - ShelleyGenesisCmdFilesNoIndex files -> - "The genesis keys files are expected to have a numeric index but these do not:\n" - <> unlines files - ShelleyGenesisCmdFilesDupIndex files -> - "The genesis keys files are expected to have a unique numeric index but these do not:\n" - <> unlines files - ShelleyGenesisCmdTextEnvReadFileError fileErr -> displayError fileErr - ShelleyGenesisCmdUnexpectedAddressVerificationKey (File file) expect got -> mconcat - [ "Unexpected address verification key type in file ", file - , ", expected: ", Text.unpack expect, ", got: ", Text.unpack (renderSomeAddressVerificationKey got) - ] - ShelleyGenesisCmdTooFewPoolsForBulkCreds pools files perPool -> mconcat - [ "Number of pools requested for generation (", show pools - , ") is insufficient to fill ", show files - , " bulk files, with ", show perPool, " pools per file." - ] - ShelleyGenesisCmdAddressCmdError e -> Text.unpack $ renderShelleyAddressCmdError e - ShelleyGenesisCmdNodeCmdError e -> Text.unpack $ renderShelleyNodeCmdError e - ShelleyGenesisCmdPoolCmdError e -> Text.unpack $ renderShelleyPoolCmdError e - ShelleyGenesisCmdStakeAddressCmdError e -> Text.unpack $ renderShelleyStakeAddressCmdError e - ShelleyGenesisCmdCostModelsError fp -> "Cost model is invalid: " <> fp - ShelleyGenesisCmdGenesisFileDecodeError fp e -> - "Error while decoding Shelley genesis at: " <> fp <> - " Error: " <> Text.unpack e - ShelleyGenesisCmdGenesisFileReadError e -> displayError e - ShelleyGenesisCmdByronError e -> show e - ShelleyGenesisStakePoolRelayFileError fp e -> - "Error occurred while reading the stake pool relay specification file: " <> fp <> - " Error: " <> show e - ShelleyGenesisStakePoolRelayJsonDecodeError fp e -> - "Error occurred while decoding the stake pool relay specification file: " <> fp <> - " Error: " <> e - -runGenesisCmd :: GenesisCmd -> ExceptT ShelleyGenesisCmdError IO () -runGenesisCmd (GenesisKeyGenGenesis vk sk) = runGenesisKeyGenGenesis vk sk -runGenesisCmd (GenesisKeyGenDelegate vk sk ctr) = runGenesisKeyGenDelegate vk sk ctr -runGenesisCmd (GenesisKeyGenUTxO vk sk) = runGenesisKeyGenUTxO vk sk -runGenesisCmd (GenesisCmdKeyHash vk) = runGenesisKeyHash vk -runGenesisCmd (GenesisVerKey vk sk) = runGenesisVerKey vk sk -runGenesisCmd (GenesisTxIn vk nw mOutFile) = runGenesisTxIn vk nw mOutFile -runGenesisCmd (GenesisAddr vk nw mOutFile) = runGenesisAddr vk nw mOutFile -runGenesisCmd (GenesisCreate gd gn un ms am nw) = runGenesisCreate gd gn un ms am nw -runGenesisCmd (GenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg) = runGenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg -runGenesisCmd (GenesisCreateStaked gd gn gp gl un ms am ds nw bf bp su relayJsonFp) = - runGenesisCreateStaked gd gn gp gl un ms am ds nw bf bp su relayJsonFp -runGenesisCmd (GenesisHashFile gf) = runGenesisHashFile gf - --- --- Genesis command implementations --- - -runGenesisKeyGenGenesis :: - VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyGenGenesis vkeyPath skeyPath = do - skey <- liftIO $ generateSigningKey AsGenesisKey - let vkey = getVerificationKey skey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - where - skeyDesc, vkeyDesc :: TextEnvelopeDescr - skeyDesc = "Genesis Signing Key" - vkeyDesc = "Genesis Verification Key" - - -runGenesisKeyGenDelegate :: - VerificationKeyFile Out - -> SigningKeyFile Out - -> OpCertCounterFile Out - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyGenDelegate vkeyPath skeyPath ocertCtrPath = do - skey <- liftIO $ generateSigningKey AsGenesisDelegateKey - let vkey = getVerificationKey skey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile ocertCtrPath - $ textEnvelopeToJSON (Just certCtrDesc) - $ OperationalCertificateIssueCounter - initialCounter - (castVerificationKey vkey) -- Cast to a 'StakePoolKey' - where - skeyDesc, vkeyDesc, certCtrDesc :: TextEnvelopeDescr - skeyDesc = "Genesis delegate operator key" - vkeyDesc = "Genesis delegate operator key" - certCtrDesc = "Next certificate issue number: " - <> fromString (show initialCounter) - - initialCounter :: Word64 - initialCounter = 0 - - -runGenesisKeyGenDelegateVRF :: - VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyGenDelegateVRF vkeyPath skeyPath = do - skey <- liftIO $ generateSigningKey AsVrfKey - let vkey = getVerificationKey skey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - where - skeyDesc, vkeyDesc :: TextEnvelopeDescr - skeyDesc = "VRF Signing Key" - vkeyDesc = "VRF Verification Key" - - -runGenesisKeyGenUTxO :: - VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyGenUTxO vkeyPath skeyPath = do - skey <- liftIO $ generateSigningKey AsGenesisUTxOKey - let vkey = getVerificationKey skey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyGenesisCmdGenesisFileError - . newExceptT - $ writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - where - skeyDesc, vkeyDesc :: TextEnvelopeDescr - skeyDesc = "Genesis Initial UTxO Signing Key" - vkeyDesc = "Genesis Initial UTxO Verification Key" - - -runGenesisKeyHash :: VerificationKeyFile In -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyHash vkeyPath = do - vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ - readFileTextEnvelopeAnyOf - [ FromSomeType (AsVerificationKey AsGenesisKey) - AGenesisKey - , FromSomeType (AsVerificationKey AsGenesisDelegateKey) - AGenesisDelegateKey - , FromSomeType (AsVerificationKey AsGenesisUTxOKey) - AGenesisUTxOKey - ] - vkeyPath - liftIO $ BS.putStrLn (renderKeyHash vkey) - where - renderKeyHash :: SomeGenesisKey VerificationKey -> ByteString - renderKeyHash (AGenesisKey vk) = renderVerificationKeyHash vk - renderKeyHash (AGenesisDelegateKey vk) = renderVerificationKeyHash vk - renderKeyHash (AGenesisUTxOKey vk) = renderVerificationKeyHash vk - - renderVerificationKeyHash :: Key keyrole => VerificationKey keyrole -> ByteString - renderVerificationKeyHash = serialiseToRawBytesHex - . verificationKeyHash - - -runGenesisVerKey :: - VerificationKeyFile Out - -> SigningKeyFile In - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisVerKey vkeyPath skeyPath = do - skey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ - readFileTextEnvelopeAnyOf - [ FromSomeType (AsSigningKey AsGenesisKey) - AGenesisKey - , FromSomeType (AsSigningKey AsGenesisDelegateKey) - AGenesisDelegateKey - , FromSomeType (AsSigningKey AsGenesisUTxOKey) - AGenesisUTxOKey - ] - skeyPath - - let vkey :: SomeGenesisKey VerificationKey - vkey = case skey of - AGenesisKey sk -> AGenesisKey (getVerificationKey sk) - AGenesisDelegateKey sk -> AGenesisDelegateKey (getVerificationKey sk) - AGenesisUTxOKey sk -> AGenesisUTxOKey (getVerificationKey sk) - - firstExceptT ShelleyGenesisCmdGenesisFileError . newExceptT . liftIO $ - case vkey of - AGenesisKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk - AGenesisDelegateKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk - AGenesisUTxOKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk - -data SomeGenesisKey f - = AGenesisKey (f GenesisKey) - | AGenesisDelegateKey (f GenesisDelegateKey) - | AGenesisUTxOKey (f GenesisUTxOKey) - - -runGenesisTxIn :: - VerificationKeyFile In - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisTxIn vkeyPath network mOutFile = do - vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ - readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath - let txin = genesisUTxOPseudoTxIn network (verificationKeyHash vkey) - liftIO $ writeOutput mOutFile (renderTxIn txin) - - -runGenesisAddr :: - VerificationKeyFile In - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisAddr vkeyPath network mOutFile = do - vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ - readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath - let vkh = verificationKeyHash (castVerificationKey vkey) - addr = makeShelleyAddress network (PaymentCredentialByKey vkh) - NoStakeAddress - liftIO $ writeOutput mOutFile (serialiseAddress addr) - -writeOutput :: Maybe (File () Out) -> Text -> IO () -writeOutput (Just (File fpath)) = Text.writeFile fpath -writeOutput Nothing = Text.putStrLn - - --- --- Create Genesis command implementation --- - -runGenesisCreate :: GenesisDir - -> Word -- ^ num genesis & delegate keys to make - -> Word -- ^ num utxo keys to make - -> Maybe SystemStart - -> Maybe Lovelace - -> NetworkId - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisCreate (GenesisDir rootdir) - genNumGenesisKeys genNumUTxOKeys - mStart mAmount network = do - liftIO $ do - createDirectoryIfMissing False rootdir - createDirectoryIfMissing False gendir - createDirectoryIfMissing False deldir - createDirectoryIfMissing False utxodir - - template <- readShelleyGenesisWithDefault (rootdir "genesis.spec.json") adjustTemplate - alonzoGenesis <- readAlonzoGenesis (rootdir "genesis.alonzo.spec.json") - conwayGenesis <- readConwayGenesis (rootdir "genesis.conway.spec.json") - - forM_ [ 1 .. genNumGenesisKeys ] $ \index -> do - createGenesisKeys gendir index - createDelegateKeys deldir index - - forM_ [ 1 .. genNumUTxOKeys ] $ \index -> - createUtxoKeys utxodir index - - genDlgs <- readGenDelegsMap gendir deldir - utxoAddrs <- readInitialFundAddresses utxodir network - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart - - let shelleyGenesis = - updateTemplate - -- Shelley genesis parameters - start genDlgs mAmount utxoAddrs mempty (Lovelace 0) [] [] template - - void $ writeFileGenesis (rootdir "genesis.json") $ WritePretty shelleyGenesis - void $ writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis - void $ writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis - --TODO: rationalise the naming convention on these genesis json files. - where - adjustTemplate t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) } - gendir = rootdir "genesis-keys" - deldir = rootdir "delegate-keys" - utxodir = rootdir "utxo-keys" - -toSKeyJSON :: Key a => SigningKey a -> ByteString -toSKeyJSON = LBS.toStrict . textEnvelopeToJSON Nothing - -toVkeyJSON :: Key a => SigningKey a -> ByteString -toVkeyJSON = LBS.toStrict . textEnvelopeToJSON Nothing . getVerificationKey - -toVkeyJSON' :: Key a => VerificationKey a -> ByteString -toVkeyJSON' = LBS.toStrict . textEnvelopeToJSON Nothing - -toOpCert :: (OperationalCertificate, OperationalCertificateIssueCounter) -> ByteString -toOpCert = LBS.toStrict . textEnvelopeToJSON Nothing . fst - -toCounter :: (OperationalCertificate, OperationalCertificateIssueCounter) -> ByteString -toCounter = LBS.toStrict . textEnvelopeToJSON Nothing . snd - -generateShelleyNodeSecrets :: [SigningKey GenesisDelegateExtendedKey] -> [VerificationKey GenesisKey] - -> IO (Map (Hash GenesisKey) - ( Hash GenesisDelegateKey, Hash VrfKey) - , [SigningKey VrfKey] - , [SigningKey KesKey] - , [(OperationalCertificate, OperationalCertificateIssueCounter)]) -generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys = do - let - shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey] - shelleyDelegatevkeys = map (castVerificationKey . getVerificationKey) shelleyDelegateKeys - vrfKeys <- forM shelleyDelegateKeys $ \_ -> generateSigningKey AsVrfKey - kesKeys <- forM shelleyDelegateKeys $ \_ -> generateSigningKey AsKesKey - - let - opCertInputs :: [(VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)] - opCertInputs = zip (map getVerificationKey kesKeys) shelleyDelegateKeys - createOpCert :: (VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey) -> (OperationalCertificate, OperationalCertificateIssueCounter) - createOpCert (kesKey, delegateKey) = either (error . show) id eResult - where - eResult = issueOperationalCertificate kesKey (Right delegateKey) (KESPeriod 0) counter - counter = OperationalCertificateIssueCounter 0 (convert . getVerificationKey $ delegateKey) - convert :: VerificationKey GenesisDelegateExtendedKey - -> VerificationKey StakePoolKey - convert = (castVerificationKey :: VerificationKey GenesisDelegateKey - -> VerificationKey StakePoolKey) - . (castVerificationKey :: VerificationKey GenesisDelegateExtendedKey - -> VerificationKey GenesisDelegateKey) - - opCerts :: [(OperationalCertificate, OperationalCertificateIssueCounter)] - opCerts = map createOpCert opCertInputs - - vrfvkeys = map getVerificationKey vrfKeys - combinedMap :: [ ( VerificationKey GenesisKey - , VerificationKey GenesisDelegateKey - , VerificationKey VrfKey - ) - ] - combinedMap = zip3 shelleyGenesisvkeys shelleyDelegatevkeys vrfvkeys - hashKeys :: (VerificationKey GenesisKey, VerificationKey GenesisDelegateKey, VerificationKey VrfKey) -> (Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey)) - hashKeys (genesis,delegate,vrf) = (verificationKeyHash genesis, (verificationKeyHash delegate, verificationKeyHash vrf)); - delegateMap :: Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) - delegateMap = Map.fromList . map hashKeys $ combinedMap - - return (delegateMap, vrfKeys, kesKeys, opCerts) - --- --- Create Genesis Cardano command implementation --- - -runGenesisCreateCardano :: GenesisDir - -> Word -- ^ num genesis & delegate keys to make - -> Word -- ^ num utxo keys to make - -> Maybe SystemStart - -> Maybe Lovelace - -> BlockCount - -> Word -- ^ slot length in ms - -> Rational - -> NetworkId - -> FilePath -- ^ Byron Genesis - -> FilePath -- ^ Shelley Genesis - -> FilePath -- ^ Alonzo Genesis - -> FilePath -- ^ Conway Genesis - -> Maybe FilePath - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisCreateCardano (GenesisDir rootdir) - genNumGenesisKeys genNumUTxOKeys - mStart mAmount mSecurity slotLength mSlotCoeff - network byronGenesisT shelleyGenesisT alonzoGenesisT conwayGenesisT mNodeCfg = do - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart - (byronGenesis', byronSecrets) <- convertToShelleyError $ Byron.mkGenesis $ byronParams start - let - byronGenesis = byronGenesis' - { gdProtocolParameters = (gdProtocolParameters byronGenesis') { - ppSlotDuration = floor ( toRational slotLength * recip mSlotCoeff ) - } - } - - genesisKeys = gsDlgIssuersSecrets byronSecrets - byronGenesisKeys = map ByronSigningKey genesisKeys - shelleyGenesisKeys = map convertGenesisKey genesisKeys - shelleyGenesisvkeys :: [VerificationKey GenesisKey] - shelleyGenesisvkeys = map (castVerificationKey . getVerificationKey) shelleyGenesisKeys - - delegateKeys = gsRichSecrets byronSecrets - byronDelegateKeys = map ByronSigningKey delegateKeys - shelleyDelegateKeys :: [SigningKey GenesisDelegateExtendedKey] - shelleyDelegateKeys = map convertDelegate delegateKeys - shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey] - shelleyDelegatevkeys = map (castVerificationKey . getVerificationKey) shelleyDelegateKeys - - utxoKeys = gsPoorSecrets byronSecrets - byronUtxoKeys = map (ByronSigningKey . Genesis.poorSecretToKey) utxoKeys - shelleyUtxoKeys = map (convertPoor . Genesis.poorSecretToKey) utxoKeys - - dlgCerts <- convertToShelleyError $ mapM (findDelegateCert byronGenesis) byronDelegateKeys - let - overrideShelleyGenesis t = t - { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) - , sgNetworkId = toShelleyNetwork network - , sgActiveSlotsCoeff = fromMaybe (error $ "Could not convert from Rational: " ++ show mSlotCoeff) $ Ledger.boundRational mSlotCoeff - , sgSecurityParam = unBlockCount mSecurity - , sgUpdateQuorum = fromIntegral $ ((genNumGenesisKeys `div` 3) * 2) + 1 - , sgEpochLength = EpochSize $ floor $ (fromIntegral (unBlockCount mSecurity) * 10) / mSlotCoeff - , sgMaxLovelaceSupply = 45000000000000000 - , sgSystemStart = getSystemStart start - , sgSlotLength = secondsToNominalDiffTimeMicro $ MkFixed (fromIntegral slotLength) * 1000 - } - shelleyGenesisTemplate <- liftIO $ overrideShelleyGenesis . fromRight (error "shelley genesis template not found") <$> readAndDecodeShelleyGenesis shelleyGenesisT - alonzoGenesis <- readAlonzoGenesis alonzoGenesisT - conwayGenesis <- readConwayGenesis conwayGenesisT - (delegateMap, vrfKeys, kesKeys, opCerts) <- liftIO $ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys - let - shelleyGenesis :: ShelleyGenesis StandardCrypto - shelleyGenesis = updateTemplate start delegateMap Nothing [] mempty 0 [] [] shelleyGenesisTemplate - - liftIO $ do - createDirectoryIfMissing False rootdir - createDirectoryIfMissing False gendir - createDirectoryIfMissing False deldir - createDirectoryIfMissing False utxodir - - writeSecrets gendir "byron" "key" serialiseToRawBytes byronGenesisKeys - writeSecrets gendir "shelley" "skey" toSKeyJSON shelleyGenesisKeys - writeSecrets gendir "shelley" "vkey" toVkeyJSON shelleyGenesisKeys - - writeSecrets deldir "byron" "key" serialiseToRawBytes byronDelegateKeys - writeSecrets deldir "shelley" "skey" toSKeyJSON shelleyDelegateKeys - writeSecrets deldir "shelley" "vkey" toVkeyJSON' shelleyDelegatevkeys - writeSecrets deldir "shelley" "vrf.skey" toSKeyJSON vrfKeys - writeSecrets deldir "shelley" "vrf.vkey" toVkeyJSON vrfKeys - writeSecrets deldir "shelley" "kes.skey" toSKeyJSON kesKeys - writeSecrets deldir "shelley" "kes.vkey" toVkeyJSON kesKeys - - writeSecrets utxodir "byron" "key" serialiseToRawBytes byronUtxoKeys - writeSecrets utxodir "shelley" "skey" toSKeyJSON shelleyUtxoKeys - writeSecrets utxodir "shelley" "vkey" toVkeyJSON shelleyUtxoKeys - - writeSecrets deldir "byron" "cert.json" serialiseDelegationCert dlgCerts - - writeSecrets deldir "shelley" "opcert.json" toOpCert opCerts - writeSecrets deldir "shelley" "counter.json" toCounter opCerts - - byronGenesisHash <- writeFileGenesis (rootdir "byron-genesis.json") $ WriteCanonical byronGenesis - shelleyGenesisHash <- writeFileGenesis (rootdir "shelley-genesis.json") $ WritePretty shelleyGenesis - alonzoGenesisHash <- writeFileGenesis (rootdir "alonzo-genesis.json") $ WritePretty alonzoGenesis - conwayGenesisHash <- writeFileGenesis (rootdir "conway-genesis.json") $ WritePretty conwayGenesis - - liftIO $ do - case mNodeCfg of - Nothing -> pure () - Just nodeCfg -> do - nodeConfig <- Yaml.decodeFileThrow nodeCfg - let - setHash field hash = Aeson.insert field $ String $ Crypto.hashToTextAsHex hash - updateConfig :: Yaml.Value -> Yaml.Value - updateConfig (Object obj) = Object - $ setHash "ByronGenesisHash" byronGenesisHash - $ setHash "ShelleyGenesisHash" shelleyGenesisHash - $ setHash "AlonzoGenesisHash" alonzoGenesisHash - $ setHash "ConwayGenesisHash" conwayGenesisHash - obj - updateConfig x = x - newConfig :: Yaml.Value - newConfig = updateConfig nodeConfig - encodeFile (rootdir "node-config.json") newConfig - - where - convertToShelleyError = withExceptT ShelleyGenesisCmdByronError - convertGenesisKey :: Byron.SigningKey -> SigningKey GenesisExtendedKey - convertGenesisKey (Byron.SigningKey xsk) = GenesisExtendedSigningKey xsk - - convertDelegate :: Byron.SigningKey -> SigningKey GenesisDelegateExtendedKey - convertDelegate (Byron.SigningKey xsk) = GenesisDelegateExtendedSigningKey xsk - - convertPoor :: Byron.SigningKey -> SigningKey ByronKey - convertPoor = ByronSigningKey - - byronParams start = Byron.GenesisParameters (getSystemStart start) byronGenesisT mSecurity byronNetwork byronBalance byronFakeAvvm byronAvvmFactor Nothing - gendir = rootdir "genesis-keys" - deldir = rootdir "delegate-keys" - utxodir = rootdir "utxo-keys" - byronNetwork = CC.AProtocolMagic - (Annotated (toByronProtocolMagicId network) ()) - (toByronRequiresNetworkMagic network) - byronBalance = TestnetBalanceOptions - { tboRichmen = genNumGenesisKeys - , tboPoors = genNumUTxOKeys - , tboTotalBalance = fromMaybe zeroLovelace $ toByronLovelace (fromMaybe 0 mAmount) - , tboRichmenShare = 0 - } - byronFakeAvvm = FakeAvvmOptions - { faoCount = 0 - , faoOneBalance = zeroLovelace - } - byronAvvmFactor = Byron.rationalToLovelacePortion 0.0 - zeroLovelace = Byron.mkKnownLovelace @0 - - -- Compare a given 'SigningKey' with a 'Certificate' 'VerificationKey' - isCertForSK :: CC.SigningKey -> Dlg.Certificate -> Bool - isCertForSK sk cert = delegateVK cert == CC.toVerification sk - - findDelegateCert :: Genesis.GenesisData -> SigningKey ByronKey -> ExceptT ByronGenesisError IO Dlg.Certificate - findDelegateCert byronGenesis bSkey@(ByronSigningKey sk) = do - case List.find (isCertForSK sk) (Map.elems $ dlgCertMap byronGenesis) of - Nothing -> throwE . NoGenesisDelegationForKey - . Byron.prettyPublicKey $ getVerificationKey bSkey - Just x -> pure x - - dlgCertMap :: Genesis.GenesisData -> Map Byron.KeyHash Dlg.Certificate - dlgCertMap byronGenesis = Genesis.unGenesisDelegation $ Genesis.gdHeavyDelegation byronGenesis - -runGenesisCreateStaked - :: GenesisDir - -> Word -- ^ num genesis & delegate keys to make - -> Word -- ^ num utxo keys to make - -> Word -- ^ num pools to make - -> Word -- ^ num delegators to make - -> Maybe SystemStart - -> Maybe Lovelace -- ^ supply going to non-delegators - -> Lovelace -- ^ supply going to delegators - -> NetworkId - -> Word -- ^ bulk credential files to write - -> Word -- ^ pool credentials per bulk file - -> Word -- ^ num stuffed UTxO entries - -> Maybe FilePath -- ^ Specified stake pool relays - -> ExceptT ShelleyGenesisCmdError IO () -runGenesisCreateStaked (GenesisDir rootdir) - genNumGenesisKeys genNumUTxOKeys genNumPools genNumStDelegs - mStart mNonDlgAmount stDlgAmount network - numBulkPoolCredFiles bulkPoolsPerFile numStuffedUtxo - sPoolRelayFp = do - liftIO $ do - createDirectoryIfMissing False rootdir - createDirectoryIfMissing False gendir - createDirectoryIfMissing False deldir - createDirectoryIfMissing False pooldir - createDirectoryIfMissing False stdeldir - createDirectoryIfMissing False utxodir - - template <- readShelleyGenesisWithDefault (rootdir "genesis.spec.json") adjustTemplate - alonzoGenesis <- readAlonzoGenesis (rootdir "genesis.alonzo.spec.json") - conwayGenesis <- readConwayGenesis (rootdir "genesis.conway.spec.json") - - forM_ [ 1 .. genNumGenesisKeys ] $ \index -> do - createGenesisKeys gendir index - createDelegateKeys deldir index - - forM_ [ 1 .. genNumUTxOKeys ] $ \index -> - createUtxoKeys utxodir index - - mayStakePoolRelays - <- forM sPoolRelayFp $ - \fp -> do - relaySpecJsonBs <- - handleIOExceptT (ShelleyGenesisStakePoolRelayFileError fp) (LBS.readFile fp) - firstExceptT (ShelleyGenesisStakePoolRelayJsonDecodeError fp) - . hoistEither $ Aeson.eitherDecode relaySpecJsonBs - - poolParams <- forM [ 1 .. genNumPools ] $ \index -> do - createPoolCredentials pooldir index - buildPoolParams network pooldir index (fromMaybe mempty mayStakePoolRelays) - - when (numBulkPoolCredFiles * bulkPoolsPerFile > genNumPools) $ - left $ ShelleyGenesisCmdTooFewPoolsForBulkCreds genNumPools numBulkPoolCredFiles bulkPoolsPerFile - -- We generate the bulk files for the last pool indices, - -- so that all the non-bulk pools have stable indices at beginning: - let bulkOffset = fromIntegral $ genNumPools - numBulkPoolCredFiles * bulkPoolsPerFile - bulkIndices :: [Word] = [ 1 + bulkOffset .. genNumPools ] - bulkSlices :: [[Word]] = List.chunksOf (fromIntegral bulkPoolsPerFile) bulkIndices - forM_ (zip [ 1 .. numBulkPoolCredFiles ] bulkSlices) $ - uncurry (writeBulkPoolCredentials pooldir) - - let (delegsPerPool, delegsRemaining) = divMod genNumStDelegs genNumPools - delegsForPool poolIx = if delegsRemaining /= 0 && poolIx == genNumPools - then delegsPerPool - else delegsPerPool + delegsRemaining - distribution = [pool | (pool, poolIx) <- zip poolParams [1 ..], _ <- [1 .. delegsForPool poolIx]] - - g <- Random.getStdGen - - -- Distribute M delegates across N pools: - delegations <- liftIO $ Lazy.forStateM g distribution $ flip computeInsecureDelegation network - - let numDelegations = length delegations - - genDlgs <- readGenDelegsMap gendir deldir - nonDelegAddrs <- readInitialFundAddresses utxodir network - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart - - stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) genStuffedAddress - - let stake = second Ledger.ppId . mkDelegationMapEntry <$> delegations - stakePools = [ (Ledger.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ] - delegAddrs = dInitialUtxoAddr <$> delegations - !shelleyGenesis = - updateCreateStakedOutputTemplate - -- Shelley genesis parameters - start genDlgs mNonDlgAmount (length nonDelegAddrs) nonDelegAddrs stakePools stake - stDlgAmount numDelegations delegAddrs stuffedUtxoAddrs template - - liftIO $ LBS.writeFile (rootdir "genesis.json") $ Aeson.encode shelleyGenesis - - void $ writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis - void $ writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis - --TODO: rationalise the naming convention on these genesis json files. - - liftIO $ Text.hPutStrLn IO.stderr $ mconcat $ - [ "generated genesis with: " - , textShow genNumGenesisKeys, " genesis keys, " - , textShow genNumUTxOKeys, " non-delegating UTxO keys, " - , textShow genNumPools, " stake pools, " - , textShow genNumStDelegs, " delegating UTxO keys, " - , textShow numDelegations, " delegation map entries, " - ] ++ - [ mconcat - [ ", " - , textShow numBulkPoolCredFiles, " bulk pool credential files, " - , textShow bulkPoolsPerFile, " pools per bulk credential file, indices starting from " - , textShow bulkOffset, ", " - , textShow $ length bulkIndices, " total pools in bulk nodes, each bulk node having this many entries: " - , textShow $ length <$> bulkSlices - ] - | numBulkPoolCredFiles * bulkPoolsPerFile > 0 ] - - where - adjustTemplate t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) } - mkDelegationMapEntry :: Delegation -> (Ledger.KeyHash Ledger.Staking StandardCrypto, Ledger.PoolParams StandardCrypto) - mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) - - gendir = rootdir "genesis-keys" - deldir = rootdir "delegate-keys" - pooldir = rootdir "pools" - stdeldir = rootdir "stake-delegator-keys" - utxodir = rootdir "utxo-keys" - - genStuffedAddress :: IO (AddressInEra ShelleyEra) - genStuffedAddress = - shelleyAddressInEra <$> - (ShelleyAddress - <$> pure Ledger.Testnet - <*> (Ledger.KeyHashObj . mkKeyHash . read64BitInt - <$> Crypto.runSecureRandom (getRandomBytes 8)) - <*> pure Ledger.StakeRefNull) - - read64BitInt :: ByteString -> Int - read64BitInt = (fromIntegral :: Word64 -> Int) - . Bin.runGet Bin.getWord64le . LBS.fromStrict - - mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash.Hash h a - mkDummyHash _ = coerce . Ledger.hashWithSerialiser @h toCBOR - - mkKeyHash :: forall c discriminator. Crypto c => Int -> Ledger.KeyHash discriminator c - mkKeyHash = Ledger.KeyHash . mkDummyHash (Proxy @(ADDRHASH c)) - --- ------------------------------------------------------------------------------------------------- - -createDelegateKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () -createDelegateKeys dir index = do - liftIO $ createDirectoryIfMissing False dir - runGenesisKeyGenDelegate - (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vkey") - (onlyOut coldSK) - (onlyOut opCertCtr) - runGenesisKeyGenDelegateVRF - (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.vkey") - (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.skey") - firstExceptT ShelleyGenesisCmdNodeCmdError $ do - runNodeKeyGenKES - (onlyOut kesVK) - (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".kes.skey") - runNodeIssueOpCert - (VerificationKeyFilePath (onlyIn kesVK)) - (onlyIn coldSK) - opCertCtr - (KESPeriod 0) - (File $ dir "opcert" ++ strIndex ++ ".cert") - where - strIndex = show index - kesVK = File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".kes.vkey" - coldSK = File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".skey" - opCertCtr = File $ dir "delegate" ++ strIndex ++ ".counter" - -createGenesisKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () -createGenesisKeys dir index = do - liftIO $ createDirectoryIfMissing False dir - let strIndex = show index - runGenesisKeyGenGenesis - (File @(VerificationKey ()) $ dir "genesis" ++ strIndex ++ ".vkey") - (File @(SigningKey ()) $ dir "genesis" ++ strIndex ++ ".skey") - - -createUtxoKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () -createUtxoKeys dir index = do - liftIO $ createDirectoryIfMissing False dir - let strIndex = show index - runGenesisKeyGenUTxO - (File @(VerificationKey ()) $ dir "utxo" ++ strIndex ++ ".vkey") - (File @(SigningKey ()) $ dir "utxo" ++ strIndex ++ ".skey") - -createPoolCredentials :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () -createPoolCredentials dir index = do - liftIO $ createDirectoryIfMissing False dir - firstExceptT ShelleyGenesisCmdNodeCmdError $ do - runNodeKeyGenKES - (onlyOut kesVK) - (File @(SigningKey ()) $ dir "kes" ++ strIndex ++ ".skey") - runNodeKeyGenVRF - (File @(VerificationKey ()) $ dir "vrf" ++ strIndex ++ ".vkey") - (File @(SigningKey ()) $ dir "vrf" ++ strIndex ++ ".skey") - runNodeKeyGenCold - (File @(VerificationKey ()) $ dir "cold" ++ strIndex ++ ".vkey") - (onlyOut coldSK) - (onlyOut opCertCtr) - runNodeIssueOpCert - (VerificationKeyFilePath (onlyIn kesVK)) - (onlyIn coldSK) - opCertCtr - (KESPeriod 0) - (File $ dir "opcert" ++ strIndex ++ ".cert") - firstExceptT ShelleyGenesisCmdStakeAddressCmdError $ - runStakeAddressKeyGenToFile - (File @(VerificationKey ()) $ dir "staking-reward" ++ strIndex ++ ".vkey") - (File @(SigningKey ()) $ dir "staking-reward" ++ strIndex ++ ".skey") - where - strIndex = show index - kesVK = File @(VerificationKey ()) $ dir "kes" ++ strIndex ++ ".vkey" - coldSK = File @(SigningKey ()) $ dir "cold" ++ strIndex ++ ".skey" - opCertCtr = File $ dir "opcert" ++ strIndex ++ ".counter" - -data Delegation = Delegation - { dInitialUtxoAddr :: !(AddressInEra ShelleyEra) - , dDelegStaking :: !(Ledger.KeyHash Ledger.Staking StandardCrypto) - , dPoolParams :: !(Ledger.PoolParams StandardCrypto) - } - deriving (Generic, NFData) - -buildPoolParams - :: NetworkId - -> FilePath -- ^ File directory where the necessary pool credentials were created - -> Word - -> Map Word [Ledger.StakePoolRelay] -- ^ User submitted stake pool relay map - -> ExceptT ShelleyGenesisCmdError IO (Ledger.PoolParams StandardCrypto) -buildPoolParams nw dir index specifiedRelays = do - StakePoolVerificationKey poolColdVK - <- firstExceptT (ShelleyGenesisCmdPoolCmdError . ShelleyPoolCmdReadFileError) - . newExceptT $ readFileTextEnvelope (AsVerificationKey AsStakePoolKey) poolColdVKF - - VrfVerificationKey poolVrfVK - <- firstExceptT (ShelleyGenesisCmdNodeCmdError . ShelleyNodeCmdReadFileError) - . newExceptT $ readFileTextEnvelope (AsVerificationKey AsVrfKey) poolVrfVKF - rewardsSVK - <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError - . newExceptT $ readFileTextEnvelope (AsVerificationKey AsStakeKey) poolRewardVKF - - pure Ledger.PoolParams - { Ledger.ppId = Ledger.hashKey poolColdVK - , Ledger.ppVrf = Ledger.hashVerKeyVRF poolVrfVK - , Ledger.ppPledge = Ledger.Coin 0 - , Ledger.ppCost = Ledger.Coin 0 - , Ledger.ppMargin = minBound - , Ledger.ppRewardAcnt = - toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK) - , Ledger.ppOwners = mempty - , Ledger.ppRelays = lookupPoolRelay specifiedRelays - , Ledger.ppMetadata = Ledger.SNothing - } - where - lookupPoolRelay - :: Map Word [Ledger.StakePoolRelay] -> Seq.StrictSeq Ledger.StakePoolRelay - lookupPoolRelay m = maybe mempty Seq.fromList (Map.lookup index m) - - strIndex = show index - poolColdVKF = File $ dir "cold" ++ strIndex ++ ".vkey" - poolVrfVKF = File $ dir "vrf" ++ strIndex ++ ".vkey" - poolRewardVKF = File $ dir "staking-reward" ++ strIndex ++ ".vkey" - -writeBulkPoolCredentials :: FilePath -> Word -> [Word] -> ExceptT ShelleyGenesisCmdError IO () -writeBulkPoolCredentials dir bulkIx poolIxs = do - creds <- mapM readPoolCreds poolIxs - handleIOExceptT (ShelleyGenesisCmdFileError . FileIOError bulkFile) $ - LBS.writeFile bulkFile $ Aeson.encode creds - where - bulkFile = dir "bulk" ++ show bulkIx ++ ".creds" - - readPoolCreds :: Word -> ExceptT ShelleyGenesisCmdError IO - (TextEnvelope, TextEnvelope, TextEnvelope) - readPoolCreds ix = do - (,,) <$> readEnvelope poolOpCert - <*> readEnvelope poolVrfSKF - <*> readEnvelope poolKesSKF - where - strIndex = show ix - poolOpCert = dir "opcert" ++ strIndex ++ ".cert" - poolVrfSKF = dir "vrf" ++ strIndex ++ ".skey" - poolKesSKF = dir "kes" ++ strIndex ++ ".skey" - readEnvelope :: FilePath -> ExceptT ShelleyGenesisCmdError IO TextEnvelope - readEnvelope fp = do - content <- handleIOExceptT (ShelleyGenesisCmdFileError . FileIOError fp) $ - BS.readFile fp - firstExceptT (ShelleyGenesisCmdAesonDecodeError fp . Text.pack) . hoistEither $ - Aeson.eitherDecodeStrict' content - --- | This function should only be used for testing purposes. --- Keys returned by this function are not cryptographically secure. -computeInsecureDelegation - :: StdGen - -> NetworkId - -> Ledger.PoolParams StandardCrypto - -> IO (StdGen, Delegation) -computeInsecureDelegation g0 nw pool = do - (paymentVK, g1) <- first getVerificationKey <$> generateInsecureSigningKey g0 AsPaymentKey - (stakeVK , g2) <- first getVerificationKey <$> generateInsecureSigningKey g1 AsStakeKey - - let stakeAddressReference = StakeAddressByValue . StakeCredentialByKey . verificationKeyHash $ stakeVK - let initialUtxoAddr = makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash paymentVK)) stakeAddressReference - - delegation <- pure $ force Delegation - { dInitialUtxoAddr = shelleyAddressInEra initialUtxoAddr - , dDelegStaking = Ledger.hashKey (unStakeVerificationKey stakeVK) - , dPoolParams = pool - } - - pure (g2, delegation) - --- | Current UTCTime plus 30 seconds -getCurrentTimePlus30 :: ExceptT a IO UTCTime -getCurrentTimePlus30 = - plus30sec <$> liftIO getCurrentTime - where - plus30sec :: UTCTime -> UTCTime - plus30sec = addUTCTime (30 :: NominalDiffTime) - --- | Attempts to read Shelley genesis from disk --- and if not found creates a default Shelley genesis. -readShelleyGenesisWithDefault - :: FilePath - -> (ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto) - -> ExceptT ShelleyGenesisCmdError IO (ShelleyGenesis StandardCrypto) -readShelleyGenesisWithDefault fpath adjustDefaults = do - newExceptT (readAndDecodeShelleyGenesis fpath) - `catchError` \err -> - case err of - ShelleyGenesisCmdGenesisFileReadError (FileIOError _ ioe) - | isDoesNotExistError ioe -> writeDefault - _ -> left err - where - defaults :: ShelleyGenesis StandardCrypto - defaults = adjustDefaults shelleyGenesisDefaults - - writeDefault = do - handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ - LBS.writeFile fpath (encode defaults) - return defaults - -readAndDecodeShelleyGenesis - :: FilePath - -> IO (Either ShelleyGenesisCmdError (ShelleyGenesis StandardCrypto)) -readAndDecodeShelleyGenesis fpath = runExceptT $ do - lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileReadError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (ShelleyGenesisCmdGenesisFileDecodeError fpath . Text.pack) - . hoistEither $ Aeson.eitherDecode' lbs - -updateTemplate - :: SystemStart -- ^ System start time - -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based) - -> Maybe Lovelace -- ^ Amount of lovelace not delegated - -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> Map (Ledger.KeyHash 'Ledger.Staking StandardCrypto) (Ledger.PoolParams StandardCrypto) -- ^ Genesis staking: pools/delegation map & delegated initial UTxO spec - -> Lovelace -- ^ Number of UTxO Addresses for delegation - -> [AddressInEra ShelleyEra] -- ^ UTxO Addresses for delegation - -> [AddressInEra ShelleyEra] -- ^ Stuffed UTxO addresses - -> ShelleyGenesis StandardCrypto -- ^ Template from which to build a genesis - -> ShelleyGenesis StandardCrypto -- ^ Updated genesis -updateTemplate (SystemStart start) - genDelegMap mAmountNonDeleg utxoAddrsNonDeleg - poolSpecs (Lovelace amountDeleg) utxoAddrsDeleg stuffedUtxoAddrs - template = do - - let pparamsFromTemplate = sgProtocolParams template - shelleyGenesis = template - { sgSystemStart = start - , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin - , sgGenDelegs = shelleyDelKeys - , sgInitialFunds = ListMap.fromList - [ (toShelleyAddr addr, toShelleyLovelace v) - | (addr, v) <- - distribute (nonDelegCoin - subtractForTreasury) utxoAddrsNonDeleg ++ - distribute (delegCoin - subtractForTreasury) utxoAddrsDeleg ++ - mkStuffedUtxo stuffedUtxoAddrs ] - , sgStaking = - ShelleyGenesisStaking - { sgsPools = ListMap.fromList - [ (Ledger.ppId poolParams, poolParams) - | poolParams <- Map.elems poolSpecs ] - , sgsStake = ListMap.fromMap $ Ledger.ppId <$> poolSpecs - } - , sgProtocolParams = pparamsFromTemplate - } - shelleyGenesis - where - maximumLovelaceSupply :: Word64 - maximumLovelaceSupply = sgMaxLovelaceSupply template - -- If the initial funds are equal to the maximum funds, rewards cannot be created. - subtractForTreasury :: Integer - subtractForTreasury = nonDelegCoin `quot` 10 - nonDelegCoin, delegCoin :: Integer - nonDelegCoin = fromIntegral (maybe maximumLovelaceSupply unLovelace mAmountNonDeleg) - delegCoin = fromIntegral amountDeleg - - distribute :: Integer -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] - distribute funds addrs = - fst $ List.foldl' folder ([], fromIntegral funds) addrs - where - nAddrs, coinPerAddr, splitThreshold :: Integer - nAddrs = fromIntegral $ length addrs - coinPerAddr = funds `div` nAddrs - splitThreshold = coinPerAddr + nAddrs - - folder :: ([(AddressInEra ShelleyEra, Lovelace)], Integer) - -> AddressInEra ShelleyEra - -> ([(AddressInEra ShelleyEra, Lovelace)], Integer) - folder (acc, rest) addr - | rest > splitThreshold = - ((addr, Lovelace coinPerAddr) : acc, rest - coinPerAddr) - | otherwise = ((addr, Lovelace rest) : acc, 0) - - mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] - mkStuffedUtxo xs = (, Lovelace minUtxoVal) <$> xs - where Coin minUtxoVal = sgProtocolParams template ^. ppMinUTxOValueL - - shelleyDelKeys = - Map.fromList - [ (gh, Ledger.GenDelegPair gdh h) - | (GenesisKeyHash gh, - (GenesisDelegateKeyHash gdh, VrfKeyHash h)) <- Map.toList genDelegMap - ] - - unLovelace :: Integral a => Lovelace -> a - unLovelace (Lovelace coin) = fromIntegral coin - -updateCreateStakedOutputTemplate - :: SystemStart -- ^ System start time - -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based) - -> Maybe Lovelace -- ^ Amount of lovelace not delegated - -> Int -- ^ Number of UTxO addresses that are delegating - -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> [(Ledger.KeyHash 'Ledger.StakePool StandardCrypto, Ledger.PoolParams StandardCrypto)] -- ^ Pool map - -> [(Ledger.KeyHash 'Ledger.Staking StandardCrypto, Ledger.KeyHash 'Ledger.StakePool StandardCrypto)] -- ^ Delegaton map - -> Lovelace -- ^ Amount of lovelace to delegate - -> Int -- ^ Number of UTxO address for delegationg - -> [AddressInEra ShelleyEra] -- ^ UTxO address for delegationg - -> [AddressInEra ShelleyEra] -- ^ Stuffed UTxO addresses - -> ShelleyGenesis StandardCrypto -- ^ Template from which to build a genesis - -> ShelleyGenesis StandardCrypto -- ^ Updated genesis -updateCreateStakedOutputTemplate - (SystemStart start) - genDelegMap mAmountNonDeleg nUtxoAddrsNonDeleg utxoAddrsNonDeleg pools stake - (Lovelace amountDeleg) - nUtxoAddrsDeleg utxoAddrsDeleg stuffedUtxoAddrs - template = do - let pparamsFromTemplate = sgProtocolParams template - shelleyGenesis = template - { sgSystemStart = start - , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin - , sgGenDelegs = shelleyDelKeys - , sgInitialFunds = ListMap.fromList - [ (toShelleyAddr addr, toShelleyLovelace v) - | (addr, v) <- - distribute (nonDelegCoin - subtractForTreasury) nUtxoAddrsNonDeleg utxoAddrsNonDeleg - ++ - distribute (delegCoin - subtractForTreasury) nUtxoAddrsDeleg utxoAddrsDeleg - ++ - mkStuffedUtxo stuffedUtxoAddrs - ] - , sgStaking = - ShelleyGenesisStaking - { sgsPools = ListMap pools - , sgsStake = ListMap stake - } - , sgProtocolParams = pparamsFromTemplate - } - shelleyGenesis - where - maximumLovelaceSupply :: Word64 - maximumLovelaceSupply = sgMaxLovelaceSupply template - -- If the initial funds are equal to the maximum funds, rewards cannot be created. - subtractForTreasury :: Integer - subtractForTreasury = nonDelegCoin `quot` 10 - nonDelegCoin, delegCoin :: Integer - nonDelegCoin = fromIntegral (maybe maximumLovelaceSupply unLovelace mAmountNonDeleg) - delegCoin = fromIntegral amountDeleg - - distribute :: Integer -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] - distribute funds nAddrs addrs = zip addrs (fmap Lovelace (coinPerAddr + remainder:repeat coinPerAddr)) - where coinPerAddr, remainder :: Integer - (,) coinPerAddr remainder = funds `divMod` fromIntegral nAddrs - - mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] - mkStuffedUtxo xs = (, Lovelace minUtxoVal) <$> xs - where Coin minUtxoVal = sgProtocolParams template ^. ppMinUTxOValueL - - shelleyDelKeys = Map.fromList - [ (gh, Ledger.GenDelegPair gdh h) - | (GenesisKeyHash gh, - (GenesisDelegateKeyHash gdh, VrfKeyHash h)) <- Map.toList genDelegMap - ] - - unLovelace :: Integral a => Lovelace -> a - unLovelace (Lovelace coin) = fromIntegral coin - -writeFileGenesis - :: FilePath - -> WriteFileGenesis - -> ExceptT ShelleyGenesisCmdError IO (Crypto.Hash Crypto.Blake2b_256 ByteString) -writeFileGenesis fpath genesis = do - handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ - BS.writeFile fpath content - return $ Crypto.hashWith id content - where - content = case genesis of - WritePretty a -> LBS.toStrict $ encodePretty a - WriteCanonical a -> LBS.toStrict - . renderCanonicalJSON - . either (error "error parsing json that was just encoded!?") id - . parseCanonicalJSON - . canonicalEncodePretty $ a - -data WriteFileGenesis where - WriteCanonical :: Text.JSON.Canonical.ToJSON Identity genesis => genesis -> WriteFileGenesis - WritePretty :: ToJSON genesis => genesis -> WriteFileGenesis - --- ---------------------------------------------------------------------------- - -readGenDelegsMap :: FilePath -> FilePath - -> ExceptT ShelleyGenesisCmdError IO - (Map (Hash GenesisKey) - (Hash GenesisDelegateKey, Hash VrfKey)) -readGenDelegsMap gendir deldir = do - gkm <- readGenesisKeys gendir - dkm <- readDelegateKeys deldir - vkm <- readDelegateVrfKeys deldir - - let combinedMap :: Map Int (VerificationKey GenesisKey, - (VerificationKey GenesisDelegateKey, - VerificationKey VrfKey)) - combinedMap = - Map.intersectionWith (,) - gkm - (Map.intersectionWith (,) - dkm vkm) - - -- All the maps should have an identical set of keys. Complain if not. - let gkmExtra = gkm Map.\\ combinedMap - dkmExtra = dkm Map.\\ combinedMap - vkmExtra = vkm Map.\\ combinedMap - unless (Map.null gkmExtra && Map.null dkmExtra && Map.null vkmExtra) $ - throwError $ ShelleyGenesisCmdMismatchedGenesisKeyFiles - (Map.keys gkm) (Map.keys dkm) (Map.keys vkm) - - let delegsMap :: Map (Hash GenesisKey) - (Hash GenesisDelegateKey, Hash VrfKey) - delegsMap = - Map.fromList [ (gh, (dh, vh)) - | (g,(d,v)) <- Map.elems combinedMap - , let gh = verificationKeyHash g - dh = verificationKeyHash d - vh = verificationKeyHash v - ] - - pure delegsMap - - -readGenesisKeys :: FilePath -> ExceptT ShelleyGenesisCmdError IO - (Map Int (VerificationKey GenesisKey)) -readGenesisKeys gendir = do - files <- liftIO (listDirectory gendir) - fileIxs <- extractFileNameIndexes [ gendir file - | file <- files - , takeExtension file == ".vkey" ] - firstExceptT ShelleyGenesisCmdTextEnvReadFileError $ - Map.fromList <$> - sequence - [ (,) ix <$> readKey (File file) - | (file, ix) <- fileIxs ] - where - readKey = newExceptT - . readFileTextEnvelope (AsVerificationKey AsGenesisKey) - -readDelegateKeys :: FilePath - -> ExceptT ShelleyGenesisCmdError IO - (Map Int (VerificationKey GenesisDelegateKey)) -readDelegateKeys deldir = do - files <- liftIO (listDirectory deldir) - fileIxs <- extractFileNameIndexes [ deldir file - | file <- files - , takeExtensions file == ".vkey" ] - firstExceptT ShelleyGenesisCmdTextEnvReadFileError $ - Map.fromList <$> - sequence - [ (,) ix <$> readKey (File file) - | (file, ix) <- fileIxs ] - where - readKey = newExceptT - . readFileTextEnvelope (AsVerificationKey AsGenesisDelegateKey) - -readDelegateVrfKeys :: FilePath -> ExceptT ShelleyGenesisCmdError IO - (Map Int (VerificationKey VrfKey)) -readDelegateVrfKeys deldir = do - files <- liftIO (listDirectory deldir) - fileIxs <- extractFileNameIndexes [ deldir file - | file <- files - , takeExtensions file == ".vrf.vkey" ] - firstExceptT ShelleyGenesisCmdTextEnvReadFileError $ - Map.fromList <$> - sequence - [ (,) ix <$> readKey (File file) - | (file, ix) <- fileIxs ] - where - readKey = newExceptT - . readFileTextEnvelope (AsVerificationKey AsVrfKey) - - --- | The file path is of the form @"delegate-keys/delegate3.vkey"@. --- This function reads the file and extracts the index (in this case 3). --- -extractFileNameIndex :: FilePath -> Maybe Int -extractFileNameIndex fp = - case filter isDigit fp of - [] -> Nothing - xs -> readMaybe xs - -extractFileNameIndexes :: [FilePath] - -> ExceptT ShelleyGenesisCmdError IO [(FilePath, Int)] -extractFileNameIndexes files = do - case [ file | (file, Nothing) <- filesIxs ] of - [] -> return () - files' -> throwError (ShelleyGenesisCmdFilesNoIndex files') - case filter (\g -> length g > 1) - . List.groupBy ((==) `on` snd) - . List.sortBy (compare `on` snd) - $ [ (file, ix) | (file, Just ix) <- filesIxs ] of - [] -> return () - (g:_) -> throwError (ShelleyGenesisCmdFilesDupIndex (map fst g)) - - return [ (file, ix) | (file, Just ix) <- filesIxs ] - where - filesIxs = [ (file, extractFileNameIndex file) | file <- files ] - -readInitialFundAddresses :: FilePath -> NetworkId - -> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra] -readInitialFundAddresses utxodir nw = do - files <- liftIO (listDirectory utxodir) - vkeys <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError $ - sequence - [ newExceptT $ - readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) - (File (utxodir file)) - | file <- files - , takeExtension file == ".vkey" ] - return [ addr | vkey <- vkeys - , let vkh = verificationKeyHash (castVerificationKey vkey) - addr = makeShelleyAddressInEra nw (PaymentCredentialByKey vkh) - NoStakeAddress - ] - - --- | Hash a genesis file -runGenesisHashFile :: GenesisFile -> ExceptT ShelleyGenesisCmdError IO () -runGenesisHashFile (GenesisFile fpath) = do - content <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ - BS.readFile fpath - let gh :: Crypto.Hash Crypto.Blake2b_256 ByteString - gh = Crypto.hashWith id content - liftIO $ Text.putStrLn (Crypto.hashToTextAsHex gh) - -readAlonzoGenesis - :: FilePath - -> ExceptT ShelleyGenesisCmdError IO Alonzo.AlonzoGenesis -readAlonzoGenesis fpath = do - lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (ShelleyGenesisCmdAesonDecodeError fpath . Text.pack) - . hoistEither $ Aeson.eitherDecode' lbs - -readConwayGenesis - :: FilePath - -> ExceptT ShelleyGenesisCmdError IO (Conway.ConwayGenesis StandardCrypto) -readConwayGenesis fpath = do - lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (ShelleyGenesisCmdAesonDecodeError fpath . Text.pack) - . hoistEither $ Aeson.eitherDecode' lbs - --- Protocol Parameters - -data ProtocolParamsError - = ProtocolParamsErrorFile (FileError ()) - | ProtocolParamsErrorJSON !FilePath !Text - -renderProtocolParamsError :: ProtocolParamsError -> Text -renderProtocolParamsError (ProtocolParamsErrorFile fileErr) = - Text.pack $ displayError fileErr -renderProtocolParamsError (ProtocolParamsErrorJSON fp jsonErr) = - "Error while decoding the protocol parameters at: " <> Text.pack fp <> " Error: " <> jsonErr - ---TODO: eliminate this and get only the necessary params, and get them in a more --- helpful way rather than requiring them as a local file. -readProtocolParameters :: ProtocolParamsFile - -> ExceptT ProtocolParamsError IO ProtocolParameters -readProtocolParameters (ProtocolParamsFile fpath) = do - pparams <- handleIOExceptT (ProtocolParamsErrorFile . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (ProtocolParamsErrorJSON fpath . Text.pack) . hoistEither $ - Aeson.eitherDecode' pparams - diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs deleted file mode 100644 index 798ef9145e5..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs +++ /dev/null @@ -1,350 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Shelley.Run.Governance - ( ShelleyGovernanceCmdError - , renderShelleyGovernanceError - , runGovernanceCmd - ) where - -import Control.Monad (unless, when) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, left, newExceptT, - onLeft) -import Data.Aeson (eitherDecode) -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as LB -import Data.Function ((&)) -import Data.String (fromString) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.Text.IO as Text -import qualified Data.Text.Read as Text -import Formatting (build, sformat) -import qualified System.IO as IO -import System.IO (stderr, stdin, stdout) - -import Cardano.Api -import Cardano.Api.Shelley - -import Cardano.CLI.Shelley.Key (VerificationKeyOrHashOrFile, - readVerificationKeyOrHashOrFile, readVerificationKeyOrHashOrTextEnvFile) -import Cardano.CLI.Shelley.Parsers -import Cardano.CLI.Shelley.Run.Read (CddlError, fileOrPipe, readFileTx) -import Cardano.CLI.Types - -import Cardano.Binary (DecoderError) -import qualified Cardano.Ledger.Shelley.TxBody as Shelley - -data ShelleyGovernanceCmdError - = ShelleyGovernanceCmdTextEnvReadError !(FileError TextEnvelopeError) - | ShelleyGovernanceCmdCddlError !CddlError - | ShelleyGovernanceCmdKeyReadError !(FileError InputDecodeError) - | ShelleyGovernanceCmdCostModelReadError !(FileError ()) - | ShelleyGovernanceCmdTextEnvWriteError !(FileError ()) - | ShelleyGovernanceCmdEmptyUpdateProposalError - | ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach - !FilePath - !Int - -- ^ Number of stake verification keys - !Int - -- ^ Number of reward amounts - | ShelleyGovernanceCmdCostModelsJsonDecodeErr !FilePath !Text - | ShelleyGovernanceCmdEmptyCostModel !FilePath - | ShelleyGovernanceCmdUnexpectedKeyType - ![TextEnvelopeType] - -- ^ Expected key types - | ShelleyGovernanceCmdPollOutOfBoundAnswer - !Int - -- ^ Maximum answer index - | ShelleyGovernanceCmdPollInvalidChoice - | ShelleyGovernanceCmdDecoderError !DecoderError - | ShelleyGovernanceCmdVerifyPollError !GovernancePollError - | ShelleyGovernanceCmdWriteFileError !(FileError ()) - deriving Show - -renderShelleyGovernanceError :: ShelleyGovernanceCmdError -> Text -renderShelleyGovernanceError err = - case err of - ShelleyGovernanceCmdTextEnvReadError fileErr -> Text.pack (displayError fileErr) - ShelleyGovernanceCmdCddlError cddlErr -> Text.pack (displayError cddlErr) - ShelleyGovernanceCmdKeyReadError fileErr -> Text.pack (displayError fileErr) - ShelleyGovernanceCmdTextEnvWriteError fileErr -> Text.pack (displayError fileErr) - -- TODO: The equality check is still not working for empty update proposals. - ShelleyGovernanceCmdEmptyUpdateProposalError -> - "Empty update proposals are not allowed" - ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach fp numVKeys numRwdAmts -> - "Error creating the MIR certificate at: " <> textShow fp - <> " The number of staking keys: " <> textShow numVKeys - <> " and the number of reward amounts: " <> textShow numRwdAmts - <> " are not equivalent." - ShelleyGovernanceCmdCostModelsJsonDecodeErr fp err' -> - "Error decoding cost model: " <> err' <> " at: " <> Text.pack fp - ShelleyGovernanceCmdEmptyCostModel fp -> - "The decoded cost model was empty at: " <> Text.pack fp - ShelleyGovernanceCmdCostModelReadError err' -> - "Error reading the cost model: " <> Text.pack (displayError err') - ShelleyGovernanceCmdUnexpectedKeyType expected -> - "Unexpected poll key type; expected one of: " - <> Text.intercalate ", " (textShow <$> expected) - ShelleyGovernanceCmdPollOutOfBoundAnswer nMax -> - "Poll answer out of bounds. Choices are between 0 and " <> textShow nMax - ShelleyGovernanceCmdPollInvalidChoice -> - "Invalid choice. Please choose from the available answers." - ShelleyGovernanceCmdDecoderError decoderError -> - "Unable to decode metadata: " <> sformat build decoderError - ShelleyGovernanceCmdVerifyPollError pollError -> - renderGovernancePollError pollError - ShelleyGovernanceCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - -runGovernanceCmd :: GovernanceCmd -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceCmd (GovernanceMIRPayStakeAddressesCertificate mirpot vKeys rewards out) = - runGovernanceMIRCertificatePayStakeAddrs mirpot vKeys rewards out -runGovernanceCmd (GovernanceMIRTransfer amt out direction) = - runGovernanceMIRCertificateTransfer amt out direction -runGovernanceCmd (GovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out) = - runGovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out -runGovernanceCmd (GovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp) = - runGovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp -runGovernanceCmd (GovernanceCreatePoll prompt choices nonce out) = - runGovernanceCreatePoll prompt choices nonce out -runGovernanceCmd (GovernanceAnswerPoll poll ix mOutFile) = - runGovernanceAnswerPoll poll ix mOutFile -runGovernanceCmd (GovernanceVerifyPoll poll metadata mOutFile) = - runGovernanceVerifyPoll poll metadata mOutFile - -runGovernanceMIRCertificatePayStakeAddrs - :: Shelley.MIRPot - -> [StakeAddress] -- ^ Stake addresses - -> [Lovelace] -- ^ Corresponding reward amounts (same length) - -> File () Out - -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceMIRCertificatePayStakeAddrs mirPot sAddrs rwdAmts oFp = do - - unless (length sAddrs == length rwdAmts) $ - left $ ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach - (unFile oFp) (length sAddrs) (length rwdAmts) - - let sCreds = map stakeAddressCredential sAddrs - mirCert = makeMIRCertificate mirPot (StakeAddressesMIR $ zip sCreds rwdAmts) - - firstExceptT ShelleyGovernanceCmdTextEnvWriteError - . newExceptT - $ writeLazyByteStringFile oFp $ textEnvelopeToJSON (Just mirCertDesc) mirCert - where - mirCertDesc :: TextEnvelopeDescr - mirCertDesc = "Move Instantaneous Rewards Certificate" - -runGovernanceMIRCertificateTransfer - :: Lovelace - -> File () Out - -> TransferDirection - -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceMIRCertificateTransfer ll oFp direction = do - mirCert <- case direction of - TransferToReserves -> - return . makeMIRCertificate Shelley.TreasuryMIR $ SendToReservesMIR ll - TransferToTreasury -> - return . makeMIRCertificate Shelley.ReservesMIR $ SendToTreasuryMIR ll - - firstExceptT ShelleyGovernanceCmdTextEnvWriteError - . newExceptT - $ writeLazyByteStringFile oFp - $ textEnvelopeToJSON (Just $ mirCertDesc direction) mirCert - where - mirCertDesc :: TransferDirection -> TextEnvelopeDescr - mirCertDesc TransferToTreasury = "MIR Certificate Send To Treasury" - mirCertDesc TransferToReserves = "MIR Certificate Send To Reserves" - - -runGovernanceGenesisKeyDelegationCertificate - :: VerificationKeyOrHashOrFile GenesisKey - -> VerificationKeyOrHashOrFile GenesisDelegateKey - -> VerificationKeyOrHashOrFile VrfKey - -> File () Out - -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceGenesisKeyDelegationCertificate genVkOrHashOrFp - genDelVkOrHashOrFp - vrfVkOrHashOrFp - oFp = do - genesisVkHash <- firstExceptT ShelleyGovernanceCmdKeyReadError - . newExceptT - $ readVerificationKeyOrHashOrTextEnvFile AsGenesisKey genVkOrHashOrFp - genesisDelVkHash <-firstExceptT ShelleyGovernanceCmdKeyReadError - . newExceptT - $ readVerificationKeyOrHashOrTextEnvFile AsGenesisDelegateKey genDelVkOrHashOrFp - vrfVkHash <- firstExceptT ShelleyGovernanceCmdKeyReadError - . newExceptT - $ readVerificationKeyOrHashOrFile AsVrfKey vrfVkOrHashOrFp - firstExceptT ShelleyGovernanceCmdTextEnvWriteError - . newExceptT - $ writeLazyByteStringFile oFp - $ textEnvelopeToJSON (Just genKeyDelegCertDesc) - $ makeGenesisKeyDelegationCertificate genesisVkHash genesisDelVkHash vrfVkHash - where - genKeyDelegCertDesc :: TextEnvelopeDescr - genKeyDelegCertDesc = "Genesis Key Delegation Certificate" - -runGovernanceUpdateProposal - :: File () Out - -> EpochNo - -> [VerificationKeyFile In] - -- ^ Genesis verification keys - -> ProtocolParametersUpdate - -> Maybe FilePath -- ^ Cost models file path - -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceUpdateProposal upFile eNo genVerKeyFiles upPprams mCostModelFp = do - finalUpPprams <- case mCostModelFp of - Nothing -> return upPprams - Just fp -> do - costModelsBs <- handleIOExceptT (ShelleyGovernanceCmdCostModelReadError . FileIOError fp) $ LB.readFile fp - - cModels <- pure (eitherDecode costModelsBs) - & onLeft (left . ShelleyGovernanceCmdCostModelsJsonDecodeErr fp . Text.pack) - - let costModels = fromAlonzoCostModels cModels - - when (null costModels) $ left (ShelleyGovernanceCmdEmptyCostModel fp) - - return $ upPprams {protocolUpdateCostModels = costModels} - - when (finalUpPprams == mempty) $ left ShelleyGovernanceCmdEmptyUpdateProposalError - - genVKeys <- sequence - [ firstExceptT ShelleyGovernanceCmdTextEnvReadError . newExceptT $ readFileTextEnvelope (AsVerificationKey AsGenesisKey) vkeyFile - | vkeyFile <- genVerKeyFiles - ] - let genKeyHashes = fmap verificationKeyHash genVKeys - upProp = makeShelleyUpdateProposal finalUpPprams genKeyHashes eNo - - firstExceptT ShelleyGovernanceCmdTextEnvWriteError . newExceptT - $ writeLazyByteStringFile upFile $ textEnvelopeToJSON Nothing upProp - -runGovernanceCreatePoll - :: Text - -> [Text] - -> Maybe Word - -> File GovernancePoll Out - -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceCreatePoll govPollQuestion govPollAnswers govPollNonce out = do - let poll = GovernancePoll{ govPollQuestion, govPollAnswers, govPollNonce } - - let description = fromString $ "An on-chain poll for SPOs: " <> Text.unpack govPollQuestion - firstExceptT ShelleyGovernanceCmdTextEnvWriteError . newExceptT $ - writeFileTextEnvelope out (Just description) poll - - let metadata = asTxMetadata poll - & metadataToJson TxMetadataJsonDetailedSchema - - let outPath = unFile out & Text.encodeUtf8 . Text.pack - - liftIO $ do - BSC.hPutStrLn stderr $ mconcat - [ "Poll created successfully.\n" - , "Please submit a transaction using the resulting metadata.\n" - ] - BSC.hPutStrLn stdout (prettyPrintJSON metadata) - BSC.hPutStrLn stderr $ mconcat - [ "\n" - , "Hint (1): Use '--json-metadata-detailed-schema' and '--metadata-json-file' " - , "from the build or build-raw commands.\n" - , "Hint (2): You can redirect the standard output of this command to a JSON " - , "file to capture metadata.\n\n" - , "Note: A serialized version of the poll suitable for sharing with " - , "participants has been generated at '" <> outPath <> "'." - ] - -runGovernanceAnswerPoll - :: File GovernancePoll In - -> Maybe Word -- ^ Answer index - -> Maybe (File () Out) -- ^ Output file - -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceAnswerPoll pollFile maybeChoice mOutFile = do - poll <- firstExceptT ShelleyGovernanceCmdTextEnvReadError . newExceptT $ - readFileTextEnvelope AsGovernancePoll pollFile - - choice <- case maybeChoice of - Nothing -> do - askInteractively poll - Just ix -> do - validateChoice poll ix - liftIO $ BSC.hPutStrLn stderr $ Text.encodeUtf8 $ Text.intercalate "\n" - [ govPollQuestion poll - , "→ " <> (govPollAnswers poll !! fromIntegral ix) - , "" - ] - pure ix - - let pollAnswer = GovernancePollAnswer - { govAnsPoll = hashGovernancePoll poll - , govAnsChoice = choice - } - let metadata = - metadataToJson TxMetadataJsonDetailedSchema (asTxMetadata pollAnswer) - - liftIO $ BSC.hPutStrLn stderr $ mconcat - [ "Poll answer created successfully.\n" - , "Please submit a transaction using the resulting metadata.\n" - , "To be valid, the transaction must also be signed using a valid key\n" - , "identifying your stake pool (e.g. your cold key).\n" - ] - - lift (writeByteStringOutput mOutFile (prettyPrintJSON metadata)) - & onLeft (left . ShelleyGovernanceCmdWriteFileError) - - liftIO $ BSC.hPutStrLn stderr $ mconcat - [ "\n" - , "Hint (1): Use '--json-metadata-detailed-schema' and '--metadata-json-file' " - , "from the build or build-raw commands.\n" - , "Hint (2): You can redirect the standard output of this command to a JSON " - , "file to capture metadata." - ] - where - validateChoice :: GovernancePoll -> Word -> ExceptT ShelleyGovernanceCmdError IO () - validateChoice GovernancePoll{govPollAnswers} ix = do - let maxAnswerIndex = length govPollAnswers - 1 - when (fromIntegral ix > maxAnswerIndex) $ left $ - ShelleyGovernanceCmdPollOutOfBoundAnswer maxAnswerIndex - - askInteractively :: GovernancePoll -> ExceptT ShelleyGovernanceCmdError IO Word - askInteractively poll@GovernancePoll{govPollQuestion, govPollAnswers} = do - liftIO $ BSC.hPutStrLn stderr $ Text.encodeUtf8 $ Text.intercalate "\n" - ( govPollQuestion - : [ "[" <> textShow ix <> "] " <> answer - | (ix :: Int, answer) <- zip [0..] govPollAnswers - ] - ) - liftIO $ BSC.hPutStrLn stderr "" - liftIO $ BSC.hPutStr stderr "Please indicate an answer (by index): " - txt <- liftIO $ Text.hGetLine stdin - liftIO $ BSC.hPutStrLn stderr "" - case Text.decimal txt of - Right (choice, rest) | Text.null rest -> - choice <$ validateChoice poll choice - _ -> - left ShelleyGovernanceCmdPollInvalidChoice - -runGovernanceVerifyPoll - :: File GovernancePoll In - -> File (Tx ()) In - -> Maybe (File () Out) -- ^ Output file - -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceVerifyPoll pollFile txFile mOutFile = do - poll <- firstExceptT ShelleyGovernanceCmdTextEnvReadError . newExceptT $ - readFileTextEnvelope AsGovernancePoll pollFile - - txFileOrPipe <- liftIO $ fileOrPipe (unFile txFile) - tx <- firstExceptT ShelleyGovernanceCmdCddlError . newExceptT $ - readFileTx txFileOrPipe - - signatories <- firstExceptT ShelleyGovernanceCmdVerifyPollError . newExceptT $ pure $ - verifyPollAnswer poll tx - - liftIO $ IO.hPutStrLn stderr $ "Found valid poll answer with " <> show (length signatories) <> " signatories" - - lift (writeByteStringOutput mOutFile (prettyPrintJSON signatories)) - & onLeft (left . ShelleyGovernanceCmdWriteFileError) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs deleted file mode 100644 index 87f51576332..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs +++ /dev/null @@ -1,657 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Shelley.Run.Key - ( ShelleyKeyCmdError - , SomeSigningKey(..) - , renderShelleyKeyCmdError - , runKeyCmd - , readSigningKeyFile - - -- * Exports for testing - , decodeBech32 - ) where - -import Control.Exception (Exception (..), IOException) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Data.Bifunctor (Bifunctor (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import System.Exit (exitFailure) - -import qualified Control.Exception as Exception -import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, left, newExceptT) - -import qualified Codec.Binary.Bech32 as Bech32 - -import qualified Cardano.Crypto.DSIGN as DSIGN -import qualified Cardano.Crypto.Signing as Byron -import qualified Cardano.Crypto.Signing as Byron.Crypto -import qualified Cardano.Crypto.Signing as Crypto -import qualified Cardano.Crypto.Wallet as Crypto -import qualified Cardano.Ledger.Keys as Shelley - -import Cardano.Api -import qualified Cardano.Api.Byron as ByronApi -import Cardano.Api.Crypto.Ed25519Bip32 (xPrvFromBytes) -import Cardano.Api.Shelley - -import qualified Cardano.CLI.Byron.Key as Byron -import Cardano.CLI.Shelley.Commands -import Cardano.CLI.Shelley.Key (VerificationKeyTextOrFile (..), - VerificationKeyTextOrFileError, readVerificationKeyTextOrFileAnyOf, - renderVerificationKeyTextOrFileError) -import Cardano.CLI.Types (SigningKeyFile, VerificationKeyFile) - - -data ShelleyKeyCmdError - = ShelleyKeyCmdReadFileError !(FileError TextEnvelopeError) - | ShelleyKeyCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyKeyCmdWriteFileError !(FileError ()) - | ShelleyKeyCmdByronKeyFailure !Byron.ByronKeyFailure - | ShelleyKeyCmdByronKeyParseError - !Text - -- ^ Text representation of the parse error. Unfortunately, the actual - -- error type isn't exported. - | ShelleyKeyCmdItnKeyConvError !ItnKeyConversionError - | ShelleyKeyCmdWrongKeyTypeError - | ShelleyKeyCmdCardanoAddressSigningKeyFileError - !(FileError CardanoAddressSigningKeyConversionError) - | ShelleyKeyCmdNonLegacyKey !FilePath - | ShelleyKeyCmdExpectedExtendedVerificationKey SomeAddressVerificationKey - | ShelleyKeyCmdVerificationKeyReadError VerificationKeyTextOrFileError - deriving Show - -renderShelleyKeyCmdError :: ShelleyKeyCmdError -> Text -renderShelleyKeyCmdError err = - case err of - ShelleyKeyCmdReadFileError fileErr -> Text.pack (displayError fileErr) - ShelleyKeyCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr) - ShelleyKeyCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyKeyCmdByronKeyFailure e -> Byron.renderByronKeyFailure e - ShelleyKeyCmdByronKeyParseError errTxt -> errTxt - ShelleyKeyCmdItnKeyConvError convErr -> renderConversionError convErr - ShelleyKeyCmdWrongKeyTypeError -> - Text.pack "Please use a signing key file when converting ITN BIP32 or Extended keys" - ShelleyKeyCmdCardanoAddressSigningKeyFileError fileErr -> - Text.pack (displayError fileErr) - ShelleyKeyCmdNonLegacyKey fp -> - "Signing key at: " <> Text.pack fp <> " is not a legacy Byron signing key and should not need to be converted." - ShelleyKeyCmdVerificationKeyReadError e -> renderVerificationKeyTextOrFileError e - ShelleyKeyCmdExpectedExtendedVerificationKey someVerKey -> - "Expected an extended verification key but got: " <> renderSomeAddressVerificationKey someVerKey - -runKeyCmd :: KeyCmd -> ExceptT ShelleyKeyCmdError IO () -runKeyCmd cmd = - case cmd of - KeyGetVerificationKey skf vkf -> - runGetVerificationKey skf vkf - - KeyNonExtendedKey evkf vkf -> - runConvertToNonExtendedKey evkf vkf - - KeyConvertByronKey mPassword keytype skfOld skfNew -> - runConvertByronKey mPassword keytype skfOld skfNew - - KeyConvertByronGenesisVKey oldVk newVkf -> - runConvertByronGenesisVerificationKey oldVk newVkf - - KeyConvertITNStakeKey itnKeyFile outFile -> - runConvertITNStakeKey itnKeyFile outFile - KeyConvertITNExtendedToStakeKey itnPrivKeyFile outFile -> - runConvertITNExtendedToStakeKey itnPrivKeyFile outFile - KeyConvertITNBip32ToStakeKey itnPrivKeyFile outFile -> - runConvertITNBip32ToStakeKey itnPrivKeyFile outFile - - KeyConvertCardanoAddressSigningKey keyType skfOld skfNew -> - runConvertCardanoAddressSigningKey keyType skfOld skfNew - -runGetVerificationKey :: SigningKeyFile In - -> VerificationKeyFile Out - -> ExceptT ShelleyKeyCmdError IO () -runGetVerificationKey skf vkf = do - ssk <- firstExceptT ShelleyKeyCmdReadKeyFileError $ - readSigningKeyFile skf - withSomeSigningKey ssk $ \sk -> - let vk = getVerificationKey sk in - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ - writeLazyByteStringFile vkf $ textEnvelopeToJSON Nothing vk - - -data SomeSigningKey - = AByronSigningKey (SigningKey ByronKey) - | APaymentSigningKey (SigningKey PaymentKey) - | APaymentExtendedSigningKey (SigningKey PaymentExtendedKey) - | AStakeSigningKey (SigningKey StakeKey) - | AStakeExtendedSigningKey (SigningKey StakeExtendedKey) - | AStakePoolSigningKey (SigningKey StakePoolKey) - | AGenesisSigningKey (SigningKey GenesisKey) - | AGenesisExtendedSigningKey (SigningKey GenesisExtendedKey) - | AGenesisDelegateSigningKey (SigningKey GenesisDelegateKey) - | AGenesisDelegateExtendedSigningKey - (SigningKey GenesisDelegateExtendedKey) - | AGenesisUTxOSigningKey (SigningKey GenesisUTxOKey) - | AVrfSigningKey (SigningKey VrfKey) - | AKesSigningKey (SigningKey KesKey) - -withSomeSigningKey :: SomeSigningKey - -> (forall keyrole. Key keyrole => SigningKey keyrole -> a) - -> a -withSomeSigningKey ssk f = - case ssk of - AByronSigningKey sk -> f sk - APaymentSigningKey sk -> f sk - APaymentExtendedSigningKey sk -> f sk - AStakeSigningKey sk -> f sk - AStakeExtendedSigningKey sk -> f sk - AStakePoolSigningKey sk -> f sk - AGenesisSigningKey sk -> f sk - AGenesisExtendedSigningKey sk -> f sk - AGenesisDelegateSigningKey sk -> f sk - AGenesisDelegateExtendedSigningKey - sk -> f sk - AGenesisUTxOSigningKey sk -> f sk - AVrfSigningKey sk -> f sk - AKesSigningKey sk -> f sk - -readSigningKeyFile - :: SigningKeyFile In - -> ExceptT (FileError InputDecodeError) IO SomeSigningKey -readSigningKeyFile skFile = - newExceptT $ - readKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile - where - textEnvFileTypes = - [ FromSomeType (AsSigningKey AsByronKey) - AByronSigningKey - , FromSomeType (AsSigningKey AsPaymentKey) - APaymentSigningKey - , FromSomeType (AsSigningKey AsPaymentExtendedKey) - APaymentExtendedSigningKey - , FromSomeType (AsSigningKey AsStakeKey) - AStakeSigningKey - , FromSomeType (AsSigningKey AsStakeExtendedKey) - AStakeExtendedSigningKey - , FromSomeType (AsSigningKey AsStakePoolKey) - AStakePoolSigningKey - , FromSomeType (AsSigningKey AsGenesisKey) - AGenesisSigningKey - , FromSomeType (AsSigningKey AsGenesisExtendedKey) - AGenesisExtendedSigningKey - , FromSomeType (AsSigningKey AsGenesisDelegateKey) - AGenesisDelegateSigningKey - , FromSomeType (AsSigningKey AsGenesisDelegateExtendedKey) - AGenesisDelegateExtendedSigningKey - , FromSomeType (AsSigningKey AsGenesisUTxOKey) - AGenesisUTxOSigningKey - , FromSomeType (AsSigningKey AsVrfKey) - AVrfSigningKey - , FromSomeType (AsSigningKey AsKesKey) - AKesSigningKey - ] - - bech32FileTypes = - [ FromSomeType (AsSigningKey AsPaymentKey) - APaymentSigningKey - , FromSomeType (AsSigningKey AsPaymentExtendedKey) - APaymentExtendedSigningKey - , FromSomeType (AsSigningKey AsStakeKey) - AStakeSigningKey - , FromSomeType (AsSigningKey AsStakeExtendedKey) - AStakeExtendedSigningKey - , FromSomeType (AsSigningKey AsStakePoolKey) - AStakePoolSigningKey - , FromSomeType (AsSigningKey AsVrfKey) - AVrfSigningKey - , FromSomeType (AsSigningKey AsKesKey) - AKesSigningKey - ] - - -runConvertToNonExtendedKey - :: VerificationKeyFile In - -> VerificationKeyFile Out - -> ExceptT ShelleyKeyCmdError IO () -runConvertToNonExtendedKey evkf vkf = - writeVerificationKey =<< readExtendedVerificationKeyFile evkf - where - -- TODO: Expose a function specifically for this purpose - -- and explain the extended verification keys can be converted - -- to their non-extended counterparts however this is NOT the case - -- for extended signing keys - - writeVerificationKey - :: SomeAddressVerificationKey - -> ExceptT ShelleyKeyCmdError IO () - writeVerificationKey ssk = - case ssk of - APaymentExtendedVerificationKey vk -> - writeToDisk vkf (castVerificationKey vk :: VerificationKey PaymentKey) - AStakeExtendedVerificationKey vk -> - writeToDisk vkf (castVerificationKey vk :: VerificationKey StakeKey) - AGenesisExtendedVerificationKey vk -> - writeToDisk vkf (castVerificationKey vk :: VerificationKey GenesisKey) - AGenesisDelegateExtendedVerificationKey vk -> - writeToDisk vkf (castVerificationKey vk :: VerificationKey GenesisDelegateKey) - nonExtendedKey -> left $ ShelleyKeyCmdExpectedExtendedVerificationKey nonExtendedKey - - - writeToDisk - :: Key keyrole - => File content Out - -> VerificationKey keyrole - -> ExceptT ShelleyKeyCmdError IO () - writeToDisk vkf' vk = - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT - $ writeLazyByteStringFile vkf' $ textEnvelopeToJSON Nothing vk - - -readExtendedVerificationKeyFile - :: VerificationKeyFile In - -> ExceptT ShelleyKeyCmdError IO SomeAddressVerificationKey -readExtendedVerificationKeyFile evkfile = do - vKey <- firstExceptT ShelleyKeyCmdVerificationKeyReadError - . newExceptT $ readVerificationKeyTextOrFileAnyOf - $ VktofVerificationKeyFile evkfile - case vKey of - k@APaymentExtendedVerificationKey{} -> return k - k@AStakeExtendedVerificationKey{} -> return k - k@AGenesisExtendedVerificationKey{} -> return k - k@AGenesisDelegateExtendedVerificationKey{} -> return k - nonExtendedKey -> - left $ ShelleyKeyCmdExpectedExtendedVerificationKey nonExtendedKey - - -runConvertByronKey - :: Maybe Text -- ^ Password (if applicable) - -> ByronKeyType - -> SomeKeyFile In -- ^ Input file: old format - -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () -runConvertByronKey mPwd (ByronPaymentKey format) (ASigningKeyFile skeyPathOld) = - convertByronSigningKey mPwd format convert skeyPathOld - where - convert :: Byron.SigningKey -> SigningKey ByronKey - convert = ByronSigningKey - -runConvertByronKey mPwd (ByronGenesisKey format) (ASigningKeyFile skeyPathOld) = - convertByronSigningKey mPwd format convert skeyPathOld - where - convert :: Byron.SigningKey -> SigningKey GenesisExtendedKey - convert (Byron.SigningKey xsk) = GenesisExtendedSigningKey xsk - -runConvertByronKey mPwd (ByronDelegateKey format) (ASigningKeyFile skeyPathOld) = - convertByronSigningKey mPwd format convert skeyPathOld - where - convert :: Byron.SigningKey -> SigningKey GenesisDelegateExtendedKey - convert (Byron.SigningKey xsk) = GenesisDelegateExtendedSigningKey xsk - -runConvertByronKey _ (ByronPaymentKey NonLegacyByronKeyFormat) - (AVerificationKeyFile vkeyPathOld) = - convertByronVerificationKey convert vkeyPathOld - where - convert :: Byron.VerificationKey -> VerificationKey ByronKey - convert = ByronVerificationKey - -runConvertByronKey _ (ByronGenesisKey NonLegacyByronKeyFormat) - (AVerificationKeyFile vkeyPathOld) = - convertByronVerificationKey convert vkeyPathOld - where - convert :: Byron.VerificationKey -> VerificationKey GenesisExtendedKey - convert (Byron.VerificationKey xvk) = GenesisExtendedVerificationKey xvk - -runConvertByronKey _ (ByronDelegateKey NonLegacyByronKeyFormat) - (AVerificationKeyFile vkeyPathOld) = - convertByronVerificationKey convert vkeyPathOld - where - convert :: Byron.VerificationKey - -> VerificationKey GenesisDelegateExtendedKey - convert (Byron.VerificationKey xvk) = - GenesisDelegateExtendedVerificationKey xvk - -runConvertByronKey _ (ByronPaymentKey LegacyByronKeyFormat) - AVerificationKeyFile{} = - const legacyVerificationKeysNotSupported - -runConvertByronKey _ (ByronGenesisKey LegacyByronKeyFormat) - AVerificationKeyFile{} = - const legacyVerificationKeysNotSupported - -runConvertByronKey _ (ByronDelegateKey LegacyByronKeyFormat) - AVerificationKeyFile{} = - const legacyVerificationKeysNotSupported - -legacyVerificationKeysNotSupported :: ExceptT e IO a -legacyVerificationKeysNotSupported = - liftIO $ do - putStrLn $ "convert keys: byron legacy format not supported for " - ++ "verification keys. Convert the signing key and then get the " - ++ "verification key." - exitFailure - - -convertByronSigningKey - :: forall keyrole. - Key keyrole - => Maybe Text -- ^ Password (if applicable) - -> ByronKeyFormat - -> (Byron.SigningKey -> SigningKey keyrole) - -> SigningKeyFile In -- ^ Input file: old format - -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () -convertByronSigningKey mPwd byronFormat convert skeyPathOld skeyPathNew = do - sKey <- firstExceptT ShelleyKeyCmdByronKeyFailure - $ Byron.readByronSigningKey byronFormat skeyPathOld - - -- Account for password protected legacy Byron keys - unprotectedSk <- case sKey of - ByronApi.AByronSigningKeyLegacy (ByronSigningKeyLegacy sk@(Crypto.SigningKey xprv)) -> - case mPwd of - -- Change password to empty string - Just pwd -> return . Crypto.SigningKey - $ Crypto.xPrvChangePass (Text.encodeUtf8 pwd) (Text.encodeUtf8 "") xprv - Nothing -> return sk - ByronApi.AByronSigningKey (ByronSigningKey sk) -> return sk - - - let sk' :: SigningKey keyrole - sk' = convert unprotectedSk - - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ - writeLazyByteStringFile skeyPathNew $ textEnvelopeToJSON Nothing sk' - -convertByronVerificationKey - :: forall keyrole. - Key keyrole - => (Byron.VerificationKey -> VerificationKey keyrole) - -> VerificationKeyFile In -- ^ Input file: old format - -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () -convertByronVerificationKey convert vkeyPathOld vkeyPathNew = do - - vk <- firstExceptT ShelleyKeyCmdByronKeyFailure $ - Byron.readPaymentVerificationKey vkeyPathOld - - let vk' :: VerificationKey keyrole - vk' = convert vk - - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ - writeLazyByteStringFile vkeyPathNew $ textEnvelopeToJSON Nothing vk' - - -runConvertByronGenesisVerificationKey - :: VerificationKeyBase64 -- ^ Input key raw old format - -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () -runConvertByronGenesisVerificationKey (VerificationKeyBase64 b64ByronVKey) vkeyPathNew = do - - vk <- firstExceptT (ShelleyKeyCmdByronKeyParseError . textShow) - . hoistEither - . Byron.Crypto.parseFullVerificationKey - . Text.pack - $ b64ByronVKey - - let vk' :: VerificationKey GenesisKey - vk' = convert vk - - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ - writeLazyByteStringFile vkeyPathNew $ textEnvelopeToJSON Nothing vk' - where - convert :: Byron.VerificationKey -> VerificationKey GenesisKey - convert (Byron.VerificationKey xvk) = - castVerificationKey (GenesisExtendedVerificationKey xvk) - - --------------------------------------------------------------------------------- --- ITN verification/signing key conversion to Haskell verficiation/signing keys --------------------------------------------------------------------------------- - -runConvertITNStakeKey - :: SomeKeyFile In - -> File () Out - -> ExceptT ShelleyKeyCmdError IO () -runConvertITNStakeKey (AVerificationKeyFile (File vk)) outFile = do - bech32publicKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ - readFileITNKey vk - vkey <- hoistEither - . first ShelleyKeyCmdItnKeyConvError - $ convertITNVerificationKey bech32publicKey - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ - writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing vkey - -runConvertITNStakeKey (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ - readFileITNKey sk - skey <- hoistEither - . first ShelleyKeyCmdItnKeyConvError - $ convertITNSigningKey bech32privateKey - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outFile - $ textEnvelopeToJSON Nothing skey - -runConvertITNExtendedToStakeKey :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () -runConvertITNExtendedToStakeKey (AVerificationKeyFile _) _ = left ShelleyKeyCmdWrongKeyTypeError -runConvertITNExtendedToStakeKey (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk - skey <- hoistEither . first ShelleyKeyCmdItnKeyConvError - $ convertITNExtendedSigningKey bech32privateKey - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outFile - $ textEnvelopeToJSON Nothing skey - -runConvertITNBip32ToStakeKey :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () -runConvertITNBip32ToStakeKey (AVerificationKeyFile _) _ = left ShelleyKeyCmdWrongKeyTypeError -runConvertITNBip32ToStakeKey (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk - skey <- hoistEither . first ShelleyKeyCmdItnKeyConvError - $ convertITNBIP32SigningKey bech32privateKey - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outFile - $ textEnvelopeToJSON Nothing skey - --- | An error that can occur while converting an Incentivized Testnet (ITN) --- key. -data ItnKeyConversionError - = ItnKeyBech32DecodeError !Bech32DecodeError - | ItnReadBech32FileError !FilePath !IOException - | ItnSigningKeyDeserialisationError !ByteString - | ItnVerificationKeyDeserialisationError !ByteString - deriving Show - --- | Render an error message for an 'ItnKeyConversionError'. -renderConversionError :: ItnKeyConversionError -> Text -renderConversionError err = - case err of - ItnKeyBech32DecodeError decErr -> - "Error decoding Bech32 key: " <> Text.pack (displayError decErr) - ItnReadBech32FileError fp readErr -> - "Error reading Bech32 key at: " <> textShow fp - <> " Error: " <> Text.pack (displayException readErr) - ItnSigningKeyDeserialisationError _sKey -> - -- Sensitive data, such as the signing key, is purposely not included in - -- the error message. - "Error deserialising signing key." - ItnVerificationKeyDeserialisationError vKey -> - "Error deserialising verification key: " <> textShow (BSC.unpack vKey) - --- | Convert public ed25519 key to a Shelley stake verification key -convertITNVerificationKey :: Text -> Either ItnKeyConversionError (VerificationKey StakeKey) -convertITNVerificationKey pubKey = do - (_, _, keyBS) <- first ItnKeyBech32DecodeError (decodeBech32 pubKey) - case DSIGN.rawDeserialiseVerKeyDSIGN keyBS of - Just verKey -> Right . StakeVerificationKey $ Shelley.VKey verKey - Nothing -> Left $ ItnVerificationKeyDeserialisationError keyBS - --- | Convert private ed22519 key to a Shelley signing key. -convertITNSigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeKey) -convertITNSigningKey privKey = do - (_, _, keyBS) <- first ItnKeyBech32DecodeError (decodeBech32 privKey) - case DSIGN.rawDeserialiseSignKeyDSIGN keyBS of - Just signKey -> Right $ StakeSigningKey signKey - Nothing -> Left $ ItnSigningKeyDeserialisationError keyBS - --- | Convert extended private ed22519 key to a Shelley signing key --- Extended private key = 64 bytes, --- Public key = 32 bytes. -convertITNExtendedSigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeExtendedKey) -convertITNExtendedSigningKey privKey = do - (_, _, privkeyBS) <- first ItnKeyBech32DecodeError (decodeBech32 privKey) - let dummyChainCode = BS.replicate 32 0 - case xPrvFromBytes $ BS.concat [privkeyBS, dummyChainCode] of - Just xprv -> Right $ StakeExtendedSigningKey xprv - Nothing -> Left $ ItnSigningKeyDeserialisationError privkeyBS - --- BIP32 Private key = 96 bytes (64 bytes extended private key + 32 bytes chaincode) --- BIP32 Public Key = 64 Bytes -convertITNBIP32SigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeExtendedKey) -convertITNBIP32SigningKey privKey = do - (_, _, privkeyBS) <- first ItnKeyBech32DecodeError (decodeBech32 privKey) - case xPrvFromBytes privkeyBS of - Just xprv -> Right $ StakeExtendedSigningKey xprv - Nothing -> Left $ ItnSigningKeyDeserialisationError privkeyBS - -readFileITNKey :: FilePath -> IO (Either ItnKeyConversionError Text) -readFileITNKey fp = do - eStr <- Exception.try $ readFile fp - case eStr of - Left e -> return . Left $ ItnReadBech32FileError fp e - Right str -> return . Right . Text.concat $ Text.words $ Text.pack str - --------------------------------------------------------------------------------- --- `cardano-address` extended signing key conversions --------------------------------------------------------------------------------- - -runConvertCardanoAddressSigningKey - :: CardanoAddressKeyType - -> SigningKeyFile In - -> File () Out - -> ExceptT ShelleyKeyCmdError IO () -runConvertCardanoAddressSigningKey keyType skFile outFile = do - sKey <- firstExceptT ShelleyKeyCmdCardanoAddressSigningKeyFileError - . newExceptT - $ readSomeCardanoAddressSigningKeyFile keyType skFile - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT - $ writeSomeCardanoAddressSigningKeyFile outFile sKey - --- | Some kind of signing key that was converted from a @cardano-address@ --- signing key. -data SomeCardanoAddressSigningKey - = ACardanoAddrShelleyPaymentSigningKey !(SigningKey PaymentExtendedKey) - | ACardanoAddrShelleyStakeSigningKey !(SigningKey StakeExtendedKey) - | ACardanoAddrByronSigningKey !(SigningKey ByronKey) - --- | An error that can occur while converting a @cardano-address@ extended --- signing key. -data CardanoAddressSigningKeyConversionError - = CardanoAddressSigningKeyBech32DecodeError !Bech32DecodeError - -- ^ There was an error in decoding the string as Bech32. - | CardanoAddressSigningKeyDeserialisationError !ByteString - -- ^ There was an error in converting the @cardano-address@ extended signing - -- key. - deriving (Show, Eq) - -instance Error CardanoAddressSigningKeyConversionError where - displayError = Text.unpack . renderCardanoAddressSigningKeyConversionError - --- | Render an error message for a 'CardanoAddressSigningKeyConversionError'. -renderCardanoAddressSigningKeyConversionError - :: CardanoAddressSigningKeyConversionError - -> Text -renderCardanoAddressSigningKeyConversionError err = - case err of - CardanoAddressSigningKeyBech32DecodeError decErr -> - Text.pack (displayError decErr) - CardanoAddressSigningKeyDeserialisationError _bs -> - -- Sensitive data, such as the signing key, is purposely not included in - -- the error message. - "Error deserialising cardano-address signing key." - --- | Decode a Bech32-encoded string. -decodeBech32 - :: Text - -> Either Bech32DecodeError (Bech32.HumanReadablePart, Bech32.DataPart, ByteString) -decodeBech32 bech32Str = - case Bech32.decodeLenient bech32Str of - Left err -> Left (Bech32DecodingError err) - Right (hrPart, dataPart) -> - case Bech32.dataPartToBytes dataPart of - Nothing -> - Left $ Bech32DataPartToBytesError (Bech32.dataPartToText dataPart) - Just bs -> Right (hrPart, dataPart, bs) - --- | Convert a Ed25519 BIP32 extended signing key (96 bytes) to a @cardano-crypto@ --- style extended signing key. --- --- Note that both the ITN and @cardano-address@ use this key format. -convertBip32SigningKey - :: ByteString - -> Either CardanoAddressSigningKeyConversionError Crypto.XPrv -convertBip32SigningKey signingKeyBs = - case xPrvFromBytes signingKeyBs of - Just xPrv -> Right xPrv - Nothing -> - Left $ CardanoAddressSigningKeyDeserialisationError signingKeyBs - --- | Read a file containing a Bech32-encoded Ed25519 BIP32 extended signing --- key. -readBech32Bip32SigningKeyFile - :: SigningKeyFile In - -> IO (Either (FileError CardanoAddressSigningKeyConversionError) Crypto.XPrv) -readBech32Bip32SigningKeyFile (File fp) = do - eStr <- Exception.try $ readFile fp - case eStr of - Left e -> pure . Left $ FileIOError fp e - Right str -> - case decodeBech32 (Text.concat $ Text.words $ Text.pack str) of - Left err -> - pure $ Left $ - FileError fp (CardanoAddressSigningKeyBech32DecodeError err) - Right (_hrPart, _dataPart, bs) -> - pure $ first (FileError fp) (convertBip32SigningKey bs) - --- | Read a file containing a Bech32-encoded @cardano-address@ extended --- signing key. -readSomeCardanoAddressSigningKeyFile - :: CardanoAddressKeyType - -> SigningKeyFile In - -> IO (Either (FileError CardanoAddressSigningKeyConversionError) SomeCardanoAddressSigningKey) -readSomeCardanoAddressSigningKeyFile keyType skFile = do - xPrv <- readBech32Bip32SigningKeyFile skFile - pure (toSomeCardanoAddressSigningKey <$> xPrv) - where - toSomeCardanoAddressSigningKey :: Crypto.XPrv -> SomeCardanoAddressSigningKey - toSomeCardanoAddressSigningKey xPrv = - case keyType of - CardanoAddressShelleyPaymentKey -> - ACardanoAddrShelleyPaymentSigningKey - (PaymentExtendedSigningKey xPrv) - CardanoAddressShelleyStakeKey -> - ACardanoAddrShelleyStakeSigningKey (StakeExtendedSigningKey xPrv) - CardanoAddressIcarusPaymentKey -> - ACardanoAddrByronSigningKey $ - ByronSigningKey (Byron.SigningKey xPrv) - CardanoAddressByronPaymentKey -> - ACardanoAddrByronSigningKey $ - ByronSigningKey (Byron.SigningKey xPrv) - --- | Write a text envelope formatted file containing a @cardano-address@ --- extended signing key, but converted to a format supported by @cardano-cli@. -writeSomeCardanoAddressSigningKeyFile - :: File direction Out - -> SomeCardanoAddressSigningKey - -> IO (Either (FileError ()) ()) -writeSomeCardanoAddressSigningKeyFile outFile skey = - case skey of - ACardanoAddrShelleyPaymentSigningKey sk -> - writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing sk - ACardanoAddrShelleyStakeSigningKey sk -> - writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing sk - ACardanoAddrByronSigningKey sk -> - writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing sk diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Node.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Node.hs deleted file mode 100644 index 7da5900320b..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Node.hs +++ /dev/null @@ -1,268 +0,0 @@ -{-# LANGUAGE DataKinds #-} - -module Cardano.CLI.Shelley.Run.Node - ( ShelleyNodeCmdError(ShelleyNodeCmdReadFileError) - , renderShelleyNodeCmdError - , runNodeCmd - , runNodeIssueOpCert - , runNodeKeyGenCold - , runNodeKeyGenKES - , runNodeKeyGenVRF - , readColdVerificationKeyOrFile - ) where - -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, newExceptT) -import qualified Data.ByteString.Char8 as BS -import Data.String (fromString) -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Word (Word64) - -import Cardano.Api -import Cardano.Api.Shelley - -import Cardano.CLI.Shelley.Commands -import Cardano.CLI.Shelley.Key (VerificationKeyOrFile, readVerificationKeyOrFile) -import Cardano.CLI.Types (SigningKeyFile, VerificationKeyFile) - -{- HLINT ignore "Reduce duplication" -} - -data ShelleyNodeCmdError - = ShelleyNodeCmdReadFileError !(FileError TextEnvelopeError) - | ShelleyNodeCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyNodeCmdWriteFileError !(FileError ()) - | ShelleyNodeCmdOperationalCertificateIssueError !OperationalCertIssueError - | ShelleyNodeCmdVrfSigningKeyCreationError - FilePath - -- ^ Target path - FilePath - -- ^ Temp path - deriving Show - -renderShelleyNodeCmdError :: ShelleyNodeCmdError -> Text -renderShelleyNodeCmdError err = - case err of - ShelleyNodeCmdVrfSigningKeyCreationError targetPath tempPath -> - Text.pack $ "Error creating VRF signing key file. Target path: " <> targetPath - <> " Temporary path: " <> tempPath - - ShelleyNodeCmdReadFileError fileErr -> Text.pack (displayError fileErr) - - ShelleyNodeCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr) - - ShelleyNodeCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - - ShelleyNodeCmdOperationalCertificateIssueError issueErr -> - Text.pack (displayError issueErr) - - -runNodeCmd :: NodeCmd -> ExceptT ShelleyNodeCmdError IO () -runNodeCmd (NodeKeyGenCold vk sk ctr) = runNodeKeyGenCold vk sk ctr -runNodeCmd (NodeKeyGenKES vk sk) = runNodeKeyGenKES vk sk -runNodeCmd (NodeKeyGenVRF vk sk) = runNodeKeyGenVRF vk sk -runNodeCmd (NodeKeyHashVRF vk mOutFp) = runNodeKeyHashVRF vk mOutFp -runNodeCmd (NodeNewCounter vk ctr out) = runNodeNewCounter vk ctr out -runNodeCmd (NodeIssueOpCert vk sk ctr p out) = - runNodeIssueOpCert vk sk ctr p out - - - --- --- Node command implementations --- - -runNodeKeyGenCold :: VerificationKeyFile Out - -> SigningKeyFile Out - -> OpCertCounterFile Out - -> ExceptT ShelleyNodeCmdError IO () -runNodeKeyGenCold vkeyPath skeyPath ocertCtrPath = do - skey <- liftIO $ generateSigningKey AsStakePoolKey - let vkey = getVerificationKey skey - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile ocertCtrPath - $ textEnvelopeToJSON (Just ocertCtrDesc) - $ OperationalCertificateIssueCounter initialCounter vkey - where - skeyDesc, vkeyDesc, ocertCtrDesc :: TextEnvelopeDescr - skeyDesc = "Stake Pool Operator Signing Key" - vkeyDesc = "Stake Pool Operator Verification Key" - ocertCtrDesc = "Next certificate issue number: " - <> fromString (show initialCounter) - - initialCounter :: Word64 - initialCounter = 0 - - -runNodeKeyGenKES :: VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT ShelleyNodeCmdError IO () -runNodeKeyGenKES vkeyPath skeyPath = do - skey <- liftIO $ generateSigningKey AsKesKey - let vkey = getVerificationKey skey - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - where - skeyDesc, vkeyDesc :: TextEnvelopeDescr - skeyDesc = "KES Signing Key" - vkeyDesc = "KES Verification Key" - -runNodeKeyGenVRF :: - VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT ShelleyNodeCmdError IO () -runNodeKeyGenVRF vkeyPath skeyPath = do - skey <- liftIO $ generateSigningKey AsVrfKey - let vkey = getVerificationKey skey - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFileWithOwnerPermissions skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - where - skeyDesc, vkeyDesc :: TextEnvelopeDescr - skeyDesc = "VRF Signing Key" - vkeyDesc = "VRF Verification Key" - -runNodeKeyHashVRF :: VerificationKeyOrFile VrfKey - -> Maybe (File () Out) - -> ExceptT ShelleyNodeCmdError IO () -runNodeKeyHashVRF verKeyOrFile mOutputFp = do - vkey <- firstExceptT ShelleyNodeCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsVrfKey verKeyOrFile - - let hexKeyHash = serialiseToRawBytesHex (verificationKeyHash vkey) - - case mOutputFp of - Just fpath -> liftIO $ BS.writeFile (unFile fpath) hexKeyHash - Nothing -> liftIO $ BS.putStrLn hexKeyHash - - -runNodeNewCounter :: ColdVerificationKeyOrFile - -> Word - -> OpCertCounterFile InOut - -> ExceptT ShelleyNodeCmdError IO () -runNodeNewCounter coldVerKeyOrFile counter ocertCtrPath = do - - vkey <- firstExceptT ShelleyNodeCmdReadFileError . newExceptT $ - readColdVerificationKeyOrFile coldVerKeyOrFile - - let ocertIssueCounter = - OperationalCertificateIssueCounter (fromIntegral counter) vkey - - firstExceptT ShelleyNodeCmdWriteFileError . newExceptT - $ writeLazyByteStringFile (onlyOut ocertCtrPath) - $ textEnvelopeToJSON Nothing ocertIssueCounter - - -runNodeIssueOpCert :: VerificationKeyOrFile KesKey - -- ^ This is the hot KES verification key. - -> SigningKeyFile In - -- ^ This is the cold signing key. - -> OpCertCounterFile InOut - -- ^ Counter that establishes the precedence - -- of the operational certificate. - -> KESPeriod - -- ^ Start of the validity period for this certificate. - -> File () Out - -> ExceptT ShelleyNodeCmdError IO () -runNodeIssueOpCert kesVerKeyOrFile stakePoolSKeyFile ocertCtrPath kesPeriod certFile = do - - ocertIssueCounter <- firstExceptT ShelleyNodeCmdReadFileError - . newExceptT - $ readFileTextEnvelope AsOperationalCertificateIssueCounter (onlyIn ocertCtrPath) - - verKeyKes <- firstExceptT ShelleyNodeCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsKesKey kesVerKeyOrFile - - signKey <- firstExceptT ShelleyNodeCmdReadKeyFileError - . newExceptT - $ readKeyFileAnyOf - bech32PossibleBlockIssuers - textEnvPossibleBlockIssuers - stakePoolSKeyFile - - (ocert, nextOcertCtr) <- - firstExceptT ShelleyNodeCmdOperationalCertificateIssueError - . hoistEither - $ issueOperationalCertificate - verKeyKes - signKey - kesPeriod - ocertIssueCounter - - -- Write the counter first, to reduce the chance of ending up with - -- a new cert but without updating the counter. - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile (onlyOut ocertCtrPath) - $ textEnvelopeToJSON (Just $ ocertCtrDesc $ getCounter nextOcertCtr) nextOcertCtr - - firstExceptT ShelleyNodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile certFile - $ textEnvelopeToJSON Nothing ocert - where - getCounter :: OperationalCertificateIssueCounter -> Word64 - getCounter (OperationalCertificateIssueCounter n _) = n - - ocertCtrDesc :: Word64 -> TextEnvelopeDescr - ocertCtrDesc n = "Next certificate issue number: " <> fromString (show n) - - textEnvPossibleBlockIssuers - :: [FromSomeType HasTextEnvelope - (Either (SigningKey StakePoolKey) - (SigningKey GenesisDelegateExtendedKey))] - textEnvPossibleBlockIssuers = - [ FromSomeType (AsSigningKey AsStakePoolKey) Left - , FromSomeType (AsSigningKey AsGenesisDelegateKey) (Left . castSigningKey) - , FromSomeType (AsSigningKey AsGenesisDelegateExtendedKey) Right - ] - - bech32PossibleBlockIssuers - :: [FromSomeType SerialiseAsBech32 - (Either (SigningKey StakePoolKey) - (SigningKey GenesisDelegateExtendedKey))] - bech32PossibleBlockIssuers = - [FromSomeType (AsSigningKey AsStakePoolKey) Left] - --- | Read a cold verification key or file. --- --- If a filepath is provided, it will be interpreted as a text envelope --- formatted file. -readColdVerificationKeyOrFile - :: ColdVerificationKeyOrFile - -> IO (Either (FileError TextEnvelopeError) (VerificationKey StakePoolKey)) -readColdVerificationKeyOrFile coldVerKeyOrFile = - case coldVerKeyOrFile of - ColdStakePoolVerificationKey vk -> pure (Right vk) - ColdGenesisDelegateVerificationKey vk -> - pure $ Right (castVerificationKey vk) - ColdVerificationKeyFile fp -> - readFileTextEnvelopeAnyOf - [ FromSomeType (AsVerificationKey AsStakePoolKey) id - , FromSomeType (AsVerificationKey AsGenesisDelegateKey) castVerificationKey - ] - fp - diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Pool.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Pool.hs deleted file mode 100644 index 75b3256a3de..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Pool.hs +++ /dev/null @@ -1,198 +0,0 @@ -{-# LANGUAGE DataKinds #-} - -module Cardano.CLI.Shelley.Run.Pool - ( ShelleyPoolCmdError(ShelleyPoolCmdReadFileError) - , renderShelleyPoolCmdError - , runPoolCmd - ) where - -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans (lift) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, - newExceptT, onLeft) -import qualified Data.ByteString.Char8 as BS -import Data.Function ((&)) -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text - -import Cardano.Api -import Cardano.Api.Shelley -import Cardano.CLI.Shelley.Commands -import Cardano.CLI.Shelley.Key (VerificationKeyOrFile, readVerificationKeyOrFile) -import Cardano.CLI.Types (OutputFormat (..)) - -import qualified Cardano.Ledger.Slot as Shelley - -data ShelleyPoolCmdError - = ShelleyPoolCmdReadFileError !(FileError TextEnvelopeError) - | ShelleyPoolCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyPoolCmdWriteFileError !(FileError ()) - | ShelleyPoolCmdMetadataValidationError !StakePoolMetadataValidationError - deriving Show - -renderShelleyPoolCmdError :: ShelleyPoolCmdError -> Text -renderShelleyPoolCmdError err = - case err of - ShelleyPoolCmdReadFileError fileErr -> Text.pack (displayError fileErr) - ShelleyPoolCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr) - ShelleyPoolCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyPoolCmdMetadataValidationError validationErr -> - "Error validating stake pool metadata: " <> Text.pack (displayError validationErr) - - - -runPoolCmd :: PoolCmd -> ExceptT ShelleyPoolCmdError IO () -runPoolCmd (PoolRegistrationCert sPvkey vrfVkey pldg pCost pMrgn rwdVerFp ownerVerFps relays mbMetadata network outfp) = - runStakePoolRegistrationCert sPvkey vrfVkey pldg pCost pMrgn rwdVerFp ownerVerFps relays mbMetadata network outfp -runPoolCmd (PoolRetirementCert sPvkeyFp retireEpoch outfp) = - runStakePoolRetirementCert sPvkeyFp retireEpoch outfp -runPoolCmd (PoolGetId sPvkey outputFormat) = runPoolId sPvkey outputFormat -runPoolCmd (PoolMetadataHash poolMdFile mOutFile) = runPoolMetadataHash poolMdFile mOutFile - - --- --- Stake pool command implementations --- - --- | Create a stake pool registration cert. --- TODO: Metadata and more stake pool relay support to be --- added in the future. -runStakePoolRegistrationCert - :: VerificationKeyOrFile StakePoolKey - -- ^ Stake pool verification key. - -> VerificationKeyOrFile VrfKey - -- ^ VRF Verification key. - -> Lovelace - -- ^ Pool pledge. - -> Lovelace - -- ^ Pool cost. - -> Rational - -- ^ Pool margin. - -> VerificationKeyOrFile StakeKey - -- ^ Stake verification key for reward account. - -> [VerificationKeyOrFile StakeKey] - -- ^ Pool owner stake verification key(s). - -> [StakePoolRelay] - -- ^ Stake pool relays. - -> Maybe StakePoolMetadataReference - -- ^ Stake pool metadata. - -> NetworkId - -> File () Out - -> ExceptT ShelleyPoolCmdError IO () -runStakePoolRegistrationCert - stakePoolVerKeyOrFile - vrfVerKeyOrFile - pldg - pCost - pMrgn - rwdStakeVerKeyOrFile - ownerStakeVerKeyOrFiles - relays - mbMetadata - network - outfp = do - -- Pool verification key - stakePoolVerKey <- firstExceptT ShelleyPoolCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsStakePoolKey stakePoolVerKeyOrFile - let stakePoolId' = verificationKeyHash stakePoolVerKey - - -- VRF verification key - vrfVerKey <- firstExceptT ShelleyPoolCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsVrfKey vrfVerKeyOrFile - let vrfKeyHash' = verificationKeyHash vrfVerKey - - -- Pool reward account - rwdStakeVerKey <- firstExceptT ShelleyPoolCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsStakeKey rwdStakeVerKeyOrFile - let stakeCred = StakeCredentialByKey (verificationKeyHash rwdStakeVerKey) - rewardAccountAddr = makeStakeAddress network stakeCred - - -- Pool owner(s) - sPoolOwnerVkeys <- - mapM - (firstExceptT ShelleyPoolCmdReadKeyFileError - . newExceptT - . readVerificationKeyOrFile AsStakeKey - ) - ownerStakeVerKeyOrFiles - let stakePoolOwners' = map verificationKeyHash sPoolOwnerVkeys - - let stakePoolParams = - StakePoolParameters - { stakePoolId = stakePoolId' - , stakePoolVRF = vrfKeyHash' - , stakePoolCost = pCost - , stakePoolMargin = pMrgn - , stakePoolRewardAccount = rewardAccountAddr - , stakePoolPledge = pldg - , stakePoolOwners = stakePoolOwners' - , stakePoolRelays = relays - , stakePoolMetadata = mbMetadata - } - - let registrationCert = makeStakePoolRegistrationCertificate stakePoolParams - - firstExceptT ShelleyPoolCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile outfp - $ textEnvelopeToJSON (Just registrationCertDesc) registrationCert - where - registrationCertDesc :: TextEnvelopeDescr - registrationCertDesc = "Stake Pool Registration Certificate" - -runStakePoolRetirementCert - :: VerificationKeyOrFile StakePoolKey - -> Shelley.EpochNo - -> File Certificate Out - -> ExceptT ShelleyPoolCmdError IO () -runStakePoolRetirementCert stakePoolVerKeyOrFile retireEpoch outfp = do - -- Pool verification key - stakePoolVerKey <- firstExceptT ShelleyPoolCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsStakePoolKey stakePoolVerKeyOrFile - - let stakePoolId' = verificationKeyHash stakePoolVerKey - retireCert = makeStakePoolRetirementCertificate stakePoolId' retireEpoch - - firstExceptT ShelleyPoolCmdWriteFileError - . newExceptT - $ intoFile outfp retireCert writeLazyByteStringFile - $ textEnvelopeToJSON (Just retireCertDesc) - where - retireCertDesc :: TextEnvelopeDescr - retireCertDesc = "Stake Pool Retirement Certificate" - -runPoolId - :: VerificationKeyOrFile StakePoolKey - -> OutputFormat - -> ExceptT ShelleyPoolCmdError IO () -runPoolId verKeyOrFile outputFormat = do - stakePoolVerKey <- firstExceptT ShelleyPoolCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsStakePoolKey verKeyOrFile - liftIO $ - case outputFormat of - OutputFormatHex -> - BS.putStrLn $ serialiseToRawBytesHex (verificationKeyHash stakePoolVerKey) - OutputFormatBech32 -> - Text.putStrLn $ serialiseToBech32 (verificationKeyHash stakePoolVerKey) - -runPoolMetadataHash :: File StakePoolMetadata In -> Maybe (File () Out) -> ExceptT ShelleyPoolCmdError IO () -runPoolMetadataHash poolMDPath mOutFile = do - metadataBytes <- lift (readByteStringFile poolMDPath) - & onLeft (left . ShelleyPoolCmdReadFileError) - - (_metadata, metadataHash) <- - firstExceptT ShelleyPoolCmdMetadataValidationError - . hoistEither - $ validateAndHashStakePoolMetadata metadataBytes - case mOutFile of - Nothing -> liftIO $ BS.putStrLn (serialiseToRawBytesHex metadataHash) - Just (File fpath) -> - handleIOExceptT (ShelleyPoolCmdWriteFileError . FileIOError fpath) - $ BS.writeFile fpath (serialiseToRawBytesHex metadataHash) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs deleted file mode 100644 index 4a760724487..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ /dev/null @@ -1,1487 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} - -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Cardano.CLI.Shelley.Run.Query - ( DelegationsAndRewards(..) - , ShelleyQueryCmdError - , ShelleyQueryCmdLocalStateQueryError (..) - , renderOpCertIntervalInformation - , renderShelleyQueryCmdError - , renderLocalStateQueryError - , runQueryCmd - , toEpochInfo - , utcTimeToSlotNo - , determineEra - , mergeDelegsAndRewards - , percentage - , executeQuery - ) where - -import Cardano.Api -import qualified Cardano.Api as Api -import Cardano.Api.Byron -import Cardano.Api.Shelley - -import Control.Monad (forM, forM_, join) -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.IO.Unlift (MonadIO (..)) -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except (ExceptT (..), except, runExcept, runExceptT, - withExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, - hoistMaybe, left, onLeft, onNothing) -import Data.Aeson as Aeson -import Data.Aeson.Encode.Pretty (encodePretty) -import Data.Aeson.Types as Aeson -import Data.Bifunctor (Bifunctor (..)) -import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Coerce (coerce) -import Data.Function ((&)) -import Data.Functor ((<&>)) -import Data.List (nub) -import qualified Data.List as List -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Proxy (Proxy (..)) -import Data.Set (Set) -import qualified Data.Set as Set -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.Text.IO as T -import qualified Data.Text.IO as Text -import Data.Text.Lazy (toStrict) -import Data.Text.Lazy.Builder (toLazyText) -import Data.Time.Clock -import qualified Data.Vector as Vector -import Formatting.Buildable (build) -import Numeric (showEFloat) -import Prettyprinter -import qualified System.IO as IO -import Text.Printf (printf) - -import Cardano.Binary (DecoderError) -import Cardano.CLI.Helpers (HelpersError (..), hushM, pPrintCBOR, renderHelpersError) -import Cardano.CLI.Pretty -import Cardano.CLI.Shelley.Commands -import Cardano.CLI.Shelley.Key (VerificationKeyOrHashOrFile, - readVerificationKeyOrHashOrFile) -import qualified Cardano.CLI.Shelley.Output as O -import Cardano.CLI.Shelley.Run.Genesis (ShelleyGenesisCmdError, - readAndDecodeShelleyGenesis) -import Cardano.CLI.Types -import Cardano.Crypto.Hash (hashToBytesAsHex) -import qualified Cardano.Crypto.Hash.Blake2b as Blake2b -import qualified Cardano.Crypto.VRF as Crypto -import Cardano.Ledger.BaseTypes (Seed) -import qualified Cardano.Ledger.Core as Core -import qualified Cardano.Ledger.Crypto as Crypto -import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..)) -import Cardano.Ledger.SafeHash (HashAnnotated) -import Cardano.Ledger.Shelley.LedgerState - (PState (psFutureStakePoolParams, psRetiring, psStakePoolParams)) -import qualified Cardano.Ledger.Shelley.LedgerState as SL -import Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCTime, hoistEpochInfo) - -import Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime (..), - toRelativeTime) -import Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..)) -import Ouroboros.Consensus.Protocol.TPraos (StandardCrypto) -import Ouroboros.Network.Block (Serialised (..)) - -import qualified Ouroboros.Consensus.HardFork.History as Consensus -import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry -import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus -import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus - -{- HLINT ignore "Move brackets to avoid $" -} -{- HLINT ignore "Redundant flip" -} - -data ShelleyQueryCmdError - = ShelleyQueryCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError - | ShelleyQueryCmdWriteFileError !(FileError ()) - | ShelleyQueryCmdHelpersError !HelpersError - | ShelleyQueryCmdAcquireFailure !AcquiringFailure - | ShelleyQueryCmdEraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra - | ShelleyQueryCmdByronEra - | ShelleyQueryCmdEraMismatch !EraMismatch - | ShelleyQueryCmdUnsupportedMode !AnyConsensusMode - | ShelleyQueryCmdPastHorizon !Qry.PastHorizonException - | ShelleyQueryCmdSystemStartUnavailable - | ShelleyQueryCmdGenesisReadError !ShelleyGenesisCmdError - | ShelleyQueryCmdLeaderShipError !LeadershipError - | ShelleyQueryCmdTextEnvelopeReadError !(FileError TextEnvelopeError) - | ShelleyQueryCmdTextReadError !(FileError InputDecodeError) - | ShelleyQueryCmdOpCertCounterReadError !(FileError TextEnvelopeError) - | ShelleyQueryCmdProtocolStateDecodeFailure !(LBS.ByteString, DecoderError) - | ShelleyQueryCmdPoolStateDecodeError DecoderError - | ShelleyQueryCmdStakeSnapshotDecodeError DecoderError - | ShelleyQueryCmdUnsupportedNtcVersion !UnsupportedNtcVersionError - | ShelleyQueryCmdProtocolParameterConversionError !ProtocolParametersConversionError - deriving Show - -renderShelleyQueryCmdError :: ShelleyQueryCmdError -> Text -renderShelleyQueryCmdError err = - case err of - ShelleyQueryCmdLocalStateQueryError lsqErr -> renderLocalStateQueryError lsqErr - ShelleyQueryCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyQueryCmdHelpersError helpersErr -> renderHelpersError helpersErr - ShelleyQueryCmdAcquireFailure acquireFail -> Text.pack $ show acquireFail - ShelleyQueryCmdByronEra -> "This query cannot be used for the Byron era" - ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra era) -> - "Consensus mode and era mismatch. Consensus mode: " <> textShow cMode <> - " Era: " <> textShow era - ShelleyQueryCmdEraMismatch (EraMismatch ledgerEra queryEra) -> - "\nAn error mismatch occurred." <> "\nSpecified query era: " <> queryEra <> - "\nCurrent ledger era: " <> ledgerEra - ShelleyQueryCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode - ShelleyQueryCmdPastHorizon e -> "Past horizon: " <> textShow e - ShelleyQueryCmdSystemStartUnavailable -> "System start unavailable" - ShelleyQueryCmdGenesisReadError err' -> Text.pack $ displayError err' - ShelleyQueryCmdLeaderShipError e -> Text.pack $ displayError e - ShelleyQueryCmdTextEnvelopeReadError e -> Text.pack $ displayError e - ShelleyQueryCmdTextReadError e -> Text.pack $ displayError e - ShelleyQueryCmdOpCertCounterReadError e -> Text.pack $ displayError e - ShelleyQueryCmdProtocolStateDecodeFailure (_, decErr) -> - "Failed to decode the protocol state: " <> toStrict (toLazyText $ build decErr) - ShelleyQueryCmdPoolStateDecodeError decoderError -> - "Failed to decode PoolState. Error: " <> Text.pack (show decoderError) - ShelleyQueryCmdStakeSnapshotDecodeError decoderError -> - "Failed to decode StakeSnapshot. Error: " <> Text.pack (show decoderError) - ShelleyQueryCmdUnsupportedNtcVersion (UnsupportedNtcVersionError minNtcVersion ntcVersion) -> - "Unsupported feature for the node-to-client protocol version.\n" <> - "This query requires at least " <> textShow minNtcVersion <> " but the node negotiated " <> textShow ntcVersion <> ".\n" <> - "Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)." - ShelleyQueryCmdProtocolParameterConversionError ppce -> - Text.pack $ "Failed to convert protocol parameter: " <> displayError ppce - -runQueryCmd :: QueryCmd -> ExceptT ShelleyQueryCmdError IO () -runQueryCmd cmd = - case cmd of - QueryLeadershipSchedule mNodeSocketPath consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs -> - runQueryLeadershipSchedule mNodeSocketPath consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs - QueryProtocolParameters' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryProtocolParameters mNodeSocketPath consensusModeParams network mOutFile - QueryTip mNodeSocketPath consensusModeParams network mOutFile -> - runQueryTip mNodeSocketPath consensusModeParams network mOutFile - QueryStakePools' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryStakePools mNodeSocketPath consensusModeParams network mOutFile - QueryStakeDistribution' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryStakeDistribution mNodeSocketPath consensusModeParams network mOutFile - QueryStakeAddressInfo mNodeSocketPath consensusModeParams addr network mOutFile -> - runQueryStakeAddressInfo mNodeSocketPath consensusModeParams addr network mOutFile - QueryDebugLedgerState' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryLedgerState mNodeSocketPath consensusModeParams network mOutFile - QueryStakeSnapshot' mNodeSocketPath consensusModeParams network allOrOnlyPoolIds mOutFile -> - runQueryStakeSnapshot mNodeSocketPath consensusModeParams network allOrOnlyPoolIds mOutFile - QueryProtocolState' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryProtocolState mNodeSocketPath consensusModeParams network mOutFile - QueryUTxO' mNodeSocketPath consensusModeParams qFilter networkId mOutFile -> - runQueryUTxO mNodeSocketPath consensusModeParams qFilter networkId mOutFile - QueryKesPeriodInfo mNodeSocketPath consensusModeParams network nodeOpCert mOutFile -> - runQueryKesPeriodInfo mNodeSocketPath consensusModeParams network nodeOpCert mOutFile - QueryPoolState' mNodeSocketPath consensusModeParams network poolid -> - runQueryPoolState mNodeSocketPath consensusModeParams network poolid - QueryTxMempool mNodeSocketPath consensusModeParams network op mOutFile -> - runQueryTxMempool mNodeSocketPath consensusModeParams network op mOutFile - QuerySlotNumber mNodeSocketPath consensusModeParams network utcTime -> - runQuerySlotNumber mNodeSocketPath consensusModeParams network utcTime - -runQueryProtocolParameters - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryProtocolParameters socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - - case cardanoEraStyle era of - LegacyByronEra -> left ShelleyQueryCmdByronEra - ShelleyBasedEra sbe -> do - let cMode = consensusModeOnly cModeParams - - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - - lift (queryExpr $ QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryProtocolParameters) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdEraMismatch) - - writeProtocolParameters mOutFile =<< except (join (first ShelleyQueryCmdAcquireFailure result)) - - where - writeProtocolParameters - :: Maybe (File () Out) - -> ProtocolParameters - -> ExceptT ShelleyQueryCmdError IO () - writeProtocolParameters mOutFile' pparams = - case mOutFile' of - Nothing -> liftIO $ LBS.putStrLn (encodePretty pparams) - Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) $ - LBS.writeFile fpath (encodePretty pparams) - --- | Calculate the percentage sync rendered as text. -percentage - :: RelativeTime - -- ^ 'tolerance'. If 'b' - 'a' < 'tolerance', then 100% is reported. This even if we are 'tolerance' seconds - -- behind, we are still considered fully synced. - -> RelativeTime - -- ^ 'nowTime'. The time of the most recently synced block. - -> RelativeTime - -- ^ 'tipTime'. The time of the tip of the block chain to which we need to sync. - -> Text -percentage tolerance a b = Text.pack (printf "%.2f" pc) - where -- All calculations are in seconds (Integer) - t = relativeTimeSeconds tolerance - -- Plus 1 to prevent division by zero. The 's' prefix stands for strictly-positive. - sa = relativeTimeSeconds a + 1 - sb = relativeTimeSeconds b + 1 - -- Fast forward the 'nowTime` by the tolerance, but don't let the result exceed the tip time. - ua = min (sa + t) sb - ub = sb - -- Final percentage to render as text. - pc = id @Double (fromIntegral ua / fromIntegral ub) * 100.0 - -relativeTimeSeconds :: RelativeTime -> Integer -relativeTimeSeconds (RelativeTime dt) = floor (nominalDiffTimeToSeconds dt) - --- | Query the chain tip via the chain sync protocol. --- --- This is a fallback query to support older versions of node to client protocol. -queryChainTipViaChainSync :: MonadIO m => LocalNodeConnectInfo mode -> m ChainTip -queryChainTipViaChainSync localNodeConnInfo = do - liftIO . T.hPutStrLn IO.stderr $ - "Warning: Local header state query unavailable. Falling back to chain sync query" - liftIO $ getLocalChainTip localNodeConnInfo - -runQueryTip - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryTip socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do - case consensusModeOnly cModeParams of - CardanoMode -> do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - eLocalState <- ExceptT $ fmap sequence $ - executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - era <- lift (queryExpr (QueryCurrentEra CardanoModeIsMultiEra)) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - eraHistory <- lift (queryExpr (QueryEraHistory CardanoModeIsMultiEra)) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - mChainBlockNo <- lift (queryExpr QueryChainBlockNo) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & fmap Just - mChainPoint <- lift (queryExpr (QueryChainPoint CardanoMode)) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & fmap Just - mSystemStart <- lift (queryExpr QuerySystemStart) & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & fmap Just - - return O.QueryTipLocalState - { O.era = era - , O.eraHistory = eraHistory - , O.mSystemStart = mSystemStart - , O.mChainTip = makeChainTip <$> mChainBlockNo <*> mChainPoint - } - - mLocalState <- hushM (first ShelleyQueryCmdAcquireFailure eLocalState) $ \e -> - liftIO . T.hPutStrLn IO.stderr $ "Warning: Local state unavailable: " <> renderShelleyQueryCmdError e - - chainTip <- pure (mLocalState >>= O.mChainTip) - -- The chain tip is unavailable via local state query because we are connecting with an older - -- node to client protocol so we use chain sync instead which necessitates another connection. - -- At some point when we can stop supporting the older node to client protocols, this fallback - -- can be removed. - & onNothing (queryChainTipViaChainSync localNodeConnInfo) - - let tipSlotNo :: SlotNo = case chainTip of - ChainTipAtGenesis -> 0 - ChainTip slotNo _ _ -> slotNo - - localStateOutput <- forM mLocalState $ \localState -> do - case slotToEpoch tipSlotNo (O.eraHistory localState) of - Left e -> do - liftIO . T.hPutStrLn IO.stderr $ - "Warning: Epoch unavailable: " <> renderShelleyQueryCmdError (ShelleyQueryCmdPastHorizon e) - return $ O.QueryTipLocalStateOutput - { O.localStateChainTip = chainTip - , O.mEra = Nothing - , O.mEpoch = Nothing - , O.mSyncProgress = Nothing - , O.mSlotInEpoch = Nothing - , O.mSlotsToEpochEnd = Nothing - } - - Right (epochNo, SlotsInEpoch slotsInEpoch, SlotsToEpochEnd slotsToEpochEnd) -> do - syncProgressResult <- runExceptT $ do - systemStart <- fmap getSystemStart (O.mSystemStart localState) & hoistMaybe ShelleyQueryCmdSystemStartUnavailable - nowSeconds <- toRelativeTime (SystemStart systemStart) <$> liftIO getCurrentTime - tipTimeResult <- getProgress tipSlotNo (O.eraHistory localState) & bimap ShelleyQueryCmdPastHorizon fst & except - - let tolerance = RelativeTime (secondsToNominalDiffTime 600) - - return $ flip (percentage tolerance) nowSeconds tipTimeResult - - mSyncProgress <- hushM syncProgressResult $ \e -> do - liftIO . T.hPutStrLn IO.stderr $ "Warning: Sync progress unavailable: " <> renderShelleyQueryCmdError e - - return $ O.QueryTipLocalStateOutput - { O.localStateChainTip = chainTip - , O.mEra = Just (O.era localState) - , O.mEpoch = Just epochNo - , O.mSlotInEpoch = Just slotsInEpoch - , O.mSlotsToEpochEnd = Just slotsToEpochEnd - , O.mSyncProgress = mSyncProgress - } - - case mOutFile of - Just (File fpath) -> liftIO $ LBS.writeFile fpath $ encodePretty localStateOutput - Nothing -> liftIO $ LBS.putStrLn $ encodePretty localStateOutput - - mode -> left (ShelleyQueryCmdUnsupportedMode (AnyConsensusMode mode)) - --- | Query the UTxO, filtered by a given set of addresses, from a Shelley node --- via the local state query protocol. -runQueryUTxO - :: SocketPath - -> AnyConsensusModeParams - -> QueryUTxOFilter - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryUTxO socketPath (AnyConsensusModeParams cModeParams) - qfilter network mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let cMode = consensusModeOnly cModeParams - sbe <- getSbe $ cardanoEraStyle era - - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - - let query = QueryInShelleyBasedEra sbe (QueryUTxO qfilter) - qInMode = QueryInEra eInMode query - - result <- executeQuery era cModeParams localNodeConnInfo qInMode - - writeFilteredUTxOs sbe mOutFile result - -runQueryKesPeriodInfo - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> File () In - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryKesPeriodInfo socketPath (AnyConsensusModeParams cModeParams) network nodeOpCertFile mOutFile = do - opCert <- lift (readFileTextEnvelope AsOperationalCertificate nodeOpCertFile) - & onLeft (left . ShelleyQueryCmdOpCertCounterReadError) - - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let cMode = consensusModeOnly cModeParams - sbe <- getSbe $ cardanoEraStyle era - case cMode of - CardanoMode -> do - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - - -- We check that the KES period specified in the operational certificate is correct - -- based on the KES period defined in the genesis parameters and the current slot number - let genesisQinMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryGenesisParameters - eraHistoryQuery = QueryEraHistory CardanoModeIsMultiEra - gParams <- executeQuery era cModeParams localNodeConnInfo genesisQinMode - - chainTip <- liftIO $ getLocalChainTip localNodeConnInfo - - let curKesPeriod = currentKesPeriod chainTip gParams - oCertStartKesPeriod = opCertStartingKesPeriod opCert - oCertEndKesPeriod = opCertEndKesPeriod gParams opCert - opCertIntervalInformation = opCertIntervalInfo gParams chainTip curKesPeriod oCertStartKesPeriod oCertEndKesPeriod - - eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let eInfo = toTentativeEpochInfo eraHistory - - - -- We get the operational certificate counter from the protocol state and check that - -- it is equivalent to what we have on disk. - - let ptclStateQinMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryProtocolState - ptclState <- executeQuery era cModeParams localNodeConnInfo ptclStateQinMode - - (onDiskC, stateC) <- eligibleLeaderSlotsConstaints sbe $ opCertOnDiskAndStateCounters ptclState opCert - let counterInformation = opCertNodeAndOnDiskCounters onDiskC stateC - - -- Always render diagnostic information - liftIO . putStrLn $ renderOpCertIntervalInformation (unFile nodeOpCertFile) opCertIntervalInformation - liftIO . putStrLn $ renderOpCertNodeAndOnDiskCounterInformation (unFile nodeOpCertFile) counterInformation - - let qKesInfoOutput = createQueryKesPeriodInfoOutput opCertIntervalInformation counterInformation eInfo gParams - kesPeriodInfoJSON = encodePretty qKesInfoOutput - - liftIO $ LBS.putStrLn kesPeriodInfoJSON - forM_ mOutFile (\(File oFp) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp) - $ LBS.writeFile oFp kesPeriodInfoJSON) - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode - where - currentKesPeriod :: ChainTip -> GenesisParameters -> CurrentKesPeriod - currentKesPeriod ChainTipAtGenesis _ = CurrentKesPeriod 0 - currentKesPeriod (ChainTip currSlot _ _) gParams = - let slotsPerKesPeriod = fromIntegral $ protocolParamSlotsPerKESPeriod gParams - in CurrentKesPeriod $ unSlotNo currSlot `div` slotsPerKesPeriod - - opCertStartingKesPeriod :: OperationalCertificate -> OpCertStartingKesPeriod - opCertStartingKesPeriod = OpCertStartingKesPeriod . fromIntegral . getKesPeriod - - opCertEndKesPeriod :: GenesisParameters -> OperationalCertificate -> OpCertEndingKesPeriod - opCertEndKesPeriod gParams oCert = - let OpCertStartingKesPeriod start = opCertStartingKesPeriod oCert - maxKesEvo = fromIntegral $ protocolParamMaxKESEvolutions gParams - in OpCertEndingKesPeriod $ start + maxKesEvo - - -- See OCERT rule in Shelley Spec: https://hydra.iohk.io/job/Cardano/cardano-ledger-specs/shelleyLedgerSpec/latest/download-by-type/doc-pdf/ledger-spec - opCertIntervalInfo - :: GenesisParameters - -> ChainTip - -> CurrentKesPeriod - -> OpCertStartingKesPeriod - -> OpCertEndingKesPeriod - -> OpCertIntervalInformation - opCertIntervalInfo gParams currSlot' c s e@(OpCertEndingKesPeriod oCertEnd) = - let cSlot = case currSlot' of - (ChainTip cSlotN _ _) -> unSlotNo cSlotN - ChainTipAtGenesis -> 0 - slotsTillExp = SlotsTillKesKeyExpiry . SlotNo $ (oCertEnd * fromIntegral (protocolParamSlotsPerKESPeriod gParams)) - cSlot - in O.createOpCertIntervalInfo c s e (Just slotsTillExp) - - opCertNodeAndOnDiskCounters - :: OpCertOnDiskCounter - -> Maybe OpCertNodeStateCounter - -> OpCertNodeAndOnDiskCounterInformation - opCertNodeAndOnDiskCounters o@(OpCertOnDiskCounter odc) (Just n@(OpCertNodeStateCounter nsc)) - | odc < nsc = OpCertOnDiskCounterBehindNodeState o n - | odc > nsc + 1 = OpCertOnDiskCounterTooFarAheadOfNodeState o n - | odc == nsc + 1 = OpCertOnDiskCounterAheadOfNodeState o n - | otherwise = OpCertOnDiskCounterEqualToNodeState o n - opCertNodeAndOnDiskCounters o Nothing = OpCertNoBlocksMintedYet o - - opCertExpiryUtcTime - :: Tentative (EpochInfo (Either Text)) - -> GenesisParameters - -> OpCertEndingKesPeriod - -> Maybe UTCTime - opCertExpiryUtcTime eInfo gParams (OpCertEndingKesPeriod oCertExpiryKesPeriod) = - let time = epochInfoSlotToUTCTime - (tentative eInfo) - (SystemStart $ protocolParamSystemStart gParams) - (fromIntegral $ oCertExpiryKesPeriod * fromIntegral (protocolParamSlotsPerKESPeriod gParams)) - in case time of - Left _ -> Nothing - Right t -> Just t - - renderOpCertNodeAndOnDiskCounterInformation :: FilePath -> OpCertNodeAndOnDiskCounterInformation -> String - renderOpCertNodeAndOnDiskCounterInformation opCertFile opCertCounterInfo = - case opCertCounterInfo of - OpCertOnDiskCounterEqualToNodeState _ _ -> - renderStringDefault $ - green "✓" <+> hang 0 - ( vsep - [ "The operational certificate counter agrees with the node protocol state counter" - ] - ) - OpCertOnDiskCounterAheadOfNodeState _ _ -> - renderStringDefault $ - green "✓" <+> hang 0 - ( vsep - [ "The operational certificate counter ahead of the node protocol state counter by 1" - ] - ) - OpCertOnDiskCounterTooFarAheadOfNodeState onDiskC nodeStateC -> - renderStringDefault $ - red "✗" <+> hang 0 - ( vsep - [ "The operational certificate counter too far ahead of the node protocol state counter in the operational certificate at: " <> pretty opCertFile - , "On disk operational certificate counter: " <> pretty (unOpCertOnDiskCounter onDiskC) - , "Protocol state counter: " <> pretty (unOpCertNodeStateCounter nodeStateC) - ] - ) - OpCertOnDiskCounterBehindNodeState onDiskC nodeStateC -> - renderStringDefault $ - red "✗" <+> hang 0 - ( vsep - [ "The protocol state counter is greater than the counter in the operational certificate at: " <> pretty opCertFile - , "On disk operational certificate counter: " <> pretty (unOpCertOnDiskCounter onDiskC) - , "Protocol state counter: " <> pretty (unOpCertNodeStateCounter nodeStateC) - ] - ) - OpCertNoBlocksMintedYet (OpCertOnDiskCounter onDiskC) -> - renderStringDefault $ - red "✗" <+> hang 0 - ( vsep - [ "No blocks minted so far with the operational certificate at: " <> pretty opCertFile - , "On disk operational certificate counter: " <> pretty onDiskC - ] - ) - - - createQueryKesPeriodInfoOutput - :: OpCertIntervalInformation - -> OpCertNodeAndOnDiskCounterInformation - -> Tentative (EpochInfo (Either Text)) - -> GenesisParameters - -> O.QueryKesPeriodInfoOutput - createQueryKesPeriodInfoOutput oCertIntervalInfo oCertCounterInfo eInfo gParams = - let (e, mStillExp) = case oCertIntervalInfo of - OpCertWithinInterval _ end _ sTillExp -> (end, Just sTillExp) - OpCertStartingKesPeriodIsInTheFuture _ end _ -> (end, Nothing) - OpCertExpired _ end _ -> (end, Nothing) - OpCertSomeOtherError _ end _ -> (end, Nothing) - (onDiskCounter, mNodeCounter) = case oCertCounterInfo of - OpCertOnDiskCounterEqualToNodeState d n -> (d, Just n) - OpCertOnDiskCounterAheadOfNodeState d n -> (d, Just n) - OpCertOnDiskCounterTooFarAheadOfNodeState d n -> (d, Just n) - OpCertOnDiskCounterBehindNodeState d n -> (d, Just n) - OpCertNoBlocksMintedYet d -> (d, Nothing) - - in O.QueryKesPeriodInfoOutput - { O.qKesOpCertIntervalInformation = oCertIntervalInfo - , O.qKesInfoNodeStateOperationalCertNo = mNodeCounter - , O.qKesInfoOnDiskOperationalCertNo = onDiskCounter - , O.qKesInfoMaxKesKeyEvolutions = fromIntegral $ protocolParamMaxKESEvolutions gParams - , O.qKesInfoSlotsPerKesPeriod = fromIntegral $ protocolParamSlotsPerKESPeriod gParams - , O.qKesInfoKesKeyExpiry = - case mStillExp of - Just _ -> opCertExpiryUtcTime eInfo gParams e - Nothing -> Nothing - } - - -- We get the operational certificate counter from the protocol state and check that - -- it is equivalent to what we have on disk. - opCertOnDiskAndStateCounters :: forall era . () - => Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) - => FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) - => Crypto.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224 - => ProtocolState era - -> OperationalCertificate - -> ExceptT ShelleyQueryCmdError IO (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter) - opCertOnDiskAndStateCounters ptclState opCert@(OperationalCertificate _ stakePoolVKey) = do - let onDiskOpCertCount = fromIntegral $ getOpCertCount opCert - - chainDepState <- pure (decodeProtocolState ptclState) - & onLeft (left . ShelleyQueryCmdProtocolStateDecodeFailure) - - -- We need the stake pool id to determine what the counter of our SPO - -- should be. - let opCertCounterMap = Consensus.getOpCertCounters (Proxy @(ConsensusProtocol era)) chainDepState - StakePoolKeyHash blockIssuerHash = verificationKeyHash stakePoolVKey - - case Map.lookup (coerce blockIssuerHash) opCertCounterMap of - -- Operational certificate exists in the protocol state - -- so our ondisk op cert counter must be greater than or - -- equal to what is in the node state - Just ptclStateCounter -> return (OpCertOnDiskCounter onDiskOpCertCount, Just $ OpCertNodeStateCounter ptclStateCounter) - Nothing -> return (OpCertOnDiskCounter onDiskOpCertCount, Nothing) - - -renderOpCertIntervalInformation :: FilePath -> OpCertIntervalInformation -> String -renderOpCertIntervalInformation opCertFile opCertInfo = case opCertInfo of - OpCertWithinInterval _start _end _current _stillExp -> - renderStringDefault $ - green "✓" <+> hang 0 - ( vsep - [ "Operational certificate's KES period is within the correct KES period interval" - ] - ) - OpCertStartingKesPeriodIsInTheFuture (OpCertStartingKesPeriod start) (OpCertEndingKesPeriod end) (CurrentKesPeriod current) -> - renderStringDefault $ - red "✗" <+> hang 0 - ( vsep - [ "Node operational certificate at: " <> pretty opCertFile <> " has an incorrectly specified starting KES period. " - , "Current KES period: " <> pretty current - , "Operational certificate's starting KES period: " <> pretty start - , "Operational certificate's expiry KES period: " <> pretty end - ] - ) - OpCertExpired _ (OpCertEndingKesPeriod end) (CurrentKesPeriod current) -> - renderStringDefault $ - red "✗" <+> hang 0 - ( vsep - [ "Node operational certificate at: " <> pretty opCertFile <> " has expired. " - , "Current KES period: " <> pretty current - , "Operational certificate's expiry KES period: " <> pretty end - ] - ) - - OpCertSomeOtherError (OpCertStartingKesPeriod start) (OpCertEndingKesPeriod end) (CurrentKesPeriod current) -> - renderStringDefault $ - red "✗" <+> hang 0 - ( vsep - [ "An unknown error occurred with operational certificate at: " <> pretty opCertFile - , "Current KES period: " <> pretty current - , "Operational certificate's starting KES period: " <> pretty start - , "Operational certificate's expiry KES period: " <> pretty end - ] - ) - --- | Query the current and future parameters for a stake pool, including the retirement date. --- Any of these may be empty (in which case a null will be displayed). --- -runQueryPoolState - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> [Hash StakePoolKey] - -> ExceptT ShelleyQueryCmdError IO () -runQueryPoolState socketPath (AnyConsensusModeParams cModeParams) network poolIds = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let cMode = consensusModeOnly cModeParams - sbe <- getSbe $ cardanoEraStyle era - - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - - let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryPoolState $ Just $ Set.fromList poolIds - result <- executeQuery era cModeParams localNodeConnInfo qInMode - obtainLedgerEraClassConstraints sbe writePoolState result - --- | Query the local mempool state -runQueryTxMempool - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> TxMempoolQuery - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryTxMempool socketPath (AnyConsensusModeParams cModeParams) network query mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - localQuery <- case query of - TxMempoolQueryTxExists tx -> do - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - let cMode = consensusModeOnly cModeParams - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - pure $ LocalTxMonitoringQueryTx $ TxIdInMode tx eInMode - TxMempoolQueryNextTx -> pure LocalTxMonitoringSendNextTx - TxMempoolQueryInfo -> pure LocalTxMonitoringMempoolInformation - - result <- liftIO $ queryTxMonitoringLocal localNodeConnInfo localQuery - let renderedResult = encodePretty result - case mOutFile of - Nothing -> liftIO $ LBS.putStrLn renderedResult - Just (File oFp) -> handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp) - $ LBS.writeFile oFp renderedResult - -runQuerySlotNumber - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> UTCTime - -> ExceptT ShelleyQueryCmdError IO () -runQuerySlotNumber sockPath aCmp network utcTime = do - SlotNo slotNo <- utcTimeToSlotNo sockPath aCmp network utcTime - liftIO . putStr $ show slotNo - --- | Obtain stake snapshot information for a pool, plus information about the total active stake. --- This information can be used for leader slot calculation, for example, and has been requested by SPOs. --- Obtaining the information directly is significantly more time and memory efficient than using a full ledger state dump. -runQueryStakeSnapshot - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> AllOrOnly [Hash StakePoolKey] - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryStakeSnapshot socketPath (AnyConsensusModeParams cModeParams) network allOrOnlyPoolIds mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let cMode = consensusModeOnly cModeParams - sbe <- getSbe $ cardanoEraStyle era - - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - - let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakeSnapshot $ case allOrOnlyPoolIds of - All -> Nothing - Only poolIds -> Just $ Set.fromList poolIds - - result <- executeQuery era cModeParams localNodeConnInfo qInMode - obtainLedgerEraClassConstraints sbe (writeStakeSnapshots mOutFile) result - - -runQueryLedgerState - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryLedgerState socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let cMode = consensusModeOnly cModeParams - sbe <- getSbe $ cardanoEraStyle era - - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - - let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryDebugLedgerState - - result <- executeQuery era cModeParams localNodeConnInfo qInMode - - obtainLedgerEraClassConstraints sbe (writeLedgerState mOutFile) result - -runQueryProtocolState - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryProtocolState socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let cMode = consensusModeOnly cModeParams - sbe <- getSbe $ cardanoEraStyle era - - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - - let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryProtocolState - - result <- executeQuery era cModeParams localNodeConnInfo qInMode - - case cMode of - CardanoMode -> eligibleWriteProtocolStateConstaints sbe $ writeProtocolState mOutFile result - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode - --- | Query the current delegations and reward accounts, filtered by a given --- set of addresses, from a Shelley node via the local state query protocol. - -runQueryStakeAddressInfo - :: SocketPath - -> AnyConsensusModeParams - -> StakeAddress - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryStakeAddressInfo socketPath (AnyConsensusModeParams cModeParams) (StakeAddress _ addr) network mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let cMode = consensusModeOnly cModeParams - sbe <- getSbe $ cardanoEraStyle era - - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - - let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr - query = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakeAddresses stakeAddr network - - result <- executeQuery era cModeParams localNodeConnInfo query - - writeStakeAddressInfo mOutFile $ DelegationsAndRewards result - --- ------------------------------------------------------------------------------------------------- - --- | An error that can occur while querying a node's local state. -newtype ShelleyQueryCmdLocalStateQueryError - = EraMismatchError EraMismatch - -- ^ A query from a certain era was applied to a ledger from a different - -- era. - deriving (Eq, Show) - -renderLocalStateQueryError :: ShelleyQueryCmdLocalStateQueryError -> Text -renderLocalStateQueryError lsqErr = - case lsqErr of - EraMismatchError err -> - "A query from a certain era was applied to a ledger from a different era: " <> textShow err - -writeStakeAddressInfo - :: Maybe (File () Out) - -> DelegationsAndRewards - -> ExceptT ShelleyQueryCmdError IO () -writeStakeAddressInfo mOutFile delegsAndRewards = - case mOutFile of - Nothing -> liftIO $ LBS.putStrLn (encodePretty delegsAndRewards) - Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) - $ LBS.writeFile fpath (encodePretty delegsAndRewards) - -writeLedgerState :: forall era ledgerera. - ShelleyLedgerEra era ~ ledgerera - => ToJSON (DebugLedgerState era) - => FromCBOR (DebugLedgerState era) - => Maybe (File () Out) - -> SerialisedDebugLedgerState era - -> ExceptT ShelleyQueryCmdError IO () -writeLedgerState mOutFile qState@(SerialisedDebugLedgerState serLedgerState) = - case mOutFile of - Nothing -> - case decodeDebugLedgerState qState of - Left bs -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs - Right ledgerState -> liftIO . LBS.putStrLn $ Aeson.encode ledgerState - Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) - $ LBS.writeFile fpath $ unSerialised serLedgerState - -writeStakeSnapshots :: forall era ledgerera. () - => ShelleyLedgerEra era ~ ledgerera - => Core.EraCrypto ledgerera ~ StandardCrypto - => Maybe (File () Out) - -> SerialisedStakeSnapshots era - -> ExceptT ShelleyQueryCmdError IO () -writeStakeSnapshots mOutFile qState = do - StakeSnapshot snapshot <- pure (decodeStakeSnapshot qState) - & onLeft (left . ShelleyQueryCmdStakeSnapshotDecodeError) - - -- Calculate the three pool and active stake values for the given pool - liftIO . maybe LBS.putStrLn (LBS.writeFile . unFile) mOutFile $ encodePretty snapshot - --- | This function obtains the pool parameters, equivalent to the following jq query on the output of query ledger-state --- .nesEs.esLState.lsDPState.dpsPState.psStakePoolParams. -writePoolState :: forall era ledgerera. () - => ShelleyLedgerEra era ~ ledgerera - => Core.EraCrypto ledgerera ~ StandardCrypto - => Core.Era ledgerera - => SerialisedPoolState era - -> ExceptT ShelleyQueryCmdError IO () -writePoolState serialisedCurrentEpochState = do - PoolState poolState <- pure (decodePoolState serialisedCurrentEpochState) - & onLeft (left . ShelleyQueryCmdPoolStateDecodeError) - - let hks = Set.toList $ Set.fromList $ Map.keys (psStakePoolParams poolState) - <> Map.keys (psFutureStakePoolParams poolState) <> Map.keys (psRetiring poolState) - - let poolStates :: Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto) - poolStates = Map.fromList $ hks <&> - ( \hk -> - ( hk - , Params - { poolParameters = Map.lookup hk (SL.psStakePoolParams poolState) - , futurePoolParameters = Map.lookup hk (SL.psFutureStakePoolParams poolState) - , retiringEpoch = Map.lookup hk (SL.psRetiring poolState) - } - ) - ) - - liftIO . LBS.putStrLn $ encodePretty poolStates - -writeProtocolState :: - ( FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) - , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) - ) - => Maybe (File () Out) - -> ProtocolState era - -> ExceptT ShelleyQueryCmdError IO () -writeProtocolState mOutFile ps@(ProtocolState pstate) = - case mOutFile of - Nothing -> case decodeProtocolState ps of - Left (bs, _) -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs - Right chainDepstate -> liftIO . LBS.putStrLn $ encodePretty chainDepstate - Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) - . LBS.writeFile fpath $ unSerialised pstate - -writeFilteredUTxOs :: Api.ShelleyBasedEra era - -> Maybe (File () Out) - -> UTxO era - -> ExceptT ShelleyQueryCmdError IO () -writeFilteredUTxOs shelleyBasedEra' mOutFile utxo = - case mOutFile of - Nothing -> liftIO $ printFilteredUTxOs shelleyBasedEra' utxo - Just (File fpath) -> - case shelleyBasedEra' of - ShelleyBasedEraShelley -> writeUTxo fpath utxo - ShelleyBasedEraAllegra -> writeUTxo fpath utxo - ShelleyBasedEraMary -> writeUTxo fpath utxo - ShelleyBasedEraAlonzo -> writeUTxo fpath utxo - ShelleyBasedEraBabbage -> writeUTxo fpath utxo - ShelleyBasedEraConway -> writeUTxo fpath utxo - where - writeUTxo fpath utxo' = - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) - $ LBS.writeFile fpath (encodePretty utxo') - -printFilteredUTxOs :: Api.ShelleyBasedEra era -> UTxO era -> IO () -printFilteredUTxOs shelleyBasedEra' (UTxO utxo) = do - Text.putStrLn title - putStrLn $ replicate (Text.length title + 2) '-' - case shelleyBasedEra' of - ShelleyBasedEraShelley -> - mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo - ShelleyBasedEraAllegra -> - mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo - ShelleyBasedEraMary -> - mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo - ShelleyBasedEraAlonzo -> - mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo - ShelleyBasedEraBabbage -> - mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo - ShelleyBasedEraConway -> - mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo - - where - title :: Text - title = - " TxHash TxIx Amount" - -printUtxo - :: Api.ShelleyBasedEra era - -> (TxIn, TxOut CtxUTxO era) - -> IO () -printUtxo shelleyBasedEra' txInOutTuple = - case shelleyBasedEra' of - ShelleyBasedEraShelley -> - let (TxIn (TxId txhash) (TxIx index), TxOut _ value _ _) = txInOutTuple - in Text.putStrLn $ - mconcat - [ Text.decodeLatin1 (hashToBytesAsHex txhash) - , textShowN 6 index - , " " <> printableValue value - ] - - ShelleyBasedEraAllegra -> - let (TxIn (TxId txhash) (TxIx index), TxOut _ value _ _) = txInOutTuple - in Text.putStrLn $ - mconcat - [ Text.decodeLatin1 (hashToBytesAsHex txhash) - , textShowN 6 index - , " " <> printableValue value - ] - ShelleyBasedEraMary -> - let (TxIn (TxId txhash) (TxIx index), TxOut _ value _ _) = txInOutTuple - in Text.putStrLn $ - mconcat - [ Text.decodeLatin1 (hashToBytesAsHex txhash) - , textShowN 6 index - , " " <> printableValue value - ] - ShelleyBasedEraAlonzo -> - let (TxIn (TxId txhash) (TxIx index), TxOut _ value mDatum _) = txInOutTuple - in Text.putStrLn $ - mconcat - [ Text.decodeLatin1 (hashToBytesAsHex txhash) - , textShowN 6 index - , " " <> printableValue value <> " + " <> Text.pack (show mDatum) - ] - ShelleyBasedEraBabbage -> - let (TxIn (TxId txhash) (TxIx index), TxOut _ value mDatum _) = txInOutTuple - in Text.putStrLn $ - mconcat - [ Text.decodeLatin1 (hashToBytesAsHex txhash) - , textShowN 6 index - , " " <> printableValue value <> " + " <> Text.pack (show mDatum) - ] - ShelleyBasedEraConway -> - let (TxIn (TxId txhash) (TxIx index), TxOut _ value mDatum _) = txInOutTuple - in Text.putStrLn $ - mconcat - [ Text.decodeLatin1 (hashToBytesAsHex txhash) - , textShowN 6 index - , " " <> printableValue value <> " + " <> Text.pack (show mDatum) - ] - where - textShowN :: Show a => Int -> a -> Text - textShowN len x = - let str = show x - slen = length str - in Text.pack $ replicate (max 1 (len - slen)) ' ' ++ str - - printableValue :: TxOutValue era -> Text - printableValue (TxOutValue _ val) = renderValue val - printableValue (TxOutAdaOnly _ (Lovelace i)) = Text.pack $ show i - -runQueryStakePools - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryStakePools socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - poolIds <- - ( lift $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT @ShelleyQueryCmdError $ do - anyE@(AnyCardanoEra era) <- case consensusModeOnly cModeParams of - ByronMode -> return $ AnyCardanoEra ByronEra - ShelleyMode -> return $ AnyCardanoEra ShelleyEra - CardanoMode -> - lift (queryExpr $ QueryCurrentEra CardanoModeIsMultiEra) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - - let cMode = consensusModeOnly cModeParams - - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - - sbe <- getSbe $ cardanoEraStyle era - - lift (queryExpr (QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryStakePools)) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdEraMismatch) - ) & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft left - - writeStakePools mOutFile poolIds - -writeStakePools - :: Maybe (File () Out) - -> Set PoolId - -> ExceptT ShelleyQueryCmdError IO () -writeStakePools (Just (File outFile)) stakePools = - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError outFile) $ - LBS.writeFile outFile (encodePretty stakePools) - -writeStakePools Nothing stakePools = - forM_ (Set.toList stakePools) $ \poolId -> - liftIO . putStrLn $ Text.unpack (serialiseToBech32 poolId) - -runQueryStakeDistribution - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryStakeDistribution socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let cMode = consensusModeOnly cModeParams - sbe <- getSbe $ cardanoEraStyle era - - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - - let query = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakeDistribution - - result <- executeQuery era cModeParams localNodeConnInfo query - - writeStakeDistribution mOutFile result - -writeStakeDistribution - :: Maybe (File () Out) - -> Map PoolId Rational - -> ExceptT ShelleyQueryCmdError IO () -writeStakeDistribution (Just (File outFile)) stakeDistrib = - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError outFile) $ - LBS.writeFile outFile (encodePretty stakeDistrib) - -writeStakeDistribution Nothing stakeDistrib = - liftIO $ printStakeDistribution stakeDistrib - - -printStakeDistribution :: Map PoolId Rational -> IO () -printStakeDistribution stakeDistrib = do - Text.putStrLn title - putStrLn $ replicate (Text.length title + 2) '-' - sequence_ - [ putStrLn $ showStakeDistr poolId stakeFraction - | (poolId, stakeFraction) <- Map.toList stakeDistrib ] - where - title :: Text - title = - " PoolId Stake frac" - - showStakeDistr :: PoolId - -> Rational - -- ^ Stake fraction - -> String - showStakeDistr poolId stakeFraction = - concat - [ Text.unpack (serialiseToBech32 poolId) - , " " - , showEFloat (Just 3) (fromRational stakeFraction :: Double) "" - ] - --- | A mapping of Shelley reward accounts to both the stake pool that they --- delegate to and their reward account balance. --- TODO: Move to cardano-api -newtype DelegationsAndRewards - = DelegationsAndRewards (Map StakeAddress Lovelace, Map StakeAddress PoolId) - deriving (Eq, Show) - - -mergeDelegsAndRewards :: DelegationsAndRewards -> [(StakeAddress, Maybe Lovelace, Maybe PoolId)] -mergeDelegsAndRewards (DelegationsAndRewards (rewardsMap, delegMap)) = - [ (stakeAddr, Map.lookup stakeAddr rewardsMap, Map.lookup stakeAddr delegMap) - | stakeAddr <- nub $ Map.keys rewardsMap ++ Map.keys delegMap - ] - - -instance ToJSON DelegationsAndRewards where - toJSON delegsAndRwds = - Aeson.Array . Vector.fromList - . map delegAndRwdToJson $ mergeDelegsAndRewards delegsAndRwds - where - delegAndRwdToJson :: (StakeAddress, Maybe Lovelace, Maybe PoolId) -> Aeson.Value - delegAndRwdToJson (addr, mRewards, mPoolId) = - Aeson.object - [ "address" .= addr - , "delegation" .= mPoolId - , "rewardAccountBalance" .= mRewards - ] - -instance FromJSON DelegationsAndRewards where - parseJSON = withArray "DelegationsAndRewards" $ \arr -> do - let vals = Vector.toList arr - decoded <- mapM decodeObject vals - pure $ zipper decoded - where - zipper :: [(StakeAddress, Maybe Lovelace, Maybe PoolId)] - -> DelegationsAndRewards - zipper l = do - let maps = [ ( maybe mempty (Map.singleton sa) delegAmt - , maybe mempty (Map.singleton sa) mPool - ) - | (sa, delegAmt, mPool) <- l - ] - DelegationsAndRewards - $ foldl - (\(amtA, delegA) (amtB, delegB) -> (amtA <> amtB, delegA <> delegB)) - (mempty, mempty) - maps - - decodeObject :: Aeson.Value - -> Aeson.Parser (StakeAddress, Maybe Lovelace, Maybe PoolId) - decodeObject = withObject "DelegationsAndRewards" $ \o -> do - address <- o .: "address" - delegation <- o .:? "delegation" - rewardAccountBalance <- o .:? "rewardAccountBalance" - pure (address, rewardAccountBalance, delegation) - -runQueryLeadershipSchedule - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> GenesisFile -- ^ Shelley genesis - -> VerificationKeyOrHashOrFile StakePoolKey - -> SigningKeyFile In -- ^ VRF signing key - -> EpochLeadershipSchedule - -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () -runQueryLeadershipSchedule - socketPath (AnyConsensusModeParams cModeParams) network - (GenesisFile genFile) coldVerKeyFile vrfSkeyFp - whichSchedule mJsonOutputFile = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - - anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - sbe <- getSbe (cardanoEraStyle era) - - let cMode = consensusModeOnly cModeParams - - poolid <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile) - & onLeft (left . ShelleyQueryCmdTextReadError) - - vrkSkey <- lift (readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp) - & onLeft (left . ShelleyQueryCmdTextEnvelopeReadError) - - shelleyGenesis <- lift (readAndDecodeShelleyGenesis genFile) - & onLeft (left . ShelleyQueryCmdGenesisReadError) - - case cMode of - CardanoMode -> do - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - - let pparamsQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryProtocolParameters - ptclStateQuery = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryProtocolState - eraHistoryQuery = QueryEraHistory CardanoModeIsMultiEra - - pparams <- executeQuery era cModeParams localNodeConnInfo pparamsQuery - ptclState <- executeQuery era cModeParams localNodeConnInfo ptclStateQuery - eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - - let eInfo = toEpochInfo eraHistory - let currentEpochQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryEpoch - curentEpoch <- executeQuery era cModeParams localNodeConnInfo currentEpochQuery - - bpp <- hoistEither . first ShelleyQueryCmdProtocolParameterConversionError $ - bundleProtocolParams era pparams - - schedule <- case whichSchedule of - CurrentEpoch -> do - serCurrentEpochState <- executeQuery era cModeParams localNodeConnInfo $ - QueryInEra eInMode $ QueryInShelleyBasedEra sbe (QueryPoolDistribution (Just (Set.singleton poolid))) - firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither - $ eligibleLeaderSlotsConstaints sbe - $ currentEpochEligibleLeadershipSlots - sbe - shelleyGenesis - eInfo - bpp - ptclState - poolid - vrkSkey - serCurrentEpochState - curentEpoch - - NextEpoch -> do - let currentEpochStateQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryCurrentEpochState - - tip <- liftIO $ getLocalChainTip localNodeConnInfo - serCurrentEpochState <- executeQuery era cModeParams localNodeConnInfo currentEpochStateQuery - - firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither - $ eligibleLeaderSlotsConstaints sbe - $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis - serCurrentEpochState ptclState poolid vrkSkey bpp - eInfo (tip, curentEpoch) - - case mJsonOutputFile of - Nothing -> liftIO $ printLeadershipScheduleAsText schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) - Just (File jsonOutputFile) -> - liftIO $ LBS.writeFile jsonOutputFile $ - printLeadershipScheduleAsJson schedule eInfo (SystemStart $ sgSystemStart shelleyGenesis) - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode - where - printLeadershipScheduleAsText - :: Set SlotNo - -> EpochInfo (Either Text) - -> SystemStart - -> IO () - printLeadershipScheduleAsText leadershipSlots eInfo sStart = do - Text.putStrLn title - putStrLn $ replicate (Text.length title + 2) '-' - sequence_ - [ putStrLn $ showLeadershipSlot slot eInfo sStart - | slot <- Set.toList leadershipSlots ] - where - title :: Text - title = - " SlotNo UTC Time " - - showLeadershipSlot - :: SlotNo - -> EpochInfo (Either Text) - -> SystemStart - -> String - showLeadershipSlot lSlot@(SlotNo sn) eInfo' sStart' = - case epochInfoSlotToUTCTime eInfo' sStart' lSlot of - Right slotTime -> - concat - [ " " - , show sn - , " " - , show slotTime - ] - Left err -> - concat - [ " " - , show sn - , " " - , Text.unpack err - ] - printLeadershipScheduleAsJson - :: Set SlotNo - -> EpochInfo (Either Text) - -> SystemStart - -> LBS.ByteString - printLeadershipScheduleAsJson leadershipSlots eInfo sStart = - encodePretty $ showLeadershipSlot <$> List.sort (Set.toList leadershipSlots) - where - showLeadershipSlot :: SlotNo -> Aeson.Value - showLeadershipSlot lSlot@(SlotNo sn) = - case epochInfoSlotToUTCTime eInfo sStart lSlot of - Right slotTime -> - Aeson.object - [ "slotNumber" Aeson..= sn - , "slotTime" Aeson..= slotTime - ] - Left err -> - Aeson.object - [ "slotNumber" Aeson..= sn - , "error" Aeson..= Text.unpack err - ] - - --- Helpers - -calcEraInMode - :: CardanoEra era - -> ConsensusMode mode - -> ExceptT ShelleyQueryCmdError IO (EraInMode era mode) -calcEraInMode era mode = - pure (toEraInMode era mode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode mode) (anyCardanoEra era))) - -executeQuery - :: forall result era mode. CardanoEra era - -> ConsensusModeParams mode - -> LocalNodeConnectInfo mode - -> QueryInMode mode (Either EraMismatch result) - -> ExceptT ShelleyQueryCmdError IO result -executeQuery era cModeP localNodeConnInfo q = do - eraInMode <- calcEraInMode era $ consensusModeOnly cModeP - case eraInMode of - ByronEraInByronMode -> left ShelleyQueryCmdByronEra - _ -> liftIO execQuery >>= queryResult - where - execQuery :: IO (Either AcquiringFailure (Either EraMismatch result)) - execQuery = queryNodeLocalState localNodeConnInfo Nothing q - -getSbe :: Monad m => CardanoEraStyle era -> ExceptT ShelleyQueryCmdError m (Api.ShelleyBasedEra era) -getSbe LegacyByronEra = left ShelleyQueryCmdByronEra -getSbe (Api.ShelleyBasedEra sbe) = return sbe - -queryResult - :: Either AcquiringFailure (Either EraMismatch a) - -> ExceptT ShelleyQueryCmdError IO a -queryResult eAcq = pure eAcq - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - -toEpochInfo :: EraHistory CardanoMode -> EpochInfo (Either Text) -toEpochInfo (EraHistory _ interpreter) = - hoistEpochInfo (first (Text.pack . show) . runExcept) - $ Consensus.interpreterToEpochInfo interpreter - --- | A value that is tentative or produces a tentative value if used. These values --- are considered accurate only if some future event such as a hard fork does not --- render them invalid. -newtype Tentative a = Tentative { tentative :: a } deriving (Eq, Show) - --- | Get an Epoch Info that computes tentative values. The values computed are --- tentative because it uses an interpreter that is extended past the horizon. --- This interpreter will compute accurate values into the future as long as a --- a hard fork does not happen in the intervening time. Those values are thus --- "tentative" because they can change in the event of a hard fork. -toTentativeEpochInfo :: EraHistory CardanoMode -> Tentative (EpochInfo (Either Text)) -toTentativeEpochInfo (EraHistory _ interpreter) = - Tentative - $ hoistEpochInfo (first (Text.pack . show) . runExcept) - $ Consensus.interpreterToEpochInfo (Consensus.unsafeExtendSafeZone interpreter) - - --- | Get slot number for timestamp, or an error if the UTC timestamp is before 'SystemStart' or after N+1 era -utcTimeToSlotNo - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> UTCTime - -> ExceptT ShelleyQueryCmdError IO SlotNo -utcTimeToSlotNo socketPath (AnyConsensusModeParams cModeParams) network utcTime = do - let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - case consensusModeOnly cModeParams of - CardanoMode -> do - (systemStart, eraHistory) <- executeLocalStateQueryExpr' localNodeConnInfo $ - (,) <$> queryExpr' QuerySystemStart - <*> queryExpr' (QueryEraHistory CardanoModeIsMultiEra) - let relTime = toRelativeTime systemStart utcTime - hoistEither $ Api.getSlotForRelativeTime relTime eraHistory & first ShelleyQueryCmdPastHorizon - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode - where - executeLocalStateQueryExpr' - :: LocalNodeConnectInfo mode - -> ExceptT ShelleyQueryCmdError (LocalStateQueryExpr (BlockInMode mode) ChainPoint (QueryInMode mode) () IO) a - -> ExceptT ShelleyQueryCmdError IO a - executeLocalStateQueryExpr' localNodeConnInfo = - ExceptT - . fmap (join . first ShelleyQueryCmdAcquireFailure) - . executeLocalStateQueryExpr localNodeConnInfo Nothing - . runExceptT - - queryExpr' - :: QueryInMode mode a - -> ExceptT ShelleyQueryCmdError (LocalStateQueryExpr block point (QueryInMode mode) r IO) a - queryExpr' = withExceptT ShelleyQueryCmdUnsupportedNtcVersion . ExceptT . queryExpr - - -obtainLedgerEraClassConstraints - :: ShelleyLedgerEra era ~ ledgerera - => Api.ShelleyBasedEra era - -> (( ToJSON (DebugLedgerState era) - , FromCBOR (DebugLedgerState era) - , Core.EraCrypto ledgerera ~ StandardCrypto - , Core.Era (ShelleyLedgerEra era) - ) => a) -> a -obtainLedgerEraClassConstraints ShelleyBasedEraShelley f = f -obtainLedgerEraClassConstraints ShelleyBasedEraAllegra f = f -obtainLedgerEraClassConstraints ShelleyBasedEraMary f = f -obtainLedgerEraClassConstraints ShelleyBasedEraAlonzo f = f -obtainLedgerEraClassConstraints ShelleyBasedEraBabbage f = f -obtainLedgerEraClassConstraints ShelleyBasedEraConway f = f - - -eligibleLeaderSlotsConstaints - :: ShelleyLedgerEra era ~ ledgerera - => ShelleyBasedEra era - -> (( ShelleyLedgerEra era ~ ledgerera - , Core.EraCrypto ledgerera ~ StandardCrypto - , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) - , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) - , Core.Era ledgerera - , Crypto.Signable (Crypto.VRF (Core.EraCrypto ledgerera)) Seed - , Crypto.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224 - , HashAnnotated - (Core.TxBody (ShelleyLedgerEra era)) - Core.EraIndependentTxBody - StandardCrypto - ) => a - ) - -> a -eligibleLeaderSlotsConstaints ShelleyBasedEraShelley f = f -eligibleLeaderSlotsConstaints ShelleyBasedEraAllegra f = f -eligibleLeaderSlotsConstaints ShelleyBasedEraMary f = f -eligibleLeaderSlotsConstaints ShelleyBasedEraAlonzo f = f -eligibleLeaderSlotsConstaints ShelleyBasedEraBabbage f = f -eligibleLeaderSlotsConstaints ShelleyBasedEraConway f = f - -eligibleWriteProtocolStateConstaints - :: ShelleyBasedEra era - -> (( FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) - , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) - ) => a - ) - -> a -eligibleWriteProtocolStateConstaints ShelleyBasedEraShelley f = f -eligibleWriteProtocolStateConstaints ShelleyBasedEraAllegra f = f -eligibleWriteProtocolStateConstaints ShelleyBasedEraMary f = f -eligibleWriteProtocolStateConstaints ShelleyBasedEraAlonzo f = f -eligibleWriteProtocolStateConstaints ShelleyBasedEraBabbage f = f -eligibleWriteProtocolStateConstaints ShelleyBasedEraConway f = f - --- Required instances --- instance FromCBOR (TPraosState StandardCrypto) where --- instance FromCBOR (Praos.PraosState StandardCrypto) where diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs deleted file mode 100644 index ab489324649..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs +++ /dev/null @@ -1,839 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Cardano.CLI.Shelley.Run.Read - ( -- * Metadata - MetadataError(..) - , renderMetadataError - , readFileTxMetadata - , readTxMetadata - - -- * Script - , ScriptWitnessError(..) - , renderScriptWitnessError - , readScriptDataOrFile - , readScriptWitness - , readScriptWitnessFiles - , readScriptWitnessFilesThruple - , ScriptDecodeError (..) - , deserialiseScriptInAnyLang - , readFileScriptInAnyLang - - -- * Script data (datums and redeemers) - , ScriptDataError(..) - , readScriptDatumOrFile - , readScriptRedeemerOrFile - , renderScriptDataError - - -- * Tx - , CddlError - , CddlTx(..) - , IncompleteTx(..) - , readFileTx - , readFileTxBody - , readCddlTx -- For testing purposes - - -- * Tx witnesses - , ReadWitnessSigningDataError(..) - , renderReadWitnessSigningDataError - , SomeWitness(..) - , ByronOrShelleyWitness(..) - , ShelleyBootstrapWitnessSigningKeyData(..) - , CddlWitnessError(..) - , readFileTxKeyWitness - , readWitnessSigningData - - -- * Required signer - , RequiredSignerError(..) - , categoriseSomeWitness - , readRequiredSigner - - -- * FileOrPipe - , FileOrPipe - , fileOrPipe - , fileOrPipePath - , fileOrPipeCache - , readFileOrPipe - ) where - -import Prelude - -import Cardano.Api -import Cardano.Api.Shelley - -import Control.Exception (bracket) -import Control.Monad (unless) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, - newExceptT) -import qualified Data.Aeson as Aeson -import Data.Bifunctor (first) -import qualified Data.ByteString.Builder as Builder -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import qualified Data.List as List -import qualified Data.Text as Text -import Data.Word -import GHC.IO.Handle (hClose, hIsSeekable) -import GHC.IO.Handle.FD (openFileBlocking) -import System.IO (IOMode (ReadMode)) - ---TODO: do this nicely via the API too: -import qualified Cardano.Binary as CBOR -import Data.Text (Text) - -import Cardano.CLI.Shelley.Parsers -import Cardano.CLI.Types - --- Metadata - -data MetadataError - = MetadataErrorFile (FileError ()) - | MetadataErrorJsonParseError !FilePath !String - | MetadataErrorConversionError !FilePath !TxMetadataJsonError - | MetadataErrorValidationError !FilePath ![(Word64, TxMetadataRangeError)] - | MetadataErrorDecodeError !FilePath !CBOR.DecoderError - | MetadataErrorNotAvailableInEra AnyCardanoEra - deriving Show - -renderMetadataError :: MetadataError -> Text -renderMetadataError (MetadataErrorFile fileErr) = - Text.pack $ displayError fileErr -renderMetadataError (MetadataErrorJsonParseError fp jsonErr) = - Text.pack $ "Invalid JSON format in file: " <> show fp <> - "\nJSON parse error: " <> jsonErr -renderMetadataError (MetadataErrorConversionError fp metadataErr) = - Text.pack $ "Error reading metadata at: " <> show fp <> - "\n" <> displayError metadataErr -renderMetadataError (MetadataErrorValidationError fp errs) = - Text.pack $ "Error validating transaction metadata at: " <> fp <> "\n" <> - List.intercalate "\n" - [ "key " <> show k <> ":" <> displayError valErr - | (k, valErr) <- errs ] -renderMetadataError (MetadataErrorDecodeError fp metadataErr) = - Text.pack $ "Error decoding CBOR metadata at: " <> show fp <> - " Error: " <> show metadataErr -renderMetadataError (MetadataErrorNotAvailableInEra e) = - "Transaction metadata not supported in " <> renderEra e - -readTxMetadata :: CardanoEra era - -> TxMetadataJsonSchema - -> [MetadataFile] - -> IO (Either MetadataError (TxMetadataInEra era)) -readTxMetadata _ _ [] = return $ Right TxMetadataNone -readTxMetadata era' schema files = - case txMetadataSupportedInEra era' of - Nothing -> - return . Left - . MetadataErrorNotAvailableInEra - $ getIsCardanoEraConstraint era' $ AnyCardanoEra era' - Just supported -> do - let exceptAllTxMetadata = mapM (readFileTxMetadata schema) files - eAllTxMetaData <- runExceptT exceptAllTxMetadata - return $ do - metaData <- eAllTxMetaData - Right $ TxMetadataInEra supported $ mconcat metaData - -readFileTxMetadata - :: TxMetadataJsonSchema - -> MetadataFile - -> ExceptT MetadataError IO TxMetadata -readFileTxMetadata mapping (MetadataFileJSON fp) = do - bs <- handleIOExceptT (MetadataErrorFile . FileIOError (unFile fp)) - $ LBS.readFile (unFile fp) - v <- firstExceptT (MetadataErrorJsonParseError (unFile fp)) - $ hoistEither $ Aeson.eitherDecode' bs - txMetadata' <- firstExceptT (MetadataErrorConversionError (unFile fp)) - . hoistEither $ metadataFromJson mapping v - firstExceptT (MetadataErrorValidationError (unFile fp)) - . hoistEither $ do - validateTxMetadata txMetadata' - return txMetadata' -readFileTxMetadata _ (MetadataFileCBOR fp) = do - bs <- handleIOExceptT (MetadataErrorFile . FileIOError (unFile fp)) - $ BS.readFile (unFile fp) - txMetadata' <- firstExceptT (MetadataErrorDecodeError (unFile fp)) - . hoistEither $ deserialiseFromCBOR AsTxMetadata bs - firstExceptT (MetadataErrorValidationError (unFile fp)) - . hoistEither $ do - validateTxMetadata txMetadata' - return txMetadata' - --- Script witnesses/ Scripts - -data ScriptWitnessError - = ScriptWitnessErrorFile (FileError ScriptDecodeError) - | ScriptWitnessErrorScriptLanguageNotSupportedInEra AnyScriptLanguage AnyCardanoEra - | ScriptWitnessErrorExpectedSimple !FilePath !AnyScriptLanguage - | ScriptWitnessErrorExpectedPlutus !FilePath !AnyScriptLanguage - | ScriptWitnessErrorReferenceScriptsNotSupportedInEra !AnyCardanoEra - | ScriptWitnessErrorScriptData ScriptDataError - -renderScriptWitnessError :: ScriptWitnessError -> Text -renderScriptWitnessError (ScriptWitnessErrorFile err) = - Text.pack $ displayError err -renderScriptWitnessError (ScriptWitnessErrorScriptLanguageNotSupportedInEra (AnyScriptLanguage lang) anyEra) = - "The script language " <> Text.pack (show lang) <> " is not supported in the " <> - renderEra anyEra <> " era." -renderScriptWitnessError (ScriptWitnessErrorExpectedSimple file (AnyScriptLanguage lang)) = - Text.pack $ file <> ": expected a script in the simple script language, " <> - "but it is actually using " <> show lang <> ". Alternatively, to use " <> - "a Plutus script, you must also specify the redeemer " <> - "(datum if appropriate) and script execution units." -renderScriptWitnessError (ScriptWitnessErrorExpectedPlutus file (AnyScriptLanguage lang)) = - Text.pack $ file <> ": expected a script in the Plutus script language, " <> - "but it is actually using " <> show lang <> "." -renderScriptWitnessError (ScriptWitnessErrorReferenceScriptsNotSupportedInEra anyEra) = - "Reference scripts not supported in era': " <> renderEra anyEra -renderScriptWitnessError (ScriptWitnessErrorScriptData sDataError) = - renderScriptDataError sDataError - -readScriptWitnessFiles - :: CardanoEra era - -> [(a, Maybe (ScriptWitnessFiles ctx))] - -> ExceptT ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))] -readScriptWitnessFiles era' = mapM readSwitFile - where - readSwitFile (tIn, Just switFile) = do - sWit <- readScriptWitness era' switFile - return (tIn, Just sWit) - readSwitFile (tIn, Nothing) = return (tIn, Nothing) - -readScriptWitnessFilesThruple - :: CardanoEra era - -> [(a, b, Maybe (ScriptWitnessFiles ctx))] - -> ExceptT ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))] -readScriptWitnessFilesThruple era' = mapM readSwitFile - where - readSwitFile (tIn, b, Just switFile) = do - sWit <- readScriptWitness era' switFile - return (tIn, b, Just sWit) - readSwitFile (tIn, b, Nothing) = return (tIn, b, Nothing) - -readScriptWitness - :: CardanoEra era - -> ScriptWitnessFiles witctx - -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era) -readScriptWitness era' (SimpleScriptWitnessFile (ScriptFile scriptFile)) = do - script@(ScriptInAnyLang lang _) <- firstExceptT ScriptWitnessErrorFile $ - readFileScriptInAnyLang scriptFile - ScriptInEra langInEra script' <- validateScriptSupportedInEra era' script - case script' of - SimpleScript sscript -> - return . SimpleScriptWitness langInEra $ SScript sscript - - -- If the supplied cli flags were for a simple script (i.e. the user did - -- not supply the datum, redeemer or ex units), but the script file turns - -- out to be a valid plutus script, then we must fail. - PlutusScript{} -> - left $ ScriptWitnessErrorExpectedSimple - scriptFile - (AnyScriptLanguage lang) - -readScriptWitness era' (PlutusScriptWitnessFiles - (ScriptFile scriptFile) - datumOrFile - redeemerOrFile - execUnits) = do - script@(ScriptInAnyLang lang _) <- firstExceptT ScriptWitnessErrorFile $ - readFileScriptInAnyLang scriptFile - ScriptInEra langInEra script' <- validateScriptSupportedInEra era' script - case script' of - PlutusScript version pscript -> do - datum <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptDatumOrFile datumOrFile - redeemer <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptRedeemerOrFile redeemerOrFile - return $ PlutusScriptWitness - langInEra version (PScript pscript) - datum - redeemer - execUnits - - -- If the supplied cli flags were for a plutus script (i.e. the user did - -- supply the datum, redeemer and ex units), but the script file turns - -- out to be a valid simple script, then we must fail. - SimpleScript{} -> - left $ ScriptWitnessErrorExpectedPlutus - scriptFile - (AnyScriptLanguage lang) - -readScriptWitness era' (PlutusReferenceScriptWitnessFiles refTxIn - anyScrLang@(AnyScriptLanguage anyScriptLanguage) - datumOrFile redeemerOrFile execUnits mPid) = do - case refInsScriptsAndInlineDatsSupportedInEra era' of - Nothing -> left $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra - $ getIsCardanoEraConstraint era' (AnyCardanoEra era') - Just _ -> do - - case scriptLanguageSupportedInEra era' anyScriptLanguage of - Just sLangInEra -> - case languageOfScriptLanguageInEra sLangInEra of - SimpleScriptLanguage -> - -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang - -- in order to make this branch unrepresentable. - error "readScriptWitness: Should not be possible to specify a simple script" - PlutusScriptLanguage version -> do - datum <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptDatumOrFile datumOrFile - redeemer <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptRedeemerOrFile redeemerOrFile - return $ PlutusScriptWitness - sLangInEra - version - (PReferenceScript refTxIn (unPolicyId <$> mPid)) - datum redeemer execUnits - Nothing -> - left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era') -readScriptWitness era' (SimpleReferenceScriptWitnessFiles refTxIn - anyScrLang@(AnyScriptLanguage anyScriptLanguage) mPid) = do - case refInsScriptsAndInlineDatsSupportedInEra era' of - Nothing -> left $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra - $ getIsCardanoEraConstraint era' (AnyCardanoEra era') - Just _ -> do - case scriptLanguageSupportedInEra era' anyScriptLanguage of - Just sLangInEra -> - case languageOfScriptLanguageInEra sLangInEra of - SimpleScriptLanguage -> - return . SimpleScriptWitness sLangInEra - $ SReferenceScript refTxIn (unPolicyId <$> mPid) - PlutusScriptLanguage{} -> - error "readScriptWitness: Should not be possible to specify a plutus script" - Nothing -> - left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era') - -validateScriptSupportedInEra :: CardanoEra era - -> ScriptInAnyLang - -> ExceptT ScriptWitnessError IO (ScriptInEra era) -validateScriptSupportedInEra era' script@(ScriptInAnyLang lang _) = - case toScriptInEra era' script of - Nothing -> left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra - (AnyScriptLanguage lang) (anyCardanoEra era') - Just script' -> pure script' - -data ScriptDataError = - ScriptDataErrorFile (FileError ()) - | ScriptDataErrorJsonParse !FilePath !String - | ScriptDataErrorConversion !FilePath !ScriptDataJsonError - | ScriptDataErrorValidation !FilePath !ScriptDataRangeError - | ScriptDataErrorMetadataDecode !FilePath !CBOR.DecoderError - | ScriptDataErrorJsonBytes !ScriptDataJsonBytesError - -renderScriptDataError :: ScriptDataError -> Text -renderScriptDataError (ScriptDataErrorFile err) = - Text.pack $ displayError err -renderScriptDataError (ScriptDataErrorJsonParse fp jsonErr) = - Text.pack $ "Invalid JSON format in file: " <> show fp <> - "\nJSON parse error: " <> jsonErr -renderScriptDataError (ScriptDataErrorConversion fp sDataJsonErr) = - Text.pack $ "Error reading metadata at: " <> show fp <> - "\n" <> displayError sDataJsonErr -renderScriptDataError (ScriptDataErrorValidation fp sDataRangeErr) = - Text.pack $ "Error validating script data at: " <> show fp <> ":\n" <> - displayError sDataRangeErr -renderScriptDataError (ScriptDataErrorMetadataDecode fp decoderErr) = - Text.pack $ "Error decoding CBOR metadata at: " <> show fp <> - " Error: " <> show decoderErr -renderScriptDataError (ScriptDataErrorJsonBytes e) = - Text.pack $ displayError e - - -readScriptDatumOrFile :: ScriptDatumOrFile witctx - -> ExceptT ScriptDataError IO (ScriptDatum witctx) -readScriptDatumOrFile (ScriptDatumOrFileForTxIn df) = ScriptDatumForTxIn <$> - readScriptDataOrFile df -readScriptDatumOrFile InlineDatumPresentAtTxIn = pure InlineScriptDatum -readScriptDatumOrFile NoScriptDatumOrFileForMint = pure NoScriptDatumForMint -readScriptDatumOrFile NoScriptDatumOrFileForStake = pure NoScriptDatumForStake - -readScriptRedeemerOrFile :: ScriptRedeemerOrFile - -> ExceptT ScriptDataError IO ScriptRedeemer -readScriptRedeemerOrFile = readScriptDataOrFile - -readScriptDataOrFile :: ScriptDataOrFile - -> ExceptT ScriptDataError IO HashableScriptData -readScriptDataOrFile (ScriptDataValue d) = return d -readScriptDataOrFile (ScriptDataJsonFile fp) = do - sDataBs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) $ LBS.readFile fp - sDataValue <- hoistEither . first (ScriptDataErrorJsonParse fp) $ Aeson.eitherDecode sDataBs - hoistEither - . first ScriptDataErrorJsonBytes - $ scriptDataJsonToHashable ScriptDataJsonDetailedSchema sDataValue - -readScriptDataOrFile (ScriptDataCborFile fp) = do - origBs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) (BS.readFile fp) - hSd <- firstExceptT (ScriptDataErrorMetadataDecode fp) - $ hoistEither $ deserialiseFromCBOR AsHashableScriptData origBs - firstExceptT (ScriptDataErrorValidation fp) - $ hoistEither $ validateScriptData $ getScriptData hSd - return hSd - - --- --- Handling decoding the variety of script languages and formats --- - -data ScriptDecodeError = - ScriptDecodeTextEnvelopeError TextEnvelopeError - | ScriptDecodeSimpleScriptError JsonDecodeError - deriving Show - -instance Error ScriptDecodeError where - displayError (ScriptDecodeTextEnvelopeError err) = - "Error decoding script: " ++ displayError err - displayError (ScriptDecodeSimpleScriptError err) = - "Syntax error in script: " ++ displayError err - - --- | Read a script file. The file can either be in the text envelope format --- wrapping the binary representation of any of the supported script languages, --- or alternatively it can be a JSON format file for one of the simple script --- language versions. --- -readFileScriptInAnyLang :: FilePath - -> ExceptT (FileError ScriptDecodeError) IO - ScriptInAnyLang -readFileScriptInAnyLang file = do - scriptBytes <- handleIOExceptT (FileIOError file) $ BS.readFile file - firstExceptT (FileError file) $ hoistEither $ - deserialiseScriptInAnyLang scriptBytes - - -deserialiseScriptInAnyLang :: BS.ByteString - -> Either ScriptDecodeError ScriptInAnyLang -deserialiseScriptInAnyLang bs = - -- Accept either the text envelope format wrapping the binary serialisation, - -- or accept the simple script language in its JSON format. - -- - case deserialiseFromJSON AsTextEnvelope bs of - Left _ -> - -- In addition to the TextEnvelope format, we also try to - -- deserialize the JSON representation of SimpleScripts. - case Aeson.eitherDecodeStrict' bs of - Left err -> Left (ScriptDecodeSimpleScriptError $ JsonDecodeError err) - Right script -> Right $ ScriptInAnyLang SimpleScriptLanguage $ SimpleScript script - - Right te -> - case deserialiseFromTextEnvelopeAnyOf textEnvTypes te of - Left err -> Left (ScriptDecodeTextEnvelopeError err) - Right script -> Right script - - where - -- TODO: Think of a way to get type checker to warn when there is a missing - -- script version. - textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang] - textEnvTypes = - [ FromSomeType (AsScript AsSimpleScript) - (ScriptInAnyLang SimpleScriptLanguage) - - , FromSomeType (AsScript AsPlutusScriptV1) - (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV1)) - - , FromSomeType (AsScript AsPlutusScriptV2) - (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV2)) - ] - --- Tx & TxBody - -newtype CddlTx = CddlTx {unCddlTx :: InAnyCardanoEra Tx} deriving (Show, Eq) - -readFileTx :: FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx)) -readFileTx file = do - eAnyTx <- readFileInAnyCardanoEra AsTx file - case eAnyTx of - Left e -> fmap unCddlTx <$> acceptTxCDDLSerialisation file e - Right tx -> return $ Right tx - --- IncompleteCddlFormattedTx is an CDDL formatted tx or partial tx --- (respectively needs additional witnesses or totally unwitnessed) --- while UnwitnessedCliFormattedTxBody is CLI formatted TxBody and --- needs to be key witnessed. - -data IncompleteTx - = UnwitnessedCliFormattedTxBody (InAnyCardanoEra TxBody) - | IncompleteCddlFormattedTx (InAnyCardanoEra Tx) - -readFileTxBody :: FileOrPipe -> IO (Either CddlError IncompleteTx) -readFileTxBody file = do - eTxBody <- readFileInAnyCardanoEra AsTxBody file - case eTxBody of - Left e -> fmap (IncompleteCddlFormattedTx . unCddlTx) <$> acceptTxCDDLSerialisation file e - Right txBody -> return $ Right $ UnwitnessedCliFormattedTxBody txBody - -data CddlError = CddlErrorTextEnv - !(FileError TextEnvelopeError) - !(FileError TextEnvelopeCddlError) - | CddlIOError (FileError TextEnvelopeError) - deriving Show - -instance Error CddlError where - displayError (CddlErrorTextEnv textEnvErr cddlErr) = - "Failed to decode neither the cli's serialisation format nor the ledger's \ - \CDDL serialisation format. TextEnvelope error: " <> displayError textEnvErr <> "\n" <> - "TextEnvelopeCddl error: " <> displayError cddlErr - displayError (CddlIOError e) = displayError e - -acceptTxCDDLSerialisation - :: FileOrPipe - -> FileError TextEnvelopeError - -> IO (Either CddlError CddlTx) -acceptTxCDDLSerialisation file err = - case err of - e@(FileError _ (TextEnvelopeDecodeError _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx file - e@(FileError _ (TextEnvelopeAesonDecodeError _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx file - e@(FileError _ (TextEnvelopeTypeError _ _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx file - e@FileErrorTempFile{} -> return . Left $ CddlIOError e - e@FileIOError{} -> return . Left $ CddlIOError e - -readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx) -readCddlTx = readFileOrPipeTextEnvelopeCddlAnyOf teTypes - where - teTypes = [ FromCDDLTx "Witnessed Tx ByronEra" CddlTx - , FromCDDLTx "Witnessed Tx ShelleyEra" CddlTx - , FromCDDLTx "Witnessed Tx AllegraEra" CddlTx - , FromCDDLTx "Witnessed Tx MaryEra" CddlTx - , FromCDDLTx "Witnessed Tx AlonzoEra" CddlTx - , FromCDDLTx "Witnessed Tx BabbageEra" CddlTx - , FromCDDLTx "Unwitnessed Tx ByronEra" CddlTx - , FromCDDLTx "Unwitnessed Tx ShelleyEra" CddlTx - , FromCDDLTx "Unwitnessed Tx AllegraEra" CddlTx - , FromCDDLTx "Unwitnessed Tx MaryEra" CddlTx - , FromCDDLTx "Unwitnessed Tx AlonzoEra" CddlTx - , FromCDDLTx "Unwitnessed Tx BabbageEra" CddlTx - ] - --- Tx witnesses - -newtype CddlWitness = CddlWitness { unCddlWitness :: InAnyCardanoEra KeyWitness} - -readFileTxKeyWitness :: FilePath - -> IO (Either CddlWitnessError (InAnyCardanoEra KeyWitness)) -readFileTxKeyWitness fp = do - file <- fileOrPipe fp - eWitness <- readFileInAnyCardanoEra AsKeyWitness file - case eWitness of - Left e -> fmap unCddlWitness <$> acceptKeyWitnessCDDLSerialisation e - Right keyWit -> return $ Right keyWit - -data CddlWitnessError - = CddlWitnessErrorTextEnv - (FileError TextEnvelopeError) - (FileError TextEnvelopeCddlError) - | CddlWitnessIOError (FileError TextEnvelopeError) - deriving Show - -instance Error CddlWitnessError where - displayError (CddlWitnessErrorTextEnv teErr cddlErr) = - "Failed to decode neither the cli's serialisation format nor the ledger's \ - \CDDL serialisation format. TextEnvelope error: " <> displayError teErr <> "\n" <> - "TextEnvelopeCddl error: " <> displayError cddlErr - displayError (CddlWitnessIOError fileE) = displayError fileE - - --- TODO: This is a stop gap to avoid modifying the TextEnvelope --- related functions. We intend to remove this after fully deprecating --- the cli's serialisation format -acceptKeyWitnessCDDLSerialisation - :: FileError TextEnvelopeError - -> IO (Either CddlWitnessError CddlWitness) -acceptKeyWitnessCDDLSerialisation err = - case err of - e@(FileError fp (TextEnvelopeDecodeError _)) -> - first (CddlWitnessErrorTextEnv e) <$> readCddlWitness fp - e@(FileError fp (TextEnvelopeAesonDecodeError _)) -> - first (CddlWitnessErrorTextEnv e) <$> readCddlWitness fp - e@(FileError fp (TextEnvelopeTypeError _ _)) -> - first (CddlWitnessErrorTextEnv e) <$> readCddlWitness fp - e@FileErrorTempFile{} -> return . Left $ CddlWitnessIOError e - e@FileIOError{} -> return . Left $ CddlWitnessIOError e - -readCddlWitness - :: FilePath - -> IO (Either (FileError TextEnvelopeCddlError) CddlWitness) -readCddlWitness fp = do - readFileTextEnvelopeCddlAnyOf teTypes fp - where - teTypes = [ FromCDDLWitness "TxWitness ShelleyEra" CddlWitness - , FromCDDLWitness "TxWitness AllegraEra" CddlWitness - , FromCDDLWitness "TxWitness MaryEra" CddlWitness - , FromCDDLWitness "TxWitness AlonzoEra" CddlWitness - , FromCDDLWitness "TxWitness BabbageEra" CddlWitness - ] - --- Witness handling - -data SomeWitness - = AByronSigningKey (SigningKey ByronKey) (Maybe (Address ByronAddr)) - | APaymentSigningKey (SigningKey PaymentKey) - | APaymentExtendedSigningKey (SigningKey PaymentExtendedKey) - | AStakeSigningKey (SigningKey StakeKey) - | AStakeExtendedSigningKey (SigningKey StakeExtendedKey) - | AStakePoolSigningKey (SigningKey StakePoolKey) - | AGenesisSigningKey (SigningKey GenesisKey) - | AGenesisExtendedSigningKey (SigningKey GenesisExtendedKey) - | AGenesisDelegateSigningKey (SigningKey GenesisDelegateKey) - | AGenesisDelegateExtendedSigningKey - (SigningKey GenesisDelegateExtendedKey) - | AGenesisUTxOSigningKey (SigningKey GenesisUTxOKey) - - --- | Data required for constructing a Shelley bootstrap witness. -data ShelleyBootstrapWitnessSigningKeyData - = ShelleyBootstrapWitnessSigningKeyData - !(SigningKey ByronKey) - -- ^ Byron signing key. - !(Maybe (Address ByronAddr)) - -- ^ An optionally specified Byron address. - -- - -- If specified, both the network ID and derivation path are extracted - -- from the address and used in the construction of the Byron witness. - --- | Some kind of Byron or Shelley witness. -data ByronOrShelleyWitness - = AByronWitness !ShelleyBootstrapWitnessSigningKeyData - | AShelleyKeyWitness !ShelleyWitnessSigningKey - -categoriseSomeWitness :: SomeWitness -> ByronOrShelleyWitness -categoriseSomeWitness swsk = - case swsk of - AByronSigningKey sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) - APaymentSigningKey sk -> AShelleyKeyWitness (WitnessPaymentKey sk) - APaymentExtendedSigningKey sk -> AShelleyKeyWitness (WitnessPaymentExtendedKey sk) - AStakeSigningKey sk -> AShelleyKeyWitness (WitnessStakeKey sk) - AStakeExtendedSigningKey sk -> AShelleyKeyWitness (WitnessStakeExtendedKey sk) - AStakePoolSigningKey sk -> AShelleyKeyWitness (WitnessStakePoolKey sk) - AGenesisSigningKey sk -> AShelleyKeyWitness (WitnessGenesisKey sk) - AGenesisExtendedSigningKey sk -> AShelleyKeyWitness (WitnessGenesisExtendedKey sk) - AGenesisDelegateSigningKey sk -> AShelleyKeyWitness (WitnessGenesisDelegateKey sk) - AGenesisDelegateExtendedSigningKey sk - -> AShelleyKeyWitness (WitnessGenesisDelegateExtendedKey sk) - AGenesisUTxOSigningKey sk -> AShelleyKeyWitness (WitnessGenesisUTxOKey sk) - -data ReadWitnessSigningDataError - = ReadWitnessSigningDataSigningKeyDecodeError !(FileError InputDecodeError) - | ReadWitnessSigningDataScriptError !(FileError JsonDecodeError) - | ReadWitnessSigningDataSigningKeyAndAddressMismatch - -- ^ A Byron address was specified alongside a non-Byron signing key. - deriving Show - --- | Render an error message for a 'ReadWitnessSigningDataError'. -renderReadWitnessSigningDataError :: ReadWitnessSigningDataError -> Text -renderReadWitnessSigningDataError err = - case err of - ReadWitnessSigningDataSigningKeyDecodeError fileErr -> - "Error reading signing key: " <> Text.pack (displayError fileErr) - ReadWitnessSigningDataScriptError fileErr -> - "Error reading script: " <> Text.pack (displayError fileErr) - ReadWitnessSigningDataSigningKeyAndAddressMismatch -> - "Only a Byron signing key may be accompanied by a Byron address." - -readWitnessSigningData - :: WitnessSigningData - -> IO (Either ReadWitnessSigningDataError SomeWitness) -readWitnessSigningData (KeyWitnessSigningData skFile mbByronAddr) = do - eRes <- first ReadWitnessSigningDataSigningKeyDecodeError - <$> readKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile - return $ do - res <- eRes - case (res, mbByronAddr) of - (AByronSigningKey _ _, Just _) -> pure res - (AByronSigningKey _ _, Nothing) -> pure res - (_, Nothing) -> pure res - (_, Just _) -> - -- A Byron address should only be specified along with a Byron signing key. - Left ReadWitnessSigningDataSigningKeyAndAddressMismatch - where - textEnvFileTypes = - [ FromSomeType (AsSigningKey AsByronKey) - (`AByronSigningKey` mbByronAddr) - , FromSomeType (AsSigningKey AsPaymentKey) - APaymentSigningKey - , FromSomeType (AsSigningKey AsPaymentExtendedKey) - APaymentExtendedSigningKey - , FromSomeType (AsSigningKey AsStakeKey) - AStakeSigningKey - , FromSomeType (AsSigningKey AsStakeExtendedKey) - AStakeExtendedSigningKey - , FromSomeType (AsSigningKey AsStakePoolKey) - AStakePoolSigningKey - , FromSomeType (AsSigningKey AsGenesisKey) - AGenesisSigningKey - , FromSomeType (AsSigningKey AsGenesisExtendedKey) - AGenesisExtendedSigningKey - , FromSomeType (AsSigningKey AsGenesisDelegateKey) - AGenesisDelegateSigningKey - , FromSomeType (AsSigningKey AsGenesisDelegateExtendedKey) - AGenesisDelegateExtendedSigningKey - , FromSomeType (AsSigningKey AsGenesisUTxOKey) - AGenesisUTxOSigningKey - ] - - bech32FileTypes = - [ FromSomeType (AsSigningKey AsPaymentKey) - APaymentSigningKey - , FromSomeType (AsSigningKey AsPaymentExtendedKey) - APaymentExtendedSigningKey - , FromSomeType (AsSigningKey AsStakeKey) - AStakeSigningKey - , FromSomeType (AsSigningKey AsStakeExtendedKey) - AStakeExtendedSigningKey - , FromSomeType (AsSigningKey AsStakePoolKey) - AStakePoolSigningKey - ] - --- Required signers - -data RequiredSignerError - = RequiredSignerErrorFile (FileError InputDecodeError) - | RequiredSignerErrorByronKey (SigningKeyFile In) - deriving Show - -instance Error RequiredSignerError where - displayError (RequiredSignerErrorFile e) = displayError e - displayError (RequiredSignerErrorByronKey (File byronSkeyfile)) = - "Byron witnesses cannot be used for required signers: " <> byronSkeyfile - -readRequiredSigner :: RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey)) -readRequiredSigner (RequiredSignerHash h) = return $ Right h -readRequiredSigner (RequiredSignerSkeyFile skFile) = do - eKeyWit <- first RequiredSignerErrorFile <$> readKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile - return $ do - keyWit <- eKeyWit - case categoriseSomeWitness keyWit of - AByronWitness _ -> - Left $ RequiredSignerErrorByronKey skFile - AShelleyKeyWitness skey -> - return . getHash $ toShelleySigningKey skey - where - textEnvFileTypes = - [ FromSomeType (AsSigningKey AsPaymentKey) APaymentSigningKey - , FromSomeType (AsSigningKey AsPaymentExtendedKey) APaymentExtendedSigningKey - , FromSomeType (AsSigningKey AsStakePoolKey) AStakePoolSigningKey - , FromSomeType (AsSigningKey AsGenesisDelegateKey) AGenesisDelegateSigningKey - ] - bech32FileTypes = [] - - getHash :: ShelleySigningKey -> Hash PaymentKey - getHash (ShelleyExtendedSigningKey sk) = - let extSKey = PaymentExtendedSigningKey sk - payVKey = castVerificationKey $ getVerificationKey extSKey - in verificationKeyHash payVKey - getHash (ShelleyNormalSigningKey sk) = - verificationKeyHash . getVerificationKey $ PaymentSigningKey sk - --- Misc - -readFileInAnyCardanoEra - :: ( HasTextEnvelope (thing ByronEra) - , HasTextEnvelope (thing ShelleyEra) - , HasTextEnvelope (thing AllegraEra) - , HasTextEnvelope (thing MaryEra) - , HasTextEnvelope (thing AlonzoEra) - , HasTextEnvelope (thing BabbageEra) - ) - => (forall era. AsType era -> AsType (thing era)) - -> FileOrPipe - -> IO (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing)) -readFileInAnyCardanoEra asThing = - readFileOrPipeTextEnvelopeAnyOf - [ FromSomeType (asThing AsByronEra) (InAnyCardanoEra ByronEra) - , FromSomeType (asThing AsShelleyEra) (InAnyCardanoEra ShelleyEra) - , FromSomeType (asThing AsAllegraEra) (InAnyCardanoEra AllegraEra) - , FromSomeType (asThing AsMaryEra) (InAnyCardanoEra MaryEra) - , FromSomeType (asThing AsAlonzoEra) (InAnyCardanoEra AlonzoEra) - , FromSomeType (asThing AsBabbageEra) (InAnyCardanoEra BabbageEra) - ] - --- | We need a type for handling files that may be actually be things like --- pipes. Currently the CLI makes no guarantee that a "file" will only --- be read once. This is a problem for a user who who expects to be able to pass --- a pipe. To handle this, we have a type for representing either files or pipes --- where the contents will be saved in memory if what we're reading is a pipe (so --- it can be re-read later). Unfortunately this means we can't easily stream data --- from pipes, but at present that's not an issue. -data FileOrPipe = FileOrPipe FilePath (IORef (Maybe LBS.ByteString)) - - -instance Show FileOrPipe where - show (FileOrPipe fp _) = show fp - -fileOrPipe :: FilePath -> IO FileOrPipe -fileOrPipe fp = FileOrPipe fp <$> newIORef Nothing - --- | Get the path backing a FileOrPipe. This should primarily be used when --- generating error messages for a user. A user should not call directly --- call a function like readFile on the result of this function -fileOrPipePath :: FileOrPipe -> FilePath -fileOrPipePath (FileOrPipe fp _) = fp - -fileOrPipeCache :: FileOrPipe -> IO (Maybe LBS.ByteString) -fileOrPipeCache (FileOrPipe _ c) = readIORef c - --- | Get the contents of a file or pipe. This function reads the entire --- contents of the file or pipe, and is blocking. -readFileOrPipe :: FileOrPipe -> IO LBS.ByteString -readFileOrPipe (FileOrPipe fp cacheRef) = do - cached <- readIORef cacheRef - case cached of - Just dat -> pure dat - Nothing -> bracket - (openFileBlocking fp ReadMode) - hClose - (\handle -> do - -- An arbitrary block size. - let blockSize = 4096 - let go acc = do - next <- BS.hGet handle blockSize - if BS.null next - then pure acc - else go (acc <> Builder.byteString next) - contents <- go mempty - let dat = Builder.toLazyByteString contents - -- If our file is not seekable, it's likely a pipe, so we need to - -- save the result for subsequent calls - seekable <- hIsSeekable handle - unless seekable (writeIORef cacheRef (Just dat)) - pure dat) - -readFileOrPipeTextEnvelopeAnyOf - :: [FromSomeType HasTextEnvelope b] - -> FileOrPipe - -> IO (Either (FileError TextEnvelopeError) b) -readFileOrPipeTextEnvelopeAnyOf types file = do - let path = fileOrPipePath file - runExceptT $ do - content <- handleIOExceptT (FileIOError path) $ readFileOrPipe file - firstExceptT (FileError path) $ hoistEither $ do - te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecode' content - deserialiseFromTextEnvelopeAnyOf types te - -readFileOrPipeTextEnvelopeCddlAnyOf - :: [FromSomeTypeCDDL TextEnvelopeCddl b] - -> FileOrPipe - -> IO (Either (FileError TextEnvelopeCddlError) b) -readFileOrPipeTextEnvelopeCddlAnyOf types file = do - let path = fileOrPipePath file - runExceptT $ do - te <- newExceptT $ readTextEnvelopeCddlFromFileOrPipe file - firstExceptT (FileError path) $ hoistEither $ do - deserialiseFromTextEnvelopeCddlAnyOf types te - -readTextEnvelopeCddlFromFileOrPipe - :: FileOrPipe - -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl) -readTextEnvelopeCddlFromFileOrPipe file = do - let path = fileOrPipePath file - runExceptT $ do - bs <- handleIOExceptT (FileIOError path) $ - readFileOrPipe file - firstExceptT (FileError path . TextEnvelopeCddlAesonDecodeError path) - . hoistEither $ Aeson.eitherDecode' bs diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs deleted file mode 100644 index 9aaefff3fac..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs +++ /dev/null @@ -1,202 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeApplications #-} - -module Cardano.CLI.Shelley.Run.StakeAddress - ( ShelleyStakeAddressCmdError(ShelleyStakeAddressCmdReadKeyFileError) - , renderShelleyStakeAddressCmdError - , runStakeAddressCmd - , runStakeAddressKeyGenToFile - ) where - -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, left, newExceptT, onLeft) -import qualified Data.ByteString.Char8 as BS -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text - -import Cardano.Api -import Cardano.Api.Shelley - -import Cardano.CLI.Shelley.Key (DelegationTarget (..), StakeIdentifier (..), - StakeVerifier (..), VerificationKeyOrFile, readVerificationKeyOrFile, - readVerificationKeyOrHashOrFile) -import Cardano.CLI.Shelley.Parsers -import Cardano.CLI.Shelley.Run.Read -import Cardano.CLI.Types -import Control.Monad.Trans (lift) -import Data.Function ((&)) - -data ShelleyStakeAddressCmdError - = ShelleyStakeAddressCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyStakeAddressCmdReadScriptFileError !(FileError ScriptDecodeError) - | ShelleyStakeAddressCmdWriteFileError !(FileError ()) - deriving Show - -renderShelleyStakeAddressCmdError :: ShelleyStakeAddressCmdError -> Text -renderShelleyStakeAddressCmdError err = - case err of - ShelleyStakeAddressCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr) - ShelleyStakeAddressCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyStakeAddressCmdReadScriptFileError fileErr -> Text.pack (displayError fileErr) - -runStakeAddressCmd :: StakeAddressCmd -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeAddressCmd (StakeAddressKeyGen vk sk) = runStakeAddressKeyGenToFile vk sk -runStakeAddressCmd (StakeAddressKeyHash vk mOutputFp) = runStakeAddressKeyHash vk mOutputFp -runStakeAddressCmd (StakeAddressBuild stakeVerifier nw mOutputFp) = - runStakeAddressBuild stakeVerifier nw mOutputFp -runStakeAddressCmd (StakeRegistrationCert stakeIdentifier outputFp) = - runStakeCredentialRegistrationCert stakeIdentifier outputFp -runStakeAddressCmd (StakeCredentialDelegationCert stakeIdentifier stkPoolVerKeyHashOrFp outputFp) = - runStakeCredentialDelegationCert stakeIdentifier stkPoolVerKeyHashOrFp outputFp -runStakeAddressCmd (StakeCredentialDeRegistrationCert stakeIdentifier outputFp) = - runStakeCredentialDeRegistrationCert stakeIdentifier outputFp - - --- --- Stake address command implementations --- - -runStakeAddressKeyGenToFile - :: VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeAddressKeyGenToFile vkFp skFp = do - let skeyDesc = "Stake Signing Key" - let vkeyDesc = "Stake Verification Key" - - skey <- liftIO $ generateSigningKey AsStakeKey - - let vkey = getVerificationKey skey - - firstExceptT ShelleyStakeAddressCmdWriteFileError $ do - newExceptT $ writeLazyByteStringFile skFp $ textEnvelopeToJSON (Just skeyDesc) skey - newExceptT $ writeLazyByteStringFile vkFp $ textEnvelopeToJSON (Just vkeyDesc) vkey - -runStakeAddressKeyHash - :: VerificationKeyOrFile StakeKey - -> Maybe (File () Out) - -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeAddressKeyHash stakeVerKeyOrFile mOutputFp = do - vkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile - - let hexKeyHash = serialiseToRawBytesHex (verificationKeyHash vkey) - - case mOutputFp of - Just (File fpath) -> liftIO $ BS.writeFile fpath hexKeyHash - Nothing -> liftIO $ BS.putStrLn hexKeyHash - -runStakeAddressBuild - :: StakeVerifier - -> NetworkId - -> Maybe (File () Out) - -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeAddressBuild stakeVerifier network mOutputFp = do - stakeAddr <- getStakeAddressFromVerifier network stakeVerifier - let stakeAddrText = serialiseAddress stakeAddr - liftIO $ - case mOutputFp of - Just (File fpath) -> Text.writeFile fpath stakeAddrText - Nothing -> Text.putStrLn stakeAddrText - - -runStakeCredentialRegistrationCert - :: StakeIdentifier - -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeCredentialRegistrationCert stakeIdentifier oFp = do - stakeCred <- getStakeCredentialFromIdentifier stakeIdentifier - writeRegistrationCert stakeCred - - where - writeRegistrationCert - :: StakeCredential - -> ExceptT ShelleyStakeAddressCmdError IO () - writeRegistrationCert sCred = do - let deRegCert = makeStakeAddressRegistrationCertificate sCred - firstExceptT ShelleyStakeAddressCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile oFp - $ textEnvelopeToJSON (Just regCertDesc) deRegCert - - regCertDesc :: TextEnvelopeDescr - regCertDesc = "Stake Address Registration Certificate" - - -runStakeCredentialDelegationCert - :: StakeIdentifier - -- ^ Delegator stake verification key, verification key file or script file. - -> DelegationTarget - -- ^ Delegatee stake pool verification key or verification key file or - -- verification key hash. - -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeCredentialDelegationCert stakeVerifier delegationTarget outFp = - case delegationTarget of - StakePoolDelegationTarget poolVKeyOrHashOrFile -> do - poolStakeVKeyHash <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile) - & onLeft (left . ShelleyStakeAddressCmdReadKeyFileError) - stakeCred <- getStakeCredentialFromIdentifier stakeVerifier - let delegCert = makeStakeAddressPoolDelegationCertificate stakeCred poolStakeVKeyHash - firstExceptT ShelleyStakeAddressCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile outFp - $ textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Address Delegation Certificate") delegCert - -runStakeCredentialDeRegistrationCert - :: StakeIdentifier - -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeCredentialDeRegistrationCert stakeVerifier oFp = do - stakeCred <- getStakeCredentialFromIdentifier stakeVerifier - writeDeregistrationCert stakeCred - - where - writeDeregistrationCert - :: StakeCredential - -> ExceptT ShelleyStakeAddressCmdError IO () - writeDeregistrationCert sCred = do - let deRegCert = makeStakeAddressDeregistrationCertificate sCred - firstExceptT ShelleyStakeAddressCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile oFp - $ textEnvelopeToJSON (Just deregCertDesc) deRegCert - - deregCertDesc :: TextEnvelopeDescr - deregCertDesc = "Stake Address Deregistration Certificate" - - -getStakeCredentialFromVerifier - :: StakeVerifier - -> ExceptT ShelleyStakeAddressCmdError IO StakeCredential -getStakeCredentialFromVerifier = \case - StakeVerifierScriptFile (ScriptFile sFile) -> do - ScriptInAnyLang _ script <- - firstExceptT ShelleyStakeAddressCmdReadScriptFileError $ - readFileScriptInAnyLang sFile - pure $ StakeCredentialByScript $ hashScript script - - StakeVerifierKey stakeVerKeyOrFile -> do - stakeVerKey <- - firstExceptT ShelleyStakeAddressCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile - pure $ StakeCredentialByKey $ verificationKeyHash stakeVerKey - -getStakeCredentialFromIdentifier - :: StakeIdentifier - -> ExceptT ShelleyStakeAddressCmdError IO StakeCredential -getStakeCredentialFromIdentifier = \case - StakeIdentifierAddress stakeAddr -> pure $ stakeAddressCredential stakeAddr - StakeIdentifierVerifier stakeVerifier -> getStakeCredentialFromVerifier stakeVerifier - -getStakeAddressFromVerifier - :: NetworkId - -> StakeVerifier - -> ExceptT ShelleyStakeAddressCmdError IO StakeAddress -getStakeAddressFromVerifier networkId stakeVerifier = - makeStakeAddress networkId <$> getStakeCredentialFromVerifier stakeVerifier diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/TextView.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/TextView.hs deleted file mode 100644 index b1d23495e94..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/TextView.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE DataKinds #-} - -module Cardano.CLI.Shelley.Run.TextView - ( ShelleyTextViewFileError(..) - , renderShelleyTextViewFileError - , runTextViewCmd - ) where - -import Control.Monad.Trans.Except (ExceptT) -import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Text (Text) -import qualified Data.Text as Text - -import Cardano.CLI.Helpers (HelpersError, pPrintCBOR, renderHelpersError) -import Cardano.CLI.Shelley.Parsers - -import Cardano.Api - -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT) - -data ShelleyTextViewFileError - = TextViewReadFileError (FileError TextEnvelopeError) - | TextViewCBORPrettyPrintError !HelpersError - deriving Show - -renderShelleyTextViewFileError :: ShelleyTextViewFileError -> Text -renderShelleyTextViewFileError err = - case err of - TextViewReadFileError fileErr -> Text.pack (displayError fileErr) - TextViewCBORPrettyPrintError hlprsErr -> - "Error pretty printing CBOR: " <> renderHelpersError hlprsErr - - -runTextViewCmd :: TextViewCmd -> ExceptT ShelleyTextViewFileError IO () -runTextViewCmd cmd = - case cmd of - TextViewInfo fpath mOutfile -> runTextViewInfo fpath mOutfile - -runTextViewInfo :: FilePath -> Maybe (File () Out) -> ExceptT ShelleyTextViewFileError IO () -runTextViewInfo fpath mOutFile = do - tv <- firstExceptT TextViewReadFileError $ newExceptT (readTextEnvelopeFromFile fpath) - let lbCBOR = LBS.fromStrict (textEnvelopeRawCBOR tv) - case mOutFile of - Just (File oFpath) -> liftIO $ LBS.writeFile oFpath lbCBOR - Nothing -> firstExceptT TextViewCBORPrettyPrintError $ pPrintCBOR lbCBOR diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs deleted file mode 100644 index ae8605b5c3a..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ /dev/null @@ -1,1456 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Cardano.CLI.Shelley.Run.Transaction - ( ShelleyTxCmdError(..) - , renderShelleyTxCmdError - , runTransactionCmd - , readFileTx - , toTxOutInAnyEra - ) where - -import Control.Monad (forM, forM_, void) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans (MonadTrans (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, hoistMaybe, left, - newExceptT, onLeft, onNothing) -import Data.Aeson.Encode.Pretty (encodePretty) -import Data.Bifunctor (Bifunctor (..)) -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Data ((:~:) (..)) -import Data.Foldable (Foldable (..)) -import Data.Function ((&)) -import qualified Data.List as List -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromMaybe) -import Data.Set (Set) -import qualified Data.Set as Set -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import Data.Type.Equality (TestEquality (..)) -import qualified System.IO as IO - -import Cardano.Api -import Cardano.Api.Byron hiding (SomeByronSigningKey (..)) -import Cardano.Api.Shelley - -import Cardano.CLI.Helpers (printWarning) -import Cardano.CLI.Run.Friendly (friendlyTxBS, friendlyTxBodyBS) -import Cardano.CLI.Shelley.Output -import Cardano.CLI.Shelley.Parsers -import Cardano.CLI.Shelley.Run.Genesis -import Cardano.CLI.Shelley.Run.Read -import Cardano.CLI.Shelley.Run.Validate -import Cardano.CLI.Types - -import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) -import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx - -{- HLINT ignore "Use let" -} - -data ShelleyTxCmdError - = ShelleyTxCmdMetadataError MetadataError - | ShelleyTxCmdScriptWitnessError ScriptWitnessError - | ShelleyTxCmdProtocolParamsError ProtocolParamsError - | ShelleyTxCmdScriptFileError (FileError ScriptDecodeError) - | ShelleyTxCmdReadTextViewFileError !(FileError TextEnvelopeError) - | ShelleyTxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError - | ShelleyTxCmdWriteFileError !(FileError ()) - | ShelleyTxCmdEraConsensusModeMismatch - !(Maybe FilePath) - !AnyConsensusMode - !AnyCardanoEra - -- ^ Era - | ShelleyTxCmdBootstrapWitnessError !ShelleyBootstrapWitnessError - | ShelleyTxCmdTxSubmitError !Text - | ShelleyTxCmdTxSubmitErrorEraMismatch !EraMismatch - | ShelleyTxCmdTxFeatureMismatch !AnyCardanoEra !TxFeature - | ShelleyTxCmdTxBodyError !TxBodyError - | ShelleyTxCmdNotImplemented !Text - | ShelleyTxCmdWitnessEraMismatch !AnyCardanoEra !AnyCardanoEra !WitnessFile - | ShelleyTxCmdPolicyIdsMissing ![PolicyId] - | ShelleyTxCmdPolicyIdsExcess ![PolicyId] - | ShelleyTxCmdUnsupportedMode !AnyConsensusMode - | ShelleyTxCmdByronEra - | ShelleyTxCmdEraConsensusModeMismatchTxBalance - !TxBuildOutputOptions - !AnyConsensusMode - !AnyCardanoEra - | ShelleyTxCmdBalanceTxBody !TxBodyErrorAutoBalance - | ShelleyTxCmdTxInsDoNotExist !TxInsExistError - | ShelleyTxCmdPParamsErr !ProtocolParametersError - | ShelleyTxCmdTextEnvCddlError - !(FileError TextEnvelopeError) - !(FileError TextEnvelopeCddlError) - | ShelleyTxCmdTxExecUnitsErr !TransactionValidityError - | ShelleyTxCmdPlutusScriptCostErr !PlutusScriptCostError - | ShelleyTxCmdPParamExecutionUnitsNotAvailable - | ShelleyTxCmdPlutusScriptsRequireCardanoMode - | ShelleyTxCmdProtocolParametersNotPresentInTxBody - | ShelleyTxCmdTxEraCastErr EraCastError - | ShelleyTxCmdQueryConvenienceError !QueryConvenienceError - | ShelleyTxCmdQueryNotScriptLocked !ScriptLockedTxInsError - | ShelleyTxCmdScriptDataError !ScriptDataError - | ShelleyTxCmdCddlError CddlError - | ShelleyTxCmdCddlWitnessError CddlWitnessError - | ShelleyTxCmdRequiredSignerError RequiredSignerError - -- Validation errors - | ShelleyTxCmdAuxScriptsValidationError TxAuxScriptsValidationError - | ShelleyTxCmdTotalCollateralValidationError TxTotalCollateralValidationError - | ShelleyTxCmdReturnCollateralValidationError TxReturnCollateralValidationError - | ShelleyTxCmdTxFeeValidationError TxFeeValidationError - | ShelleyTxCmdTxValidityLowerBoundValidationError TxValidityLowerBoundValidationError - | ShelleyTxCmdTxValidityUpperBoundValidationError TxValidityUpperBoundValidationError - | ShelleyTxCmdRequiredSignersValidationError TxRequiredSignersValidationError - | ShelleyTxCmdProtocolParametersValidationError TxProtocolParametersValidationError - | ShelleyTxCmdTxWithdrawalsValidationError TxWithdrawalsValidationError - | ShelleyTxCmdTxCertificatesValidationError TxCertificatesValidationError - | ShelleyTxCmdTxUpdateProposalValidationError TxUpdateProposalValidationError - | ShelleyTxCmdScriptValidityValidationError TxScriptValidityValidationError - -renderShelleyTxCmdError :: ShelleyTxCmdError -> Text -renderShelleyTxCmdError err = - case err of - ShelleyTxCmdReadTextViewFileError fileErr -> Text.pack (displayError fileErr) - ShelleyTxCmdScriptFileError fileErr -> Text.pack (displayError fileErr) - ShelleyTxCmdReadWitnessSigningDataError witSignDataErr -> - renderReadWitnessSigningDataError witSignDataErr - ShelleyTxCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyTxCmdTxSubmitError res -> "Error while submitting tx: " <> res - ShelleyTxCmdTxSubmitErrorEraMismatch EraMismatch{ledgerEraName, otherEraName} -> - "The era of the node and the tx do not match. " <> - "The node is running in the " <> ledgerEraName <> - " era, but the transaction is for the " <> otherEraName <> " era." - ShelleyTxCmdBootstrapWitnessError sbwErr -> - renderShelleyBootstrapWitnessError sbwErr - ShelleyTxCmdTxFeatureMismatch era TxFeatureImplicitFees -> - "An explicit transaction fee must be specified for " <> - renderEra era <> " era transactions." - - ShelleyTxCmdTxFeatureMismatch (AnyCardanoEra ShelleyEra) - TxFeatureValidityNoUpperBound -> - "A TTL must be specified for Shelley era transactions." - - ShelleyTxCmdTxFeatureMismatch era feature -> - renderFeature feature <> " cannot be used for " <> renderEra era <> - " era transactions." - - ShelleyTxCmdTxBodyError err' -> - "Transaction validaton error: " <> Text.pack (displayError err') - - ShelleyTxCmdNotImplemented msg -> - "Feature not yet implemented: " <> msg - - ShelleyTxCmdWitnessEraMismatch era era' (WitnessFile file) -> - "The era of a witness does not match the era of the transaction. " <> - "The transaction is for the " <> renderEra era <> " era, but the " <> - "witness in " <> textShow file <> " is for the " <> renderEra era' <> " era." - - ShelleyTxCmdEraConsensusModeMismatch fp mode era -> - "Submitting " <> renderEra era <> " era transaction (" <> textShow fp <> - ") is not supported in the " <> renderMode mode <> " consensus mode." - ShelleyTxCmdPolicyIdsMissing policyids -> mconcat - [ "The \"--mint\" flag specifies an asset with a policy Id, but no " - , "corresponding monetary policy script has been provided as a witness " - , "(via the \"--mint-script-file\" flag). The policy Id in question is: " - , Text.intercalate ", " (map serialiseToRawBytesHexText policyids) - ] - - ShelleyTxCmdPolicyIdsExcess policyids -> mconcat - [ "A script provided to witness minting does not correspond to the policy " - , "id of any asset specified in the \"--mint\" field. The script hash is: " - , Text.intercalate ", " (map serialiseToRawBytesHexText policyids) - ] - ShelleyTxCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode - ShelleyTxCmdByronEra -> "This query cannot be used for the Byron era" - ShelleyTxCmdEraConsensusModeMismatchTxBalance fp mode era -> - "Cannot balance " <> renderEra era <> " era transaction body (" <> textShow fp <> - ") because is not supported in the " <> renderMode mode <> " consensus mode." - ShelleyTxCmdBalanceTxBody err' -> Text.pack $ displayError err' - ShelleyTxCmdTxInsDoNotExist e -> - renderTxInsExistError e - ShelleyTxCmdPParamsErr err' -> Text.pack $ displayError err' - ShelleyTxCmdTextEnvCddlError textEnvErr cddlErr -> mconcat - [ "Failed to decode neither the cli's serialisation format nor the ledger's " - , "CDDL serialisation format. TextEnvelope error: " <> Text.pack (displayError textEnvErr) <> "\n" - , "TextEnvelopeCddl error: " <> Text.pack (displayError cddlErr) - ] - ShelleyTxCmdTxExecUnitsErr err' -> Text.pack $ displayError err' - ShelleyTxCmdPlutusScriptCostErr err'-> Text.pack $ displayError err' - ShelleyTxCmdPParamExecutionUnitsNotAvailable -> mconcat - [ "Execution units not available in the protocol parameters. This is " - , "likely due to not being in the Alonzo era" - ] - ShelleyTxCmdTxEraCastErr (EraCastError value fromEra toEra) -> - "Unable to cast era from " <> textShow fromEra <> " to " <> textShow toEra <> " the value " <> textShow value - ShelleyTxCmdQueryConvenienceError e -> - renderQueryConvenienceError e - ShelleyTxCmdQueryNotScriptLocked e -> - renderNotScriptLockedTxInsError e - ShelleyTxCmdPlutusScriptsRequireCardanoMode -> - "Plutus scripts are only available in CardanoMode" - ShelleyTxCmdProtocolParametersNotPresentInTxBody -> - "Protocol parameters were not found in transaction body" - ShelleyTxCmdMetadataError e -> renderMetadataError e - ShelleyTxCmdScriptWitnessError e -> renderScriptWitnessError e - ShelleyTxCmdScriptDataError e -> renderScriptDataError e - ShelleyTxCmdProtocolParamsError e -> renderProtocolParamsError e - ShelleyTxCmdCddlError e -> Text.pack $ displayError e - ShelleyTxCmdCddlWitnessError e -> Text.pack $ displayError e - ShelleyTxCmdRequiredSignerError e -> Text.pack $ displayError e - -- Validation errors - ShelleyTxCmdAuxScriptsValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTotalCollateralValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdReturnCollateralValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxFeeValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxValidityLowerBoundValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxValidityUpperBoundValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdRequiredSignersValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdProtocolParametersValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxWithdrawalsValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxCertificatesValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxUpdateProposalValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdScriptValidityValidationError e -> - Text.pack $ displayError e - -renderFeature :: TxFeature -> Text -renderFeature TxFeatureShelleyAddresses = "Shelley addresses" -renderFeature TxFeatureExplicitFees = "Explicit fees" -renderFeature TxFeatureImplicitFees = "Implicit fees" -renderFeature TxFeatureValidityLowerBound = "A validity lower bound" -renderFeature TxFeatureValidityUpperBound = "A validity upper bound" -renderFeature TxFeatureValidityNoUpperBound = "An absent validity upper bound" -renderFeature TxFeatureTxMetadata = "Transaction metadata" -renderFeature TxFeatureAuxScripts = "Auxiliary scripts" -renderFeature TxFeatureWithdrawals = "Reward account withdrawals" -renderFeature TxFeatureCertificates = "Certificates" -renderFeature TxFeatureMintValue = "Asset minting" -renderFeature TxFeatureMultiAssetOutputs = "Multi-Asset outputs" -renderFeature TxFeatureScriptWitnesses = "Script witnesses" -renderFeature TxFeatureShelleyKeys = "Shelley keys" -renderFeature TxFeatureCollateral = "Collateral inputs" -renderFeature TxFeatureProtocolParameters = "Protocol parameters" -renderFeature TxFeatureTxOutDatum = "Transaction output datums" -renderFeature TxFeatureScriptValidity = "Script validity" -renderFeature TxFeatureExtraKeyWits = "Required signers" -renderFeature TxFeatureInlineDatums = "Inline datums" -renderFeature TxFeatureTotalCollateral = "Total collateral" -renderFeature TxFeatureReferenceInputs = "Reference inputs" -renderFeature TxFeatureReturnCollateral = "Return collateral" - -runTransactionCmd :: TransactionCmd -> ExceptT ShelleyTxCmdError IO () -runTransactionCmd cmd = - case cmd of - TxBuild mNodeSocketPath era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns - reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound - mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile - mUpProp outputOptions -> do - runTxBuildCmd mNodeSocketPath era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns - reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound - mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp outputOptions - TxBuildRaw era mScriptValidity txins readOnlyRefIns txinsc mReturnColl - mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls - metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp out -> do - runTxBuildRawCmd era mScriptValidity txins readOnlyRefIns txinsc mReturnColl - mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls - metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp out - TxSign txinfile skfiles network txoutfile -> - runTxSign txinfile skfiles network txoutfile - TxSubmit mNodeSocketPath anyConsensusModeParams network txFp -> - runTxSubmit mNodeSocketPath anyConsensusModeParams network txFp - TxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses -> - runTxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses - TxCalculateMinRequiredUTxO era pParamsFile txOuts -> runTxCalculateMinRequiredUTxO era pParamsFile txOuts - TxHashScriptData scriptDataOrFile -> runTxHashScriptData scriptDataOrFile - TxGetTxId txinfile -> runTxGetTxId txinfile - TxView txinfile -> runTxView txinfile - TxMintedPolicyId sFile -> runTxCreatePolicyId sFile - TxCreateWitness txBodyfile witSignData mbNw outFile -> - runTxCreateWitness txBodyfile witSignData mbNw outFile - TxAssembleTxBodyWitness txBodyFile witnessFile outFile -> - runTxSignWitness txBodyFile witnessFile outFile - --- ---------------------------------------------------------------------------- --- Building transactions --- - -runTxBuildCmd - :: SocketPath - -> AnyCardanoEra - -> AnyConsensusModeParams - -> NetworkId - -> Maybe ScriptValidity - -> Maybe Word -- ^ Override the required number of tx witnesses - -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] -- ^ Transaction inputs with optional spending scripts - -> [TxIn] -- ^ Read only reference inputs - -> [RequiredSigner] -- ^ Required signers - -> [TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - -> Maybe TxOutAnyEra -- ^ Return collateral - -> Maybe Lovelace -- ^ Total collateral - -> [TxOutAnyEra] - -> TxOutChangeAddress - -> Maybe (Value, [ScriptWitnessFiles WitCtxMint]) - -> Maybe SlotNo -- ^ Validity lower bound - -> Maybe SlotNo -- ^ Validity upper bound - -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))] - -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))] -- ^ Withdrawals with potential script witness - -> TxMetadataJsonSchema - -> [ScriptFile] - -> [MetadataFile] - -> Maybe ProtocolParamsFile - -> Maybe UpdateProposalFile - -> TxBuildOutputOptions - -> ExceptT ShelleyTxCmdError IO () -runTxBuildCmd - socketPath (AnyCardanoEra cEra) consensusModeParams@(AnyConsensusModeParams cModeParams) - nid mScriptValidity mOverrideWits txins readOnlyRefIns - reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound - mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp outputOptions = do - -- The user can specify an era prior to the era that the node is currently in. - -- We cannot use the user specified era to construct a query against a node because it may differ - -- from the node's era and this will result in the 'QueryEraMismatch' failure. - - let localNodeConnInfo = LocalNodeConnectInfo - { localConsensusModeParams = cModeParams - , localNodeNetworkId = nid - , localNodeSocketPath = socketPath - } - - AnyCardanoEra nodeEra <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) - - inputsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError $ readScriptWitnessFiles cEra txins - certFilesAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError $ readScriptWitnessFiles cEra certs - certsAndMaybeScriptWits <- sequence - [ fmap (,mSwit) (firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $ - readFileTextEnvelope AsCertificate (File certFile)) - | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits - ] - withdrawalsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError - $ readScriptWitnessFilesThruple cEra wdrls - txMetadata <- firstExceptT ShelleyTxCmdMetadataError - . newExceptT $ readTxMetadata cEra metadataSchema metadataFiles - valuesWithScriptWits <- readValueScriptWitnesses cEra $ fromMaybe (mempty, []) mValue - scripts <- firstExceptT ShelleyTxCmdScriptFileError $ - mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles - txAuxScripts <- hoistEither $ first ShelleyTxCmdAuxScriptsValidationError $ validateTxAuxScripts cEra scripts - mpparams <- forM mProtocolParamsFile $ \ppf -> - firstExceptT ShelleyTxCmdProtocolParamsError (readProtocolParameters ppf) - - mProp <- forM mUpProp $ \(UpdateProposalFile upFp) -> - firstExceptT ShelleyTxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) - requiredSigners <- mapM (firstExceptT ShelleyTxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners - mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra cEra - - txOuts <- mapM (toTxOutInAnyEra cEra) txouts - - -- the same collateral input can be used for several plutus scripts - let filteredTxinsc = Set.toList $ Set.fromList txinsc - - -- We need to construct the txBodycontent outside of runTxBuild - BalancedTxBody txBodycontent balancedTxBody _ _ <- - runTxBuild - socketPath cEra consensusModeParams nid mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns filteredTxinsc - mReturnCollateral mTotCollateral txOuts changeAddr valuesWithScriptWits mLowBound - mUpperBound certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits - requiredSigners txAuxScripts txMetadata mpparams mProp mOverrideWits outputOptions - - let allReferenceInputs = getAllReferenceInputs - inputsAndMaybeScriptWits - (snd valuesWithScriptWits) - certsAndMaybeScriptWits - withdrawalsAndMaybeScriptWits - readOnlyRefIns - - let inputsThatRequireWitnessing = [input | (input,_) <- inputsAndMaybeScriptWits] - allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ filteredTxinsc - - -- TODO: Calculating the script cost should live as a different command. - -- Why? Because then we can simply read a txbody and figure out - -- the script cost vs having to build the tx body each time - case outputOptions of - OutputScriptCostOnly fp -> do - let BuildTxWith mTxProtocolParams = txProtocolParams txBodycontent - - pparams <- pure mTxProtocolParams & onNothing (left ShelleyTxCmdProtocolParametersNotPresentInTxBody) - - executionUnitPrices <- pure (protocolParamPrices pparams) & onNothing (left ShelleyTxCmdPParamExecutionUnitsNotAvailable) - - let consensusMode = consensusModeOnly cModeParams - bpp <- hoistEither . first (ShelleyTxCmdTxBodyError . TxBodyProtocolParamsConversionError) $ - bundleProtocolParams cEra pparams - - case consensusMode of - CardanoMode -> do - (nodeEraUTxO, _, eraHistory, systemStart, _, _) <- - lift (queryStateForBalancedTx socketPath nodeEra nid allTxInputs []) - & onLeft (left . ShelleyTxCmdQueryConvenienceError) - - -- Why do we cast the era? The user can specify an era prior to the era that the node is currently in. - -- We cannot use the user specified era to construct a query against a node because it may differ - -- from the node's era and this will result in the 'QueryEraMismatch' failure. - txEraUtxo <- pure (eraCast cEra nodeEraUTxO) & onLeft (left . ShelleyTxCmdTxEraCastErr) - - scriptExecUnitsMap <- - firstExceptT ShelleyTxCmdTxExecUnitsErr $ hoistEither - $ evaluateTransactionExecutionUnits - systemStart (toLedgerEpochInfo eraHistory) - bpp txEraUtxo balancedTxBody - - scriptCostOutput <- - firstExceptT ShelleyTxCmdPlutusScriptCostErr $ hoistEither - $ renderScriptCosts - txEraUtxo - executionUnitPrices - (collectTxBodyScriptWitnesses txBodycontent) - scriptExecUnitsMap - liftIO $ LBS.writeFile (unFile fp) $ encodePretty scriptCostOutput - _ -> left ShelleyTxCmdPlutusScriptsRequireCardanoMode - - OutputTxBodyOnly fpath -> - let noWitTx = makeSignedTransaction [] balancedTxBody - in lift (writeTxFileTextEnvelopeCddl fpath noWitTx) - & onLeft (left . ShelleyTxCmdWriteFileError) - - -runTxBuildRawCmd - :: AnyCardanoEra - -> Maybe ScriptValidity - -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] - -> [TxIn] -- ^ Read only reference inputs - -> [TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. - -> Maybe TxOutAnyEra - -> Maybe Lovelace -- ^ Total collateral - -> [RequiredSigner] - -> [TxOutAnyEra] - -> Maybe (Value, [ScriptWitnessFiles WitCtxMint]) -- ^ Multi-Asset value with script witness - -> Maybe SlotNo -- ^ Validity lower bound - -> Maybe SlotNo -- ^ Validity upper bound - -> Maybe Lovelace -- ^ Tx fee - -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))] - -> [(StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))] - -> TxMetadataJsonSchema - -> [ScriptFile] - -> [MetadataFile] - -> Maybe ProtocolParamsFile - -> Maybe UpdateProposalFile - -> TxBodyFile Out - -> ExceptT ShelleyTxCmdError IO () -runTxBuildRawCmd - (AnyCardanoEra cEra) mScriptValidity txins readOnlyRefIns txinsc mReturnColl - mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls - metadataSchema scriptFiles metadataFiles mpParamsFile mUpProp out = do - inputsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError - $ readScriptWitnessFiles cEra txins - certFilesAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError - $ readScriptWitnessFiles cEra certs - certsAndMaybeScriptWits <- sequence - [ fmap (,mSwit) (firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $ - readFileTextEnvelope AsCertificate (File certFile)) - | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits - ] - withdrawalsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError - $ readScriptWitnessFilesThruple cEra wdrls - txMetadata <- firstExceptT ShelleyTxCmdMetadataError - . newExceptT $ readTxMetadata cEra metadataSchema metadataFiles - valuesWithScriptWits <- readValueScriptWitnesses cEra $ fromMaybe (mempty, []) mValue - scripts <- firstExceptT ShelleyTxCmdScriptFileError $ - mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles - txAuxScripts <- hoistEither $ first ShelleyTxCmdAuxScriptsValidationError $ validateTxAuxScripts cEra scripts - - pparams <- forM mpParamsFile $ \ppf -> - firstExceptT ShelleyTxCmdProtocolParamsError (readProtocolParameters ppf) - - mProp <- forM mUpProp $ \(UpdateProposalFile upFp) -> - firstExceptT ShelleyTxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) - - requiredSigners <- mapM (firstExceptT ShelleyTxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners - mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra cEra - txOuts <- mapM (toTxOutInAnyEra cEra) txouts - - -- the same collateral input can be used for several plutus scripts - let filteredTxinsc = Set.toList $ Set.fromList txinsc - - txBody <- hoistEither $ runTxBuildRaw cEra mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns filteredTxinsc - mReturnCollateral mTotColl txOuts mLowBound mUpperBound fee valuesWithScriptWits - certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits requiredSigners txAuxScripts - txMetadata pparams mProp - - let noWitTx = makeSignedTransaction [] txBody - lift (getIsCardanoEraConstraint cEra $ writeTxFileTextEnvelopeCddl out noWitTx) - & onLeft (left . ShelleyTxCmdWriteFileError) - - -runTxBuildRaw - :: CardanoEra era - -> Maybe ScriptValidity - -- ^ Mark script as expected to pass or fail validation - -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] - -- ^ TxIn with potential script witness - -> [TxIn] - -- ^ Read only reference inputs - -> [TxIn] - -- ^ TxIn for collateral - -> Maybe (TxOut CtxTx era) - -- ^ Return collateral - -> Maybe Lovelace - -- ^ Total collateral - -> [TxOut CtxTx era] - -> Maybe SlotNo - -- ^ Tx lower bound - -> Maybe SlotNo - -- ^ Tx upper bound - -> Maybe Lovelace - -- ^ Tx fee - -> (Value, [ScriptWitness WitCtxMint era]) - -- ^ Multi-Asset value(s) - -> [(Certificate, Maybe (ScriptWitness WitCtxStake era))] - -- ^ Certificate with potential script witness - -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] - -> [Hash PaymentKey] - -- ^ Required signers - -> TxAuxScripts era - -> TxMetadataInEra era - -> Maybe ProtocolParameters - -> Maybe UpdateProposal - -> Either ShelleyTxCmdError (TxBody era) -runTxBuildRaw era - mScriptValidity inputsAndMaybeScriptWits - readOnlyRefIns txinsc - mReturnCollateral mTotCollateral txouts - mLowerBound mUpperBound - mFee valuesWithScriptWits - certsAndMaybeSriptWits withdrawals reqSigners - txAuxScripts txMetadata mpparams mUpdateProp = do - - let allReferenceInputs = getAllReferenceInputs - inputsAndMaybeScriptWits - (snd valuesWithScriptWits) - certsAndMaybeSriptWits - withdrawals - readOnlyRefIns - - validatedCollateralTxIns <- validateTxInsCollateral era txinsc - validatedRefInputs <- validateTxInsReference era allReferenceInputs - validatedTotCollateral - <- first ShelleyTxCmdTotalCollateralValidationError $ validateTxTotalCollateral era mTotCollateral - validatedRetCol - <- first ShelleyTxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral - validatedFee - <- first ShelleyTxCmdTxFeeValidationError $ validateTxFee era mFee - validatedBounds <- (,) <$> first ShelleyTxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound) - <*> first ShelleyTxCmdTxValidityUpperBoundValidationError (validateTxValidityUpperBound era mUpperBound) - validatedReqSigners - <- first ShelleyTxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners - validatedPParams - <- first ShelleyTxCmdProtocolParametersValidationError $ validateProtocolParameters era mpparams - validatedTxWtdrwls - <- first ShelleyTxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals - validatedTxCerts - <- first ShelleyTxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeSriptWits - validatedTxUpProp - <- first ShelleyTxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdateProp - validatedMintValue - <- createTxMintValue era valuesWithScriptWits - validatedTxScriptValidity - <- first ShelleyTxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity - - let txBodyContent = TxBodyContent - (validateTxIns inputsAndMaybeScriptWits) - validatedCollateralTxIns - validatedRefInputs - txouts - validatedTotCollateral - validatedRetCol - validatedFee - validatedBounds - txMetadata - txAuxScripts - validatedReqSigners - validatedPParams - validatedTxWtdrwls - validatedTxCerts - validatedTxUpProp - validatedMintValue - validatedTxScriptValidity - - first ShelleyTxCmdTxBodyError $ - getIsCardanoEraConstraint era $ createAndValidateTransactionBody txBodyContent - -runTxBuild - :: SocketPath - -> CardanoEra era - -> AnyConsensusModeParams - -> NetworkId - -> Maybe ScriptValidity - -- ^ Mark script as expected to pass or fail validation - -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] - -- ^ Read only reference inputs - -> [TxIn] - -- ^ TxIn with potential script witness - -> [TxIn] - -- ^ TxIn for collateral - -> Maybe (TxOut CtxTx era) - -- ^ Return collateral - -> Maybe Lovelace - -- ^ Total collateral - -> [TxOut CtxTx era] - -- ^ Normal outputs - -> TxOutChangeAddress - -- ^ A change output - -> (Value, [ScriptWitness WitCtxMint era]) - -- ^ Multi-Asset value(s) - -> Maybe SlotNo - -- ^ Tx lower bound - -> Maybe SlotNo - -- ^ Tx upper bound - -> [(Certificate, Maybe (ScriptWitness WitCtxStake era))] - -- ^ Certificate with potential script witness - -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] - -> [Hash PaymentKey] - -- ^ Required signers - -> TxAuxScripts era - -> TxMetadataInEra era - -> Maybe ProtocolParameters - -> Maybe UpdateProposal - -> Maybe Word - -> TxBuildOutputOptions - -> ExceptT ShelleyTxCmdError IO (BalancedTxBody era) -runTxBuild - socketPath era (AnyConsensusModeParams cModeParams) networkId mScriptValidity - inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts - (TxOutChangeAddress changeAddr) valuesWithScriptWits mLowerBound mUpperBound - certsAndMaybeScriptWits withdrawals reqSigners txAuxScripts txMetadata mpparams - mUpdatePropF mOverrideWits outputOptions = do - - liftIO $ forM_ mpparams $ \_ -> - printWarning "'--protocol-params-file' for 'transaction build' is deprecated" - - let consensusMode = consensusModeOnly cModeParams - dummyFee = Just $ Lovelace 0 - inputsThatRequireWitnessing = [input | (input,_) <- inputsAndMaybeScriptWits] - - -- Pure - let allReferenceInputs = getAllReferenceInputs - inputsAndMaybeScriptWits - (snd valuesWithScriptWits) - certsAndMaybeScriptWits - withdrawals readOnlyRefIns - - validatedCollateralTxIns <- hoistEither $ validateTxInsCollateral era txinsc - validatedRefInputs <- hoistEither $ validateTxInsReference era allReferenceInputs - validatedTotCollateral - <- hoistEither $ first ShelleyTxCmdTotalCollateralValidationError $ validateTxTotalCollateral era mTotCollateral - validatedRetCol - <- hoistEither $ first ShelleyTxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral - dFee <- hoistEither $ first ShelleyTxCmdTxFeeValidationError $ validateTxFee era dummyFee - validatedBounds <- (,) <$> hoistEither (first ShelleyTxCmdTxValidityLowerBoundValidationError $ validateTxValidityLowerBound era mLowerBound) - <*> hoistEither (first ShelleyTxCmdTxValidityUpperBoundValidationError $ validateTxValidityUpperBound era mUpperBound) - validatedReqSigners <- hoistEither (first ShelleyTxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners) - validatedTxWtdrwls <- hoistEither (first ShelleyTxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals) - validatedTxCerts <- hoistEither (first ShelleyTxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeScriptWits) - validatedTxUpProp <- hoistEither (first ShelleyTxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdatePropF) - validatedMintValue <- hoistEither $ createTxMintValue era valuesWithScriptWits - validatedTxScriptValidity <- hoistEither (first ShelleyTxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity) - - case (consensusMode, cardanoEraStyle era) of - (CardanoMode, ShelleyBasedEra _sbe) -> do - void $ pure (toEraInMode era CardanoMode) - & onNothing (left (ShelleyTxCmdEraConsensusModeMismatchTxBalance outputOptions - (AnyConsensusMode CardanoMode) (AnyCardanoEra era))) - - let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc - localNodeConnInfo = LocalNodeConnectInfo - { localConsensusModeParams = CardanoModeParams $ EpochSlots 21600 - , localNodeNetworkId = networkId - , localNodeSocketPath = socketPath - } - AnyCardanoEra nodeEra <- lift (determineEra cModeParams localNodeConnInfo) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) - - let certs = - case validatedTxCerts of - TxCertificates _ cs _ -> cs - _ -> [] - - (nodeEraUTxO, pparams, eraHistory, systemStart, stakePools, stakeDelegDeposits) <- - firstExceptT ShelleyTxCmdQueryConvenienceError . newExceptT - $ queryStateForBalancedTx socketPath nodeEra networkId allTxInputs certs - - validatedPParams <- hoistEither $ first ShelleyTxCmdProtocolParametersValidationError - $ validateProtocolParameters era (Just pparams) - - let txBodyContent = TxBodyContent - (validateTxIns inputsAndMaybeScriptWits) - validatedCollateralTxIns - validatedRefInputs - txouts - validatedTotCollateral - validatedRetCol - dFee - validatedBounds - txMetadata - txAuxScripts - validatedReqSigners - validatedPParams - validatedTxWtdrwls - validatedTxCerts - validatedTxUpProp - validatedMintValue - validatedTxScriptValidity - - firstExceptT ShelleyTxCmdTxInsDoNotExist - . hoistEither $ txInsExistInUTxO allTxInputs nodeEraUTxO - firstExceptT ShelleyTxCmdQueryNotScriptLocked - . hoistEither $ notScriptLockedTxIns txinsc nodeEraUTxO - - cAddr <- pure (anyAddressInEra era changeAddr) - & onLeft (error $ "runTxBuild: Byron address used: " <> show changeAddr) -- should this throw instead? - - -- Why do we cast the era? The user can specify an era prior to the era that the node is currently in. - -- We cannot use the user specified era to construct a query against a node because it may differ - -- from the node's era and this will result in the 'QueryEraMismatch' failure. - txEraUtxo <- pure (eraCast era nodeEraUTxO) & onLeft (left . ShelleyTxCmdTxEraCastErr) - - balancedTxBody@(BalancedTxBody _ _ _ fee) <- - firstExceptT ShelleyTxCmdBalanceTxBody - . hoistEither - $ makeTransactionBodyAutoBalance systemStart (toLedgerEpochInfo eraHistory) - pparams stakePools stakeDelegDeposits txEraUtxo - txBodyContent cAddr mOverrideWits - - liftIO $ putStrLn $ "Estimated transaction fee: " <> (show fee :: String) - - return balancedTxBody - - (CardanoMode, LegacyByronEra) -> left ShelleyTxCmdByronEra - - (wrongMode, _) -> left (ShelleyTxCmdUnsupportedMode (AnyConsensusMode wrongMode)) - --- ---------------------------------------------------------------------------- --- Transaction body validation and conversion --- - --- | An enumeration of era-dependent features where we have to check that it --- is permissible to use this feature in this era. --- -data TxFeature = TxFeatureShelleyAddresses - | TxFeatureExplicitFees - | TxFeatureImplicitFees - | TxFeatureValidityLowerBound - | TxFeatureValidityUpperBound - | TxFeatureValidityNoUpperBound - | TxFeatureTxMetadata - | TxFeatureAuxScripts - | TxFeatureWithdrawals - | TxFeatureCertificates - | TxFeatureMintValue - | TxFeatureMultiAssetOutputs - | TxFeatureScriptWitnesses - | TxFeatureShelleyKeys - | TxFeatureCollateral - | TxFeatureProtocolParameters - | TxFeatureTxOutDatum - | TxFeatureScriptValidity - | TxFeatureExtraKeyWits - | TxFeatureInlineDatums - | TxFeatureTotalCollateral - | TxFeatureReferenceInputs - | TxFeatureReturnCollateral - deriving Show - -txFeatureMismatch :: CardanoEra era - -> TxFeature - -> ExceptT ShelleyTxCmdError IO a -txFeatureMismatch era feature = - hoistEither . Left $ ShelleyTxCmdTxFeatureMismatch (anyCardanoEra era) feature - -txFeatureMismatchPure :: CardanoEra era - -> TxFeature - -> Either ShelleyTxCmdError a -txFeatureMismatchPure era feature = - Left (ShelleyTxCmdTxFeatureMismatch (anyCardanoEra era) feature) - - -validateTxIns - :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] - -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] -validateTxIns = map convert - where - convert - :: (TxIn, Maybe (ScriptWitness WitCtxTxIn era)) - -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) - convert (txin, mScriptWitness) = - case mScriptWitness of - Just sWit -> - (txin , BuildTxWith $ ScriptWitness ScriptWitnessForSpending sWit) - Nothing -> - (txin, BuildTxWith $ KeyWitness KeyWitnessForSpending) - - -validateTxInsCollateral :: CardanoEra era - -> [TxIn] - -> Either ShelleyTxCmdError (TxInsCollateral era) -validateTxInsCollateral _ [] = return TxInsCollateralNone -validateTxInsCollateral era txins = - case collateralSupportedInEra era of - Nothing -> txFeatureMismatchPure era TxFeatureCollateral - Just supported -> return (TxInsCollateral supported txins) - -validateTxInsReference - :: CardanoEra era - -> [TxIn] - -> Either ShelleyTxCmdError (TxInsReference BuildTx era) -validateTxInsReference _ [] = return TxInsReferenceNone -validateTxInsReference era allRefIns = - case refInsScriptsAndInlineDatsSupportedInEra era of - Nothing -> txFeatureMismatchPure era TxFeatureReferenceInputs - Just supp -> return $ TxInsReference supp allRefIns - - -getAllReferenceInputs - :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] - -> [ScriptWitness WitCtxMint era] - -> [(Certificate , Maybe (ScriptWitness WitCtxStake era))] - -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] - -> [TxIn] -- ^ Read only reference inputs - -> [TxIn] -getAllReferenceInputs txins mintWitnesses certFiles withdrawals readOnlyRefIns = do - let txinsWitByRefInputs = [getReferenceInput sWit | (_, Just sWit) <- txins] - mintingRefInputs = map getReferenceInput mintWitnesses - certsWitByRefInputs = [getReferenceInput sWit | (_, Just sWit) <- certFiles] - withdrawalsWitByRefInputs = [getReferenceInput sWit | (_, _, Just sWit) <- withdrawals] - - catMaybes $ concat [ txinsWitByRefInputs - , mintingRefInputs - , certsWitByRefInputs - , withdrawalsWitByRefInputs - , map Just readOnlyRefIns - ] - where - getReferenceInput - :: ScriptWitness witctx era -> Maybe TxIn - getReferenceInput sWit = - case sWit of - PlutusScriptWitness _ _ (PReferenceScript refIn _) _ _ _ -> Just refIn - PlutusScriptWitness _ _ PScript{} _ _ _ -> Nothing - SimpleScriptWitness _ (SReferenceScript refIn _) -> Just refIn - SimpleScriptWitness _ SScript{} -> Nothing - -toAddressInAnyEra - :: CardanoEra era - -> AddressAny - -> Either ShelleyTxCmdError (AddressInEra era) -toAddressInAnyEra era addrAny = - case addrAny of - AddressByron bAddr -> return (AddressInEra ByronAddressInAnyEra bAddr) - AddressShelley sAddr -> - case cardanoEraStyle era of - LegacyByronEra -> txFeatureMismatchPure era TxFeatureShelleyAddresses - ShelleyBasedEra era' -> - return (AddressInEra (ShelleyAddressInEra era') sAddr) - -toTxOutValueInAnyEra - :: CardanoEra era - -> Value - -> Either ShelleyTxCmdError (TxOutValue era) -toTxOutValueInAnyEra era val = - case multiAssetSupportedInEra era of - Left adaOnlyInEra -> - case valueToLovelace val of - Just l -> return (TxOutAdaOnly adaOnlyInEra l) - Nothing -> txFeatureMismatchPure era TxFeatureMultiAssetOutputs - Right multiAssetInEra -> return (TxOutValue multiAssetInEra val) - -toTxOutInAnyEra :: CardanoEra era - -> TxOutAnyEra - -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era) -toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do - addr <- hoistEither $ toAddressInAnyEra era addr' - val <- hoistEither $ toTxOutValueInAnyEra era val' - (datum, refScript) - <- case (scriptDataSupportedInEra era, refInsScriptsAndInlineDatsSupportedInEra era) of - (Nothing, Nothing) -> pure (TxOutDatumNone, ReferenceScriptNone) - (Just sup, Nothing)-> - (,) <$> toTxAlonzoDatum sup mDatumHash <*> pure ReferenceScriptNone - (Just sup, Just inlineDatumRefScriptSupp) -> - toTxDatumReferenceScriptBabbage sup inlineDatumRefScriptSupp mDatumHash refScriptFp - (Nothing, Just _) -> - -- TODO: Figure out how to make this state unrepresentable - error "toTxOutInAnyEra: Should not be possible that inline datums are allowed but datums are not" - pure $ TxOut addr val datum refScript - where - getReferenceScript - :: ReferenceScriptAnyEra - -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era - -> ExceptT ShelleyTxCmdError IO (ReferenceScript era) - getReferenceScript ReferenceScriptAnyEraNone _ = return ReferenceScriptNone - getReferenceScript (ReferenceScriptAnyEra fp) supp = do - ReferenceScript supp - <$> firstExceptT ShelleyTxCmdScriptFileError (readFileScriptInAnyLang fp) - - toTxDatumReferenceScriptBabbage - :: ScriptDataSupportedInEra era - -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era - -> TxOutDatumAnyEra - -> ReferenceScriptAnyEra - -> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era, ReferenceScript era) - toTxDatumReferenceScriptBabbage sDataSupp inlineRefSupp cliDatum refScriptFp' = do - refScript <- getReferenceScript refScriptFp' inlineRefSupp - case cliDatum of - TxOutDatumByNone -> do - pure (TxOutDatumNone, refScript) - TxOutDatumByHashOnly dh -> do - pure (TxOutDatumHash sDataSupp dh, refScript) - TxOutDatumByHashOf fileOrSdata -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError - $ readScriptDataOrFile fileOrSdata - pure (TxOutDatumHash sDataSupp $ hashScriptDataBytes sData, refScript) - TxOutDatumByValue fileOrSdata -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError - $ readScriptDataOrFile fileOrSdata - pure (TxOutDatumInTx sDataSupp sData, refScript) - TxOutInlineDatumByValue fileOrSdata -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError - $ readScriptDataOrFile fileOrSdata - pure (TxOutDatumInline inlineRefSupp sData, refScript) - - toTxAlonzoDatum - :: ScriptDataSupportedInEra era - -> TxOutDatumAnyEra - -> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era) - toTxAlonzoDatum supp cliDatum = - case cliDatum of - TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h) - TxOutDatumByHashOf sDataOrFile -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError - $ readScriptDataOrFile sDataOrFile - pure (TxOutDatumHash supp $ hashScriptDataBytes sData) - TxOutDatumByValue sDataOrFile -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError - $ readScriptDataOrFile sDataOrFile - pure (TxOutDatumInTx supp sData) - TxOutInlineDatumByValue _ -> - txFeatureMismatch era TxFeatureInlineDatums - TxOutDatumByNone -> pure TxOutDatumNone - - --- TODO: Currently we specify the policyId with the '--mint' option on the cli --- and we added a separate '--policy-id' parser that parses the policy id for the --- given reference input (since we don't have the script in this case). To avoid asking --- for the policy id twice (in the build command) we can potentially query the UTxO and --- access the script (and therefore the policy id). -createTxMintValue :: forall era. CardanoEra era - -> (Value, [ScriptWitness WitCtxMint era]) - -> Either ShelleyTxCmdError (TxMintValue BuildTx era) -createTxMintValue era (val, scriptWitnesses) = - if List.null (valueToList val) && List.null scriptWitnesses - then return TxMintNone - else do - case multiAssetSupportedInEra era of - Left _ -> txFeatureMismatchPure era TxFeatureMintValue - Right supported -> do - -- The set of policy ids for which we need witnesses: - let witnessesNeededSet :: Set PolicyId - witnessesNeededSet = - Set.fromList [ pid | (AssetId pid _, _) <- valueToList val ] - - let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) - witnessesProvidedMap = Map.fromList $ gatherMintingWitnesses scriptWitnesses - - witnessesProvidedSet = Map.keysSet witnessesProvidedMap - - -- Check not too many, nor too few: - validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet - validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet - - return (TxMintValue supported val (BuildTxWith witnessesProvidedMap)) - where - gatherMintingWitnesses - :: [ScriptWitness WitCtxMint era] - -> [(PolicyId, ScriptWitness WitCtxMint era)] - gatherMintingWitnesses [] = [] - gatherMintingWitnesses (sWit : rest) = - case scriptWitnessPolicyId sWit of - Nothing -> gatherMintingWitnesses rest - Just pid -> (pid, sWit) : gatherMintingWitnesses rest - - validateAllWitnessesProvided witnessesNeeded witnessesProvided - | null witnessesMissing = return () - | otherwise = Left (ShelleyTxCmdPolicyIdsMissing witnessesMissing) - where - witnessesMissing = Set.elems (witnessesNeeded Set.\\ witnessesProvided) - - validateNoUnnecessaryWitnesses witnessesNeeded witnessesProvided - | null witnessesExtra = return () - | otherwise = Left (ShelleyTxCmdPolicyIdsExcess witnessesExtra) - where - witnessesExtra = Set.elems (witnessesProvided Set.\\ witnessesNeeded) - -scriptWitnessPolicyId :: ScriptWitness witctx era -> Maybe PolicyId -scriptWitnessPolicyId (SimpleScriptWitness _ (SScript script)) = - Just . scriptPolicyId $ SimpleScript script -scriptWitnessPolicyId (SimpleScriptWitness _ (SReferenceScript _ mPid)) = - PolicyId <$> mPid -scriptWitnessPolicyId (PlutusScriptWitness _ version (PScript script) _ _ _) = - Just . scriptPolicyId $ PlutusScript version script -scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _ mPid) _ _ _) = - PolicyId <$> mPid - - -readValueScriptWitnesses - :: CardanoEra era - -> (Value, [ScriptWitnessFiles WitCtxMint]) - -> ExceptT ShelleyTxCmdError IO (Value, [ScriptWitness WitCtxMint era]) -readValueScriptWitnesses era (v, sWitFiles) = do - sWits <- mapM (firstExceptT ShelleyTxCmdScriptWitnessError . readScriptWitness era) sWitFiles - return (v, sWits) - --- ---------------------------------------------------------------------------- --- Transaction signing --- - -runTxSign :: InputTxBodyOrTxFile - -> [WitnessSigningData] - -> Maybe NetworkId - -> TxFile Out - -> ExceptT ShelleyTxCmdError IO () -runTxSign txOrTxBody witSigningData mnw outTxFile = do - sks <- mapM (firstExceptT ShelleyTxCmdReadWitnessSigningDataError . newExceptT . readWitnessSigningData) witSigningData - - let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeWitness sks - - case txOrTxBody of - InputTxFile (File inputTxFilePath) -> do - inputTxFile <- liftIO $ fileOrPipe inputTxFilePath - anyTx <- lift (readFileTx inputTxFile) & onLeft (left . ShelleyTxCmdCddlError) - - InAnyShelleyBasedEra _era tx <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTx - - let (txbody, existingTxKeyWits) = getTxBodyAndWitnesses tx - - byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitnesses mnw txbody sksByron - - let newShelleyKeyWits = map (makeShelleyKeyWitness txbody) sksShelley - allKeyWits = existingTxKeyWits ++ newShelleyKeyWits ++ byronWitnesses - signedTx = makeSignedTransaction allKeyWits txbody - - lift (writeTxFileTextEnvelopeCddl outTxFile signedTx) - & onLeft (left . ShelleyTxCmdWriteFileError) - - InputTxBodyFile (File txbodyFilePath) -> do - txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT - $ readFileTxBody txbodyFile - - case unwitnessed of - IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra _era unwitTx <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTx - - let txbody = getTxBody unwitTx - -- Byron witnesses require the network ID. This can either be provided - -- directly or derived from a provided Byron address. - byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitnesses mnw txbody sksByron - - let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley - tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody - - lift (writeTxFileTextEnvelopeCddl outTxFile tx) - & onLeft (left . ShelleyTxCmdWriteFileError) - - UnwitnessedCliFormattedTxBody anyTxbody -> do - InAnyShelleyBasedEra _era txbody <- - --TODO: in principle we should be able to support Byron era txs too - onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody - -- Byron witnesses require the network ID. This can either be provided - -- directly or derived from a provided Byron address. - byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitnesses mnw txbody sksByron - - let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley - tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody - - firstExceptT ShelleyTxCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outTxFile - $ textEnvelopeToJSON Nothing tx - --- ---------------------------------------------------------------------------- --- Transaction submission --- - - -runTxSubmit - :: SocketPath - -> AnyConsensusModeParams - -> NetworkId - -> FilePath - -> ExceptT ShelleyTxCmdError IO () -runTxSubmit socketPath (AnyConsensusModeParams cModeParams) network txFilePath = do - txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) - let cMode = AnyConsensusMode $ consensusModeOnly cModeParams - eraInMode <- hoistMaybe - (ShelleyTxCmdEraConsensusModeMismatch (Just txFilePath) cMode (AnyCardanoEra era)) - (toEraInMode era $ consensusModeOnly cModeParams) - let txInMode = TxInMode tx eraInMode - localNodeConnInfo = LocalNodeConnectInfo - { localConsensusModeParams = cModeParams - , localNodeNetworkId = network - , localNodeSocketPath = socketPath - } - - res <- liftIO $ submitTxToNodeLocal localNodeConnInfo txInMode - case res of - Net.Tx.SubmitSuccess -> liftIO $ Text.putStrLn "Transaction successfully submitted." - Net.Tx.SubmitFail reason -> - case reason of - TxValidationErrorInMode err _eraInMode -> left . ShelleyTxCmdTxSubmitError . Text.pack $ show err - TxValidationEraMismatch mismatchErr -> left $ ShelleyTxCmdTxSubmitErrorEraMismatch mismatchErr - --- ---------------------------------------------------------------------------- --- Transaction fee calculation --- - -runTxCalculateMinFee - :: TxBodyFile In - -> NetworkId - -> ProtocolParamsFile - -> TxInCount - -> TxOutCount - -> TxShelleyWitnessCount - -> TxByronWitnessCount - -> ExceptT ShelleyTxCmdError IO () -runTxCalculateMinFee (File txbodyFilePath) nw pParamsFile - (TxInCount nInputs) (TxOutCount nOutputs) - (TxShelleyWitnessCount nShelleyKeyWitnesses) - (TxByronWitnessCount nByronKeyWitnesses) = do - - txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT - $ readFileTxBody txbodyFile - pparams <- firstExceptT ShelleyTxCmdProtocolParamsError $ readProtocolParameters pParamsFile - case unwitnessed of - IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra _era unwitTx <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTx - let txbody = getTxBody unwitTx - let tx = makeSignedTransaction [] txbody - Lovelace fee = estimateTransactionFee - nw - (protocolParamTxFeeFixed pparams) - (protocolParamTxFeePerByte pparams) - tx - nInputs nOutputs - nByronKeyWitnesses nShelleyKeyWitnesses - - liftIO $ putStrLn $ (show fee :: String) <> " Lovelace" - - UnwitnessedCliFormattedTxBody anyTxBody -> do - InAnyShelleyBasedEra _era txbody <- - --TODO: in principle we should be able to support Byron era txs too - onlyInShelleyBasedEras "calculate-min-fee for Byron era transactions" anyTxBody - - let tx = makeSignedTransaction [] txbody - Lovelace fee = estimateTransactionFee - nw - (protocolParamTxFeeFixed pparams) - (protocolParamTxFeePerByte pparams) - tx - nInputs nOutputs - nByronKeyWitnesses nShelleyKeyWitnesses - - liftIO $ putStrLn $ (show fee :: String) <> " Lovelace" - --- ---------------------------------------------------------------------------- --- Transaction fee calculation --- - -runTxCalculateMinRequiredUTxO - :: AnyCardanoEra - -> ProtocolParamsFile - -> TxOutAnyEra - -> ExceptT ShelleyTxCmdError IO () -runTxCalculateMinRequiredUTxO (AnyCardanoEra era) pParamsFile txOut = do - pp <- firstExceptT ShelleyTxCmdProtocolParamsError (readProtocolParameters pParamsFile) - out <- toTxOutInAnyEra era txOut - case cardanoEraStyle era of - LegacyByronEra -> error "runTxCalculateMinRequiredUTxO: Byron era not implemented yet" - ShelleyBasedEra sbe -> do - firstExceptT ShelleyTxCmdPParamsErr . hoistEither - $ checkProtocolParameters sbe pp - bpparams <- hoistEither . first (ShelleyTxCmdTxBodyError . TxBodyProtocolParamsConversionError) $ - bundleProtocolParams era pp - let minValue = calculateMinimumUTxO sbe out bpparams - liftIO . IO.print $ minValue - -runTxCreatePolicyId :: ScriptFile -> ExceptT ShelleyTxCmdError IO () -runTxCreatePolicyId (ScriptFile sFile) = do - ScriptInAnyLang _ script <- firstExceptT ShelleyTxCmdScriptFileError $ - readFileScriptInAnyLang sFile - liftIO . Text.putStrLn . serialiseToRawBytesHexText $ hashScript script - - --- | Error reading the data required to construct a key witness. - - -partitionSomeWitnesses - :: [ByronOrShelleyWitness] - -> ( [ShelleyBootstrapWitnessSigningKeyData] - , [ShelleyWitnessSigningKey] - ) -partitionSomeWitnesses = reversePartitionedWits . foldl' go mempty - where - reversePartitionedWits (bw, skw) = - (reverse bw, reverse skw) - - go (byronAcc, shelleyKeyAcc) byronOrShelleyWit = - case byronOrShelleyWit of - AByronWitness byronWit -> - (byronWit:byronAcc, shelleyKeyAcc) - AShelleyKeyWitness shelleyKeyWit -> - (byronAcc, shelleyKeyWit:shelleyKeyAcc) - - --- | Error constructing a Shelley bootstrap witness (i.e. a Byron key witness --- in the Shelley era). -data ShelleyBootstrapWitnessError - = MissingNetworkIdOrByronAddressError - -- ^ Neither a network ID nor a Byron address were provided to construct the - -- Shelley bootstrap witness. One or the other is required. - deriving Show - --- | Render an error message for a 'ShelleyBootstrapWitnessError'. -renderShelleyBootstrapWitnessError :: ShelleyBootstrapWitnessError -> Text -renderShelleyBootstrapWitnessError MissingNetworkIdOrByronAddressError = - "Transactions witnessed by a Byron signing key must be accompanied by a " - <> "network ID. Either provide a network ID or provide a Byron " - <> "address with each Byron signing key (network IDs can be derived " - <> "from Byron addresses)." - --- | Construct a Shelley bootstrap witness (i.e. a Byron key witness in the --- Shelley era). -mkShelleyBootstrapWitness - :: IsShelleyBasedEra era - => Maybe NetworkId - -> TxBody era - -> ShelleyBootstrapWitnessSigningKeyData - -> Either ShelleyBootstrapWitnessError (KeyWitness era) -mkShelleyBootstrapWitness Nothing _ (ShelleyBootstrapWitnessSigningKeyData _ Nothing) = - Left MissingNetworkIdOrByronAddressError -mkShelleyBootstrapWitness (Just nw) txBody (ShelleyBootstrapWitnessSigningKeyData skey Nothing) = - Right $ makeShelleyBootstrapWitness (WitnessNetworkId nw) txBody skey -mkShelleyBootstrapWitness _ txBody (ShelleyBootstrapWitnessSigningKeyData skey (Just addr)) = - Right $ makeShelleyBootstrapWitness (WitnessByronAddress addr) txBody skey - --- | Attempt to construct Shelley bootstrap witnesses until an error is --- encountered. -mkShelleyBootstrapWitnesses - :: IsShelleyBasedEra era - => Maybe NetworkId - -> TxBody era - -> [ShelleyBootstrapWitnessSigningKeyData] - -> Either ShelleyBootstrapWitnessError [KeyWitness era] -mkShelleyBootstrapWitnesses mnw txBody = - mapM (mkShelleyBootstrapWitness mnw txBody) - - --- ---------------------------------------------------------------------------- --- Other misc small commands --- - -runTxHashScriptData :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO () -runTxHashScriptData scriptDataOrFile = do - d <- firstExceptT ShelleyTxCmdScriptDataError $ readScriptDataOrFile scriptDataOrFile - liftIO $ BS.putStrLn $ serialiseToRawBytesHex (hashScriptDataBytes d) - -runTxGetTxId :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () -runTxGetTxId txfile = do - InAnyCardanoEra _era txbody <- - case txfile of - InputTxBodyFile (File txbodyFilePath) -> do - txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT - $ readFileTxBody txbodyFile - case unwitnessed of - UnwitnessedCliFormattedTxBody anyTxBody -> return anyTxBody - IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> - return (InAnyCardanoEra era (getTxBody tx)) - - InputTxFile (File txFilePath) -> do - txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) - return . InAnyCardanoEra era $ getTxBody tx - - liftIO $ BS.putStrLn $ serialiseToRawBytesHex (getTxId txbody) - -runTxView :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () -runTxView = \case - InputTxBodyFile (File txbodyFilePath) -> do - txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT - $ readFileTxBody txbodyFile - InAnyCardanoEra era txbody <- - case unwitnessed of - UnwitnessedCliFormattedTxBody anyTxBody -> pure anyTxBody - IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> - pure $ InAnyCardanoEra era (getTxBody tx) - --TODO: Why are we maintaining friendlyTxBodyBS and friendlyTxBS? - -- In the case of a transaction body, we can simply call makeSignedTransaction [] - -- to get a transaction which allows us to reuse friendlyTxBS! - liftIO $ BS.putStr $ friendlyTxBodyBS era txbody - InputTxFile (File txFilePath) -> do - txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) - liftIO $ BS.putStr $ friendlyTxBS era tx - - --- ---------------------------------------------------------------------------- --- Witness commands --- - -runTxCreateWitness - :: TxBodyFile In - -> WitnessSigningData - -> Maybe NetworkId - -> File () Out - -> ExceptT ShelleyTxCmdError IO () -runTxCreateWitness (File txbodyFilePath) witSignData mbNw oFile = do - txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT - $ readFileTxBody txbodyFile - case unwitnessed of - IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra sbe cddlTx <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTx - - let txbody = getTxBody cddlTx - someWit <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError - . newExceptT $ readWitnessSigningData witSignData - witness <- - case categoriseSomeWitness someWit of - -- Byron witnesses require the network ID. This can either be provided - -- directly or derived from a provided Byron address. - AByronWitness bootstrapWitData -> - firstExceptT ShelleyTxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitness mbNw txbody bootstrapWitData - AShelleyKeyWitness skShelley -> - pure $ makeShelleyKeyWitness txbody skShelley - - firstExceptT ShelleyTxCmdWriteFileError . newExceptT - $ writeTxWitnessFileTextEnvelopeCddl sbe oFile witness - - UnwitnessedCliFormattedTxBody anyTxbody -> do - InAnyShelleyBasedEra _era txbody <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody - - someWit <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError - . newExceptT $ readWitnessSigningData witSignData - - witness <- - case categoriseSomeWitness someWit of - -- Byron witnesses require the network ID. This can either be provided - -- directly or derived from a provided Byron address. - AByronWitness bootstrapWitData -> - firstExceptT ShelleyTxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitness mbNw txbody bootstrapWitData - AShelleyKeyWitness skShelley -> - pure $ makeShelleyKeyWitness txbody skShelley - - firstExceptT ShelleyTxCmdWriteFileError . newExceptT - $ writeLazyByteStringFile oFile - $ textEnvelopeToJSON Nothing witness - -runTxSignWitness - :: TxBodyFile In - -> [WitnessFile] - -> File () Out - -> ExceptT ShelleyTxCmdError IO () -runTxSignWitness (File txbodyFilePath) witnessFiles oFp = do - txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT - $ readFileTxBody txbodyFile - case unwitnessed of - UnwitnessedCliFormattedTxBody (InAnyCardanoEra era txbody) -> do - witnesses <- - sequence - [ do InAnyCardanoEra era' witness <- firstExceptT ShelleyTxCmdCddlWitnessError . newExceptT - $ readFileTxKeyWitness file - case testEquality era era' of - Nothing -> left $ ShelleyTxCmdWitnessEraMismatch - (AnyCardanoEra era) - (AnyCardanoEra era') - witnessFile - Just Refl -> return witness - | witnessFile@(WitnessFile file) <- witnessFiles - ] - - let tx = makeSignedTransaction witnesses txbody - firstExceptT ShelleyTxCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile oFp - $ textEnvelopeToJSON Nothing tx - - IncompleteCddlFormattedTx (InAnyCardanoEra era anyTx) -> do - let txbody = getTxBody anyTx - - witnesses <- - sequence - [ do InAnyCardanoEra era' witness <- firstExceptT ShelleyTxCmdCddlWitnessError . newExceptT - $ readFileTxKeyWitness file - case testEquality era era' of - Nothing -> left $ ShelleyTxCmdWitnessEraMismatch - (AnyCardanoEra era) - (AnyCardanoEra era') - witnessFile - Just Refl -> return witness - | witnessFile@(WitnessFile file) <- witnessFiles ] - - let tx = makeSignedTransaction witnesses txbody - - lift (writeTxFileTextEnvelopeCddl oFp tx) & onLeft (left . ShelleyTxCmdWriteFileError) - - --- | Constrain the era to be Shelley based. Fail for the Byron era. --- -onlyInShelleyBasedEras :: Text - -> InAnyCardanoEra a - -> ExceptT ShelleyTxCmdError IO - (InAnyShelleyBasedEra a) -onlyInShelleyBasedEras notImplMsg (InAnyCardanoEra era x) = - case cardanoEraStyle era of - LegacyByronEra -> left (ShelleyTxCmdNotImplemented notImplMsg) - ShelleyBasedEra era' -> return (InAnyShelleyBasedEra era' x) - - diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Validate.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Validate.hs deleted file mode 100644 index ec9c47a2357..00000000000 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Validate.hs +++ /dev/null @@ -1,359 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Cardano.CLI.Shelley.Run.Validate - ( TxAuxScriptsValidationError(..) - , TxCertificatesValidationError(..) - , TxFeeValidationError(..) - , TxProtocolParametersValidationError - , TxScriptValidityValidationError(..) - , TxUpdateProposalValidationError(..) - , TxValidityLowerBoundValidationError(..) - , TxValidityUpperBoundValidationError(..) - , TxRequiredSignersValidationError - , TxReturnCollateralValidationError(..) - , TxTotalCollateralValidationError(..) - , TxWithdrawalsValidationError(..) - , validateProtocolParameters - , validateScriptSupportedInEra - , validateTxAuxScripts - , validateTxCertificates - , validateTxFee - , validateRequiredSigners - , validateTxReturnCollateral - , validateTxScriptValidity - , validateTxTotalCollateral - , validateTxUpdateProposal - , validateTxValidityUpperBound - , validateTxValidityLowerBound - , validateTxWithdrawals - ) where - -import Prelude - -import Cardano.Api -import Cardano.Api.Shelley - -import Data.Bifunctor (first) -import qualified Data.Map.Strict as Map -import Data.Maybe -import qualified Data.Text as Text - -data ScriptLanguageValidationError - = ScriptLanguageValidationError AnyScriptLanguage AnyCardanoEra - deriving Show - -instance Error ScriptLanguageValidationError where - displayError (ScriptLanguageValidationError lang era) = - "The script language " <> show lang <> " is not supported in the " <> - Text.unpack (renderEra era) <> " era." - -validateScriptSupportedInEra - :: CardanoEra era - -> ScriptInAnyLang - -> Either ScriptLanguageValidationError (ScriptInEra era) -validateScriptSupportedInEra era script@(ScriptInAnyLang lang _) = - case toScriptInEra era script of - Nothing -> Left $ ScriptLanguageValidationError - (AnyScriptLanguage lang) (anyCardanoEra era) - Just script' -> pure script' - - -data TxFeeValidationError - = TxFeatureImplicitFeesE AnyCardanoEra -- ^ Expected an explicit fee - | TxFeatureExplicitFeesE AnyCardanoEra -- ^ Expected an implicit fee - deriving Show - -instance Error TxFeeValidationError where - displayError (TxFeatureImplicitFeesE era) = - "Implicit transaction fee not supported in " <> Text.unpack (renderEra era) - displayError (TxFeatureExplicitFeesE era) = - "Explicit transaction fee not supported in " <> Text.unpack (renderEra era) - -validateTxFee :: CardanoEra era - -> Maybe Lovelace - -> Either TxFeeValidationError (TxFee era) -validateTxFee era mfee = - case (txFeesExplicitInEra era, mfee) of - (Left implicit, Nothing) -> return (TxFeeImplicit implicit) - (Right explicit, Just fee) -> return (TxFeeExplicit explicit fee) - - (Right _, Nothing) -> Left . TxFeatureImplicitFeesE - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - (Left _, Just _) -> Left . TxFeatureExplicitFeesE - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - -newtype TxTotalCollateralValidationError - = TxTotalCollateralNotSupported AnyCardanoEra - deriving Show - -instance Error TxTotalCollateralValidationError where - displayError (TxTotalCollateralNotSupported era) = - "Transaction collateral not supported in " <> Text.unpack (renderEra era) - -validateTxTotalCollateral :: CardanoEra era - -> Maybe Lovelace - -> Either TxTotalCollateralValidationError (TxTotalCollateral era) -validateTxTotalCollateral _ Nothing = return TxTotalCollateralNone -validateTxTotalCollateral era (Just coll) = - case totalAndReturnCollateralSupportedInEra era of - Just supp -> return $ TxTotalCollateral supp coll - Nothing -> Left $ TxTotalCollateralNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - -newtype TxReturnCollateralValidationError - = TxReturnCollateralNotSupported AnyCardanoEra - deriving Show - -instance Error TxReturnCollateralValidationError where - displayError (TxReturnCollateralNotSupported era) = - "Transaction return collateral not supported in " <> Text.unpack (renderEra era) - -validateTxReturnCollateral :: CardanoEra era - -> Maybe (TxOut CtxTx era) - -> Either TxReturnCollateralValidationError (TxReturnCollateral CtxTx era) -validateTxReturnCollateral _ Nothing = return TxReturnCollateralNone -validateTxReturnCollateral era (Just retColTxOut) = do - case totalAndReturnCollateralSupportedInEra era of - Just supp -> return $ TxReturnCollateral supp retColTxOut - Nothing -> Left $ TxReturnCollateralNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - -newtype TxValidityLowerBoundValidationError - = TxValidityLowerBoundNotSupported AnyCardanoEra - deriving Show - -instance Error TxValidityLowerBoundValidationError where - displayError (TxValidityLowerBoundNotSupported era) = - "Transaction validity lower bound not supported in " <> Text.unpack (renderEra era) - - -validateTxValidityLowerBound :: CardanoEra era - -> Maybe SlotNo - -> Either TxValidityLowerBoundValidationError (TxValidityLowerBound era) -validateTxValidityLowerBound _ Nothing = return TxValidityNoLowerBound -validateTxValidityLowerBound era (Just slot) = - case validityLowerBoundSupportedInEra era of - Nothing -> Left $ TxValidityLowerBoundNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> return (TxValidityLowerBound supported slot) - -newtype TxValidityUpperBoundValidationError - = TxValidityUpperBoundNotSupported AnyCardanoEra - deriving Show - -instance Error TxValidityUpperBoundValidationError where - displayError (TxValidityUpperBoundNotSupported era) = - "Transaction validity upper bound must be specified in " <> Text.unpack (renderEra era) - -validateTxValidityUpperBound - :: CardanoEra era - -> Maybe SlotNo - -> Either TxValidityUpperBoundValidationError (TxValidityUpperBound era) -validateTxValidityUpperBound era Nothing = - case validityNoUpperBoundSupportedInEra era of - Nothing -> Left $ TxValidityUpperBoundNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> return (TxValidityNoUpperBound supported) -validateTxValidityUpperBound era (Just slot) = - case validityUpperBoundSupportedInEra era of - Nothing -> Left $ TxValidityUpperBoundNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> return (TxValidityUpperBound supported slot) - -data TxAuxScriptsValidationError - = TxAuxScriptsNotSupportedInEra AnyCardanoEra - | TxAuxScriptsLanguageError ScriptLanguageValidationError - deriving Show - -instance Error TxAuxScriptsValidationError where - displayError (TxAuxScriptsNotSupportedInEra era) = - "Transaction auxiliary scripts are not supported in " <> Text.unpack (renderEra era) - displayError (TxAuxScriptsLanguageError e) = - "Transaction auxiliary scripts error: " <> displayError e - -validateTxAuxScripts - :: CardanoEra era - -> [ScriptInAnyLang] - -> Either TxAuxScriptsValidationError (TxAuxScripts era) -validateTxAuxScripts _ [] = return TxAuxScriptsNone -validateTxAuxScripts era scripts = - case auxScriptsSupportedInEra era of - Nothing -> Left $ TxAuxScriptsNotSupportedInEra - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> do - scriptsInEra <- mapM (first TxAuxScriptsLanguageError . validateScriptSupportedInEra era) scripts - return $ TxAuxScripts supported scriptsInEra - -newtype TxRequiredSignersValidationError - = TxRequiredSignersValidationError AnyCardanoEra - deriving Show - -instance Error TxRequiredSignersValidationError where - displayError (TxRequiredSignersValidationError e) = - "Transaction required signers are not supported in " <> Text.unpack (renderEra e) - -validateRequiredSigners - :: CardanoEra era - -> [Hash PaymentKey] - -> Either TxRequiredSignersValidationError (TxExtraKeyWitnesses era) -validateRequiredSigners _ [] = return TxExtraKeyWitnessesNone -validateRequiredSigners era reqSigs = - case extraKeyWitnessesSupportedInEra era of - Nothing -> Left $ TxRequiredSignersValidationError - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> return $ TxExtraKeyWitnesses supported reqSigs - -newtype TxWithdrawalsValidationError - = TxWithdrawalsNotSupported AnyCardanoEra - deriving Show - -instance Error TxWithdrawalsValidationError where - displayError (TxWithdrawalsNotSupported e) = - "Transaction withdrawals are not supported in " <> Text.unpack (renderEra e) - -validateTxWithdrawals - :: forall era. - CardanoEra era - -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] - -> Either TxWithdrawalsValidationError (TxWithdrawals BuildTx era) -validateTxWithdrawals _ [] = return TxWithdrawalsNone -validateTxWithdrawals era withdrawals = - case withdrawalsSupportedInEra era of - Nothing -> Left $ TxWithdrawalsNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> do - let convWithdrawals = map convert withdrawals - return (TxWithdrawals supported convWithdrawals) - where - convert - :: (StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era)) - -> (StakeAddress, Lovelace, BuildTxWith BuildTx (Witness WitCtxStake era)) - convert (sAddr, ll, mScriptWitnessFiles) = - case mScriptWitnessFiles of - Just sWit -> do - (sAddr, ll, BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr sWit) - Nothing -> (sAddr,ll, BuildTxWith $ KeyWitness KeyWitnessForStakeAddr) - -newtype TxCertificatesValidationError - = TxCertificatesValidationNotSupported AnyCardanoEra - deriving Show - -instance Error TxCertificatesValidationError where - displayError (TxCertificatesValidationNotSupported e) = - "Transaction certificates are not supported in " <> Text.unpack (renderEra e) - -validateTxCertificates - :: forall era. - CardanoEra era - -> [(Certificate, Maybe (ScriptWitness WitCtxStake era))] - -> Either TxCertificatesValidationError (TxCertificates BuildTx era) -validateTxCertificates _ [] = return TxCertificatesNone -validateTxCertificates era certsAndScriptWitnesses = - case certificatesSupportedInEra era of - Nothing -> Left $ TxCertificatesValidationNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> do - let certs = map fst certsAndScriptWitnesses - reqWits = Map.fromList $ mapMaybe convert certsAndScriptWitnesses - return $ TxCertificates supported certs $ BuildTxWith reqWits - where - -- We get the stake credential witness for a certificate that requires it. - -- NB: Only stake address deregistration and delegation requires - -- witnessing (witness can be script or key) - deriveStakeCredentialWitness - :: Certificate - -> Maybe StakeCredential - deriveStakeCredentialWitness cert = do - case cert of - StakeAddressDeregistrationCertificate sCred -> Just sCred - StakeAddressPoolDelegationCertificate sCred _ -> Just sCred - _ -> Nothing - - convert - :: (Certificate, Maybe (ScriptWitness WitCtxStake era)) - -> Maybe (StakeCredential, Witness WitCtxStake era) - convert (cert, mScriptWitnessFiles) = do - sCred <- deriveStakeCredentialWitness cert - case mScriptWitnessFiles of - Just sWit -> do - Just ( sCred - , ScriptWitness ScriptWitnessForStakeAddr sWit - ) - Nothing -> Just (sCred, KeyWitness KeyWitnessForStakeAddr) - -newtype TxProtocolParametersValidationError - = ProtocolParametersNotSupported AnyCardanoEra - deriving Show - -instance Error TxProtocolParametersValidationError where - displayError (ProtocolParametersNotSupported e) = - "Transaction protocol parameters are not supported in " <> Text.unpack (renderEra e) - -validateProtocolParameters - :: CardanoEra era - -> Maybe ProtocolParameters - -> Either TxProtocolParametersValidationError (BuildTxWith BuildTx (Maybe ProtocolParameters)) -validateProtocolParameters _ Nothing = return (BuildTxWith Nothing) -validateProtocolParameters era (Just pparams) = - case scriptDataSupportedInEra era of - Nothing -> Left $ ProtocolParametersNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just _ -> return . BuildTxWith $ Just pparams - -newtype TxUpdateProposalValidationError - = TxUpdateProposalNotSupported AnyCardanoEra - deriving Show - -instance Error TxUpdateProposalValidationError where - displayError (TxUpdateProposalNotSupported e) = - "Transaction update proposal is not supported in " <> Text.unpack (renderEra e) - -validateTxUpdateProposal - :: CardanoEra era - -> Maybe UpdateProposal - -> Either TxUpdateProposalValidationError (TxUpdateProposal era) -validateTxUpdateProposal _ Nothing = return TxUpdateProposalNone -validateTxUpdateProposal era (Just prop) = - case updateProposalSupportedInEra era of - Nothing -> Left $ TxUpdateProposalNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> return $ TxUpdateProposal supported prop - -newtype TxScriptValidityValidationError - = ScriptValidityNotSupported AnyCardanoEra - deriving Show - -instance Error TxScriptValidityValidationError where - displayError (ScriptValidityNotSupported e) = - "Transaction script validity is not supported in " <> Text.unpack (renderEra e) - -validateTxScriptValidity - :: CardanoEra era - -> Maybe ScriptValidity - -> Either TxScriptValidityValidationError (TxScriptValidity era) -validateTxScriptValidity _ Nothing = pure TxScriptValidityNone -validateTxScriptValidity era (Just scriptValidity) = - case txScriptValiditySupportedInCardanoEra era of - Nothing -> Left $ ScriptValidityNotSupported - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - Just supported -> pure $ TxScriptValidity supported scriptValidity diff --git a/cardano-cli/src/Cardano/CLI/TopHandler.hs b/cardano-cli/src/Cardano/CLI/TopHandler.hs deleted file mode 100644 index 57900afc2de..00000000000 --- a/cardano-cli/src/Cardano/CLI/TopHandler.hs +++ /dev/null @@ -1,106 +0,0 @@ -module Cardano.CLI.TopHandler - ( toplevelExceptionHandler - ) where - --- The code in this module derives from multiple authors over many years. --- It is all under the BSD3 license below. --- --- Copyright (c) 2019 Input Output Global Inc (IOG). --- 2017 Edward Z. Yang --- 2015 Edsko de Vries --- 2009 Duncan Coutts --- 2007 Galois Inc. --- 2003 Isaac Jones, Simon Marlow --- --- Copyright (c) 2003-2017, Cabal Development Team. --- See the AUTHORS file for the full list of copyright holders. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- * Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- * Redistributions in binary form must reproduce the above --- copyright notice, this list of conditions and the following --- disclaimer in the documentation and/or other materials provided --- with the distribution. --- --- * Neither the name of Isaac Jones nor the names of other --- contributors may be used to endorse or promote products derived --- from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS --- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT --- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR --- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT --- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT --- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, --- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY --- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT --- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE --- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -import Prelude - -import Control.Exception - -import System.Environment -import System.Exit -import System.IO - - --- | An exception handler to use for a program top level, as an alternative to --- the default top level handler provided by GHC. --- --- Use like: --- --- > main :: IO () --- > main = toplevelExceptionHandler $ do --- > ... --- -toplevelExceptionHandler :: IO a -> IO a -toplevelExceptionHandler prog = do - -- Use line buffering in case we have to print big error messages, because - -- by default stderr to a terminal device is NoBuffering which is slow. - hSetBuffering stderr LineBuffering - catches prog [ - Handler rethrowAsyncExceptions - , Handler rethrowExitCode - , Handler handleSomeException - ] - where - -- Let async exceptions rise to the top for the default GHC top-handler. - -- This includes things like CTRL-C. - rethrowAsyncExceptions :: SomeAsyncException -> IO a - rethrowAsyncExceptions = throwIO - - -- We don't want to print ExitCode, and it should be handled by the default - -- top handler because that sets the actual OS process exit code. - rethrowExitCode :: ExitCode -> IO a - rethrowExitCode = throwIO - - -- Print all other exceptions - handleSomeException :: SomeException -> IO a - handleSomeException e = do - hFlush stdout - progname <- getProgName - hPutStr stderr (renderSomeException progname e) - throwIO (ExitFailure 1) - - -- Print the human-readable output of 'displayException' if it differs - -- from the default output (of 'show'), so that the user/sysadmin - -- sees something readable in the log. - renderSomeException :: String -> SomeException -> String - renderSomeException progname e - | showOutput /= displayOutput - = showOutput ++ "\n\n" ++ progname ++ ": " ++ displayOutput - - | otherwise - = "\n" ++ progname ++ ": " ++ showOutput - where - showOutput = show e - displayOutput = displayException e diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs deleted file mode 100644 index 78c2dd06096..00000000000 --- a/cardano-cli/src/Cardano/CLI/Types.hs +++ /dev/null @@ -1,361 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralisedNewtypeDeriving #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE StandaloneDeriving #-} - -module Cardano.CLI.Types - ( BalanceTxExecUnits (..) - , CBORObject (..) - , CertificateFile (..) - , CurrentKesPeriod (..) - , EpochLeadershipSchedule (..) - , GenesisFile (..) - , OpCertEndingKesPeriod (..) - , OpCertIntervalInformation (..) - , OpCertOnDiskCounter (..) - , OpCertNodeAndOnDiskCounterInformation (..) - , OpCertNodeStateCounter (..) - , OpCertStartingKesPeriod (..) - , OutputFormat (..) - , TxBuildOutputOptions(..) - , ReferenceScriptAnyEra (..) - , SigningKeyFile - , ScriptFile (..) - , ScriptDataOrFile (..) - , ScriptRedeemerOrFile - , ScriptWitnessFiles (..) - , ScriptDatumOrFile (..) - , SlotsTillKesKeyExpiry (..) - , TransferDirection(..) - , TxBodyFile - , TxOutAnyEra (..) - , TxOutChangeAddress (..) - , TxOutDatumAnyEra (..) - , TxFile - , TxMempoolQuery (..) - , UpdateProposalFile (..) - , VerificationKeyFile - , Params (..) - , RequiredSigner (..) - , AllOrOnly(..) - , File(..) - , FileDirection (..) - ) where - -import Data.Aeson (FromJSON (..), ToJSON (..), object, pairs, (.=)) -import qualified Data.Aeson as Aeson -import Data.String (IsString) -import qualified Data.Text as Text -import Data.Word (Word64) - -import qualified Cardano.Chain.Slotting as Byron - -import Cardano.Api (AddressAny, AnyScriptLanguage, EpochNo, ExecutionUnits, File (..), - FileDirection (..), Hash, HashableScriptData, Key (..), PaymentKey, PolicyId, - ScriptData, SlotNo (SlotNo), Tx, TxBody, TxId, TxIn, Value, WitCtxMint, - WitCtxStake, WitCtxTxIn) - -import qualified Cardano.Ledger.Crypto as Crypto - -import Cardano.Ledger.Shelley.TxBody (PoolParams (..)) - --- | Specify whether to render the script cost as JSON --- in the cli's build command. -data TxBuildOutputOptions = OutputScriptCostOnly (File () Out) - | OutputTxBodyOnly (TxBodyFile Out) - deriving Show - - --- | Specify what the CBOR file is --- i.e a block, a tx, etc -data CBORObject = CBORBlockByron Byron.EpochSlots - | CBORDelegationCertificateByron - | CBORTxByron - | CBORUpdateProposalByron - | CBORVoteByron - deriving Show - --- Encompasses stake certificates, stake pool certificates, --- genesis delegate certificates and MIR certificates. -newtype CertificateFile = CertificateFile { unCertificateFile :: FilePath } - deriving newtype (Eq, Show) - -newtype CurrentKesPeriod = CurrentKesPeriod { unCurrentKesPeriod :: Word64 } deriving (Eq, Show) - -instance ToJSON CurrentKesPeriod where - toJSON (CurrentKesPeriod k) = toJSON k - -instance FromJSON CurrentKesPeriod where - parseJSON v = CurrentKesPeriod <$> parseJSON v - -newtype GenesisFile = GenesisFile - { unGenesisFile :: FilePath } - deriving stock (Eq, Ord) - deriving newtype (IsString, Show) - -data OpCertNodeAndOnDiskCounterInformation - -- | The on disk operational certificate has a counter - -- that is equal to its corresponding counter in the - -- node state. The on disk operational certificate therefore - -- has a valid counter. - = OpCertOnDiskCounterEqualToNodeState - OpCertOnDiskCounter - OpCertNodeStateCounter - -- | The on disk operational certificate has a counter - -- that is ahead of the counter in the node state by 1. - -- The on disk operational certificate is invalid in - -- this case. - | OpCertOnDiskCounterAheadOfNodeState - OpCertOnDiskCounter - OpCertNodeStateCounter - -- | The on disk operational certificate has a counter - -- that is less than the counter in the node state. The - -- on disk operational certificate is invalid in this case. - | OpCertOnDiskCounterTooFarAheadOfNodeState - OpCertOnDiskCounter - OpCertNodeStateCounter - -- | The corresponding counter for operational certificate - -- was not found in the node state. This means the relevant - -- stake pool has not minted a block yet. When the stake pool - -- has minted a block the corresponding operational certificate's - -- counter will be present in the node state. - | OpCertOnDiskCounterBehindNodeState - OpCertOnDiskCounter - OpCertNodeStateCounter - -- | The on disk operational certificate has a counter - -- that is ahead of the counter in the node state by more - -- than 1. The on disk operational certificate is invalid in - -- this case. - | OpCertNoBlocksMintedYet - OpCertOnDiskCounter - deriving (Eq, Show) - -newtype OpCertOnDiskCounter = OpCertOnDiskCounter { unOpCertOnDiskCounter :: Word64 } - deriving (Eq, Show) - -instance ToJSON OpCertOnDiskCounter where - toJSON (OpCertOnDiskCounter k) = toJSON k - -instance FromJSON OpCertOnDiskCounter where - parseJSON v = OpCertOnDiskCounter <$> parseJSON v - -newtype OpCertNodeStateCounter = OpCertNodeStateCounter { unOpCertNodeStateCounter :: Word64 } - deriving (Eq, Show) - -instance ToJSON OpCertNodeStateCounter where - toJSON (OpCertNodeStateCounter k) = toJSON k - -instance FromJSON OpCertNodeStateCounter where - parseJSON v = OpCertNodeStateCounter <$> parseJSON v - -newtype OpCertStartingKesPeriod = OpCertStartingKesPeriod { unOpCertStartingKesPeriod :: Word64 } - deriving (Eq, Show) - -instance ToJSON OpCertStartingKesPeriod where - toJSON (OpCertStartingKesPeriod k) = toJSON k - -instance FromJSON OpCertStartingKesPeriod where - parseJSON v = OpCertStartingKesPeriod <$> parseJSON v - -newtype OpCertEndingKesPeriod = OpCertEndingKesPeriod { unOpCertEndingKesPeriod :: Word64 } - deriving (Eq, Show) - -instance ToJSON OpCertEndingKesPeriod where - toJSON (OpCertEndingKesPeriod k) = toJSON k - -instance FromJSON OpCertEndingKesPeriod where - parseJSON v = OpCertEndingKesPeriod <$> parseJSON v - -data OpCertIntervalInformation - = OpCertWithinInterval - OpCertStartingKesPeriod - OpCertEndingKesPeriod - CurrentKesPeriod - SlotsTillKesKeyExpiry - | OpCertStartingKesPeriodIsInTheFuture - OpCertStartingKesPeriod - OpCertEndingKesPeriod - CurrentKesPeriod - | OpCertExpired - OpCertStartingKesPeriod - OpCertEndingKesPeriod - CurrentKesPeriod - | OpCertSomeOtherError -- ^ Shouldn't be possible - OpCertStartingKesPeriod - OpCertEndingKesPeriod - CurrentKesPeriod - deriving (Eq, Show) - -instance FromJSON GenesisFile where - parseJSON (Aeson.String genFp) = pure . GenesisFile $ Text.unpack genFp - parseJSON invalid = error $ "Parsing of GenesisFile failed due to type mismatch. " - <> "Encountered: " <> show invalid - --- | The desired output format. -data OutputFormat - = OutputFormatHex - | OutputFormatBech32 - deriving (Eq, Show) - -data AllOrOnly a = All | Only a deriving (Eq, Show) - --- | This data structure is used to allow nicely formatted output in the query pool-params command. --- params are the current pool parameter settings, futureparams are new parameters, retiringEpoch is the --- epoch that has been set for pool retirement. Any of these may be Nothing. -data Params crypto = Params - { poolParameters :: Maybe (PoolParams crypto) - , futurePoolParameters :: Maybe (PoolParams crypto) - , retiringEpoch :: Maybe EpochNo - } deriving Show - --- | Pretty printing for pool parameters -instance Crypto.Crypto crypto => ToJSON (Params crypto) where - toJSON (Params p fp r) = object - [ "poolParams" .= p - , "futurePoolParams" .= fp - , "retiring" .= r - ] - - toEncoding (Params p fp r) = pairs $ mconcat - [ "poolParams" .= p - , "futurePoolParams" .= fp - , "retiring" .= r - ] - -type SigningKeyFile = File (SigningKey ()) - -newtype UpdateProposalFile = UpdateProposalFile { unUpdateProposalFile :: FilePath } - deriving newtype (Eq, Show) - -type VerificationKeyFile = File (VerificationKey ()) - -newtype ScriptFile = ScriptFile { unScriptFile :: FilePath } - deriving (Eq, Show) - -data ScriptDataOrFile = ScriptDataCborFile FilePath -- ^ By reference to a CBOR file - | ScriptDataJsonFile FilePath -- ^ By reference to a JSON file - | ScriptDataValue HashableScriptData -- ^ By value - deriving (Eq, Show) - -type ScriptRedeemerOrFile = ScriptDataOrFile - --- | This type is like 'ScriptWitness', but the file paths from which to load --- the script witness data representation. --- --- It is era-independent, but witness context-dependent. --- -data ScriptWitnessFiles witctx where - SimpleScriptWitnessFile :: ScriptFile - -> ScriptWitnessFiles witctx - - PlutusScriptWitnessFiles :: ScriptFile - -> ScriptDatumOrFile witctx - -> ScriptRedeemerOrFile - -> ExecutionUnits - -> ScriptWitnessFiles witctx - - -- TODO: Need to figure out how to exclude PlutusV1 scripts at the type level - PlutusReferenceScriptWitnessFiles - :: TxIn - -> AnyScriptLanguage - -> ScriptDatumOrFile witctx - -> ScriptRedeemerOrFile - -> ExecutionUnits - -> Maybe PolicyId -- ^ For minting reference scripts - -> ScriptWitnessFiles witctx - - SimpleReferenceScriptWitnessFiles - :: TxIn - -> AnyScriptLanguage - -> Maybe PolicyId -- ^ For minting reference scripts - -> ScriptWitnessFiles witctx - - -deriving instance Show (ScriptWitnessFiles witctx) - -data ScriptDatumOrFile witctx where - ScriptDatumOrFileForTxIn :: ScriptDataOrFile - -> ScriptDatumOrFile WitCtxTxIn - InlineDatumPresentAtTxIn :: ScriptDatumOrFile WitCtxTxIn - - NoScriptDatumOrFileForMint :: ScriptDatumOrFile WitCtxMint - NoScriptDatumOrFileForStake :: ScriptDatumOrFile WitCtxStake - -deriving instance Show (ScriptDatumOrFile witctx) - -newtype SlotsTillKesKeyExpiry = SlotsTillKesKeyExpiry { unSlotsTillKesKeyExpiry :: SlotNo } - deriving (Eq, Show) - -instance ToJSON SlotsTillKesKeyExpiry where - toJSON (SlotsTillKesKeyExpiry k) = toJSON k - -instance FromJSON SlotsTillKesKeyExpiry where - parseJSON v = SlotsTillKesKeyExpiry <$> parseJSON v - --- | Determines the direction in which the MIR certificate will transfer ADA. -data TransferDirection = TransferToReserves | TransferToTreasury - deriving Show - --- | A TxOut value that is the superset of possibilities for any era: any --- address type and allowing multi-asset values. This is used as the type for --- values passed on the command line. It can be converted into the --- era-dependent 'TxOutValue' type. --- -data TxOutAnyEra = TxOutAnyEra - AddressAny - Value - TxOutDatumAnyEra - ReferenceScriptAnyEra - deriving (Eq, Show) - -data TxOutDatumAnyEra = TxOutDatumByHashOnly (Hash ScriptData) - | TxOutDatumByHashOf ScriptDataOrFile - | TxOutDatumByValue ScriptDataOrFile - | TxOutInlineDatumByValue ScriptDataOrFile - | TxOutDatumByNone - deriving (Eq, Show) - -data ReferenceScriptAnyEra - = ReferenceScriptAnyEraNone - | ReferenceScriptAnyEra FilePath - deriving (Eq, Show) - --- | A partially-specified transaction output indented to use as a change --- output. --- --- It does not specify a value, since this will be worked out automatically. --- --- It does not use any script data hash, since that's generally not used for --- change outputs. --- -newtype TxOutChangeAddress = TxOutChangeAddress AddressAny - deriving (Eq, Show) - --- | A flag that differentiates between automatically --- and manually balancing a tx. -data BalanceTxExecUnits = AutoBalance | ManualBalance - --- | Plutus script required signers -data RequiredSigner - = RequiredSignerSkeyFile (SigningKeyFile In) - | RequiredSignerHash (Hash PaymentKey) - deriving Show - --- | Which leadership schedule we are interested in. --- TODO: Implement Previous and Next epochs -data EpochLeadershipSchedule - = CurrentEpoch - | NextEpoch - deriving Show - -type TxBodyFile = File (TxBody ()) - -type TxFile = File (Tx ()) - -data TxMempoolQuery = - TxMempoolQueryTxExists TxId - | TxMempoolQueryNextTx - | TxMempoolQueryInfo - deriving Show diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/SigningKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/SigningKeys.hs deleted file mode 100644 index 468bbdfb37e..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/SigningKeys.hs +++ /dev/null @@ -1,127 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Byron.SigningKeys - ( tests - ) where - -import Codec.CBOR.Read (deserialiseFromBytes) -import Control.Monad (void) -import Control.Monad.Trans.Except (runExceptT) -import qualified Data.ByteString.Lazy as LB - -import qualified Cardano.Crypto.Signing as Crypto - -import Cardano.Api.Byron - -import Cardano.CLI.Byron.Key (readByronSigningKey) -import Cardano.CLI.Byron.Legacy (decodeLegacyDelegateKey) -import Cardano.CLI.Shelley.Commands - -import Hedgehog (Group (..), Property, checkSequential, property, success) -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import Hedgehog.Internal.Property (failWith) -import Test.Cardano.CLI.Util - -prop_deserialise_legacy_signing_Key :: Property -prop_deserialise_legacy_signing_Key = propertyOnce $ do - legSkeyBs <- H.evalIO $ LB.readFile "test/cardano-cli-golden/files/golden/byron/keys/legacy.skey" - case deserialiseFromBytes decodeLegacyDelegateKey legSkeyBs of - Left deSerFail -> failWith Nothing $ show deSerFail - Right _ -> success - -prop_deserialise_nonLegacy_signing_Key :: Property -prop_deserialise_nonLegacy_signing_Key = propertyOnce $ do - skeyBs <- H.evalIO $ LB.readFile "test/cardano-cli-golden/files/golden/byron/keys/byron.skey" - case deserialiseFromBytes Crypto.fromCBORXPrv skeyBs of - Left deSerFail -> failWith Nothing $ show deSerFail - Right _ -> success - -prop_print_legacy_signing_key_address :: Property -prop_print_legacy_signing_key_address = propertyOnce $ do - let legKeyFp = "test/cardano-cli-golden/files/golden/byron/keys/legacy.skey" - - void $ execCardanoCLI - [ "signing-key-address", "--byron-legacy-formats" - , "--testnet-magic", "42" - , "--secret", legKeyFp - ] - - void $ execCardanoCLI - [ "signing-key-address", "--byron-legacy-formats" - , "--mainnet" - , "--secret", legKeyFp - ] - -prop_print_nonLegacy_signing_key_address :: Property -prop_print_nonLegacy_signing_key_address = propertyOnce $ do - let nonLegKeyFp = "test/cardano-cli-golden/files/golden/byron/keys/byron.skey" - - void $ execCardanoCLI - [ "signing-key-address", "--byron-formats" - , "--testnet-magic", "42" - , "--secret", nonLegKeyFp - ] - - void $ execCardanoCLI - [ "signing-key-address", "--byron-formats" - , "--mainnet" - , "--secret", nonLegKeyFp - ] - -prop_generate_and_read_nonlegacy_signingkeys :: Property -prop_generate_and_read_nonlegacy_signingkeys = property $ do - byronSkey <- H.evalIO $ generateSigningKey AsByronKey - case deserialiseFromRawBytes (AsSigningKey AsByronKey) (serialiseToRawBytes byronSkey) of - Left _ -> failWith Nothing "Failed to deserialise non-legacy Byron signing key. " - Right _ -> success - -prop_migrate_legacy_to_nonlegacy_signingkeys :: Property -prop_migrate_legacy_to_nonlegacy_signingkeys = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - let legKeyFp = "test/cardano-cli-golden/files/golden/byron/keys/legacy.skey" - nonLegacyKeyFp <- noteTempFile tempDir "nonlegacy.skey" - - void $ execCardanoCLI - [ "migrate-delegate-key-from" - , "--from", legKeyFp - , "--to", nonLegacyKeyFp - ] - - eSignKey <- H.evalIO . runExceptT . readByronSigningKey NonLegacyByronKeyFormat - $ File nonLegacyKeyFp - - case eSignKey of - Left err -> failWith Nothing $ show err - Right _ -> success - -prop_deserialise_NonLegacy_Signing_Key_API :: Property -prop_deserialise_NonLegacy_Signing_Key_API = propertyOnce $ do - eFailOrWit <- H.evalIO . runExceptT $ readByronSigningKey NonLegacyByronKeyFormat "test/cardano-cli-golden/files/golden/byron/keys/byron.skey" - case eFailOrWit of - Left keyFailure -> failWith Nothing $ show keyFailure - Right _ -> success - -prop_deserialiseLegacy_Signing_Key_API :: Property -prop_deserialiseLegacy_Signing_Key_API = propertyOnce $ do - eFailOrWit <- H.evalIO . runExceptT $ readByronSigningKey LegacyByronKeyFormat "test/cardano-cli-golden/files/golden/byron/keys/legacy.skey" - case eFailOrWit of - Left keyFailure -> failWith Nothing $ show keyFailure - Right _ -> success - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - checkSequential - $ Group "Byron Signing Key Serialisation" - [ ("prop_deserialise_legacy_signing_Key", prop_deserialise_legacy_signing_Key) - , ("prop_print_legacy_signing_key_address", prop_print_legacy_signing_key_address) - , ("prop_deserialise_nonLegacy_signing_Key", prop_deserialise_nonLegacy_signing_Key) - , ("prop_print_nonLegacy_signing_key_address", prop_print_nonLegacy_signing_key_address) - , ("prop_generate_and_read_nonlegacy_signingkeys", prop_generate_and_read_nonlegacy_signingkeys) - , ("prop_migrate_legacy_to_nonlegacy_signingkeys", prop_migrate_legacy_to_nonlegacy_signingkeys) - , ("prop_deserialise_NonLegacy_Signing_Key_API", prop_deserialise_NonLegacy_Signing_Key_API) - , ("prop_deserialiseLegacy_Signing_Key_API", prop_deserialiseLegacy_Signing_Key_API) - ] - diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Tx.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Tx.hs deleted file mode 100644 index b594ae181d4..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Tx.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Byron.Tx - ( txTests - ) where - -import Cardano.Api -import Cardano.Chain.UTxO (ATxAux) -import Cardano.CLI.Byron.Tx - -import Control.Monad (void) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Except (runExceptT) -import Data.ByteString (ByteString) -import qualified Data.Text as Text - -import Hedgehog (Property, (===)) -import qualified Hedgehog as H -import Hedgehog.Internal.Property (failWith) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - -golden_byronTx_legacy :: Property -golden_byronTx_legacy = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - signingKey <- noteInputFile "test/cardano-cli-golden/files/golden/byron/keys/legacy.skey" - goldenTx <- noteInputFile "test/cardano-cli-golden/files/golden/byron/tx/legacy.tx" - createdTx <- noteTempFile tempDir "tx" - void $ execCardanoCLI - [ "byron","transaction","issue-utxo-expenditure" - , "--mainnet" - , "--byron-legacy-formats" - , "--wallet-key", signingKey - , "--tx", createdTx - , "--txin", "(796a90e0a89b292d53a6129b9f0d757429063b529d27e4f56565192a8c8da5e3,10)" - , "--txout", "(\"2657WMsDfac6eFirdvKVPVMxNVYuACd1RGM2arH3g1y1yaQCr1yYpb2jr2b2aSiDZ\",999)" - ] - - compareByronTxs createdTx goldenTx - -golden_byronTx :: Property -golden_byronTx = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - signingKey <- noteInputFile "test/cardano-cli-golden/files/golden/byron/keys/byron.skey" - goldenTx <- noteInputFile "test/cardano-cli-golden/files/golden/byron/tx/normal.tx" - createdTx <- noteTempFile tempDir "tx" - void $ execCardanoCLI - [ "byron","transaction","issue-utxo-expenditure" - , "--mainnet" - , "--byron-formats" - , "--wallet-key", signingKey - , "--tx", createdTx - , "--txin", "(796a90e0a89b292d53a6129b9f0d757429063b529d27e4f56565192a8c8da5e3,10)" - , "--txout", "(\"2657WMsDfac6eFirdvKVPVMxNVYuACd1RGM2arH3g1y1yaQCr1yYpb2jr2b2aSiDZ\",999)" - ] - - compareByronTxs createdTx goldenTx - -getTxByteString :: FilePath -> H.PropertyT IO (ATxAux ByteString) -getTxByteString txFp = do - eATxAuxBS <- liftIO . runExceptT $ readByronTx $ File txFp - case eATxAuxBS of - Left err -> failWith Nothing . Text.unpack $ renderByronTxError err - Right aTxAuxBS -> return aTxAuxBS - -compareByronTxs :: FilePath -> FilePath -> H.PropertyT IO () -compareByronTxs createdTx goldenTx = do - createdATxAuxBS <- getTxByteString createdTx - goldenATxAuxBS <- getTxByteString goldenTx - - normalByronTxToGenTx goldenATxAuxBS === normalByronTxToGenTx createdATxAuxBS - -txTests :: IO Bool -txTests = - H.checkSequential - $ H.Group "Byron Tx Goldens" - [ ("golden_byronTx", golden_byronTx) - , ("golden_byronTx_legacy", golden_byronTx_legacy) - ] diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/TxBody.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/TxBody.hs deleted file mode 100644 index 3b86ac46729..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/TxBody.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Byron.TxBody - ( golden_byronTxBody - ) where - -import Hedgehog (Property) - -{- HLINT ignore "Use camelCase" -} - -golden_byronTxBody :: Property -golden_byronTxBody = error "TODO" diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/UpdateProposal.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/UpdateProposal.hs deleted file mode 100644 index 1e193d7bd2e..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/UpdateProposal.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Byron.UpdateProposal - ( updateProposalTest - ) where - -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (runExceptT) -import qualified Data.Text as Text - -import Cardano.CLI.Byron.UpdateProposal - -import Hedgehog (Property, (===)) -import qualified Hedgehog as H -import Hedgehog.Internal.Property (failWith) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - -golden_byron_update_proposal :: Property -golden_byron_update_proposal = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - goldenUpdateProposal <- noteInputFile "test/cardano-cli-golden/files/golden/byron/update-proposal" - signingKey <- noteInputFile "test/cardano-cli-golden/files/golden/byron/keys/byron.skey" - createdUpdateProposal <- noteTempFile tempDir "byron-update-proposal" - void $ execCardanoCLI - [ "byron","governance","create-update-proposal" - , "--mainnet" - , "--signing-key", signingKey - , "--protocol-version-major", "1" - , "--protocol-version-minor", "0" - , "--protocol-version-alt", "0" - , "--application-name", "cardano-sl" - , "--software-version-num", "1" - , "--system-tag", "linux" - , "--installer-hash", "0" - , "--filepath", createdUpdateProposal - ] - - eGolden <- liftIO . runExceptT $ readByronUpdateProposal goldenUpdateProposal - golden <- case eGolden of - Left err -> failWith Nothing . Text.unpack $ renderByronUpdateProposalError err - Right prop -> return prop - - eCreated <- liftIO . runExceptT $ readByronUpdateProposal createdUpdateProposal - created <- case eCreated of - Left err -> failWith Nothing . Text.unpack $ renderByronUpdateProposalError err - Right prop -> return prop - - golden === created - -updateProposalTest :: IO Bool -updateProposalTest = - H.checkSequential - $ H.Group "Byron Update Proposal Golden" - [ ("golden_byron_update_proposal", golden_byron_update_proposal) - ] diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Vote.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Vote.hs deleted file mode 100644 index 7b571cb5b6b..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Vote.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Byron.Vote - ( voteTests - ) where - -import Cardano.CLI.Byron.Vote - -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (runExceptT) -import qualified Data.Text as Text -import qualified Hedgehog.Extras.Test.Base as H - -import Hedgehog (Property, (===)) -import qualified Hedgehog as H -import Hedgehog.Internal.Property (failWith) -import Test.Cardano.CLI.Util - -{- HLINT ignore "Use camelCase" -} - -golden_byron_yes_vote :: Property -golden_byron_yes_vote = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - goldenYesVote <- noteInputFile "test/cardano-cli-golden/files/golden/byron/votes/vote-yes" - proposal <- noteInputFile "test/cardano-cli-golden/files/golden/byron/update-proposal" - signingKey <- noteInputFile "test/cardano-cli-golden/files/golden/byron/keys/byron.skey" - createdYesVote <- noteTempFile tempDir "byron-yes-vote" - void $ execCardanoCLI - [ "byron","governance","create-proposal-vote" - , "--mainnet" - , "--proposal-filepath", proposal - , "--signing-key", signingKey - , "--vote-yes" - , "--output-filepath", createdYesVote - ] - - eGolden <- liftIO . runExceptT $ readByronVote goldenYesVote - golden <- case eGolden of - Left err -> failWith Nothing . Text.unpack $ renderByronVoteError err - Right prop -> return prop - - eCreated <- liftIO . runExceptT $ readByronVote createdYesVote - created <- case eCreated of - Left err -> failWith Nothing . Text.unpack $ renderByronVoteError err - Right prop -> return prop - - golden === created - -golden_byron_no_vote :: Property -golden_byron_no_vote = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - goldenNoVote <- noteInputFile "test/cardano-cli-golden/files/golden/byron/votes/vote-no" - proposal <- noteInputFile "test/cardano-cli-golden/files/golden/byron/update-proposal" - signingKey <- noteInputFile "test/cardano-cli-golden/files/golden/byron/keys/byron.skey" - createdNoVote <- noteTempFile tempDir "byron-no-vote" - void $ execCardanoCLI - [ "byron","governance","create-proposal-vote" - , "--mainnet" - , "--proposal-filepath", proposal - , "--signing-key", signingKey - , "--vote-no" - , "--output-filepath", createdNoVote - ] - - eGolden <- liftIO . runExceptT $ readByronVote goldenNoVote - golden <- case eGolden of - Left err -> failWith Nothing . Text.unpack $ renderByronVoteError err - Right prop -> return prop - - eCreated <- liftIO . runExceptT $ readByronVote createdNoVote - created <- case eCreated of - Left err -> failWith Nothing . Text.unpack $ renderByronVoteError err - Right prop -> return prop - - golden === created - -voteTests :: IO Bool -voteTests = - H.checkSequential - $ H.Group "Byron Vote Goldens" - [ ("golden_byron_no_vote", golden_byron_no_vote) - , ("golden_byron_yes_vote", golden_byron_yes_vote) - ] diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Witness.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Witness.hs deleted file mode 100644 index 7225db71db0..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Witness.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Byron.Witness - ( golden_byronWitness - ) where - -import Hedgehog (Property) - -{- HLINT ignore "Use camelCase" -} - -golden_byronWitness :: Property -golden_byronWitness = error "TODO" diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Help.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Help.hs deleted file mode 100644 index ac9e5c10cec..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Help.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- HLINT ignore "Redundant id" -} - -module Test.Golden.Help - ( helpTests - ) where - -import Prelude hiding (lines) - -import Control.Monad (forM_, unless, (<=<)) -import Data.Maybe (maybeToList) -import Data.Text (Text) -import Hedgehog (Property) -import Hedgehog.Extras.Stock.OS (isWin32) -import System.FilePath (()) -import Test.Cardano.CLI.Util (execCardanoCLI, propertyOnce) -import Text.Regex (Regex, mkRegex, subRegex) - -import qualified Data.Char as Char -import qualified Data.List as List -import qualified Data.Text as Text -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.Golden as H -import qualified Test.Cardano.CLI.Util as H - -ansiRegex :: Regex -ansiRegex = mkRegex "\\[[0-9]+m" - -filterAnsi :: String -> String -filterAnsi line = subRegex ansiRegex stripped "" - where stripped = filter (/= '\ESC') line - -{- HLINT ignore "Use camelCase" -} - -extractCmd :: Text -> [Text] -extractCmd = id - . takeWhile nonSwitch - . Text.split Char.isSpace - . Text.strip - where nonSwitch :: Text -> Bool - nonSwitch s = - case Text.unpack (Text.take 1 s) of - (c:_) -> Char.isAlpha c - [] -> False - --- | Test that converting a @cardano-address@ Byron signing key yields the --- expected result. -golden_HelpAll :: Property -golden_HelpAll = - propertyOnce . H.moduleWorkspace "help" $ \_ -> do - -- These tests are not run on Windows because the cardano-cli usage - -- output is slightly different on Windows. For example it uses - -- "cardano-cli.exe" instead of "cardano-cli". - unless isWin32 $ do - helpFp <- H.note "test/cardano-cli-golden/files/golden/help.cli" - - help <- filterAnsi <$> execCardanoCLI - [ "help" - ] - - H.diffVsGoldenFile help helpFp - -third :: (a, b, c) -> c -third (_, _, c) = c - --- | Return the string with the prefix dropped if the prefix is present, otherwise return Nothing. -selectAndDropPrefix :: Text -> Text -> Maybe Text -selectAndDropPrefix prefix text = - if Text.isPrefixOf prefix text - then Just $ Text.drop (Text.length prefix) text - else Nothing - -deselectSuffix :: Text -> Text -> Maybe Text -deselectSuffix suffix text = - if Text.isSuffixOf suffix text - then Nothing - else Just text - -selectCmd :: Text -> Maybe Text -selectCmd = selectAndDropPrefix "Usage: cardano-cli " <=< deselectSuffix " COMMAND" - -golden_HelpCmds :: Property -golden_HelpCmds = - propertyOnce . H.moduleWorkspace "help-commands" $ \_ -> do - -- These tests are not run on Windows because the cardano-cli usage - -- output is slightly different on Windows. For example it uses - -- "cardano-cli.exe" instead of "cardano-cli". - unless isWin32 $ do - help <- filterAnsi <$> execCardanoCLI - [ "help" - ] - - let lines = Text.lines $ Text.pack help - let usages = List.filter (not . null) $ fmap extractCmd $ maybeToList . selectCmd =<< lines - - forM_ usages $ \usage -> do - H.noteShow_ usage - let expectedCmdHelpFp = "test/cardano-cli-golden/files/golden/help" Text.unpack (Text.intercalate "_" usage) <> ".cli" - - cmdHelp <- filterAnsi . third <$> H.execDetailCardanoCli (fmap Text.unpack usage) - - H.diffVsGoldenFile cmdHelp expectedCmdHelpFp - -helpTests :: IO Bool -helpTests = - H.checkSequential $ H.Group "Help" - [ ( "golden_HelpAll" - , Test.Golden.Help.golden_HelpAll - ) - , ( "golden_HelpCmds" - , Test.Golden.Help.golden_HelpCmds - ) - ] diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Key.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Key.hs deleted file mode 100644 index 1ae0cb81f34..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Key.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Key - ( keyTests - ) where - -import qualified Test.Golden.Key.NonExtendedKey - -import qualified Hedgehog as H - -keyTests :: IO Bool -keyTests = - H.checkSequential - $ H.Group "Key command group" - [ ( "golden_KeyNonExtendedKey_GenesisExtendedVerificationKey" - , Test.Golden.Key.NonExtendedKey.golden_KeyNonExtendedKey_GenesisExtendedVerificationKey - ) - , ( "golden_KeyNonExtendedKey_StakeExtendedVerificationKeyShelley" - , Test.Golden.Key.NonExtendedKey.golden_KeyNonExtendedKey_StakeExtendedVerificationKeyShelley - ) - ] diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Key/NonExtendedKey.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Key/NonExtendedKey.hs deleted file mode 100644 index 2e3627bbcd7..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Key/NonExtendedKey.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Key.NonExtendedKey - ( golden_KeyNonExtendedKey_GenesisExtendedVerificationKey - , golden_KeyNonExtendedKey_StakeExtendedVerificationKeyShelley - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H -import qualified Hedgehog.Extras.Test.Golden as H -import System.FilePath (()) -import Test.Cardano.CLI.Util (execCardanoCLI, propertyOnce) - -{- HLINT ignore "Use camelCase" -} - --- | Test that converting a @cardano-address@ Byron signing key yields the --- expected result. -golden_KeyNonExtendedKey_GenesisExtendedVerificationKey :: Property -golden_KeyNonExtendedKey_GenesisExtendedVerificationKey = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - genesisVKeyFp <- H.note "test/cardano-cli-golden/files/golden/key/non-extended-keys/shelley.000.vkey" - nonExtendedFp <- H.note "test/cardano-cli-golden/files/golden/key/non-extended-keys/non-extended-shelley.000.vkey" - outFp <- H.note $ tempDir "non-extended-shelley.000.vkey" - - H.assertFilesExist [genesisVKeyFp] - - -- Convert the `cardano-address` signing key - void $ execCardanoCLI - [ "key", "non-extended-key" - , "--extended-verification-key-file", genesisVKeyFp - , "--verification-key-file", outFp - ] - - -- Check for existence of the converted signing key file - H.assertFilesExist [outFp] - - H.diffFileVsGoldenFile outFp nonExtendedFp - --- | Test that converting a @cardano-address@ Byron signing key yields the --- expected result. -golden_KeyNonExtendedKey_StakeExtendedVerificationKeyShelley :: Property -golden_KeyNonExtendedKey_StakeExtendedVerificationKeyShelley = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - genesisVKeyFp <- H.note "test/cardano-cli-golden/files/golden/key/non-extended-keys/stake.000.vkey" - nonExtendedFp <- H.note "test/cardano-cli-golden/files/golden/key/non-extended-keys/non-extended-stake.000.vkey" - outFp <- H.note $ tempDir "non-extended-stake.000.vkey" - - H.assertFilesExist [genesisVKeyFp] - - -- Convert the `cardano-address` signing key - void $ execCardanoCLI - [ "key", "non-extended-key" - , "--extended-verification-key-file", genesisVKeyFp - , "--verification-key-file", outFp - ] - - -- Check for existence of the converted signing key file - H.assertFilesExist [outFp] - - H.diffFileVsGoldenFile outFp nonExtendedFp diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley.hs deleted file mode 100644 index d639746d8e1..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley.hs +++ /dev/null @@ -1,202 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley - ( keyConversionTests - , keyTests - , certificateTests - , governancePollTests - , metadataTests - , multiSigTests - , txTests - ) where - -import Test.Golden.Shelley.Address.Build (golden_shelleyAddressBuild) -import Test.Golden.Shelley.Address.Info (golden_shelleyAddressInfo) -import Test.Golden.Shelley.Address.KeyGen (golden_shelleyAddressKeyGen) -import Test.Golden.Shelley.Genesis.Create (golden_shelleyGenesisCreate) -import Test.Golden.Shelley.Genesis.InitialTxIn (golden_shelleyGenesisInitialTxIn) -import Test.Golden.Shelley.Genesis.KeyGenDelegate (golden_shelleyGenesisKeyGenDelegate) -import Test.Golden.Shelley.Genesis.KeyGenGenesis (golden_shelleyGenesisKeyGenGenesis) -import Test.Golden.Shelley.Genesis.KeyGenUtxo (golden_shelleyGenesisKeyGenUtxo) -import Test.Golden.Shelley.Genesis.KeyHash (golden_shelleyGenesisKeyHash) - -import Test.Golden.Shelley.Governance.AnswerPoll (golden_shelleyGovernanceAnswerPoll0, - golden_shelleyGovernanceAnswerPollNeg1Invalid, - golden_shelleyGovernanceAnswerPollPos1, - golden_shelleyGovernanceAnswerPollPos2Invalid) -import Test.Golden.Shelley.Governance.CreatePoll (golden_shelleyGovernanceCreateLongPoll, - golden_shelleyGovernanceCreatePoll) -import Test.Golden.Shelley.Governance.VerifyPoll (golden_shelleyGovernanceVerifyPoll, - golden_shelleyGovernanceVerifyPollInvalidAnswer, - golden_shelleyGovernanceVerifyPollMalformedAnswer, - golden_shelleyGovernanceVerifyPollMismatch, - golden_shelleyGovernanceVerifyPollNoAnswer) - -import Test.Golden.Shelley.Key.ConvertCardanoAddressKey - (golden_convertCardanoAddressByronSigningKey, - golden_convertCardanoAddressIcarusSigningKey, - golden_convertCardanoAddressShelleyPaymentSigningKey, - golden_convertCardanoAddressShelleyStakeSigningKey) -import Test.Golden.Shelley.Node.IssueOpCert (golden_shelleyNodeIssueOpCert) -import Test.Golden.Shelley.Node.KeyGen (golden_shelleyNodeKeyGen) -import Test.Golden.Shelley.Node.KeyGenKes (golden_shelleyNodeKeyGenKes) -import Test.Golden.Shelley.Node.KeyGenVrf (golden_shelleyNodeKeyGenVrf) -import Test.Golden.Shelley.StakeAddress.Build (golden_shelleyStakeAddressBuild) -import Test.Golden.Shelley.StakeAddress.DeregistrationCertificate - (golden_shelleyStakeAddressDeregistrationCertificate) -import Test.Golden.Shelley.StakeAddress.KeyGen (golden_shelleyStakeAddressKeyGen) -import Test.Golden.Shelley.StakeAddress.RegistrationCertificate - (golden_shelleyStakeAddressRegistrationCertificate) -import Test.Golden.Shelley.StakePool.RegistrationCertificate - (golden_shelleyStakePoolRegistrationCertificate) -import Test.Golden.Shelley.TextEnvelope.Certificates.GenesisKeyDelegationCertificate - (golden_shelleyGenesisKeyDelegationCertificate) -import Test.Golden.Shelley.TextEnvelope.Certificates.MIRCertificate - (golden_shelleyMIRCertificate) -import Test.Golden.Shelley.TextEnvelope.Certificates.OperationalCertificate - (golden_shelleyOperationalCertificate) -import Test.Golden.Shelley.TextEnvelope.Certificates.StakeAddressCertificates - (golden_shelleyStakeAddressCertificates) -import Test.Golden.Shelley.TextEnvelope.Certificates.StakePoolCertificates - (golden_shelleyStakePoolCertificates) - -import Test.Golden.Shelley.Metadata.StakePoolMetadata (golden_stakePoolMetadataHash) -import Test.Golden.Shelley.MultiSig.Address (golden_shelleyAllMultiSigAddressBuild, - golden_shelleyAnyMultiSigAddressBuild, golden_shelleyAtLeastMultiSigAddressBuild) -import Test.Golden.Shelley.TextEnvelope.Keys.ExtendedPaymentKeys - (golden_shelleyExtendedPaymentKeys) -import Test.Golden.Shelley.TextEnvelope.Keys.GenesisDelegateKeys - (golden_shelleyGenesisDelegateKeys) -import Test.Golden.Shelley.TextEnvelope.Keys.GenesisKeys (golden_shelleyGenesisKeys) -import Test.Golden.Shelley.TextEnvelope.Keys.GenesisUTxOKeys - (golden_shelleyGenesisUTxOKeys) -import Test.Golden.Shelley.TextEnvelope.Keys.KESKeys (golden_shelleyKESKeys) -import Test.Golden.Shelley.TextEnvelope.Keys.PaymentKeys (golden_shelleyPaymentKeys) -import Test.Golden.Shelley.TextEnvelope.Keys.StakeKeys (golden_shelleyStakeKeys) -import Test.Golden.Shelley.TextEnvelope.Keys.VRFKeys (golden_shelleyVRFKeys) -import Test.Golden.Shelley.TextView.DecodeCbor (golden_shelleyTextViewDecodeCbor) -import Test.Golden.Shelley.Transaction.Assemble - (golden_shelleyTransactionAssembleWitness_SigningKey) -import Test.Golden.Shelley.Transaction.Build (golden_shelleyTransactionBuild, - golden_shelleyTransactionBuild_CertificateScriptWitnessed, - golden_shelleyTransactionBuild_Minting, - golden_shelleyTransactionBuild_TxInScriptWitnessed, - golden_shelleyTransactionBuild_WithdrawalScriptWitnessed) -import Test.Golden.Shelley.Transaction.CalculateMinFee - (golden_shelleyTransactionCalculateMinFee) -import Test.Golden.Shelley.Transaction.CreateWitness - (golden_shelleyTransactionSigningKeyWitness) -import Test.Golden.Shelley.Transaction.Sign (golden_shelleyTransactionSign) - -import Test.Golden.Shelley.TextEnvelope.Tx.Tx (golden_shelleyTx) -import Test.Golden.Shelley.TextEnvelope.Tx.TxBody (golden_shelleyTxBody) - -import Test.Golden.Version (golden_version) - -import qualified Hedgehog as H - -keyTests :: IO Bool -keyTests = - H.checkSequential - $ H.Group "TextEnvelope Key Goldens" - [ ("golden_shelleyAddressInfo", golden_shelleyAddressInfo) - , ("golden_shelleyAddressKeyGen", golden_shelleyAddressKeyGen) - , ("golden_shelleyAddressBuild", golden_shelleyAddressBuild) - , ("golden_shelleyExtendedPaymentKeys", golden_shelleyExtendedPaymentKeys) - , ("golden_shelleyGenesisCreate", golden_shelleyGenesisCreate) - , ("golden_shelleyGenesisDelegateKeys", golden_shelleyGenesisDelegateKeys) - , ("golden_shelleyGenesisInitialTxIn", golden_shelleyGenesisInitialTxIn) - , ("golden_shelleyGenesisKeyGenDelegate", golden_shelleyGenesisKeyGenDelegate) - , ("golden_shelleyGenesisKeyGenGenesis", golden_shelleyGenesisKeyGenGenesis) - , ("golden_shelleyGenesisKeyGenUtxo", golden_shelleyGenesisKeyGenUtxo) - , ("golden_shelleyGenesisKeyHash", golden_shelleyGenesisKeyHash) - , ("golden_shelleyGenesisKeys", golden_shelleyGenesisKeys) - , ("golden_shelleyGenesisUTxOKeys", golden_shelleyGenesisUTxOKeys) - , ("golden_shelleyKESKeys", golden_shelleyKESKeys) - , ("golden_shelleyNodeIssueOpCert", golden_shelleyNodeIssueOpCert) - , ("golden_shelleyNodeKeyGen", golden_shelleyNodeKeyGen) - , ("golden_shelleyNodeKeyGenKes", golden_shelleyNodeKeyGenKes) - , ("golden_shelleyNodeKeyGenVrf", golden_shelleyNodeKeyGenVrf) - , ("golden_shelleyPaymentKeys", golden_shelleyPaymentKeys) - , ("golden_shelleyStakeAddressBuild", golden_shelleyStakeAddressBuild) - , ("golden_shelleyStakeAddressDeregistrationCertificate", golden_shelleyStakeAddressDeregistrationCertificate) - , ("golden_shelleyStakeAddressKeyGen", golden_shelleyStakeAddressKeyGen) - , ("golden_shelleyStakeAddressRegistrationCertificate", golden_shelleyStakeAddressRegistrationCertificate) - , ("golden_shelleyStakeKeys", golden_shelleyStakeKeys) - , ("golden_shelleyStakePoolRegistrationCertificate", golden_shelleyStakePoolRegistrationCertificate) - , ("golden_shelleyTextViewDecodeCbor", golden_shelleyTextViewDecodeCbor) - , ("golden_shelleyTransactionBuild", golden_shelleyTransactionBuild) - , ("golden_shelleyTransactionBuild_TxInScriptWitnessed", golden_shelleyTransactionBuild_TxInScriptWitnessed) - , ("golden_shelleyTransactionBuild_Minting", golden_shelleyTransactionBuild_Minting) - , ("golden_shelleyTransactionBuild_CertificateScriptWitnessed", golden_shelleyTransactionBuild_CertificateScriptWitnessed) - , ("golden_shelleyTransactionBuild_WithdrawalScriptWitnessed", golden_shelleyTransactionBuild_WithdrawalScriptWitnessed) - , ("golden_shelleyTransactionCalculateMinFee", golden_shelleyTransactionCalculateMinFee) - , ("golden_shelleyTransactionSign", golden_shelleyTransactionSign) - , ("golden_shelleyVRFKeys", golden_shelleyVRFKeys) - , ("golden_version", golden_version) - ] - -txTests :: IO Bool -txTests = - H.checkSequential - $ H.Group "TextEnvelope Tx Goldens" - [ ("golden_shelleyTxBody", golden_shelleyTxBody) - , ("golden_shelleyTx", golden_shelleyTx) - ] - -certificateTests :: IO Bool -certificateTests = - H.checkSequential - $ H.Group "TextEnvelope Certificate Goldens" - [ ("golden_shelleyStakeAddressCertificates", golden_shelleyStakeAddressCertificates) - , ("golden_shelleyOperationalCertificate", golden_shelleyOperationalCertificate) - , ("golden_shelleyStakePoolCertificates", golden_shelleyStakePoolCertificates) - , ("golden_shelleyMIRCertificate", golden_shelleyMIRCertificate) - , ("golden_shelleyGenesisKeyDelegationCertificate", golden_shelleyGenesisKeyDelegationCertificate) - ] - -keyConversionTests :: IO Bool -keyConversionTests = - H.checkSequential - $ H.Group "Key Conversion Goldens" - [ ("golden_convertCardanoAddressByronSigningKey", golden_convertCardanoAddressByronSigningKey) - , ("golden_convertCardanoAddressIcarusSigningKey", golden_convertCardanoAddressIcarusSigningKey) - , ("golden_convertCardanoAddressShelleyPaymentSigningKey", golden_convertCardanoAddressShelleyPaymentSigningKey) - , ("golden_convertCardanoAddressShelleyStakeSigningKey", golden_convertCardanoAddressShelleyStakeSigningKey) - ] - -metadataTests :: IO Bool -metadataTests = - H.checkSequential - $ H.Group "Metadata Goldens" - [ ("golden_stakePoolMetadataHash", golden_stakePoolMetadataHash) - ] - -multiSigTests :: IO Bool -multiSigTests = - H.checkSequential - $ H.Group "Multisig Goldens" - [ ("golden_shelleyAllMultiSigAddressBuild", golden_shelleyAllMultiSigAddressBuild) - , ("golden_shelleyAnyMultiSigAddressBuild", golden_shelleyAnyMultiSigAddressBuild) - , ("golden_shelleyAtLeastMultiSigAddressBuild", golden_shelleyAtLeastMultiSigAddressBuild) - , ("golden_shelleyTransactionAssembleWitness_SigningKey", golden_shelleyTransactionAssembleWitness_SigningKey) - , ("golden_shelleyTransactionSigningKeyWitness", golden_shelleyTransactionSigningKeyWitness) - ] - -governancePollTests :: IO Bool -governancePollTests = - H.checkSequential - $ H.Group "Governance Poll Goldens" - [ ("golden_shelleyGovernanceCreatePoll", golden_shelleyGovernanceCreatePoll) - , ("golden_shelleyGovernanceCreateLongPoll", golden_shelleyGovernanceCreateLongPoll) - , ("golden_shelleyGovernanceAnswerPollNeg1Invalid", golden_shelleyGovernanceAnswerPollNeg1Invalid) - , ("golden_shelleyGovernanceAnswerPoll0", golden_shelleyGovernanceAnswerPoll0) - , ("golden_shelleyGovernanceAnswerPollPos1", golden_shelleyGovernanceAnswerPollPos1) - , ("golden_shelleyGovernanceAnswerPollPos2Invalid", golden_shelleyGovernanceAnswerPollPos2Invalid) - , ("golden_shelleyGovernanceVerifyPoll", golden_shelleyGovernanceVerifyPoll) - , ("golden_shelleyGovernanceVerifyPoll (mismatch)", golden_shelleyGovernanceVerifyPollMismatch) - , ("golden_shelleyGovernanceVerifyPoll (no answer)", golden_shelleyGovernanceVerifyPollNoAnswer) - , ("golden_shelleyGovernanceVerifyPoll (malformed)", golden_shelleyGovernanceVerifyPollMalformedAnswer) - , ("golden_shelleyGovernanceVerifyPoll (invalid)", golden_shelleyGovernanceVerifyPollInvalidAnswer) - ] - diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/Build.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/Build.hs deleted file mode 100644 index 53804511825..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/Build.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Address.Build - ( golden_shelleyAddressBuild - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util as OP - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyAddressBuild :: Property -golden_shelleyAddressBuild = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - addressVKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/payment_keys/verification_key" - addressSKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/verification_key" - goldenStakingAddressHexFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/addresses/staking-address.hex" - goldenEnterpriseAddressHexFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/addresses/enterprise-address.hex" - stakingAddressHexFile <- noteTempFile tempDir "staking-address.hex" - enterpriseAddressHexFile <- noteTempFile tempDir "enterprise-address.hex" - - void $ H.readFile addressVKeyFile - - stakingAddressText <- execCardanoCLI - [ "address","build" - , "--testnet-magic", "14" - , "--payment-verification-key-file", addressVKeyFile - , "--staking-verification-key-file", addressSKeyFile - ] - - goldenStakingAddressHex <- H.readFile goldenStakingAddressHexFile - - H.writeFile stakingAddressHexFile stakingAddressText - - equivalence stakingAddressText goldenStakingAddressHex - - void $ H.readFile addressSKeyFile - - enterpriseAddressText <- execCardanoCLI - [ "address","build" - , "--testnet-magic", "14" - , "--payment-verification-key-file", addressVKeyFile - , "--staking-verification-key-file", addressSKeyFile - ] - - goldenEnterpriseAddressHex <- H.readFile goldenEnterpriseAddressHexFile - - H.writeFile enterpriseAddressHexFile enterpriseAddressText - - equivalence enterpriseAddressText goldenEnterpriseAddressHex diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/Info.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/Info.hs deleted file mode 100644 index bcaaf6037bc..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/Info.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Address.Info - ( golden_shelleyAddressInfo - ) where - -import Control.Monad (when) - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Data.List as L -import qualified Hedgehog as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyAddressInfo :: Property -golden_shelleyAddressInfo = propertyOnce $ do - -- Disable as per commit: e69984d797fc3bdd5d71bdd99a0328110d71f6ad - when False $ do - let byronBase58 = "DdzFFzCqrhsg9F1joqXWJdGKwn6MaNavCqPsrZcjADRjA4ifEtrBmREJZyCojtuexKjMKNFr6CoU7Gx6PPR7pq14JxvPZuuk2xVkzn8p" - - infoText1 <- execCardanoCLI - [ "address","info" - , "--address", byronBase58 - ] - - H.assert $ "Encoding: Base58" `L.isInfixOf` infoText1 - H.assert $ "Era: Byron" `L.isInfixOf` infoText1 - - let byronHex = "82d818584283581c120e97e4ca7b831373c1060853d4896314e17d567a5723879b9a20eaa101581e581c135a115dd5dba68c28fb7e9409729ffc0503219ff7f9c08e84d13319001a28d0b871" - - infoText2 <- execCardanoCLI - [ "address","info" - , "--address", byronHex - ] - - H.assert $ "Encoding: Hex" `L.isInfixOf` infoText2 - H.assert $ "Era: Byron" `L.isInfixOf` infoText2 - - let shelleyHex = "82065820d8b4a892f2f6f1820d350c207d17d4cd7e7a1f7e0a83059e2d698a65ab8f96ed" - - infoText3 <- execCardanoCLI - [ "address","info" - , "--address", shelleyHex - ] - - H.assert $ "Encoding: Hex" `L.isInfixOf` infoText3 - H.assert $ "Era: Shelley" `L.isInfixOf` infoText3 diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/KeyGen.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/KeyGen.hs deleted file mode 100644 index 6d42b5ab409..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/KeyGen.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Address.KeyGen - ( golden_shelleyAddressKeyGen - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyAddressKeyGen :: Property -golden_shelleyAddressKeyGen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - addressVKeyFile <- noteTempFile tempDir "address.vkey" - addressSKeyFile <- noteTempFile tempDir "address.skey" - - void $ execCardanoCLI - [ "address","key-gen" - , "--verification-key-file", addressVKeyFile - , "--signing-key-file", addressSKeyFile - ] - - void $ H.readFile addressVKeyFile - void $ H.readFile addressSKeyFile - - H.assertFileOccurences 1 "PaymentVerificationKeyShelley" addressVKeyFile - H.assertFileOccurences 1 "PaymentSigningKeyShelley_ed25519" addressSKeyFile - - H.assertEndsWithSingleNewline addressVKeyFile - H.assertEndsWithSingleNewline addressSKeyFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/Create.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/Create.hs deleted file mode 100644 index 60f6bcc91df..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/Create.hs +++ /dev/null @@ -1,231 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} - -module Test.Golden.Shelley.Genesis.Create - ( golden_shelleyGenesisCreate - ) where - -import Control.Monad (void) -import Data.Bifunctor (Bifunctor (..)) -import Data.Foldable (for_) - -import Hedgehog (Property, forAll, (===)) -import Test.Cardano.CLI.Util as OP - -import qualified Data.Aeson as J -import qualified Data.Aeson.Key as J -import qualified Data.Aeson.KeyMap as KeyMap -import qualified Data.Aeson.Types as J -import qualified Data.ByteString.Lazy as LBS -import qualified Data.HashMap.Lazy as HM -import qualified Data.Set as S -import qualified Data.Time.Clock as DT -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Stock.Time as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H -import qualified Hedgehog.Gen as G -import qualified Hedgehog.Range as R - -{- HLINT ignore "Use <$>" -} -{- HLINT ignore "Use camelCase" -} -{- HLINT ignore "Use mapM" -} -{- HLINT ignore "Reduce duplication" -} - -parseMaxLovelaceSupply :: J.Value -> J.Parser Int -parseMaxLovelaceSupply = J.withObject "Object" $ \o -> o J..: "maxLovelaceSupply" - -parseSystemStart :: J.Value -> J.Parser String -parseSystemStart = J.withObject "Object" $ \o -> o J..: "systemStart" - -parseHashMap :: J.Value -> J.Parser (HM.HashMap String J.Value) -parseHashMap (J.Object hm) = pure $ HM.fromList $ fmap (first J.toString) (KeyMap.toList hm) -parseHashMap v = J.typeMismatch "Object" v - -parseDelegateCount :: J.Value -> J.Parser Int -parseDelegateCount = J.withObject "Object" $ \o -> do - delegates <- (o J..: "genDelegs") >>= parseHashMap - pure $ HM.size delegates - -parseDelegateKey :: J.Value -> J.Parser String -parseDelegateKey = J.withObject "Object" $ \o -> o J..: "delegate" - -parseDelegateKeys :: J.Value -> J.Parser [String] -parseDelegateKeys = J.withObject "Object" $ \o -> do - delegates <- (o J..: "genDelegs") >>= parseHashMap - sequence $ fmap (parseDelegateKey . snd) (HM.toList delegates) - -parseHashKeys :: J.Value -> J.Parser [String] -parseHashKeys = J.withObject "Object" $ \o -> do - delegates <- (o J..: "genDelegs") >>= parseHashMap - pure $ fmap fst (HM.toList delegates) - -parseTotalSupply :: J.Value -> J.Parser Int -parseTotalSupply = J.withObject "Object" $ \ o -> do - initialFunds <- (o J..: "initialFunds") >>= parseHashMap - fmap sum (sequence (fmap (J.parseJSON @Int . snd) (HM.toList initialFunds))) - -golden_shelleyGenesisCreate :: Property -golden_shelleyGenesisCreate = propertyOnce $ do - H.moduleWorkspace "tmp" $ \tempDir -> do - sourceGenesisSpecFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/genesis/genesis.spec.json" - sourceAlonzoGenesisSpecFile <- noteInputFile "test/cardano-cli-golden/files/golden/alonzo/genesis.alonzo.spec.json" - sourceConwayGenesisSpecFile <- noteInputFile "test/cardano-cli-golden/files/golden/conway/genesis.conway.spec.json" - - genesisSpecFile <- noteTempFile tempDir "genesis.spec.json" - alonzoSpecFile <- noteTempFile tempDir "genesis.alonzo.spec.json" - conwaySpecFile <- noteTempFile tempDir "genesis.conway.spec.json" - - H.copyFile sourceGenesisSpecFile genesisSpecFile - H.copyFile sourceAlonzoGenesisSpecFile alonzoSpecFile - H.copyFile sourceConwayGenesisSpecFile conwaySpecFile - - let genesisFile = tempDir <> "/genesis.json" - - fmtStartTime <- fmap H.formatIso8601 $ H.evalIO DT.getCurrentTime - - (supply, fmtSupply) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 10000000 4000000000) - (delegateCount, fmtDelegateCount) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 4 19) - (utxoCount, fmtUtxoCount) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 4 19) - - -- Create the genesis json file and required keys - void $ execCardanoCLI - [ "genesis","create" - , "--testnet-magic", "12" - , "--start-time", fmtStartTime - , "--supply", fmtSupply - , "--gen-genesis-keys", fmtDelegateCount - , "--gen-utxo-keys", fmtUtxoCount - , "--genesis-dir", tempDir - ] - - H.assertFilesExist [genesisFile] - - genesisContents <- H.evalIO $ LBS.readFile genesisFile - - actualJson <- H.evalEither $ J.eitherDecode genesisContents - actualSupply <- H.evalEither $ J.parseEither parseMaxLovelaceSupply actualJson - actualStartTime <- H.evalEither $ J.parseEither parseSystemStart actualJson - actualDelegateCount <- H.evalEither $ J.parseEither parseDelegateCount actualJson - actualTotalSupply <- H.evalEither $ J.parseEither parseTotalSupply actualJson - actualHashKeys <- H.evalEither $ J.parseEither parseHashKeys actualJson - actualDelegateKeys <- H.evalEither $ J.parseEither parseDelegateKeys actualJson - - actualSupply === supply - actualStartTime === fmtStartTime - actualDelegateCount === delegateCount - actualDelegateCount === utxoCount - actualTotalSupply === supply - 1000000 -- Check that the sum of the initial fund amounts matches the total supply - -- We don't use the entire supply so there is ada in the treasury. This is - -- required for stake pool rewards. - - -- Check uniqueness and count of hash keys - S.size (S.fromList actualHashKeys) === length actualHashKeys -- This isn't strictly necessary because we use aeson which guarantees uniqueness of keys - S.size (S.fromList actualHashKeys) === delegateCount - - -- Check uniqueness and count of hash keys - S.size (S.fromList actualDelegateKeys) === length actualDelegateKeys - S.size (S.fromList actualDelegateKeys) === delegateCount - - for_ [1 .. delegateCount] $ \i -> do - -- Check Genesis keys - H.assertFileOccurences 1 "GenesisSigningKey_ed25519" $ tempDir <> "/genesis-keys/genesis" <> show i <> ".skey" - H.assertFileOccurences 1 "GenesisVerificationKey_ed25519" $ tempDir <> "/genesis-keys/genesis" <> show i <> ".vkey" - - H.assertEndsWithSingleNewline $ tempDir <> "/genesis-keys/genesis" <> show i <> ".skey" - H.assertEndsWithSingleNewline $ tempDir <> "/genesis-keys/genesis" <> show i <> ".vkey" - - -- Check delegate keys - H.assertFileOccurences 1 "GenesisDelegateSigningKey_ed25519" $ tempDir <> "/delegate-keys/delegate" <> show i <> ".skey" - H.assertFileOccurences 1 "GenesisDelegateVerificationKey_ed25519" $ tempDir <> "/delegate-keys/delegate" <> show i <> ".vkey" - H.assertFileOccurences 1 "NodeOperationalCertificateIssueCounter" $ tempDir <> "/delegate-keys/delegate" <> show i <> ".counter" - - H.assertEndsWithSingleNewline $ tempDir <> "/delegate-keys/delegate" <> show i <> ".skey" - H.assertEndsWithSingleNewline $ tempDir <> "/delegate-keys/delegate" <> show i <> ".vkey" - H.assertEndsWithSingleNewline $ tempDir <> "/delegate-keys/delegate" <> show i <> ".counter" - - -- Check utxo keys - H.assertFileOccurences 1 "GenesisUTxOSigningKey_ed25519" $ tempDir <> "/utxo-keys/utxo" <> show i <> ".skey" - H.assertFileOccurences 1 "GenesisUTxOVerificationKey_ed25519" $ tempDir <> "/utxo-keys/utxo" <> show i <> ".vkey" - - H.assertEndsWithSingleNewline $ tempDir <> "/utxo-keys/utxo" <> show i <> ".skey" - H.assertEndsWithSingleNewline $ tempDir <> "/utxo-keys/utxo" <> show i <> ".vkey" - - H.moduleWorkspace "tmp" $ \tempDir -> do - let genesisFile = tempDir <> "/genesis.json" - - fmtStartTime <- fmap H.formatIso8601 $ H.evalIO DT.getCurrentTime - - (supply, fmtSupply) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 10000000 4000000000) - (delegateCount, fmtDelegateCount) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 4 19) - (utxoCount, fmtUtxoCount) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 4 19) - - sourceAlonzoGenesisSpecFile <- noteInputFile "test/cardano-cli-golden/files/golden/alonzo/genesis.alonzo.spec.json" - alonzoSpecFile <- noteTempFile tempDir "genesis.alonzo.spec.json" - H.copyFile sourceAlonzoGenesisSpecFile alonzoSpecFile - - sourceConwayGenesisSpecFile <- noteInputFile "test/cardano-cli-golden/files/golden/conway/genesis.conway.spec.json" - conwaySpecFile <- noteTempFile tempDir "genesis.conway.spec.json" - H.copyFile sourceConwayGenesisSpecFile conwaySpecFile - - -- Create the genesis json file and required keys - void $ execCardanoCLI - [ "genesis","create" - , "--testnet-magic", "12" - , "--start-time", fmtStartTime - , "--supply", fmtSupply - , "--gen-genesis-keys", fmtDelegateCount - , "--gen-utxo-keys", fmtUtxoCount - , "--genesis-dir", tempDir - ] - - H.assertFilesExist [genesisFile] - - genesisContents <- H.evalIO $ LBS.readFile genesisFile - - actualJson <- H.evalEither $ J.eitherDecode genesisContents - actualSupply <- H.evalEither $ J.parseEither parseMaxLovelaceSupply actualJson - actualStartTime <- H.evalEither $ J.parseEither parseSystemStart actualJson - actualDelegateCount <- H.evalEither $ J.parseEither parseDelegateCount actualJson - actualTotalSupply <- H.evalEither $ J.parseEither parseTotalSupply actualJson - actualHashKeys <- H.evalEither $ J.parseEither parseHashKeys actualJson - actualDelegateKeys <- H.evalEither $ J.parseEither parseDelegateKeys actualJson - - actualSupply === supply - actualStartTime === fmtStartTime - actualDelegateCount === delegateCount - actualDelegateCount === utxoCount - actualTotalSupply === supply - 1000000 -- Check that the sum of the initial fund amounts matches the total supply - -- We don't use the entire supply so there is ada in the treasury. This is - -- required for stake pool rewards. - -- Check uniqueness and count of hash keys - S.size (S.fromList actualHashKeys) === length actualHashKeys -- This isn't strictly necessary because we use aeson which guarantees uniqueness of keys - S.size (S.fromList actualHashKeys) === delegateCount - - -- Check uniqueness and count of hash keys - S.size (S.fromList actualDelegateKeys) === length actualDelegateKeys - S.size (S.fromList actualDelegateKeys) === delegateCount - - for_ [1 .. delegateCount] $ \i -> do - -- Check Genesis keys - H.assertFileOccurences 1 "GenesisSigningKey_ed25519" $ tempDir <> "/genesis-keys/genesis" <> show i <> ".skey" - H.assertFileOccurences 1 "GenesisVerificationKey_ed25519" $ tempDir <> "/genesis-keys/genesis" <> show i <> ".vkey" - - H.assertEndsWithSingleNewline $ tempDir <> "/genesis-keys/genesis" <> show i <> ".skey" - H.assertEndsWithSingleNewline $ tempDir <> "/genesis-keys/genesis" <> show i <> ".vkey" - - -- Check delegate keys - H.assertFileOccurences 1 "GenesisDelegateSigningKey_ed25519" $ tempDir <> "/delegate-keys/delegate" <> show i <> ".skey" - H.assertFileOccurences 1 "GenesisDelegateVerificationKey_ed25519" $ tempDir <> "/delegate-keys/delegate" <> show i <> ".vkey" - H.assertFileOccurences 1 "NodeOperationalCertificateIssueCounter" $ tempDir <> "/delegate-keys/delegate" <> show i <> ".counter" - - H.assertEndsWithSingleNewline $ tempDir <> "/delegate-keys/delegate" <> show i <> ".skey" - H.assertEndsWithSingleNewline $ tempDir <> "/delegate-keys/delegate" <> show i <> ".vkey" - H.assertEndsWithSingleNewline $ tempDir <> "/delegate-keys/delegate" <> show i <> ".counter" - - -- Check utxo keys - H.assertFileOccurences 1 "GenesisUTxOSigningKey_ed25519" $ tempDir <> "/utxo-keys/utxo" <> show i <> ".skey" - H.assertFileOccurences 1 "GenesisUTxOVerificationKey_ed25519" $ tempDir <> "/utxo-keys/utxo" <> show i <> ".vkey" - - H.assertEndsWithSingleNewline $ tempDir <> "/utxo-keys/utxo" <> show i <> ".skey" - H.assertEndsWithSingleNewline $ tempDir <> "/utxo-keys/utxo" <> show i <> ".vkey" diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/InitialTxIn.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/InitialTxIn.hs deleted file mode 100644 index 9c25de1cf0a..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/InitialTxIn.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Genesis.InitialTxIn - ( golden_shelleyGenesisInitialTxIn - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGenesisInitialTxIn :: Property -golden_shelleyGenesisInitialTxIn = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - verificationKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_verification_keys/genesis-utxo.vkey" - goldenUtxoHashFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_utxo_hashes/utxo_hash" - utxoHashFile <- noteTempFile tempDir "utxo_hash" - - utxoHash <- execCardanoCLI - [ "genesis","initial-txin" - , "--testnet-magic", "16" - , "--verification-key-file", verificationKeyFile - ] - - H.writeFile utxoHashFile utxoHash - - goldenUtxoHash <- H.readFile goldenUtxoHashFile - - equivalence utxoHash goldenUtxoHash diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenDelegate.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenDelegate.hs deleted file mode 100644 index a0429352057..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenDelegate.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Genesis.KeyGenDelegate - ( golden_shelleyGenesisKeyGenDelegate - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGenesisKeyGenDelegate :: Property -golden_shelleyGenesisKeyGenDelegate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - verificationKeyFile <- noteTempFile tempDir "key-gen.vkey" - signingKeyFile <- noteTempFile tempDir "key-gen.skey" - operationalCertificateIssueCounterFile <- noteTempFile tempDir "op-cert.counter" - - void $ execCardanoCLI - [ "genesis","key-gen-delegate" - , "--verification-key-file", verificationKeyFile - , "--signing-key-file", signingKeyFile - , "--operational-certificate-issue-counter", operationalCertificateIssueCounterFile - ] - - H.assertFileOccurences 1 "GenesisDelegateVerificationKey_ed25519" verificationKeyFile - H.assertFileOccurences 1 "GenesisDelegateSigningKey_ed25519" signingKeyFile - H.assertFileOccurences 1 "NodeOperationalCertificateIssueCounter" operationalCertificateIssueCounterFile - - H.assertFileOccurences 1 "Genesis delegate operator key" verificationKeyFile - H.assertFileOccurences 1 "Genesis delegate operator key" signingKeyFile - - H.assertEndsWithSingleNewline verificationKeyFile - H.assertEndsWithSingleNewline signingKeyFile - H.assertEndsWithSingleNewline operationalCertificateIssueCounterFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenGenesis.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenGenesis.hs deleted file mode 100644 index 2de1a52a075..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenGenesis.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Genesis.KeyGenGenesis - ( golden_shelleyGenesisKeyGenGenesis - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGenesisKeyGenGenesis :: Property -golden_shelleyGenesisKeyGenGenesis = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - verificationKeyFile <- noteTempFile tempDir "key-gen.vkey" - signingKeyFile <- noteTempFile tempDir "key-gen.skey" - - void $ execCardanoCLI - [ "genesis","key-gen-genesis" - , "--verification-key-file", verificationKeyFile - , "--signing-key-file", signingKeyFile - ] - - H.assertFileOccurences 1 "GenesisVerificationKey_ed25519" verificationKeyFile - H.assertFileOccurences 1 "GenesisSigningKey_ed25519" signingKeyFile - - H.assertEndsWithSingleNewline verificationKeyFile - H.assertEndsWithSingleNewline signingKeyFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenUtxo.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenUtxo.hs deleted file mode 100644 index f0bc543cd19..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenUtxo.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Genesis.KeyGenUtxo - ( golden_shelleyGenesisKeyGenUtxo - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGenesisKeyGenUtxo :: Property -golden_shelleyGenesisKeyGenUtxo = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - utxoVerificationKeyFile <- noteTempFile tempDir "utxo.vkey" - utxoSigningKeyFile <- noteTempFile tempDir "utxo.skey" - - void $ execCardanoCLI - [ "genesis","key-gen-utxo" - , "--verification-key-file", utxoVerificationKeyFile - , "--signing-key-file", utxoSigningKeyFile - ] - - H.assertFileOccurences 1 "GenesisUTxOVerificationKey_ed25519" utxoVerificationKeyFile - H.assertFileOccurences 1 "GenesisUTxOSigningKey_ed25519" utxoSigningKeyFile - - H.assertEndsWithSingleNewline utxoVerificationKeyFile - H.assertEndsWithSingleNewline utxoSigningKeyFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyHash.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyHash.hs deleted file mode 100644 index 415d05880e0..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyHash.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Genesis.KeyHash - ( golden_shelleyGenesisKeyHash - ) where - -import Hedgehog (Property, (===)) -import Test.Cardano.CLI.Util as OP - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGenesisKeyHash :: Property -golden_shelleyGenesisKeyHash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - referenceVerificationKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/verification_key" - goldenGenesisVerificationKeyHashFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/verification_key.key-hash" - genesisVerificationKeyHashFile <- noteTempFile tempDir "key-hash.hex" - - genesisVerificationKeyHash <- execCardanoCLI - [ "genesis","key-hash" - , "--verification-key-file", referenceVerificationKey - ] - - H.writeFile genesisVerificationKeyHashFile genesisVerificationKeyHash - - goldenGenesisVerificationKeyHash <- H.readFile goldenGenesisVerificationKeyHashFile - - genesisVerificationKeyHash === goldenGenesisVerificationKeyHash diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/AnswerPoll.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/AnswerPoll.hs deleted file mode 100644 index 799238ff31f..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/AnswerPoll.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Governance.AnswerPoll - ( golden_shelleyGovernanceAnswerPollNeg1Invalid - , golden_shelleyGovernanceAnswerPoll0 - , golden_shelleyGovernanceAnswerPollPos1 - , golden_shelleyGovernanceAnswerPollPos2Invalid - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import Control.Monad (void) -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H -import qualified Hedgehog.Extras.Test.Golden as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGovernanceAnswerPollNeg1Invalid :: Property -golden_shelleyGovernanceAnswerPollNeg1Invalid = propertyOnce . H.moduleWorkspace "governance-answer-poll" $ \tempDir -> do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - outFile <- H.noteTempFile tempDir "answer-file.json" - - result <- tryExecCardanoCLI - [ "governance", "answer-poll" - , "--poll-file", pollFile - , "--answer", "-1" - , "--out-file", outFile - ] - - H.assertFileMissing outFile - - either (const H.success) (const H.failure) result - -golden_shelleyGovernanceAnswerPoll0 :: Property -golden_shelleyGovernanceAnswerPoll0 = propertyOnce . H.moduleWorkspace "governance-answer-poll" $ \tempDir -> do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - expectedAnswerFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.answer.0.json" - outFile <- H.noteTempFile tempDir "answer-file.json" - - void $ execCardanoCLI - [ "governance", "answer-poll" - , "--poll-file", pollFile - , "--answer", "0" - , "--out-file", outFile - ] - - H.diffFileVsGoldenFile outFile expectedAnswerFile - -golden_shelleyGovernanceAnswerPollPos1 :: Property -golden_shelleyGovernanceAnswerPollPos1 = propertyOnce . H.moduleWorkspace "governance-answer-poll" $ \tempDir -> do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - expectedAnswerFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.answer.1.json" - outFile <- H.noteTempFile tempDir "answer-file.json" - - void $ execCardanoCLI - [ "governance", "answer-poll" - , "--poll-file", pollFile - , "--answer", "1" - , "--out-file", outFile - ] - - H.diffFileVsGoldenFile outFile expectedAnswerFile - -golden_shelleyGovernanceAnswerPollPos2Invalid :: Property -golden_shelleyGovernanceAnswerPollPos2Invalid = propertyOnce . H.moduleWorkspace "governance-answer-poll" $ \tempDir -> do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - outFile <- H.noteTempFile tempDir "answer-file.json" - - result <- tryExecCardanoCLI - [ "governance", "answer-poll" - , "--poll-file", pollFile - , "--answer", "2" - , "--out-file", outFile - ] - - H.assertFileMissing outFile - - either (const H.success) (const H.failure) result diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/CreatePoll.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/CreatePoll.hs deleted file mode 100644 index 994ce0e6ce8..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/CreatePoll.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Governance.CreatePoll - ( golden_shelleyGovernanceCreatePoll - , golden_shelleyGovernanceCreateLongPoll - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGovernanceCreatePoll :: Property -golden_shelleyGovernanceCreatePoll = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - pollFile <- noteTempFile tempDir "poll.json" - - stdout <- execCardanoCLI - [ "governance", "create-poll" - , "--question", "Pineapples on pizza?" - , "--answer", "yes" - , "--answer", "no" - , "--out-file", pollFile - ] - - void $ H.readFile pollFile - noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/create/basic.json" - >>= H.readFile - >>= (H.===) stdout - H.assertFileOccurences 1 "GovernancePoll" pollFile - H.assertEndsWithSingleNewline pollFile - -golden_shelleyGovernanceCreateLongPoll :: Property -golden_shelleyGovernanceCreateLongPoll = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - pollFile <- noteTempFile tempDir "poll.json" - - stdout <- execCardanoCLI - [ "governance", "create-poll" - , "--question", "What is the most adequate topping to put on a pizza (please consider all possibilities and take time to answer)?" - , "--answer", "pineapples" - , "--answer", "only traditional topics should go on a pizza, this isn't room for jokes" - , "--out-file", pollFile - ] - - void $ H.readFile pollFile - noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/create/long-text.json" - >>= H.readFile - >>= (H.===) stdout - H.assertFileOccurences 1 "GovernancePoll" pollFile - H.assertEndsWithSingleNewline pollFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/VerifyPoll.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/VerifyPoll.hs deleted file mode 100644 index 891e2861f89..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Governance/VerifyPoll.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Governance.VerifyPoll - ( golden_shelleyGovernanceVerifyPoll - , golden_shelleyGovernanceVerifyPollMismatch - , golden_shelleyGovernanceVerifyPollNoAnswer - , golden_shelleyGovernanceVerifyPollMalformedAnswer - , golden_shelleyGovernanceVerifyPollInvalidAnswer - ) where - -import Control.Monad.IO.Class (liftIO) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import Cardano.Api -import Cardano.CLI.Shelley.Key (VerificationKeyOrFile (..), - readVerificationKeyOrTextEnvFile) - -import qualified Data.ByteString.Char8 as BSC -import qualified Hedgehog as H -import qualified Hedgehog.Internal.Property as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGovernanceVerifyPoll :: Property -golden_shelleyGovernanceVerifyPoll = propertyOnce $ do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - txFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/verify/valid" - vkFile <- VerificationKeyFilePath . File <$> - noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/cold.vk" - - stdout <- BSC.pack <$> execCardanoCLI - [ "governance", "verify-poll" - , "--poll-file", pollFile - , "--tx-file", txFile - ] - - liftIO (readVerificationKeyOrTextEnvFile AsStakePoolKey vkFile) >>= \case - Left e -> - H.failWith Nothing (displayError e) - Right vk -> do - let expected = prettyPrintJSON $ serialiseToRawBytesHexText <$> [verificationKeyHash vk] - H.assert $ expected `BSC.isInfixOf` stdout - -golden_shelleyGovernanceVerifyPollMismatch :: Property -golden_shelleyGovernanceVerifyPollMismatch = propertyOnce $ do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - txFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/verify/mismatch" - - result <- tryExecCardanoCLI - [ "governance", "verify-poll" - , "--poll-file", pollFile - , "--tx-file", txFile - ] - - either (const H.success) (H.failWith Nothing) result - -golden_shelleyGovernanceVerifyPollNoAnswer :: Property -golden_shelleyGovernanceVerifyPollNoAnswer = propertyOnce $ do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - txFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/verify/none" - - result <- tryExecCardanoCLI - [ "governance", "verify-poll" - , "--poll-file", pollFile - , "--tx-file", txFile - ] - - either (const H.success) (H.failWith Nothing) result - -golden_shelleyGovernanceVerifyPollMalformedAnswer :: Property -golden_shelleyGovernanceVerifyPollMalformedAnswer = propertyOnce $ do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - txFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/verify/malformed" - - result <- tryExecCardanoCLI - [ "governance", "verify-poll" - , "--poll-file", pollFile - , "--tx-file", txFile - ] - - either (const H.success) (H.failWith Nothing) result - -golden_shelleyGovernanceVerifyPollInvalidAnswer :: Property -golden_shelleyGovernanceVerifyPollInvalidAnswer = propertyOnce $ do - pollFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/polls/basic.json" - txFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/governance/verify/invalid" - - result <- tryExecCardanoCLI - [ "governance", "verify-poll" - , "--poll-file", pollFile - , "--tx-file", txFile - ] - - either (const H.success) (H.failWith Nothing) result diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Key/ConvertCardanoAddressKey.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Key/ConvertCardanoAddressKey.hs deleted file mode 100644 index dbd4ff39e47..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Key/ConvertCardanoAddressKey.hs +++ /dev/null @@ -1,192 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Key.ConvertCardanoAddressKey - ( golden_convertCardanoAddressByronSigningKey - , golden_convertCardanoAddressIcarusSigningKey - , golden_convertCardanoAddressShelleyPaymentSigningKey - , golden_convertCardanoAddressShelleyStakeSigningKey - ) where - -import Control.Monad (void) -import Data.Text (Text) -import Hedgehog (Property, (===)) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - --- | An example signing key generated by @cardano-address@ using the --- deprecated Byron style. -exampleByronSigningKey :: Text -exampleByronSigningKey = - "xprv1pp72a64en2vf568jywe9azlgrqe3p2jjf9gxxeejn2fex8g889x54w6emg2egkaz2rxyc" - <> "560fp0hrv8y0hzpuzu27zhhhgwc8t5tvrczz2jnhhjwdnd6cdjx4dxehrsr2pr406rchw" - <> "ctfwrgpc9r7nmakvaegyz9" - --- | An example signing key generated by @cardano-address@ using the Icarus --- style. -exampleIcarusSigningKey :: Text -exampleIcarusSigningKey = - "xprv1yq7c6nlmxncg7txy0z6lqf3fww4vm20m60lrxttx5lr4qmkvh395m3p59v8fn4ku9mzyc" - <> "g2rkxatgwm86uc3pvrt06e43afya6rm0s2azlpnc9yrhygl2heckeyhhtgad08c0zljpn" - <> "c6fse2ldzyx9c86yvddxjw" - --- | An example signing key generated by @cardano-address@ using the Shelley --- style. -exampleShelleySigningKey :: Text -exampleShelleySigningKey = - "xprv1yq7c6nlmxncg7txy0z6lqf3fww4vm20m60lrxttx5lr4qmkvh395m3p59v8fn4ku9mzyc" - <> "g2rkxatgwm86uc3pvrt06e43afya6rm0s2azlpnc9yrhygl2heckeyhhtgad08c0zljpn" - <> "c6fse2ldzyx9c86yvddxjw" - --- | Test that converting a @cardano-address@ Byron signing key yields the --- expected result. -golden_convertCardanoAddressByronSigningKey :: Property -golden_convertCardanoAddressByronSigningKey = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - - -- `cardano-address` signing key filepath - signingKeyFp <- noteTempFile tempDir "cardano-address-byron.skey" - - -- Converted signing key filepath - convertedSigningKeyFp <- - noteTempFile tempDir "converted-cardano-address-byron.skey" - - -- Write `cardano-address` signing key to disk - H.textWriteFile signingKeyFp exampleByronSigningKey - H.assertFilesExist [signingKeyFp] - - -- Convert the `cardano-address` signing key - void $ execCardanoCLI - [ "key","convert-cardano-address-key" - , "--byron-payment-key" - , "--signing-key-file", signingKeyFp - , "--out-file", convertedSigningKeyFp - ] - - -- Check for existence of the converted signing key file - H.assertFilesExist [convertedSigningKeyFp] - - -- Check that the contents of the converted signing key file match that of - -- the golden file. - actualConvertedSigningKey <- H.readFile convertedSigningKeyFp - expectedConvertedSigningKey <- - H.readFile $ - "test/cardano-cli-golden/files/golden/shelley/keys/converted_cardano-address_keys/" - <> "byron_signing_key" - expectedConvertedSigningKey === actualConvertedSigningKey - --- | Test that converting a @cardano-address@ Icarus signing key yields the --- expected result. -golden_convertCardanoAddressIcarusSigningKey :: Property -golden_convertCardanoAddressIcarusSigningKey = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - - -- `cardano-address` signing key filepath - signingKeyFp <- H.noteTempFile tempDir "cardano-address-icarus.skey" - - -- Converted signing key filepath - convertedSigningKeyFp <- - noteTempFile tempDir "converted-cardano-address-icarus.skey" - - -- Write `cardano-address` signing key to disk - H.textWriteFile signingKeyFp exampleIcarusSigningKey - H.assertFilesExist [signingKeyFp] - - -- Convert the `cardano-address` signing key - void $ execCardanoCLI - [ "key","convert-cardano-address-key" - , "--icarus-payment-key" - , "--signing-key-file", signingKeyFp - , "--out-file", convertedSigningKeyFp - ] - - -- Check for existence of the converted signing key file - H.assertFilesExist [convertedSigningKeyFp] - - -- Check that the contents of the converted signing key file match that of - -- the golden file. - actualConvertedSigningKey <- H.readFile convertedSigningKeyFp - expectedConvertedSigningKey <- - H.readFile $ - "test/cardano-cli-golden/files/golden/shelley/keys/converted_cardano-address_keys/" - <> "icarus_signing_key" - expectedConvertedSigningKey === actualConvertedSigningKey - --- | Test that converting a @cardano-address@ Shelley payment signing key --- yields the expected result. -golden_convertCardanoAddressShelleyPaymentSigningKey :: Property -golden_convertCardanoAddressShelleyPaymentSigningKey = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - - -- `cardano-address` signing key filepath - signingKeyFp <- - noteTempFile tempDir "cardano-address-shelley-payment.skey" - - -- Converted signing key filepath - convertedSigningKeyFp <- - noteTempFile tempDir "converted-cardano-address-shelley-payment.skey" - - -- Write `cardano-address` signing key to disk - H.textWriteFile signingKeyFp exampleShelleySigningKey - H.assertFilesExist [signingKeyFp] - - -- Convert the `cardano-address` signing key - void $ execCardanoCLI - [ "key","convert-cardano-address-key" - , "--shelley-payment-key" - , "--signing-key-file", signingKeyFp - , "--out-file", convertedSigningKeyFp - ] - - -- Check for existence of the converted signing key file - H.assertFilesExist [convertedSigningKeyFp] - - -- Check that the contents of the converted signing key file match that of - -- the golden file. - actualConvertedSigningKey <- H.readFile convertedSigningKeyFp - expectedConvertedSigningKey <- - H.readFile $ - "test/cardano-cli-golden/files/golden/shelley/keys/converted_cardano-address_keys/" - <> "shelley_payment_signing_key" - expectedConvertedSigningKey === actualConvertedSigningKey - --- | Test that converting a @cardano-address@ Shelley stake signing key yields --- the expected result. -golden_convertCardanoAddressShelleyStakeSigningKey :: Property -golden_convertCardanoAddressShelleyStakeSigningKey = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - - -- `cardano-address` signing key filepath - signingKeyFp <- - noteTempFile tempDir "cardano-address-shelley-stake.skey" - - -- Converted signing key filepath - convertedSigningKeyFp <- - H.noteTempFile tempDir "converted-cardano-address-shelley-stake.skey" - - -- Write `cardano-address` signing key to disk - H.textWriteFile signingKeyFp exampleShelleySigningKey - H.assertFilesExist [signingKeyFp] - - -- Convert the `cardano-address` signing key - void $ execCardanoCLI - [ "key","convert-cardano-address-key" - , "--shelley-stake-key" - , "--signing-key-file", signingKeyFp - , "--out-file", convertedSigningKeyFp - ] - - -- Check for existence of the converted signing key file - H.assertFilesExist [convertedSigningKeyFp] - - -- Check that the contents of the converted signing key file match that of - -- the golden file. - actualConvertedSigningKey <- H.readFile convertedSigningKeyFp - expectedConvertedSigningKey <- - H.readFile $ - "test/cardano-cli-golden/files/golden/shelley/keys/converted_cardano-address_keys/" - <> "shelley_stake_signing_key" - expectedConvertedSigningKey === actualConvertedSigningKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Metadata/StakePoolMetadata.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Metadata/StakePoolMetadata.hs deleted file mode 100644 index 77908c082c1..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Metadata/StakePoolMetadata.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Metadata.StakePoolMetadata - ( golden_stakePoolMetadataHash - ) where - -import Control.Monad (void) -import Data.Text (Text) -import qualified Data.Text.IO as Text -import Hedgehog (Property) -import Test.Cardano.CLI.Util as OP - -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_stakePoolMetadataHash :: Property -golden_stakePoolMetadataHash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - referenceStakePoolMetadata <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/metadata/stake_pool_metadata_hash" - - stakePoolMetadataFile <- noteTempFile tempDir "stake-pool-metadata.json" - outputStakePoolMetadataHashFp <- noteTempFile tempDir "stake-pool-metadata-hash.txt" - - -- Write the example stake pool metadata to disk - H.evalIO $ Text.writeFile stakePoolMetadataFile exampleStakePoolMetadata - - -- Hash the stake pool metadata - void $ execCardanoCLI - [ "stake-pool","metadata-hash" - , "--pool-metadata-file", stakePoolMetadataFile - , "--out-file", outputStakePoolMetadataHashFp - ] - - -- Check that the stake pool metadata hash file content is correct. - expectedStakePoolMetadataHash <- H.readFile referenceStakePoolMetadata - actualStakePoolMetadataHash <- H.readFile outputStakePoolMetadataHashFp - - equivalence expectedStakePoolMetadataHash actualStakePoolMetadataHash - where - exampleStakePoolMetadata :: Text - exampleStakePoolMetadata = "{\"homepage\":\"https://iohk.io\",\"name\":\"Genesis Pool C\",\"ticker\":\"GPC\",\"description\":\"Lorem Ipsum Dolor Sit Amet.\"}" diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/MultiSig/Address.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/MultiSig/Address.hs deleted file mode 100644 index 54c0e56be18..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/MultiSig/Address.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.MultiSig.Address - ( golden_shelleyAllMultiSigAddressBuild - , golden_shelleyAnyMultiSigAddressBuild - , golden_shelleyAtLeastMultiSigAddressBuild - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util as OP - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyAllMultiSigAddressBuild :: Property -golden_shelleyAllMultiSigAddressBuild = propertyOnce . H.moduleWorkspace "tmp" $ \_ -> do - allMultiSigFp <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/multisig/scripts/all" - - allMultiSigAddress <- execCardanoCLI - [ "address", "build" - , "--payment-script-file", allMultiSigFp - , "--mainnet" - ] - - goldenAllMultiSigAddrFp <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/multisig/addresses/all" - - goldenAllMs <- H.readFile goldenAllMultiSigAddrFp - - equivalence allMultiSigAddress goldenAllMs - -golden_shelleyAnyMultiSigAddressBuild :: Property -golden_shelleyAnyMultiSigAddressBuild = propertyOnce . H.moduleWorkspace "tmp" $ \_ -> do - anyMultiSigFp <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/multisig/scripts/any" - - anyMultiSigAddress <- execCardanoCLI - [ "address", "build" - , "--payment-script-file", anyMultiSigFp - , "--mainnet" - ] - - goldenAnyMultiSigAddrFp <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/multisig/addresses/any" - - goldenAnyMs <- H.readFile goldenAnyMultiSigAddrFp - - equivalence anyMultiSigAddress goldenAnyMs - -golden_shelleyAtLeastMultiSigAddressBuild :: Property -golden_shelleyAtLeastMultiSigAddressBuild = propertyOnce . H.moduleWorkspace "tmp" $ \_ -> do - atLeastMultiSigFp <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/multisig/scripts/atleast" - - atLeastMultiSigAddress <- execCardanoCLI - [ "address", "build" - , "--payment-script-file", atLeastMultiSigFp - , "--mainnet" - ] - - goldenAtLeastMultiSigAddrFp <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/multisig/addresses/atleast" - - goldenAtLeastMs <- H.readFile goldenAtLeastMultiSigAddrFp - - equivalence atLeastMultiSigAddress goldenAtLeastMs diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/IssueOpCert.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/IssueOpCert.hs deleted file mode 100644 index 2f55263628f..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/IssueOpCert.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Node.IssueOpCert - ( golden_shelleyNodeIssueOpCert - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyNodeIssueOpCert :: Property -golden_shelleyNodeIssueOpCert = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - hotKesVerificationKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/kes_keys/verification_key" - coldSigningKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_delegate_keys/signing_key" - originalOperationalCertificateIssueCounterFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_delegate_keys/operational_certificate_counter" - operationalCertificateIssueCounterFile <- noteTempFile tempDir "delegate-op-cert.counter" - operationalCertFile <- noteTempFile tempDir "operational.cert" - - H.copyFile originalOperationalCertificateIssueCounterFile operationalCertificateIssueCounterFile - - -- We could generate the required keys here, but then if the KES generation fails this - -- test would also fail which is misleading. - -- However, the keys can be generated eg: - -- cabal run cardano-cli:cardano-cli -- shelley node key-gen-KES \ - -- --verification-key-file cardano-cli/test/cli/node-issue-op-cert/data/node-kes.vkey \ - -- --signing-key-file /dev/null - void $ execCardanoCLI - [ "node","issue-op-cert" - , "--hot-kes-verification-key-file", hotKesVerificationKeyFile - , "--cold-signing-key-file", coldSigningKeyFile - , "--operational-certificate-issue-counter", operationalCertificateIssueCounterFile - , "--kes-period", "0" - , "--out-file", operationalCertFile - ] - - H.assertFileOccurences 1 "NodeOperationalCertificate" operationalCertFile - H.assertFileOccurences 1 "Next certificate issue number: 1" operationalCertificateIssueCounterFile - - H.assertEndsWithSingleNewline operationalCertFile - H.assertEndsWithSingleNewline operationalCertificateIssueCounterFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGen.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGen.hs deleted file mode 100644 index 424e6ce112b..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGen.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Node.KeyGen - ( golden_shelleyNodeKeyGen - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyNodeKeyGen :: Property -golden_shelleyNodeKeyGen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - verificationKeyFile <- noteTempFile tempDir "key-gen.vkey" - signingKeyFile <- noteTempFile tempDir "key-gen.skey" - opCertCounterFile <- noteTempFile tempDir "op-cert.counter" - - void $ execCardanoCLI - [ "node","key-gen" - , "--verification-key-file", verificationKeyFile - , "--signing-key-file", signingKeyFile - , "--operational-certificate-issue-counter", opCertCounterFile - ] - - H.assertFileOccurences 1 "StakePoolVerificationKey_ed25519" verificationKeyFile - H.assertFileOccurences 1 "StakePoolSigningKey_ed25519" signingKeyFile - H.assertFileOccurences 1 "NodeOperationalCertificateIssueCounter" opCertCounterFile - - H.assertEndsWithSingleNewline verificationKeyFile - H.assertEndsWithSingleNewline signingKeyFile - H.assertEndsWithSingleNewline opCertCounterFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGenKes.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGenKes.hs deleted file mode 100644 index c426bb344dd..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGenKes.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Node.KeyGenKes - ( golden_shelleyNodeKeyGenKes - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyNodeKeyGenKes :: Property -golden_shelleyNodeKeyGenKes = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - verificationKey <- noteTempFile tempDir "kes.vkey" - signingKey <- noteTempFile tempDir "kes.skey" - - void $ execCardanoCLI - [ "node","key-gen-KES" - , "--verification-key-file", verificationKey - , "--signing-key-file", signingKey - ] - - H.assertFileOccurences 1 "KesVerificationKey_ed25519_kes_2^6" verificationKey - H.assertFileOccurences 1 "KesSigningKey_ed25519_kes_2^6" signingKey - - H.assertEndsWithSingleNewline verificationKey - H.assertEndsWithSingleNewline signingKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGenVrf.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGenVrf.hs deleted file mode 100644 index e43f011c746..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Node/KeyGenVrf.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Node.KeyGenVrf - ( golden_shelleyNodeKeyGenVrf - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyNodeKeyGenVrf :: Property -golden_shelleyNodeKeyGenVrf = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - verificationKey <- noteTempFile tempDir "kes.vkey" - signingKey <- noteTempFile tempDir "kes.skey" - - void $ execCardanoCLI - [ "node","key-gen-VRF" - , "--verification-key-file", verificationKey - , "--signing-key-file", signingKey - ] - - H.assertFileOccurences 1 "VRF Verification Key" verificationKey - H.assertFileOccurences 1 "VRF Signing Key" signingKey - - H.assertEndsWithSingleNewline verificationKey - H.assertEndsWithSingleNewline signingKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/Build.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/Build.hs deleted file mode 100644 index e8a4854a792..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/Build.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.StakeAddress.Build - ( golden_shelleyStakeAddressBuild - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util as OP - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyStakeAddressBuild :: Property -golden_shelleyStakeAddressBuild = propertyOnce . H.moduleWorkspace "tmp" $ \_ -> do - verificationKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/verification_key" - goldenRewardAddressFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/reward_address" - - rewardAddress <- execCardanoCLI - [ "stake-address","build" - , "--mainnet" - , "--staking-verification-key-file", verificationKeyFile - ] - - goldenRewardsAddress <- H.readFile goldenRewardAddressFile - - equivalence rewardAddress goldenRewardsAddress diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/DeregistrationCertificate.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/DeregistrationCertificate.hs deleted file mode 100644 index cfefebd1a4c..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/DeregistrationCertificate.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.StakeAddress.DeregistrationCertificate - ( golden_shelleyStakeAddressDeregistrationCertificate - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import System.FilePath (()) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H -import qualified Hedgehog.Extras.Test.Process as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyStakeAddressDeregistrationCertificate :: Property -golden_shelleyStakeAddressDeregistrationCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - base <- H.getProjectBase - - verificationKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/verification_key" - deregistrationCertFile <- noteTempFile tempDir "deregistrationCertFile" - scriptDeregistrationCertFile <- noteTempFile tempDir "scripDeregistrationCertFile" - exampleScript <- noteInputFile $ base "scripts/plutus/scripts/v1/custom-guess-42-datum-42.plutus" - - void $ execCardanoCLI - [ "stake-address","deregistration-certificate" - , "--staking-verification-key-file", verificationKeyFile - , "--out-file", deregistrationCertFile - ] - - H.assertFileOccurences 1 "Stake Address Deregistration Certificate" deregistrationCertFile - - void $ execCardanoCLI - [ "stake-address","deregistration-certificate" - , "--stake-script-file", exampleScript - , "--out-file", scriptDeregistrationCertFile - ] - - H.assertFileOccurences 1 "Stake Address Deregistration Certificate" scriptDeregistrationCertFile - - H.assertEndsWithSingleNewline deregistrationCertFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/KeyGen.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/KeyGen.hs deleted file mode 100644 index 07062f36a83..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/KeyGen.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.StakeAddress.KeyGen - ( golden_shelleyStakeAddressKeyGen - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import Control.Monad (void) -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyStakeAddressKeyGen :: Property -golden_shelleyStakeAddressKeyGen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - verificationKeyFile <- noteTempFile tempDir "kes.vkey" - signingKeyFile <- noteTempFile tempDir "kes.skey" - - void $ execCardanoCLI - [ "stake-address","key-gen" - , "--verification-key-file", verificationKeyFile - , "--signing-key-file", signingKeyFile - ] - - H.assertFileOccurences 1 "StakeVerificationKeyShelley_ed25519" verificationKeyFile - H.assertFileOccurences 1 "StakeSigningKeyShelley_ed25519" signingKeyFile - - H.assertEndsWithSingleNewline verificationKeyFile - H.assertEndsWithSingleNewline signingKeyFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/RegistrationCertificate.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/RegistrationCertificate.hs deleted file mode 100644 index 384007cca7c..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakeAddress/RegistrationCertificate.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.StakeAddress.RegistrationCertificate - ( golden_shelleyStakeAddressRegistrationCertificate - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import System.FilePath (()) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H -import qualified Hedgehog.Extras.Test.Process as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyStakeAddressRegistrationCertificate :: Property -golden_shelleyStakeAddressRegistrationCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - base <- H.getProjectBase - - keyGenStakingVerificationKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/verification_key" - registrationCertFile <- noteTempFile tempDir "registration.cert" - scriptRegistrationCertFile <- noteTempFile tempDir "script-registration.cert" - exampleScript <- noteInputFile $ base "scripts/plutus/scripts/v1/custom-guess-42-datum-42.plutus" - - void $ execCardanoCLI - [ "stake-address","registration-certificate" - , "--staking-verification-key-file", keyGenStakingVerificationKeyFile - , "--out-file", registrationCertFile - ] - - H.assertFileOccurences 1 "Stake Address Registration Certificate" registrationCertFile - - void $ execCardanoCLI - [ "stake-address","registration-certificate" - , "--stake-script-file", exampleScript - , "--out-file", scriptRegistrationCertFile - ] - - H.assertFileOccurences 1 "Stake Address Registration Certificate" scriptRegistrationCertFile - - H.assertEndsWithSingleNewline registrationCertFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakePool/RegistrationCertificate.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakePool/RegistrationCertificate.hs deleted file mode 100644 index 0466fa71808..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/StakePool/RegistrationCertificate.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.StakePool.RegistrationCertificate - ( golden_shelleyStakePoolRegistrationCertificate - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import Control.Monad (void) -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyStakePoolRegistrationCertificate :: Property -golden_shelleyStakePoolRegistrationCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - operatorVerificationKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/node-pool/operator.vkey" - vrfVerificationKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/node-pool/vrf.vkey" - ownerVerificationKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/node-pool/owner.vkey" - registrationCertFile <- noteTempFile tempDir "registration.cert" - - void $ execCardanoCLI - [ "stake-pool","registration-certificate" - , "--testnet-magic", "42" - , "--pool-pledge", "0" - , "--pool-cost", "0" - , "--pool-margin", "0" - , "--cold-verification-key-file", operatorVerificationKeyFile - , "--vrf-verification-key-file", vrfVerificationKeyFile - , "--reward-account-verification-key-file", ownerVerificationKeyFile - , "--pool-owner-stake-verification-key-file", ownerVerificationKeyFile - , "--out-file", registrationCertFile - ] - - H.assertFileOccurences 1 "Stake Pool Registration Certificate" registrationCertFile - - H.assertEndsWithSingleNewline registrationCertFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/GenesisKeyDelegationCertificate.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/GenesisKeyDelegationCertificate.hs deleted file mode 100644 index 1ba07e8691e..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/GenesisKeyDelegationCertificate.hs +++ /dev/null @@ -1,88 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Certificates.GenesisKeyDelegationCertificate - ( golden_shelleyGenesisKeyDelegationCertificate - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyGenesisKeyDelegationCertificate :: Property -golden_shelleyGenesisKeyDelegationCertificate = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference certificate - referenceCertificateFilePath <- - noteInputFile $ - "test/cardano-cli-golden/files/golden/shelley/certificates/" - <> "genesis_key_delegation_certificate" - - -- Verification key and certificate filepaths - genesisVerKeyFilePath <- - noteTempFile tempDir "genesis-verification-key-file" - genesisDelegVerKeyFilePath <- - noteTempFile tempDir "genesis-delegate-verification-key-file" - vrfVerKeyFilePath <- noteTempFile tempDir "vrf-verification-key-file" - genesisKeyDelegCertFilePath <- - noteTempFile tempDir "genesis-key-delegation-certificate-file" - - -- Signing Key filepaths - genesisSignKeyFilePath <- noteTempFile tempDir "genesis-signing-key-file" - genesisDelegSignKeyFilePath <- noteTempFile tempDir "genesis-delegate-signing-key-file" - vrfSignKeyFilePath <- noteTempFile tempDir "vrf-signing-key-file" - - genesisDelegOpCertCounterFilePath <- noteTempFile tempDir "genesis-delegate-opcert-counter" - - - -- Generate genesis key pair - void $ execCardanoCLI - [ "genesis","key-gen-genesis" - , "--verification-key-file", genesisVerKeyFilePath - , "--signing-key-file", genesisSignKeyFilePath - ] - - -- Generate genesis delegate key pair - void $ execCardanoCLI - [ "genesis","key-gen-delegate" - , "--verification-key-file", genesisDelegVerKeyFilePath - , "--signing-key-file", genesisDelegSignKeyFilePath - , "--operational-certificate-issue-counter-file" - , genesisDelegOpCertCounterFilePath - ] - - -- Generate VRF key pair - void $ execCardanoCLI - [ "node","key-gen-VRF" - , "--verification-key-file", vrfVerKeyFilePath - , "--signing-key-file", vrfSignKeyFilePath - ] - - H.assertFilesExist - [ genesisVerKeyFilePath - , genesisDelegVerKeyFilePath - , vrfVerKeyFilePath - ] - - -- Create genesis key delegation certificate - void $ execCardanoCLI - [ "governance","create-genesis-key-delegation-certificate" - , "--genesis-verification-key-file", genesisVerKeyFilePath - , "--genesis-delegate-verification-key-file", genesisDelegVerKeyFilePath - , "--vrf-verification-key-file", vrfVerKeyFilePath - , "--out-file", genesisKeyDelegCertFilePath - ] - - H.assertFilesExist [genesisKeyDelegCertFilePath] - - let certificateType = textEnvelopeType AsCertificate - - checkTextEnvelopeFormat - certificateType - referenceCertificateFilePath - genesisKeyDelegCertFilePath diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/MIRCertificate.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/MIRCertificate.hs deleted file mode 100644 index 40900ca42ba..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/MIRCertificate.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Certificates.MIRCertificate - ( golden_shelleyMIRCertificate - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate stake key pair --- 2. Create MIR certificate --- s. Check the TextEnvelope serialization format has not changed. -golden_shelleyMIRCertificate :: Property -golden_shelleyMIRCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceMIRCertificate <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/certificates/mir_certificate" - - -- Key filepaths - verKey <- noteTempFile tempDir "stake-verification-key-file" - signKey <- noteTempFile tempDir "stake-signing-key-file" - mirCertificate <- noteTempFile tempDir "mir-certificate-file" - - -- Generate stake key pair - void $ execCardanoCLI - [ "stake-address","key-gen" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - H.assertFilesExist [verKey, signKey] - - let testAddr = "stake1u9j6axhcpd0exvrthn5dqzqt54g85akqvkn4uqmccm70qsc5hpv9w" - -- Create MIR certificate - void $ execCardanoCLI - [ "governance","create-mir-certificate" - , "--reserves" --TODO: Should also do "--reserves" - , "--stake-address", testAddr - , "--reward", "1000" - , "--out-file", mirCertificate - ] - - H.assertFilesExist [mirCertificate] - - let registrationCertificateType = textEnvelopeType AsCertificate - - checkTextEnvelopeFormat registrationCertificateType referenceMIRCertificate mirCertificate diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/OperationalCertificate.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/OperationalCertificate.hs deleted file mode 100644 index 910387de5d6..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/OperationalCertificate.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Certificates.OperationalCertificate - ( golden_shelleyOperationalCertificate - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Create KES key pair. --- 2. Create cold keys. --- 3. Create operational certificate. --- 4. Check the TextEnvelope serialization format has not changed. -golden_shelleyOperationalCertificate :: Property -golden_shelleyOperationalCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceOperationalCertificate <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/certificates/operational_certificate" - - -- Key filepaths - kesVerKey <- noteTempFile tempDir "KES-verification-key-file" - kesSignKey <- noteTempFile tempDir "KES-signing-key-file" - coldVerKey <- noteTempFile tempDir "cold-verification-key-file" - coldSignKey <- noteTempFile tempDir "cold-signing-key-file" - operationalCertCounter <- noteTempFile tempDir "operational-certificate-counter-file" - operationalCert <- noteTempFile tempDir "operational-certificate-file" - - -- Create KES key pair - void $ execCardanoCLI - [ "node","key-gen-KES" - , "--verification-key-file", kesVerKey - , "--signing-key-file", kesSignKey - ] - - H.assertFilesExist [kesSignKey, kesVerKey] - - -- Create cold key pair - void $ execCardanoCLI - [ "node","key-gen" - , "--cold-verification-key-file", coldVerKey - , "--cold-signing-key-file", coldSignKey - , "--operational-certificate-issue-counter", operationalCertCounter - ] - - H.assertFilesExist [coldVerKey, coldSignKey, operationalCertCounter] - - -- Create operational certificate - void $ execCardanoCLI - [ "node","issue-op-cert" - , "--kes-verification-key-file", kesVerKey - , "--cold-signing-key-file", coldSignKey - , "--operational-certificate-issue-counter", operationalCertCounter - , "--kes-period", "1000" - , "--out-file", operationalCert - ] - - let operationalCertificateType = textEnvelopeType AsOperationalCertificate - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat operationalCertificateType referenceOperationalCertificate operationalCert diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/StakeAddressCertificates.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/StakeAddressCertificates.hs deleted file mode 100644 index 21c8d4c8369..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/StakeAddressCertificates.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Certificates.StakeAddressCertificates - ( golden_shelleyStakeAddressCertificates - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a stake verification key --- 2. Create a stake address registration certificate --- 3. Check the TextEnvelope serialization format has not changed. -golden_shelleyStakeAddressCertificates :: Property -golden_shelleyStakeAddressCertificates = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference files - referenceRegistrationCertificate <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/certificates/stake_address_registration_certificate" - referenceDeregistrationCertificate <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/certificates/stake_address_deregistration_certificate" - - -- Key filepaths - verKey <- noteTempFile tempDir "stake-verification-key-file" - signKey <- noteTempFile tempDir "stake-signing-key-file" - deregistrationCertificate <- noteTempFile tempDir "stake-address-deregistration-certificate" - registrationCertificate <- noteTempFile tempDir "stake-address-registration-certificate" - - -- Generate stake verification key - void $ execCardanoCLI - [ "stake-address","key-gen" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - H.assertFilesExist [verKey, signKey] - - -- Create stake address registration certificate - void $ execCardanoCLI - [ "stake-address","registration-certificate" - , "--stake-verification-key-file", verKey - , "--out-file", registrationCertificate - ] - - let registrationCertificateType = textEnvelopeType AsCertificate - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat registrationCertificateType referenceRegistrationCertificate registrationCertificate - - -- Create stake address deregistration certificate - void $ execCardanoCLI - [ "stake-address","deregistration-certificate" - , "--stake-verification-key-file", verKey - , "--out-file", deregistrationCertificate - ] - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat registrationCertificateType referenceDeregistrationCertificate deregistrationCertificate - --- TODO: After delegation-certificate command is fixed to take a hash instead of a verification key -{- - -- Create stake address delegation certificate - void $ execCardanoCLI - [ "stake-address","delegation-certificate" - , "--stake-verification-key-file", verKey - , "--cold-verification-key-file", verKey --TODO: Should be stake pool's hash - , "--out-file", deregistrationCertificate - ] - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat registrationCertificateType referenceDeregistrationCertificate deregistrationCertificate --} diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/StakePoolCertificates.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/StakePoolCertificates.hs deleted file mode 100644 index e2a0f236f1d..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Certificates/StakePoolCertificates.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Certificates.StakePoolCertificates - ( golden_shelleyStakePoolCertificates - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Create cold key pair. --- 2. Create stake key pair. --- 3. Create VRF key pair. --- 4. Create stake pool registration certificate. --- 5. Create stake pool deregistration/retirement certificate. --- 6. Check the TextEnvelope serialization format has not changed. -golden_shelleyStakePoolCertificates :: Property -golden_shelleyStakePoolCertificates = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference files - referenceRegistrationCertificate <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/certificates/stake_pool_registration_certificate" - referenceDeregistrationCertificate <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/certificates/stake_pool_deregistration_certificate" - - -- Key filepaths - coldVerKey <- noteTempFile tempDir "cold-verification-key-file" - coldSignKey <- noteTempFile tempDir "cold-signing-key-file" - operationalCertCounter <- noteTempFile tempDir "operational-certificate-counter-file" - vrfVerKey <- noteTempFile tempDir "vrf-verification-key-file" - vrfSignKey <- noteTempFile tempDir "vrf-signing-key-file" - poolRewardAccountAndOwnerVerKey <- noteTempFile tempDir "reward-account-verification-key-file" - poolRewardAccountSignKey <- noteTempFile tempDir "reward-account-signing-key-file" - registrationCertificate <- noteTempFile tempDir "stake-pool-registration-certificate" - deregistrationCertificate <- noteTempFile tempDir "stake-pool-deregistration-certificate" - - -- Create cold key pair - void $ execCardanoCLI - [ "node","key-gen" - , "--cold-verification-key-file", coldVerKey - , "--cold-signing-key-file", coldSignKey - , "--operational-certificate-issue-counter", operationalCertCounter - ] - - H.assertFilesExist [coldSignKey, coldVerKey, operationalCertCounter] - - -- Generate stake key pair - void $ execCardanoCLI - [ "stake-address","key-gen" - , "--verification-key-file", poolRewardAccountAndOwnerVerKey - , "--signing-key-file", poolRewardAccountSignKey - ] - - H.assertFilesExist [poolRewardAccountAndOwnerVerKey, poolRewardAccountSignKey] - - -- Generate vrf verification key - void $ execCardanoCLI - [ "node","key-gen-VRF" - , "--verification-key-file", vrfVerKey - , "--signing-key-file", vrfSignKey - ] - - - H.assertFilesExist [vrfSignKey, vrfVerKey] - - -- Create stake pool registration certificate - void $ execCardanoCLI - [ "stake-pool","registration-certificate" - , "--cold-verification-key-file", coldVerKey - , "--vrf-verification-key-file", vrfVerKey - , "--mainnet" - , "--pool-cost", "1000" - , "--pool-pledge", "5000" - , "--pool-margin", "0.1" - , "--pool-reward-account-verification-key-file", poolRewardAccountAndOwnerVerKey - , "--pool-owner-stake-verification-key-file", poolRewardAccountAndOwnerVerKey - , "--out-file", registrationCertificate - ] - - H.assertFilesExist [registrationCertificate] - - let registrationCertificateType = textEnvelopeType AsCertificate - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat registrationCertificateType referenceRegistrationCertificate registrationCertificate - - -- Create stake pool deregistration certificate - void $ execCardanoCLI - [ "stake-pool", "deregistration-certificate" - , "--cold-verification-key-file", coldVerKey - , "--epoch", "42" - , "--out-file", deregistrationCertificate - ] - - H.assertFilesExist [deregistrationCertificate] - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat registrationCertificateType referenceDeregistrationCertificate deregistrationCertificate diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/ExtendedPaymentKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/ExtendedPaymentKeys.hs deleted file mode 100644 index 2a2b56a0293..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/ExtendedPaymentKeys.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Keys.ExtendedPaymentKeys - ( golden_shelleyExtendedPaymentKeys - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair --- 2. Check for the existence of the key pair --- 3. Check the TextEnvelope serialization format has not changed. -golden_shelleyExtendedPaymentKeys :: Property -golden_shelleyExtendedPaymentKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceVerKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/extended_payment_keys/verification_key" - referenceSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/extended_payment_keys/signing_key" - - -- Key filepaths - verKey <- noteTempFile tempDir "extended-payment-verification-key-file" - signKey <- noteTempFile tempDir "extended-payment-signing-key-file" - - -- Generate payment verification key - void $ execCardanoCLI - [ "address","key-gen" - , "--extended-key" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - let signingKeyType = textEnvelopeType (AsSigningKey AsPaymentExtendedKey) - verificationKeyType = textEnvelopeType (AsVerificationKey AsPaymentExtendedKey) - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat verificationKeyType referenceVerKey verKey - checkTextEnvelopeFormat signingKeyType referenceSignKey signKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisDelegateKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisDelegateKeys.hs deleted file mode 100644 index 19a2f3e1095..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisDelegateKeys.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Keys.GenesisDelegateKeys - ( golden_shelleyGenesisDelegateKeys - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair & operational certificate counter file --- 2. Check for the existence of the key pair & counter file --- 3. Check the TextEnvelope serialization format has not changed. -golden_shelleyGenesisDelegateKeys :: Property -golden_shelleyGenesisDelegateKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceVerKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_delegate_keys/verification_key" - referenceSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_delegate_keys/signing_key" - referenceOpCertCounter <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_delegate_keys/operational_certificate_counter" - - -- Key filepaths - verKey <- noteTempFile tempDir "genesis-delegate-verification-key-file" - signKey <- noteTempFile tempDir "genesis-delegate-signing-key-file" - opCertCounter <- noteTempFile tempDir "delegate-operational-cert-counter-file" - - -- Generate payment verification key - void $ execCardanoCLI - [ "genesis","key-gen-delegate" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - , "--operational-certificate-issue-counter-file", opCertCounter - ] - - let signingKeyType = textEnvelopeType (AsSigningKey AsGenesisDelegateKey) - verificationKeyType = textEnvelopeType (AsVerificationKey AsGenesisDelegateKey) - operationalCertCounterType = textEnvelopeType AsOperationalCertificateIssueCounter - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat verificationKeyType referenceVerKey verKey - checkTextEnvelopeFormat signingKeyType referenceSignKey signKey - checkTextEnvelopeFormat operationalCertCounterType referenceOpCertCounter opCertCounter diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisKeys.hs deleted file mode 100644 index fed3bcac15d..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisKeys.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Keys.GenesisKeys - ( golden_shelleyGenesisKeys - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair --- 2. Check for the existence of the key pair --- 3. Check the TextEnvelope serialization format has not changed -golden_shelleyGenesisKeys :: Property -golden_shelleyGenesisKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceVerKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/verification_key" - referenceSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/signing_key" - - -- Key filepaths - verKey <- noteTempFile tempDir "genesis-verification-key-file" - signKey <- noteTempFile tempDir "genesis-signing-key-file" - - -- Generate payment verification key - void $ execCardanoCLI - [ "genesis","key-gen-genesis" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - let signingKeyType = textEnvelopeType (AsSigningKey AsGenesisKey) - verificationKeyType = textEnvelopeType (AsVerificationKey AsGenesisKey) - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat verificationKeyType referenceVerKey verKey - checkTextEnvelopeFormat signingKeyType referenceSignKey signKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisUTxOKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisUTxOKeys.hs deleted file mode 100644 index 6dd46dad3cc..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/GenesisUTxOKeys.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Keys.GenesisUTxOKeys - ( golden_shelleyGenesisUTxOKeys - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair --- 2. Check for the existence of the key pair --- 3. Check the TextEnvelope serialization format has not changed. -golden_shelleyGenesisUTxOKeys :: Property -golden_shelleyGenesisUTxOKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceVerKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_utxo_keys/verification_key" - referenceSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/genesis_utxo_keys/signing_key" - - -- Key filepaths - verKey <- noteTempFile tempDir "genesis-utxo-verification-key-file" - signKey <- noteTempFile tempDir "genesis-utxo-signing-key-file" - - -- Generate payment verification key - void $ execCardanoCLI - [ "genesis","key-gen-utxo" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - let signingKeyType = textEnvelopeType (AsSigningKey AsGenesisUTxOKey) - verificationKeyType = textEnvelopeType (AsVerificationKey AsGenesisUTxOKey) - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat verificationKeyType referenceVerKey verKey - checkTextEnvelopeFormat signingKeyType referenceSignKey signKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/KESKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/KESKeys.hs deleted file mode 100644 index 06e7d22837b..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/KESKeys.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Keys.KESKeys - ( golden_shelleyKESKeys - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair --- 2. Check for the existence of the key pair --- 3. Check the TextEnvelope serialization format has not changed. -golden_shelleyKESKeys :: Property -golden_shelleyKESKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceVerKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/kes_keys/verification_key" - referenceSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/kes_keys/signing_key" - - -- Key filepaths - verKey <- noteTempFile tempDir "kes-verification-key-file" - signKey <- noteTempFile tempDir "kes-signing-key-file" - - -- Generate payment verification key - void $ execCardanoCLI - [ "node","key-gen-KES" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - let signingKeyType = textEnvelopeType (AsSigningKey AsKesKey) - verificationKeyType = textEnvelopeType (AsVerificationKey AsKesKey) - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat verificationKeyType referenceVerKey verKey - checkTextEnvelopeFormat signingKeyType referenceSignKey signKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/PaymentKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/PaymentKeys.hs deleted file mode 100644 index 47d832376e2..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/PaymentKeys.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Keys.PaymentKeys - ( golden_shelleyPaymentKeys - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair --- 2. Check for the existence of the key pair --- 3. Check the TextEnvelope serialization format has not changed. -golden_shelleyPaymentKeys :: Property -golden_shelleyPaymentKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceVerKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/payment_keys/verification_key" - referenceSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/payment_keys/signing_key" - - -- Key filepaths - verKey <- noteTempFile tempDir "payment-verification-key-file" - signKey <- noteTempFile tempDir "payment-signing-key-file" - - -- Generate payment verification key - void $ execCardanoCLI - [ "address","key-gen" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - let signingKeyType = textEnvelopeType (AsSigningKey AsPaymentKey) - verificationKeyType = textEnvelopeType (AsVerificationKey AsPaymentKey) - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat verificationKeyType referenceVerKey verKey - checkTextEnvelopeFormat signingKeyType referenceSignKey signKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/StakeKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/StakeKeys.hs deleted file mode 100644 index d2ee06f2052..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/StakeKeys.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Keys.StakeKeys - ( golden_shelleyStakeKeys - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair --- 2. Check for the existence of the key pair --- 3. Check the TextEnvelope serialization format has not changed. -golden_shelleyStakeKeys :: Property -golden_shelleyStakeKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceVerKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/verification_key" - referenceSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/signing_key" - - -- Key filepaths - verKey <- noteTempFile tempDir "stake-verification-key-file" - signKey <- noteTempFile tempDir "stake-signing-key-file" - - -- Generate stake key pair - void $ execCardanoCLI - [ "stake-address","key-gen" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - let signingKeyType = textEnvelopeType (AsSigningKey AsStakeKey) - verificationKeyType = textEnvelopeType (AsVerificationKey AsStakeKey) - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat verificationKeyType referenceVerKey verKey - checkTextEnvelopeFormat signingKeyType referenceSignKey signKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/VRFKeys.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/VRFKeys.hs deleted file mode 100644 index 399e109561a..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Keys/VRFKeys.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Keys.VRFKeys - ( golden_shelleyVRFKeys - ) where - -import Cardano.Api (AsType (..), HasTextEnvelope (..)) -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair --- 2. Check for the existence of the key pair --- 3. Check the TextEnvelope serialization format has not changed. -golden_shelleyVRFKeys :: Property -golden_shelleyVRFKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceVerKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/vrf_keys/verification_key" - referenceSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/vrf_keys/signing_key" - - -- Key filepaths - verKey <- noteTempFile tempDir "vrf-verification-key-file" - signKey <- noteTempFile tempDir "vrf-signing-key-file" - - -- Generate vrf verification key - void $ execCardanoCLI - [ "node","key-gen-VRF" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - let signingKeyType = textEnvelopeType (AsSigningKey AsVrfKey) - verificationKeyType = textEnvelopeType (AsVerificationKey AsVrfKey) - - -- Check the newly created files have not deviated from the - -- golden files - checkTextEnvelopeFormat verificationKeyType referenceVerKey verKey - checkTextEnvelopeFormat signingKeyType referenceSignKey signKey diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs deleted file mode 100644 index f42cbd81cb5..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Tx.Tx - ( golden_shelleyTx - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. Generate a key pair --- 2. Create tx body --- 3. Sign tx body --- 4. Check the TextEnvelope serialization format has not changed. -golden_shelleyTx :: Property -golden_shelleyTx = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - let referenceTx = "test/cardano-cli-golden/files/golden/alonzo/tx" - - -- Key filepaths - paymentSignKey <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/transaction-sign/utxo.skey" - transactionFile <- noteTempFile tempDir "tx-file" - transactionBodyFile <- noteTempFile tempDir "tx-body-file" - - -- Create transaction body - void $ execCardanoCLI - [ "transaction", "build-raw" - , "--alonzo-era" - , "--tx-in", "f62cd7bc15d8c6d2c8519fb8d13c57c0157ab6bab50af62bc63706feb966393d#0" - , "--tx-out", "addr_test1qpmxr8d8jcl25kyz2tz9a9sxv7jxglhddyf475045y8j3zxjcg9vquzkljyfn3rasfwwlkwu7hhm59gzxmsyxf3w9dps8832xh+1199989833223" - , "--tx-out", "addr_test1vpqgspvmh6m2m5pwangvdg499srfzre2dd96qq57nlnw6yctpasy4+10000000" - , "--fee", "166777" - , "--out-file", transactionBodyFile - ] - - -- Sign transaction - void $ execCardanoCLI - [ "transaction", "sign" - , "--tx-body-file", transactionBodyFile - , "--signing-key-file", paymentSignKey - , "--testnet-magic", "42" - , "--out-file", transactionFile - ] - - -- Check the newly created files have not deviated from the - -- golden files - checkTxCddlFormat referenceTx transactionFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/TxBody.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/TxBody.hs deleted file mode 100644 index bd03037717e..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/TxBody.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Tx.TxBody - ( golden_shelleyTxBody - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import Control.Monad (void) -import qualified Hedgehog.Extras.Test.Base as H - -{- HLINT ignore "Use camelCase" -} - --- | 1. We create a 'TxBody Shelley' file. --- 2. Check the TextEnvelope serialization format has not changed. -golden_shelleyTxBody :: Property -golden_shelleyTxBody = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Reference keys - referenceTxBody <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/tx/txbody" - - -- Key filepaths - transactionBodyFile <- noteTempFile tempDir "transaction-body-file" - - -- Create transaction body - void $ execCardanoCLI - [ "transaction", "build-raw" - , "--mary-era" - , "--tx-in", "91999ea21177b33ebe6b8690724a0c026d410a11ad7521caa350abdafa5394c3#0" - , "--tx-out", "addr1v9wmu83pzajplrtpsq6tsqdgwr98x888trpmah2u0ezznsge7del3+100000000" - , "--fee", "1000000" - , "--invalid-hereafter", "500000" - , "--out-file", transactionBodyFile - ] - - - -- Check the newly created files have not deviated from the - -- golden files - checkTxCddlFormat referenceTxBody transactionBodyFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/Witness.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/Witness.hs deleted file mode 100644 index d40a52ae9fa..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextEnvelope/Tx/Witness.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextEnvelope.Tx.Witness - ( golden_shelleyWitness - ) where - -import Hedgehog (Property) - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyWitness :: Property -golden_shelleyWitness = error "TODO" diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextView/DecodeCbor.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextView/DecodeCbor.hs deleted file mode 100644 index 8e77c7fb70c..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/TextView/DecodeCbor.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.TextView.DecodeCbor - ( golden_shelleyTextViewDecodeCbor - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyTextViewDecodeCbor :: Property -golden_shelleyTextViewDecodeCbor = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - unsignedTxFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/tx/unsigned.tx" - decodedTxtFile <- noteTempFile tempDir "decoded.txt" - - -- Defaults to signing a Mainnet transaction. - - decodedTxt <- execCardanoCLI - [ "text-view","decode-cbor" - , "--file", unsignedTxFile - ] - - H.writeFile decodedTxtFile decodedTxt - - H.assertFileOccurences 1 "# int(4999998000)" decodedTxtFile - H.assertFileOccurences 1 "# int(2000)" decodedTxtFile - H.assertFileOccurences 1 "# int(1000)" decodedTxtFile - - H.assertEndsWithSingleNewline decodedTxtFile - H.assertFileLines (>= 10) decodedTxtFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Assemble.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Assemble.hs deleted file mode 100644 index f3721a90c58..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Assemble.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Transaction.Assemble - ( golden_shelleyTransactionAssembleWitness_SigningKey - ) where - -import Control.Monad (void) - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - --- Check that we can assemble a txbody and a tx witness to form a transaction - -golden_shelleyTransactionAssembleWitness_SigningKey :: Property -golden_shelleyTransactionAssembleWitness_SigningKey = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - witnessTx <- noteTempFile tempDir "single-signing-key-witness-tx" - txBodyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/tx/txbody" - signingKeyWitnessFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/witnesses/singleSigningKeyWitness" - void $ execCardanoCLI - [ "transaction","sign-witness" - , "--tx-body-file", txBodyFile - , "--witness-file", signingKeyWitnessFile - , "--witness-file", signingKeyWitnessFile - , "--out-file", witnessTx - ] - - H.assertFileOccurences 1 "Tx MaryEra" witnessTx diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Build.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Build.hs deleted file mode 100644 index e5c9f274066..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Build.hs +++ /dev/null @@ -1,144 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Transaction.Build - ( golden_shelleyTransactionBuild - , golden_shelleyTransactionBuild_TxInScriptWitnessed - , golden_shelleyTransactionBuild_Minting - , golden_shelleyTransactionBuild_CertificateScriptWitnessed - , golden_shelleyTransactionBuild_WithdrawalScriptWitnessed - ) where - -import Control.Monad (void) - -import qualified Data.ByteString.Base16 as Base16 -import qualified Data.ByteString.Char8 as BSC -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -txOut :: String -txOut = "addr1q94cxl99qvtwunsqqv6g9mgj3zrawtpt4edsgwxkjtwpy5dsezcht90tmwfur7t5hc9fk8hjd3r5vjwec2h8vmk3xh8s7er7t3+100" - -txIn :: String -txIn = "2392d2b1200b5139fe555c81261697b29a8ccf561c5c783d46e78a479d977053#0" - -golden_shelleyTransactionBuild :: Property -golden_shelleyTransactionBuild = - propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - txBodyOutFile <- noteTempFile tempDir "tx-body-out" - - void $ execCardanoCLI - [ "transaction","build-raw" - , "--mary-era" - , "--tx-in", txIn - , "--tx-out", txOut - , "--fee", "12" - , "--tx-body-file", txBodyOutFile - ] - - H.assertFileOccurences 1 "Tx MaryEra" txBodyOutFile - - H.assertEndsWithSingleNewline txBodyOutFile - - -golden_shelleyTransactionBuild_CertificateScriptWitnessed :: Property -golden_shelleyTransactionBuild_CertificateScriptWitnessed = - propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - let deregcert = "test/cardano-cli-golden/files/golden/shelley/certificates/stake_address_deregistration_certificate" - scriptWit = "test/cardano-cli-golden/files/golden/shelley/multisig/scripts/any" - - txBodyOutFile <- noteTempFile tempDir "tx-body-out" - - void $ execCardanoCLI - [ "transaction","build-raw" - , "--mary-era" - , "--tx-in", txIn - , "--tx-out", txOut - , "--certificate-file", deregcert, "--certificate-script-file", scriptWit - , "--fee", "12" - , "--tx-body-file", txBodyOutFile - ] - - H.assertFileOccurences 1 "Tx MaryEra" txBodyOutFile - - H.assertEndsWithSingleNewline txBodyOutFile - -golden_shelleyTransactionBuild_Minting :: Property -golden_shelleyTransactionBuild_Minting = - propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - let scriptWit = "test/cardano-cli-golden/files/golden/shelley/multisig/scripts/any" - - polid <- execCardanoCLI - [ "transaction" - , "policyid" - , "--script-file" - , scriptWit - ] - - let dummyMA = - filter (/= '\n') $ - "50 " ++ polid ++ "." ++ BSC.unpack (Base16.encode "ethereum") - - txBodyOutFile <- noteTempFile tempDir "tx-body-out" - - void $ execCardanoCLI - [ "transaction","build-raw" - , "--mary-era" - , "--tx-in", txIn - , "--tx-out", txOut ++ "+" ++ dummyMA, "--mint-script-file", scriptWit - , "--mint", dummyMA - , "--fee", "12" - , "--tx-body-file", txBodyOutFile - ] - - H.assertFileOccurences 1 "Tx MaryEra" txBodyOutFile - - H.assertEndsWithSingleNewline txBodyOutFile - -golden_shelleyTransactionBuild_WithdrawalScriptWitnessed :: Property -golden_shelleyTransactionBuild_WithdrawalScriptWitnessed = - propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - txBodyOutFile <- noteTempFile tempDir "tx-body-out" - - stakeAddress <- H.readFile "test/cardano-cli-golden/files/golden/shelley/keys/stake_keys/reward_address" - - let withdrawal = filter (/= '\n') $ stakeAddress <> "+100" - scriptWit = "test/cardano-cli-golden/files/golden/shelley/multisig/scripts/any" - - void $ execCardanoCLI - [ "transaction","build-raw" - , "--mary-era" - , "--tx-in", txIn - , "--tx-out", txOut - , "--withdrawal", withdrawal, "--withdrawal-script-file", scriptWit - , "--fee", "12" - , "--tx-body-file", txBodyOutFile - ] - - H.assertFileOccurences 1 "Tx MaryEra" txBodyOutFile - - H.assertEndsWithSingleNewline txBodyOutFile - -golden_shelleyTransactionBuild_TxInScriptWitnessed :: Property -golden_shelleyTransactionBuild_TxInScriptWitnessed = - propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - let scriptWit = "test/cardano-cli-golden/files/golden/shelley/multisig/scripts/any" - - txBodyOutFile <- noteTempFile tempDir "tx-body-out" - - void $ execCardanoCLI - [ "transaction","build-raw" - , "--mary-era" - , "--tx-in", txIn, "--txin-script-file", scriptWit - , "--tx-out", txOut - , "--fee", "12" - , "--tx-body-file", txBodyOutFile - ] - - H.assertFileOccurences 1 "Tx MaryEra" txBodyOutFile - - H.assertEndsWithSingleNewline txBodyOutFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/CalculateMinFee.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/CalculateMinFee.hs deleted file mode 100644 index 665c7be43cc..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/CalculateMinFee.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Transaction.CalculateMinFee - ( golden_shelleyTransactionCalculateMinFee - ) where - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyTransactionCalculateMinFee :: Property -golden_shelleyTransactionCalculateMinFee = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - protocolParamsJsonFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/transaction-calculate-min-fee/protocol-params.json" - txBodyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/tx/txbody" - minFeeTxtFile <- noteTempFile tempDir "min-fee.txt" - - minFeeTxt <- execCardanoCLI - [ "transaction","calculate-min-fee" - , "--tx-in-count", "32" - , "--tx-out-count", "27" - , "--byron-witness-count", "5" - , "--witness-count", "10" - , "--testnet-magic", "4036000900" - , "--protocol-params-file", protocolParamsJsonFile - , "--tx-body-file", txBodyFile - ] - - H.writeFile minFeeTxtFile minFeeTxt - - H.assertFileOccurences 1 "5083100" minFeeTxtFile - H.assertFileLines (== 1) minFeeTxtFile - H.assertEndsWithSingleNewline minFeeTxtFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/CreateWitness.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/CreateWitness.hs deleted file mode 100644 index c2cd6b99413..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/CreateWitness.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Transaction.CreateWitness - ( golden_shelleyTransactionSigningKeyWitness - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -txIn :: String -txIn = "2392d2b1200b5139fe555c81261697b29a8ccf561c5c783d46e78a479d977053#0" - -txOut :: String -txOut = "addr1q94cxl99qvtwunsqqv6g9mgj3zrawtpt4edsgwxkjtwpy5dsezcht90tmwfur7t5hc9fk8hjd3r5vjwec2h8vmk3xh8s7er7t3+100" - -golden_shelleyTransactionSigningKeyWitness :: Property -golden_shelleyTransactionSigningKeyWitness = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - txBodyOutFile <- noteTempFile tempDir "tx-body-out" - - -- Create tx body file - void $ execCardanoCLI - [ "transaction","build-raw" - , "--shelley-era" - , "--tx-in", txIn - , "--tx-out", txOut - , "--invalid-hereafter", "60" - , "--fee", "12" - , "--tx-body-file", txBodyOutFile - ] - - -- Create all multisig witness - witnessOutFile <- noteTempFile tempDir "signingkey-witness" - signingKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/payment_keys/signing_key" - void $ execCardanoCLI - [ "transaction","witness" - , "--tx-body-file", txBodyOutFile - , "--signing-key-file", signingKeyFile - , "--mainnet" - , "--out-file", witnessOutFile - ] - - H.assertFileOccurences 1 "TxWitness ShelleyEra" witnessOutFile - H.assertEndsWithSingleNewline txBodyOutFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Sign.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Sign.hs deleted file mode 100644 index 1153e2b4c06..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Transaction/Sign.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Shelley.Transaction.Sign - ( golden_shelleyTransactionSign - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - -golden_shelleyTransactionSign :: Property -golden_shelleyTransactionSign = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - txBodyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/tx/txbody" - initialUtxo1SigningKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/keys/payment_keys/signing_key" - utxoSigningKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/transaction-sign/utxo.skey" - stakeSigningKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/transaction-sign/stake.skey" - nodeColdSigningKeyFile <- noteInputFile "test/cardano-cli-golden/files/golden/shelley/transaction-sign/node-cold.skey" - signedTransactionFile <- noteTempFile tempDir "signed.tx" - transactionPoolRegSignedFile <- noteTempFile tempDir "tx-pool-reg.signed" - - -- Defaults to signing a Mainnet transaction - - void $ execCardanoCLI - [ "transaction","sign" - , "--mainnet" - , "--tx-body-file", txBodyFile - , "--signing-key-file", initialUtxo1SigningKeyFile - , "--tx-file", signedTransactionFile - ] - - H.assertFileOccurences 1 "Tx MaryEra" signedTransactionFile - H.assertEndsWithSingleNewline signedTransactionFile - - -- Sign for a testnet with a testnet network magic of 11, but use two signing keys - - void $ execCardanoCLI - [ "transaction","sign" - , "--mainnet" - , "--tx-body-file", txBodyFile - , "--signing-key-file", initialUtxo1SigningKeyFile - , "--signing-key-file", initialUtxo1SigningKeyFile - , "--tx-file", signedTransactionFile - ] - - H.assertFileOccurences 1 "Tx MaryEra" signedTransactionFile - H.assertEndsWithSingleNewline signedTransactionFile - - -- Sign a pool registration transaction. - -- TODO: This needs to use an unsigned tx with a registration certificate - - void $ execCardanoCLI - [ "transaction","sign" - , "--mainnet" - , "--tx-body-file", txBodyFile - , "--signing-key-file", utxoSigningKeyFile - , "--signing-key-file", stakeSigningKeyFile - , "--signing-key-file", nodeColdSigningKeyFile - , "--tx-file", transactionPoolRegSignedFile - ] - - H.assertFileOccurences 1 "Tx MaryEra" transactionPoolRegSignedFile - H.assertEndsWithSingleNewline transactionPoolRegSignedFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs deleted file mode 100644 index 24ce8999fdf..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs +++ /dev/null @@ -1,317 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.TxView (txViewTests) where - -import Control.Monad (void) - -import Hedgehog (Group (..), Property, checkSequential) -import Hedgehog.Extras (Integration, moduleWorkspace, note_, propertyOnce) -import qualified Hedgehog.Extras.Test.Golden as H -import System.FilePath (()) -import Test.Cardano.CLI.Util (execCardanoCLI, noteTempFile) - -{- HLINT ignore "Use camelCase" -} - -txViewTests :: IO Bool -txViewTests = - checkSequential $ - Group "`transaction view` Goldens" - [ ("golden_view_byron", golden_view_byron) - , ("golden_view_shelley", golden_view_shelley) - , ("golden_view_allegra", golden_view_allegra) - , ("golden_view_mary", golden_view_mary) - , ("golden_view_alonzo", golden_view_alonzo) - , ("golden_view_alonzo_signed", golden_view_alonzo_signed) - ] - -golden_view_byron :: Property -golden_view_byron = - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do - transactionBodyFile <- noteTempFile tempDir "transaction-body-file" - - -- Create transaction body - void $ - execCardanoCLI - [ "transaction", "build-raw" - , "--byron-era" - , "--tx-in" - , "F8EC302D19E3C8251C30B1434349BF2E949A1DBF14A4EBC3D512918D2D4D5C56#88" - , "--tx-out" - , "5oP9ib6ym3XfwXuy3ksXZzgtBzXSArXAACQVXKqcPhiLnHVYjXJNu2T6Zomh8LAWLV+68" - , "--out-file", transactionBodyFile - ] - - -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - H.diffVsGoldenFile result "test/cardano-cli-golden/files/golden/byron/transaction-view.out" - -golden_view_shelley :: Property -golden_view_shelley = let - certDir = "test/cardano-cli-golden/files/golden/shelley/certificates" - certs = - (certDir ) <$> - [ "genesis_key_delegation_certificate" - , "mir_certificate" - , "stake_address_deregistration_certificate" - , "stake_address_registration_certificate" - , "stake_pool_deregistration_certificate" - , "stake_pool_registration_certificate" - ] - in - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do - updateProposalFile <- noteTempFile tempDir "update-proposal" - transactionBodyFile <- noteTempFile tempDir "transaction-body" - - let extraEntropySeed = "c0ffee" - note_ $ "extra entropy seed: " ++ extraEntropySeed - note_ $ mconcat - [ "extra entropy hash:" - , " 88f04f011dcded879039ae4b9b20219d9448e5c7b42c2d1f638fb8740e0ab8be" - ] - - note_ $ mconcat - [ "genesis-verification-key-file hash:" - , " 81cb0bc5b6fbba391e6f7ec3d9271cbea25bcbf907181b7c4d5f8c2f" - ] - - -- Create update proposal - void $ - execCardanoCLI - [ "governance", "create-update-proposal" - , "--decentralization-parameter", "63/64" - , "--epoch", "64" - , "--extra-entropy", extraEntropySeed - , "--genesis-verification-key-file" - , "test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/verification_key" - , "--key-reg-deposit-amt", "71" - , "--max-block-body-size", "72" - , "--max-block-header-size", "73" - , "--max-tx-size", "74" - , "--min-fee-constant", "75" - , "--min-fee-linear", "76" - , "--min-pool-cost", "77" - , "--min-utxo-value", "78" - , "--monetary-expansion", "79/80" - , "--number-of-pools", "80" - , "--out-file", updateProposalFile - , "--pool-influence", "82/83" - , "--pool-reg-deposit", "83" - , "--pool-retirement-epoch-boundary", "84" - , "--protocol-major-version", "8" - , "--protocol-minor-version", "86" - , "--treasury-expansion", "87/88" - ] - - -- Create transaction body - void $ - execCardanoCLI $ - [ "transaction", "build-raw" - , "--shelley-era" - , "--tx-in" - , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#29" - , "--tx-out" - , "addr_test1vz7w0r9epak6nmnh3mc8e2ypkjyu8zsc3xf7dpct6k577acxmcfyv+31" - , "--fee", "32" - , "--invalid-hereafter", "33" - , "--withdrawal" - , "stake_test1up00fz9lyqs5sjks82k22eqz7a9srym9vysjgp3h2ua2v2cm522kg+42" - , "--update-proposal-file", updateProposalFile - , "--out-file", transactionBodyFile - ] - ++ - ["--certificate-file=" <> cert | cert <- certs] - - -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - H.diffVsGoldenFile result "test/cardano-cli-golden/files/golden/shelley/transaction-view.out" - -golden_view_allegra :: Property -golden_view_allegra = - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do - transactionBodyFile <- noteTempFile tempDir "transaction-body-file" - - -- Create transaction body - void $ - execCardanoCLI - [ "transaction", "build-raw" - , "--allegra-era" - , "--tx-in" - , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#94" - , "--tx-out" - , mconcat - [ "addr_test1" - , "qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r7" - , "9jmxlyk4eqt6z6hj5g8jd8393msqaw47f4" - , "+99" - ] - , "--fee", "100" - , "--invalid-hereafter", "101" - , "--out-file", transactionBodyFile - ] - - -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - H.diffVsGoldenFile result "test/cardano-cli-golden/files/golden/allegra/transaction-view.out" - -golden_view_mary :: Property -golden_view_mary = - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do - transactionBodyFile <- noteTempFile tempDir "transaction-body-file" - - -- Create transaction body - void $ - execCardanoCLI - [ "transaction", "build-raw" - , "--mary-era" - , "--tx-in" - , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#135" - , "--tx-out" - , mconcat - [ "addr_test1" - , "qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r7" - , "9jmxlyk4eqt6z6hj5g8jd8393msqaw47f4" - , " + " - , "138" - , " + " - , "130 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" - , " + " - , "132 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.cafe" - , " + " - , "134 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf.f00d" - , " + " - , "136 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.dead" - , " + " - , "138" - , " d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" - , ".736e6f77" - , " + " - , "142" - , " a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067" - , ".736b79" - ] - , "--fee", "139" - , "--invalid-before", "140" - , "--mint" - , mconcat - [ "130 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" - , " + " - , "132 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.cafe" - , " + " - , "134 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf.f00d" - , " + " - , "136 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.dead" - , " + " - , "138" - , " d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" - , ".736e6f77" - , " + " - , "142" - , " a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067" - , ".736b79" - ] - , "--mint-script-file", "test/cardano-cli-golden/files/golden/mary/scripts/mint.all" - , "--mint-script-file", "test/cardano-cli-golden/files/golden/mary/scripts/mint.sig" - , "--out-file", transactionBodyFile - ] - - -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - H.diffVsGoldenFile result "test/cardano-cli-golden/files/golden/mary/transaction-view.out" - -createAlonzoTxBody :: Maybe FilePath -> FilePath -> Integration () -createAlonzoTxBody mUpdateProposalFile transactionBodyFile = do - void $ - execCardanoCLI - ( [ "transaction", "build-raw" - , "--alonzo-era" - , "--tx-in" - , "ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212" - , "--tx-in-collateral" - , "c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256" - , "--fee", "213" - , "--required-signer-hash" - , "98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27" - , "--required-signer-hash" - , "fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4" - , "--out-file", transactionBodyFile - ] - ++ [ "--update-proposal-file=" <> updateProposalFile - | Just updateProposalFile <- [mUpdateProposalFile] - ] - ) - -golden_view_alonzo :: Property -golden_view_alonzo = - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do - updateProposalFile <- noteTempFile tempDir "update-proposal" - transactionBodyFile <- noteTempFile tempDir "transaction-body" - - note_ $ mconcat - [ "genesis-verification-key-file hash:" - , " 1bafa294233a5a7ffbf539ae798da0943aa83d2a19398c2d0e5af114" - ] - - -- Create update proposal - void $ - execCardanoCLI - [ "governance", "create-update-proposal" - , "--epoch", "190" - , "--genesis-verification-key-file" - , "test/cardano-cli-golden/files/golden/shelley/keys/genesis_keys/verification_key" - , "--utxo-cost-per-word", "194" - , "--price-execution-steps", "195/196" - , "--price-execution-memory", "196/197" - , "--max-tx-execution-units", "(197, 198)" - , "--max-block-execution-units", "(198, 199)" - , "--max-value-size", "199" - , "--collateral-percent", "200" - , "--max-collateral-inputs", "201" - , "--out-file", updateProposalFile - ] - - createAlonzoTxBody (Just updateProposalFile) transactionBodyFile - - -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - H.diffVsGoldenFile result "test/cardano-cli-golden/files/golden/alonzo/transaction-view.out" - -golden_view_alonzo_signed :: Property -golden_view_alonzo_signed = - let testData = "test/cardano-cli-golden/files/golden/alonzo" - in - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do - transactionBodyFile <- noteTempFile tempDir "transaction-body" - transactionFile <- noteTempFile tempDir "transaction" - - createAlonzoTxBody Nothing transactionBodyFile - - -- Sign - void $ - execCardanoCLI - [ "transaction", "sign" - , "--tx-body-file", transactionBodyFile - , "--signing-key-file", testData "signing.key" - , "--out-file", transactionFile - ] - - -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-file", transactionFile] - H.diffVsGoldenFile result (testData "signed-transaction-view.out") diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Version.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Version.hs deleted file mode 100644 index d63153edfc6..00000000000 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Version.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Golden.Version - ( golden_version - ) where - -import Control.Monad (void) - -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -{- HLINT ignore "Use camelCase" -} - -golden_version :: Property -golden_version = propertyOnce $ do - void $ execCardanoCLI - [ "version" - ] diff --git a/cardano-cli/test/cardano-cli-golden/cardano-cli-golden.hs b/cardano-cli/test/cardano-cli-golden/cardano-cli-golden.hs deleted file mode 100644 index 7aa0be90de1..00000000000 --- a/cardano-cli/test/cardano-cli-golden/cardano-cli-golden.hs +++ /dev/null @@ -1,33 +0,0 @@ -import Hedgehog.Main (defaultMain) - -import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8) - -import qualified Test.Golden.Byron.SigningKeys -import qualified Test.Golden.Byron.Tx -import qualified Test.Golden.Byron.UpdateProposal -import qualified Test.Golden.Byron.Vote -import qualified Test.Golden.Help -import qualified Test.Golden.Key -import qualified Test.Golden.Shelley -import qualified Test.Golden.TxView - -main :: IO () -main = do - hSetBuffering stdout LineBuffering - hSetEncoding stdout utf8 - defaultMain - [ Test.Golden.Byron.SigningKeys.tests - , Test.Golden.Byron.Tx.txTests - , Test.Golden.Byron.UpdateProposal.updateProposalTest - , Test.Golden.Byron.Vote.voteTests - , Test.Golden.Help.helpTests - , Test.Golden.Key.keyTests - , Test.Golden.Shelley.keyTests - , Test.Golden.Shelley.certificateTests - , Test.Golden.Shelley.keyConversionTests - , Test.Golden.Shelley.metadataTests - , Test.Golden.Shelley.multiSigTests - , Test.Golden.Shelley.txTests - , Test.Golden.Shelley.governancePollTests - , Test.Golden.TxView.txViewTests - ] diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out deleted file mode 100644 index b4a82f94d22..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out +++ /dev/null @@ -1,27 +0,0 @@ -auxiliary scripts: null -certificates: null -collateral inputs: null -era: Allegra -fee: 100 Lovelace -inputs: -- fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#94 -metadata: null -mint: null -outputs: -- address: addr_test1qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r79jmxlyk4eqt6z6hj5g8jd8393msqaw47f4 - address era: Shelley - amount: 99 Lovelace - network: Testnet - payment credential key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 - reference script: null - stake reference: - stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 -reference inputs: null -required signers (payment key hashes needed for scripts): null -return collateral: null -total collateral: null -update proposal: null -validity range: - lower bound: null - upper bound: 101 -withdrawals: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/genesis.alonzo.spec.json b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/genesis.alonzo.spec.json deleted file mode 100644 index cf8e5ef324e..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/genesis.alonzo.spec.json +++ /dev/null @@ -1,194 +0,0 @@ -{ - "lovelacePerUTxOWord": 34482, - "executionPrices": { - "prSteps": { - "numerator": 721, - "denominator": 10000000 - }, - "prMem": { - "numerator": 577, - "denominator": 10000 - } - }, - "maxTxExUnits": { - "exUnitsMem": 10000000, - "exUnitsSteps": 10000000000 - }, - "maxBlockExUnits": { - "exUnitsMem": 50000000, - "exUnitsSteps": 40000000000 - }, - "maxValueSize": 5000, - "collateralPercentage": 150, - "maxCollateralInputs": 3, - "costModels": { - "PlutusV1": { - "sha2_256-memory-arguments": 4, - "equalsString-cpu-arguments-constant": 1000, - "cekDelayCost-exBudgetMemory": 100, - "lessThanEqualsByteString-cpu-arguments-intercept": 103599, - "divideInteger-memory-arguments-minimum": 1, - "appendByteString-cpu-arguments-slope": 621, - "blake2b-cpu-arguments-slope": 29175, - "iData-cpu-arguments": 150000, - "encodeUtf8-cpu-arguments-slope": 1000, - "unBData-cpu-arguments": 150000, - "multiplyInteger-cpu-arguments-intercept": 61516, - "cekConstCost-exBudgetMemory": 100, - "nullList-cpu-arguments": 150000, - "equalsString-cpu-arguments-intercept": 150000, - "trace-cpu-arguments": 150000, - "mkNilData-memory-arguments": 32, - "lengthOfByteString-cpu-arguments": 150000, - "cekBuiltinCost-exBudgetCPU": 29773, - "bData-cpu-arguments": 150000, - "subtractInteger-cpu-arguments-slope": 0, - "unIData-cpu-arguments": 150000, - "consByteString-memory-arguments-intercept": 0, - "divideInteger-memory-arguments-slope": 1, - "divideInteger-cpu-arguments-model-arguments-slope": 118, - "listData-cpu-arguments": 150000, - "headList-cpu-arguments": 150000, - "chooseData-memory-arguments": 32, - "equalsInteger-cpu-arguments-intercept": 136542, - "sha3_256-cpu-arguments-slope": 82363, - "sliceByteString-cpu-arguments-slope": 5000, - "unMapData-cpu-arguments": 150000, - "lessThanInteger-cpu-arguments-intercept": 179690, - "mkCons-cpu-arguments": 150000, - "appendString-memory-arguments-intercept": 0, - "modInteger-cpu-arguments-model-arguments-slope": 118, - "ifThenElse-cpu-arguments": 1, - "mkNilPairData-cpu-arguments": 150000, - "lessThanEqualsInteger-cpu-arguments-intercept": 145276, - "addInteger-memory-arguments-slope": 1, - "chooseList-memory-arguments": 32, - "constrData-memory-arguments": 32, - "decodeUtf8-cpu-arguments-intercept": 150000, - "equalsData-memory-arguments": 1, - "subtractInteger-memory-arguments-slope": 1, - "appendByteString-memory-arguments-intercept": 0, - "lengthOfByteString-memory-arguments": 4, - "headList-memory-arguments": 32, - "listData-memory-arguments": 32, - "consByteString-cpu-arguments-intercept": 150000, - "unIData-memory-arguments": 32, - "remainderInteger-memory-arguments-minimum": 1, - "bData-memory-arguments": 32, - "lessThanByteString-cpu-arguments-slope": 248, - "encodeUtf8-memory-arguments-intercept": 0, - "cekStartupCost-exBudgetCPU": 100, - "multiplyInteger-memory-arguments-intercept": 0, - "unListData-memory-arguments": 32, - "remainderInteger-cpu-arguments-model-arguments-slope": 118, - "cekVarCost-exBudgetCPU": 29773, - "remainderInteger-memory-arguments-slope": 1, - "cekForceCost-exBudgetCPU": 29773, - "sha2_256-cpu-arguments-slope": 29175, - "equalsInteger-memory-arguments": 1, - "indexByteString-memory-arguments": 1, - "addInteger-memory-arguments-intercept": 1, - "chooseUnit-cpu-arguments": 150000, - "sndPair-cpu-arguments": 150000, - "cekLamCost-exBudgetCPU": 29773, - "fstPair-cpu-arguments": 150000, - "quotientInteger-memory-arguments-minimum": 1, - "decodeUtf8-cpu-arguments-slope": 1000, - "lessThanInteger-memory-arguments": 1, - "lessThanEqualsInteger-cpu-arguments-slope": 1366, - "fstPair-memory-arguments": 32, - "modInteger-memory-arguments-intercept": 0, - "unConstrData-cpu-arguments": 150000, - "lessThanEqualsInteger-memory-arguments": 1, - "chooseUnit-memory-arguments": 32, - "sndPair-memory-arguments": 32, - "addInteger-cpu-arguments-intercept": 197209, - "decodeUtf8-memory-arguments-slope": 8, - "equalsData-cpu-arguments-intercept": 150000, - "mapData-cpu-arguments": 150000, - "mkPairData-cpu-arguments": 150000, - "quotientInteger-cpu-arguments-constant": 148000, - "consByteString-memory-arguments-slope": 1, - "cekVarCost-exBudgetMemory": 100, - "indexByteString-cpu-arguments": 150000, - "unListData-cpu-arguments": 150000, - "equalsInteger-cpu-arguments-slope": 1326, - "cekStartupCost-exBudgetMemory": 100, - "subtractInteger-cpu-arguments-intercept": 197209, - "divideInteger-cpu-arguments-model-arguments-intercept": 425507, - "divideInteger-memory-arguments-intercept": 0, - "cekForceCost-exBudgetMemory": 100, - "blake2b-cpu-arguments-intercept": 2477736, - "remainderInteger-cpu-arguments-constant": 148000, - "tailList-cpu-arguments": 150000, - "encodeUtf8-cpu-arguments-intercept": 150000, - "equalsString-cpu-arguments-slope": 1000, - "lessThanByteString-memory-arguments": 1, - "multiplyInteger-cpu-arguments-slope": 11218, - "appendByteString-cpu-arguments-intercept": 396231, - "lessThanEqualsByteString-cpu-arguments-slope": 248, - "modInteger-memory-arguments-slope": 1, - "addInteger-cpu-arguments-slope": 0, - "equalsData-cpu-arguments-slope": 10000, - "decodeUtf8-memory-arguments-intercept": 0, - "chooseList-cpu-arguments": 150000, - "constrData-cpu-arguments": 150000, - "equalsByteString-memory-arguments": 1, - "cekApplyCost-exBudgetCPU": 29773, - "quotientInteger-memory-arguments-slope": 1, - "verifySignature-cpu-arguments-intercept": 3345831, - "unMapData-memory-arguments": 32, - "mkCons-memory-arguments": 32, - "sliceByteString-memory-arguments-slope": 1, - "sha3_256-memory-arguments": 4, - "ifThenElse-memory-arguments": 1, - "mkNilPairData-memory-arguments": 32, - "equalsByteString-cpu-arguments-slope": 247, - "appendString-cpu-arguments-intercept": 150000, - "quotientInteger-cpu-arguments-model-arguments-slope": 118, - "cekApplyCost-exBudgetMemory": 100, - "equalsString-memory-arguments": 1, - "multiplyInteger-memory-arguments-slope": 1, - "cekBuiltinCost-exBudgetMemory": 100, - "remainderInteger-memory-arguments-intercept": 0, - "sha2_256-cpu-arguments-intercept": 2477736, - "remainderInteger-cpu-arguments-model-arguments-intercept": 425507, - "lessThanEqualsByteString-memory-arguments": 1, - "tailList-memory-arguments": 32, - "mkNilData-cpu-arguments": 150000, - "chooseData-cpu-arguments": 150000, - "unBData-memory-arguments": 32, - "blake2b-memory-arguments": 4, - "iData-memory-arguments": 32, - "nullList-memory-arguments": 32, - "cekDelayCost-exBudgetCPU": 29773, - "subtractInteger-memory-arguments-intercept": 1, - "lessThanByteString-cpu-arguments-intercept": 103599, - "consByteString-cpu-arguments-slope": 1000, - "appendByteString-memory-arguments-slope": 1, - "trace-memory-arguments": 32, - "divideInteger-cpu-arguments-constant": 148000, - "cekConstCost-exBudgetCPU": 29773, - "encodeUtf8-memory-arguments-slope": 8, - "quotientInteger-cpu-arguments-model-arguments-intercept": 425507, - "mapData-memory-arguments": 32, - "appendString-cpu-arguments-slope": 1000, - "modInteger-cpu-arguments-constant": 148000, - "verifySignature-cpu-arguments-slope": 1, - "unConstrData-memory-arguments": 32, - "quotientInteger-memory-arguments-intercept": 0, - "equalsByteString-cpu-arguments-constant": 150000, - "sliceByteString-memory-arguments-intercept": 0, - "mkPairData-memory-arguments": 32, - "equalsByteString-cpu-arguments-intercept": 112536, - "appendString-memory-arguments-slope": 1, - "lessThanInteger-cpu-arguments-slope": 497, - "modInteger-cpu-arguments-model-arguments-intercept": 425507, - "modInteger-memory-arguments-minimum": 1, - "sha3_256-cpu-arguments-intercept": 0, - "verifySignature-memory-arguments": 1, - "cekLamCost-exBudgetMemory": 100, - "sliceByteString-cpu-arguments-intercept": 150000 - } - } -} \ No newline at end of file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out deleted file mode 100644 index 1983ca24b36..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out +++ /dev/null @@ -1,25 +0,0 @@ -auxiliary scripts: null -certificates: null -collateral inputs: -- c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 -era: Alonzo -fee: 213 Lovelace -inputs: -- ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212 -metadata: null -mint: null -outputs: [] -reference inputs: null -required signers (payment key hashes needed for scripts): -- 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27 -- fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4 -return collateral: null -total collateral: null -update proposal: null -validity range: - lower bound: null - upper bound: null -withdrawals: null -witnesses: -- key: VKey (VerKeyEd25519DSIGN "84ce03e08b05533685d593c14cd6ca5c7485824156ca11fb303ddac9dd3ef41c") - signature: SignedDSIGN (SigEd25519DSIGN "f6aae8023de4858244c6aac4b1ca7428f669a142731fe7354021059887b5366f24abba49355e14d435dbc7726df66dfeafe269e2752a7a6f752529600d1e9a00") diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signing.key b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signing.key deleted file mode 100644 index 5d9349985af..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signing.key +++ /dev/null @@ -1,5 +0,0 @@ -{ - "type": "PaymentSigningKeyShelley_ed25519", - "description": "Payment Signing Key", - "cborHex": "5820c0610ce25f512132fc619c34f6232a795f344e7499d03e8f54881ee9c404f414" -} diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out deleted file mode 100644 index fe8af64a163..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out +++ /dev/null @@ -1,39 +0,0 @@ -auxiliary scripts: null -certificates: null -collateral inputs: -- c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 -era: Alonzo -fee: 213 Lovelace -inputs: -- ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212 -metadata: null -mint: null -outputs: [] -reference inputs: null -required signers (payment key hashes needed for scripts): -- 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27 -- fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4 -return collateral: null -total collateral: null -update proposal: - epoch: 190 - updates: - - genesis key hash: 1bafa294233a5a7ffbf539ae798da0943aa83d2a19398c2d0e5af114 - update: - UTxO storage cost per word: 194 Lovelace - collateral inputs share: 200% - execution prices: - memory: 196/197 - steps: 195/196 - max block execution units: - memory: 199 - steps: 198 - max collateral inputs: 201 - max transaction execution units: - memory: 198 - steps: 197 - max value size: 199 -validity range: - lower bound: null - upper bound: null -withdrawals: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/tx b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/tx deleted file mode 100644 index edce62bab25..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/tx +++ /dev/null @@ -1,5 +0,0 @@ -{ - "type": "Witnessed Tx AlonzoEra", - "description": "Ledger Cddl Format", - "cborHex": "84a30081825820f62cd7bc15d8c6d2c8519fb8d13c57c0157ab6bab50af62bc63706feb966393d0001828258390076619da7963eaa588252c45e960667a4647eed69135f51f5a10f2888d2c20ac07056fc8899c47d825cefd9dcf5efba150236e043262e2b431b0000011764f7be0782581d604088059bbeb6add02eecd0c6a2a52c06910f2a6b4ba0029e9fe6ed131a00989680021a00028b79a100818258208dc60533b5dfa60a530955a696323a2ef4f14e8bc95a8f84cf6c441fea4234275840043220211a264209f6e61903e60e80093b7b3a08e8bc5fe8f8707635acd69b6e0589e61aea544b87729983955decded90a59f9701042bebe57f2afba7c94fc02f5f6" -} \ No newline at end of file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/verification.key b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/verification.key deleted file mode 100644 index 6d7ec633976..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/verification.key +++ /dev/null @@ -1,5 +0,0 @@ -{ - "type": "PaymentVerificationKeyShelley_ed25519", - "description": "Payment Verification Key", - "cborHex": "582084ce03e08b05533685d593c14cd6ca5c7485824156ca11fb303ddac9dd3ef41c" -} diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/byron/keys/byron.skey b/cardano-cli/test/cardano-cli-golden/files/golden/byron/keys/byron.skey deleted file mode 100644 index 6dc18f8c5fa..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/byron/keys/byron.skey +++ /dev/null @@ -1,2 +0,0 @@ -Xr}(R,ؽ[z|Џ5iE+cAK+P&Lt:-zF+vJq+|C %ګϐT.KؘQCNx!d&f -ʖ:kِ1C* \ No newline at end of file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/byron/keys/legacy.skey b/cardano-cli/test/cardano-cli-golden/files/golden/byron/keys/legacy.skey deleted file mode 100644 index 8492eb198d3..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/byron/keys/legacy.skey +++ /dev/null @@ -1 +0,0 @@ -Nvss deprecatedXxaސHP"N-ԧIzo_s>_ogt\/,[N~[Sq,pjS--?)ܯBb'C"*Tk \ No newline at end of file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/byron/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/byron/transaction-view.out deleted file mode 100644 index 5cae721d26d..00000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/byron/transaction-view.out +++ /dev/null @@ -1,20 +0,0 @@ -auxiliary scripts: null -certificates: null -collateral inputs: null -era: Byron -fee: implicit -inputs: -- f8ec302d19e3c8251c30b1434349bf2e949a1dbf14a4ebc3d512918d2d4d5c56#88 -metadata: null -mint: null -outputs: -- address: 5oP9ib6ym3XfwXuy3ksXZzgtBzXSArXAACQVXKqcPhiLnHVYjXJNu2T6Zomh8LAWLV - address era: Byron - amount: 68 Lovelace -reference inputs: null -required signers (payment key hashes needed for scripts): null -return collateral: null -total collateral: null -update proposal: null -validity range: null -withdrawals: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/byron/tx/legacy.tx b/cardano-cli/test/cardano-cli-golden/files/golden/byron/tx/legacy.tx deleted file mode 100644 index 065f79a789bb230799f993d4f7dc5280823ecf71..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 240 zcmV}rjiuuX z|DS?_*cezPgIFAwqpwZsF!EDUoVMokIN{p^RcD_(LKplaq(PRF2T-Ygj-As!L0N&kM%sax=BOA94>=tBR@dsV^#l qvT=%E_qzJ?axm=}V4cy}kvi6aB-C*}V}rjiuuX z|DS?_*cezPgIFAwqpwZsF!EDUoh-DT#Ucy2Uw+3sZA4^GYjPA{3a#x%5h>Z{Pm-h7YTytnjR) zjp5JR+io0a`ZV{vkD#zfgaZFf [String] - -- ^ Arguments to the CLI command - -> m String - -- ^ Captured stdout -execCardanoCLI = GHC.withFrozenCallStack $ H.execFlex "cardano-cli" "CARDANO_CLI" - --- | Execute cardano-cli via the command line, expecting it to fail. --- --- Waits for the process to finish and returns the exit code, stdout and stderr. -execDetailCardanoCli - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) - => [String] - -- ^ Arguments to the CLI command - -> m (IO.ExitCode, String, String) - -- ^ Captured stdout -execDetailCardanoCli = GHC.withFrozenCallStack $ execDetailFlex H.defaultExecConfig "cardano-cli" "CARDANO_CLI" - -procFlex' - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) - => ExecConfig - -> String - -- ^ Cabal package name corresponding to the executable - -> String - -- ^ Environment variable pointing to the binary to run - -> [String] - -- ^ Arguments to the CLI command - -> m CreateProcess - -- ^ Captured stdout -procFlex' execConfig pkg binaryEnv arguments = GHC.withFrozenCallStack . H.evalM $ do - bin <- H.binFlex pkg binaryEnv - return (IO.proc bin arguments) - { IO.env = getLast $ execConfigEnv execConfig - , IO.cwd = getLast $ execConfigCwd execConfig - } - -execDetailFlex - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) - => ExecConfig - -> String - -> String - -> [String] - -> m (IO.ExitCode, String, String) -execDetailFlex execConfig pkgBin envBin arguments = GHC.withFrozenCallStack $ do - cp <- procFlex' execConfig pkgBin envBin arguments - H.annotate . ("Command: " <>) $ case IO.cmdspec cp of - IO.ShellCommand cmd -> cmd - IO.RawCommand cmd args -> cmd <> " " <> List.unwords args - H.evalIO $ IO.readCreateProcessWithExitCode cp "" - -tryExecCardanoCLI - :: [String] - -- ^ Arguments to the CLI command - -> H.PropertyT IO (Either H.Failure String) - -- ^ Captured stdout, or error in case of failures -tryExecCardanoCLI args = - GHC.withFrozenCallStack (H.execFlex "cardano-cli" "CARDANO_CLI") args - & H.unPropertyT - & H.unTest - & runExceptT - & lift - & H.TestT - & H.PropertyT - --- | Checks that the 'tvType' and 'tvDescription' are equivalent between two files. -checkTextEnvelopeFormat - :: (MonadTest m, MonadIO m, HasCallStack) - => TextEnvelopeType - -> FilePath - -> FilePath - -> m () -checkTextEnvelopeFormat tve reference created = GHC.withFrozenCallStack $ do - eRefTextEnvelope <- H.evalIO $ readTextEnvelopeOfTypeFromFile tve reference - refTextEnvelope <- handleTextEnvelope eRefTextEnvelope - - eCreatedTextEnvelope <- H.evalIO $ readTextEnvelopeOfTypeFromFile tve created - createdTextEnvelope <- handleTextEnvelope eCreatedTextEnvelope - - typeTitleEquivalence refTextEnvelope createdTextEnvelope - where - handleTextEnvelope :: MonadTest m - => Either (FileError TextEnvelopeError) TextEnvelope - -> m TextEnvelope - handleTextEnvelope (Right refTextEnvelope) = return refTextEnvelope - handleTextEnvelope (Left fileErr) = failWithCustom GHC.callStack Nothing . displayError $ fileErr - - typeTitleEquivalence :: (MonadTest m, HasCallStack) => TextEnvelope -> TextEnvelope -> m () - typeTitleEquivalence (TextEnvelope refType refTitle _) - (TextEnvelope createdType createdTitle _) = GHC.withFrozenCallStack $ do - equivalence refType createdType - equivalence refTitle createdTitle - -checkTxCddlFormat - :: (MonadTest m, MonadIO m, HasCallStack) - => FilePath -- ^ Reference/golden file - -> FilePath -- ^ Newly created file - -> m () -checkTxCddlFormat referencePath createdPath = do - reference <- H.evalIO $ fileOrPipe referencePath - created <- H.evalIO $ fileOrPipe createdPath - r <- H.evalIO $ readCddlTx reference - c <- H.evalIO $ readCddlTx created - r H.=== c - - --------------------------------------------------------------------------------- --- Helpers, Error rendering & Clean up --------------------------------------------------------------------------------- - -cardanoCliPath :: FilePath -cardanoCliPath = "cardano-cli" - --- | Return the input file path after annotating it relative to the project root directory -noteInputFile :: (MonadTest m, HasCallStack) => FilePath -> m FilePath -noteInputFile filePath = GHC.withFrozenCallStack $ do - H.annotate $ cardanoCliPath <> "/" <> filePath - return filePath - --- | Return the test file path after annotating it relative to the project root directory -noteTempFile :: (MonadTest m, HasCallStack) => FilePath -> FilePath -> m FilePath -noteTempFile tempDir filePath = GHC.withFrozenCallStack $ do - let relPath = tempDir <> "/" <> filePath - H.annotate $ cardanoCliPath <> "/" <> relPath - return relPath - --- | Return the supply value with the result of the supplied function as a tuple -withSnd :: (a -> b) -> a -> (a, b) -withSnd f a = (a, f a) - --- These were lifted from hedgehog and slightly modified - -propertyOnce :: H.PropertyT IO () -> H.Property -propertyOnce = H.withTests 1 . H.withShrinks 0 . H.property - --- | Check for equivalence between two types and perform a file cleanup on failure. -equivalence - :: (MonadTest m, Eq a, Show a, HasCallStack) - => a - -> a - -> m () -equivalence x y = do - ok <- H.eval (x == y) - if ok - then H.success - else failDiffCustom GHC.callStack x y - --- | Takes a 'CallStack' so the error can be rendered at the appropriate call site. -failWithCustom :: MonadTest m => CallStack -> Maybe Diff -> String -> m a -failWithCustom cs mdiff msg = - liftTest $ mkTest (Left $ H.Failure (getCaller cs) msg mdiff, mempty) - --- | Fails with an error that shows the difference between two values. -failDiffCustom :: (MonadTest m, Show a) => CallStack -> a -> a -> m () -failDiffCustom cS x y = - case valueDiff <$> mkValue x <*> mkValue y of - Nothing -> - GHC.withFrozenCallStack $ - failWithCustom cS Nothing $ - Prelude.unlines [ - "Failed" - , "━━ lhs ━━" - , showPretty x - , "━━ rhs ━━" - , showPretty y - ] - - Just vdiff@(ValueSame _) -> - GHC.withFrozenCallStack $ - failWithCustom cS (Just $ - H.Diff "━━━ Failed (" "" "no differences" "" ") ━━━" vdiff) "" - - Just vdiff -> - GHC.withFrozenCallStack $ - failWithCustom cS (Just $ - H.Diff "━━━ Failed (" "- lhs" ") (" "+ rhs" ") ━━━" vdiff) "" diff --git a/cardano-cli/test/cardano-cli-test/Readme.md b/cardano-cli/test/cardano-cli-test/Readme.md deleted file mode 100644 index ec469b64f30..00000000000 --- a/cardano-cli/test/cardano-cli-test/Readme.md +++ /dev/null @@ -1,38 +0,0 @@ -# cardano-cli tests - -This tree contains tests for the `cardano-cli` executable. - -The whole `cardano-cli` test suite can be run from the top level directory of the `cardano-node` -repository using: - -``` -cabal test cardano-cli:cardano-cli-test -``` - -Individual tests are just shell scripts and as long as `cardano-cli` has been built, individual -tests can be run like for instance: -``` -cardano-cli/test/cli/version/run -``` - -All tests should work both within the Haskell test runner and as standalone scripts. - -Currently these tests do not run on Windows. - -# Writing CLI tests - -New tests can be added, by copying the directory for an existing test (eg `cardano-cli/test/cli/version`) -as a template to a new directory and modifying the `run` shell script in the new directory as needed. - -When a new directory is added, it will be found by the `cardano-cli-test` test runner (written in -Haskell) and run. - -New test scripts should be minimal and should be [shellcheck][shellcheck] clean and all -functionality that is common between scripts should be moved to the library file -`cardano-cli/test/cli/core/common`. - -Scripts that need input and expected output data can store that data in the same directory as the -test script itself. - - -[shellcheck]: https://github.com/koalaman/shellcheck/wiki diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/CliIntermediateFormat.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/CliIntermediateFormat.hs deleted file mode 100644 index 4475c136dc0..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/CliIntermediateFormat.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module Test.Cli.CliIntermediateFormat - ( tests - ) where - -import Control.Monad (void) - -import Hedgehog (Property, discover) -import Test.Cardano.CLI.Util - -import qualified Hedgehog -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - -{- HLINT ignore "Use camelCase" -} - --- | We test to make sure that we can deserialize a tx body in the intermediate format -prop_backwardsCompatibleCliFormat :: Property -prop_backwardsCompatibleCliFormat = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - txBodyFile <- noteInputFile "test/cardano-cli-test/files/golden/babbage/deprecated-cli-format.body" - witness <- noteInputFile "test/cardano-cli-test/files/golden/babbage/tx-key-witness" - initialUtxo1SigningKeyFile <- noteInputFile "test/cardano-cli-test/files/golden/shelley/keys/payment_keys/signing_key" - signedTransactionFile <- noteTempFile tempDir "signed.tx" - - - void $ execCardanoCLI - [ "transaction","sign" - , "--mainnet" - , "--tx-body-file", txBodyFile - , "--signing-key-file", initialUtxo1SigningKeyFile - , "--tx-file", signedTransactionFile - ] - - H.assertFileOccurences 1 "Tx BabbageEra" signedTransactionFile - H.assertEndsWithSingleNewline signedTransactionFile - - void $ execCardanoCLI - [ "transaction","assemble" - , "--tx-body-file", txBodyFile - , "--witness-file", witness - , "--out-file", signedTransactionFile - ] - - H.assertFileOccurences 1 "Tx BabbageEra" signedTransactionFile - H.assertEndsWithSingleNewline signedTransactionFile - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - Hedgehog.checkParallel $$discover - diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs deleted file mode 100644 index 430d11a92a8..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module Test.Cli.FilePermissions - ( tests - ) where - -import Cardano.Api -import Cardano.Node.Run (checkVRFFilePermissions) - -import Hedgehog (Property, discover, success) -import qualified Hedgehog -import qualified Hedgehog.Extras.Test.Base as H -import Hedgehog.Internal.Property (failWith) - -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (runExceptT) -import Test.Cardano.CLI.Util (execCardanoCLI) - --- | This property ensures that the VRF signing key file is created only with owner permissions -prop_createVRFSigningKeyFilePermissions :: Property -prop_createVRFSigningKeyFilePermissions = - H.propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Key filepaths - vrfVerKey <- H.noteTempFile tempDir "VRF-verification-key-file" - - vrfSignKey <- H.noteTempFile tempDir "VRF-signing-key-file" - - -- Create VRF key pair - void $ execCardanoCLI - [ "node", "key-gen-VRF" - , "--verification-key-file", vrfVerKey - , "--signing-key-file", vrfSignKey - ] - - result <- liftIO . runExceptT $ checkVRFFilePermissions (File vrfSignKey) - case result of - Left err -> - failWith Nothing - $ "key-gen-VRF cli command created a VRF signing key \ - \file with the wrong permissions: " <> show err - Right () -> success - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - Hedgehog.checkParallel $$discover diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/ITN.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/ITN.hs deleted file mode 100644 index f1c36b5f6b2..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/ITN.hs +++ /dev/null @@ -1,159 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Cli.ITN - ( tests - ) where - -import Cardano.CLI.Shelley.Run.Key (decodeBech32) - -import qualified Codec.Binary.Bech32 as Bech32 -import Control.Monad (void) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Base16 as Base16 -import Data.Text (Text) -import qualified Data.Text.IO as Text -import Hedgehog (Property, (===)) -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H -import Test.Cardano.CLI.Util - -{- HLINT ignore "Reduce duplication" -} - --- | Bech32 verification key -itnVerKey :: Text -itnVerKey = "ed25519_pk1demeytzdadayd4qrqeg2raadp2eceg3mrdmefxyfxx73q60hg4xsjjyzyq" - --- | Bech32 signing key -itnSignKey :: Text -itnSignKey = "ed25519_sk1yhnetcmla9pskrvp5z5ff2v8gkenhmluy736jd6nrxrlxcgn70zsy94f7k" - --- | 1. Convert a bech32 ITN key pair to a haskell stake verification key and signing key --- 2. Derive the haskell verification key from the haskell signing key. -prop_convertITNKeys :: Property -prop_convertITNKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- ITN input file paths - itnVerKeyFp <- noteTempFile tempDir "itnVerKey.key" - itnSignKeyFp <- noteTempFile tempDir "itnSignKey.key" - - -- Converted keys output file paths - outputHaskellVerKeyFp <- noteTempFile tempDir "haskell-verification-key.key" - outputHaskellSignKeyFp <- noteTempFile tempDir "haskell-signing-key.key" - - -- Write ITN keys to disk - H.evalIO $ Text.writeFile itnVerKeyFp itnVerKey - H.evalIO $ Text.writeFile itnSignKeyFp itnSignKey - H.assertFilesExist [itnVerKeyFp, itnSignKeyFp] - - -- Generate haskell stake verification key - void $ execCardanoCLI - [ "key","convert-itn-key" - , "--itn-verification-key-file", itnVerKeyFp - , "--out-file", outputHaskellVerKeyFp - ] - -- Generate haskell signing key - void $ execCardanoCLI - [ "key","convert-itn-key" - , "--itn-signing-key-file", itnSignKeyFp - , "--out-file", outputHaskellSignKeyFp - ] - - -- Check for existence of the converted ITN keys - H.assertFilesExist [outputHaskellVerKeyFp, outputHaskellSignKeyFp] - --- | 1. Convert a bech32 ITN extended signing key to a haskell stake signing key -prop_convertITNExtendedSigningKey :: Property -prop_convertITNExtendedSigningKey = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - let itnExtendedSignKey = mconcat - [ "ed25519e_sk1qpcplz38tg4fusw0fkqljzspe9qmj06ldu9lgcve99v4fphuk9a535kwj" - , "f38hkyn0shcycyaha4k9tmjy6xgvzaz7stw5t7rqjadyjcwfyx6k" - ] - - -- ITN input file paths - itnSignKeyFp <- noteTempFile tempDir "itnExtendedSignKey.key" - - -- Converted keys output file paths - outputHaskellSignKeyFp <- noteTempFile tempDir "stake-signing.key" - - -- Write ITN keys to disk - H.evalIO $ writeFile itnSignKeyFp itnExtendedSignKey - H.assertFilesExist [itnSignKeyFp] - - -- Generate haskell signing key - void $ execCardanoCLI - [ "key","convert-itn-extended-key" - , "--itn-signing-key-file", itnSignKeyFp - , "--out-file", outputHaskellSignKeyFp - ] - - -- Check for existence of the converted ITN keys - H.assertFilesExist [outputHaskellSignKeyFp] - --- | 1. Convert a bech32 ITN BIP32 signing key to a haskell stake signing key -prop_convertITNBIP32SigningKey :: Property -prop_convertITNBIP32SigningKey = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - let itnExtendedSignKey = mconcat - [ "xprv1spkw5suj39723c40mr55gwh7j3vryjv2zdm4e47xs0deka" - , "jcza9ud848ckdqf48md9njzc5pkujfxwu2j8wdvtxkx02n3s2qa" - , "euhqnfx6zu9dyccpua6vf5x3kur9hsganq2kl0yw7y9hpunts0e9kc5xv3pz0yj" - ] - - -- ITN input file paths - itnSignKeyFp <- noteTempFile tempDir "itnBIP32SignKey.key" - - -- Converted keys output file paths - outputHaskellSignKeyFp <- noteTempFile tempDir "stake-signing.key" - - -- Write ITN keys to disk - H.evalIO $ writeFile itnSignKeyFp itnExtendedSignKey - - H.assertFilesExist [itnSignKeyFp] - - -- Generate haskell signing key - void $ execCardanoCLI - [ "key","convert-itn-bip32-key" - , "--itn-signing-key-file", itnSignKeyFp - , "--out-file", outputHaskellSignKeyFp - ] - - -- Check for existence of the converted ITN keys - H.assertFilesExist [outputHaskellSignKeyFp] - --- | We check our 'decodeBech32' outputs against https://slowli.github.io/bech32-buffer/ --- using 'itnVerKey' & 'itnSignKey' as inputs. -golden_bech32Decode :: Property -golden_bech32Decode = propertyOnce $ do - (vHumReadPart, vDataPart , _) <- H.evalEither $ decodeBech32 itnVerKey - Just vDataPartBase16 <- pure (dataPartToBase16 vDataPart) - - (sHumReadPart, sDataPart , _) <- H.evalEither $ decodeBech32 itnSignKey - Just sDataPartBase16 <- pure (dataPartToBase16 sDataPart) - - -- Based on https://slowli.github.io/bech32-buffer/ which are in Base16 - let expectedHumanReadPartVerificationKey = "ed25519_pk" - expectedDataPartVerificationKey = "6e77922c4deb7a46d4030650a1f7ad0ab38ca23b1b7794988931bd1069f7454d" - expectedHumanReadPartSigningKey = "ed25519_sk" - expectedDataPartSigningKey = "25e795e37fe9430b0d81a0a894a98745b33beffc27a3a937531987f36113f3c5" - - -- ITN Verification key decode check - expectedHumanReadPartVerificationKey === Bech32.humanReadablePartToText vHumReadPart - expectedDataPartVerificationKey === vDataPartBase16 - - - -- ITN Signing key decode check - expectedHumanReadPartSigningKey === Bech32.humanReadablePartToText sHumReadPart - expectedDataPartSigningKey === sDataPartBase16 - - where - dataPartToBase16 :: Bech32.DataPart -> Maybe ByteString - dataPartToBase16 = fmap Base16.encode . Bech32.dataPartToBytes - -tests :: IO Bool -tests = - H.checkParallel - $ H.Group "ITN key conversion" - [ ("prop_convertITNKeys", prop_convertITNKeys) - , ("prop_convertITNBIP32SigningKey", prop_convertITNBIP32SigningKey) - , ("prop_convertITNExtendedSigningKey", prop_convertITNExtendedSigningKey) - , ("golden_bech32Decode", golden_bech32Decode) - ] diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/JSON.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/JSON.hs deleted file mode 100644 index 68f33d41ca8..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/JSON.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module Test.Cli.JSON where - -import Cardano.Api.Shelley -import Test.Gen.Cardano.Api.Typed (genLovelace, genSlotNo, genStakeAddress, - genVerificationKeyHash) - -import Data.Aeson -import qualified Data.Map.Strict as Map -import Data.Time -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Data.Word (Word64) - -import Cardano.CLI.Shelley.Output (QueryKesPeriodInfoOutput (..), - createOpCertIntervalInfo) -import Cardano.CLI.Shelley.Run.Query -import Cardano.CLI.Types - -import Hedgehog (Gen, Property, checkSequential, discover, forAll, property, tripping) -import Hedgehog.Gen as Gen -import Hedgehog.Range as Range - --- TODO: Move to cardano-api -prop_json_roundtrip_delegations_and_rewards :: Property -prop_json_roundtrip_delegations_and_rewards = - property $ do - dAndG <- forAll genDelegationsAndRewards - tripping dAndG encode eitherDecode - -genDelegationsAndRewards :: Gen DelegationsAndRewards -genDelegationsAndRewards = do - let r = Range.constant 0 3 - sAddrs <- Gen.list r genStakeAddress - sLovelace <- Gen.list r genLovelace - let delegMapAmt = Map.fromList $ zip sAddrs sLovelace - poolIDs <- Gen.list r genPoolId - let delegMapPool = Map.fromList $ zip sAddrs poolIDs - return $ DelegationsAndRewards (delegMapAmt, delegMapPool) - -genOpCertIntervalInformation :: Gen OpCertIntervalInformation -genOpCertIntervalInformation = do - createOpCertIntervalInfo - <$> (CurrentKesPeriod <$> genWord64) - <*> (OpCertStartingKesPeriod <$> genWord64) - <*> (OpCertEndingKesPeriod <$> genWord64) - <*> Gen.maybe (SlotsTillKesKeyExpiry <$> genSlotNo) - -genPoolId :: Gen (Hash StakePoolKey) -genPoolId = genVerificationKeyHash AsStakePoolKey - -genWord64 :: Gen Word64 -genWord64 = Gen.word64 Range.constantBounded - -genUTCTime :: Gen UTCTime -genUTCTime = do - t <- Gen.int64 Range.constantBounded - pure . posixSecondsToUTCTime $ fromIntegral t / 1_000_000 - -genKesPeriodInfoOutput :: Gen QueryKesPeriodInfoOutput -genKesPeriodInfoOutput = - QueryKesPeriodInfoOutput - <$> genOpCertIntervalInformation - <*> Gen.maybe genUTCTime - <*> Gen.maybe (OpCertNodeStateCounter <$> genWord64) - <*> (OpCertOnDiskCounter <$> genWord64) - <*> genWord64 - <*> genWord64 - - -prop_roundtrip_kes_period_info_output_JSON :: Property -prop_roundtrip_kes_period_info_output_JSON = property $ do - kesPeriodOutput <- forAll genKesPeriodInfoOutput - tripping kesPeriodOutput encode eitherDecode - ---- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - checkSequential $$discover diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/MultiAssetParsing.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/MultiAssetParsing.hs deleted file mode 100644 index d3d842c9c32..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/MultiAssetParsing.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module Test.Cli.MultiAssetParsing where - -import qualified Data.Text as Text -import qualified Text.Parsec as Parsec (parse) - -import Hedgehog (Property, checkSequential, discover, forAll, property, tripping) -import qualified Hedgehog.Gen as Gen - -import Cardano.Api (parseValue, renderValue, renderValuePretty, valueToList) - -import Test.Gen.Cardano.Api.Typed (genValueDefault) - -prop_roundtrip_Value_parse_render :: Property -prop_roundtrip_Value_parse_render = - property $ do - value <- forAll $ Gen.filter (not . null . valueToList) genValueDefault - tripping - value - renderValue - (Parsec.parse parseValue "" . Text.unpack) - -prop_roundtrip_Value_parse_renderPretty :: Property -prop_roundtrip_Value_parse_renderPretty = - property $ do - value <- forAll $ Gen.filter (not . null . valueToList) genValueDefault - tripping - value - renderValuePretty - (Parsec.parse parseValue "" . Text.unpack) - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - checkSequential $$discover diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise1.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise1.hs deleted file mode 100644 index fc5e9e2fe83..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise1.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Cli.Pioneers.Exercise1 - ( tests - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - --- | 1. Generate a key pair --- 2. Check for the existence of the key pair --- 3. We use the generated verification key to build a shelley payment address. -prop_buildShelleyPaymentAddress :: Property -prop_buildShelleyPaymentAddress = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Key filepaths - verKey <- noteTempFile tempDir "payment-verification-key-file" - signKey <- noteTempFile tempDir "payment-signing-key-file" - - -- Generate payment verification key - void $ execCardanoCLI - [ "address","key-gen" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - - H.assertFilesExist [verKey, signKey] - - -- Build shelley payment address - void $ execCardanoCLI - [ "address", "build" - , "--payment-verification-key-file", verKey - , "--mainnet" - ] - --- | 1. We generate a key payment pair --- 2. We generate a staking key pair --- 2. Check for the existence of the key pairs --- 3. We use the payment verification key & staking verification key --- to build a shelley stake address. -prop_buildShelleyStakeAddress :: Property -prop_buildShelleyStakeAddress = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Key filepaths - stakeVerKey <- noteTempFile tempDir "stake-verification-key-file" - stakeSignKey <- noteTempFile tempDir "stake-signing-key-file" - paymentVerKey <- noteTempFile tempDir "payment-verification-key-file" - paymentSignKey <- noteTempFile tempDir "payment-signing-key-file" - - -- Generate payment verification key - void $ execCardanoCLI - [ "address","key-gen" - , "--verification-key-file", paymentVerKey - , "--signing-key-file", paymentSignKey - ] - - -- Generate stake verification key - void $ execCardanoCLI - [ "stake-address","key-gen" - , "--verification-key-file", stakeVerKey - , "--signing-key-file", stakeSignKey - ] - - H.assertFilesExist [stakeVerKey, stakeSignKey, paymentVerKey, paymentSignKey] - - -- Build shelley stake address - void $ execCardanoCLI - [ "address", "build" - , "--payment-verification-key-file", paymentVerKey - , "--stake-verification-key-file", stakeVerKey - , "--mainnet" - ] - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - H.checkSequential - $ H.Group "Pioneers Example 1" - [ ("prop_buildShelleyPaymentAddress", prop_buildShelleyPaymentAddress) - , ("prop_buildShelleyStakeAddress", prop_buildShelleyStakeAddress) - ] diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise2.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise2.hs deleted file mode 100644 index e3a1ce57f9e..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise2.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Cli.Pioneers.Exercise2 - ( tests - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - --- | 1. We generate a payment signing key --- 2. We create a tx body --- 3. We sign the tx body with the generated payment signing key -prop_createTransaction :: Property -prop_createTransaction = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Key filepaths - paymentVerKey <- noteTempFile tempDir "payment-verification-key-file" - paymentSignKey <- noteTempFile tempDir "payment-signing-key-file" - transactionBodyFile <- noteTempFile tempDir "transaction-body" - transactionFile <- noteTempFile tempDir "transaction-file" - - -- Generate payment signing key to sign transaction - void $ execCardanoCLI - [ "address","key-gen" - , "--verification-key-file", paymentVerKey - , "--signing-key-file", paymentSignKey - ] - - H.assertFilesExist [paymentVerKey, paymentSignKey] - - -- Create transaction body - void $ execCardanoCLI - [ "transaction", "build-raw" - , "--tx-in", "91999ea21177b33ebe6b8690724a0c026d410a11ad7521caa350abdafa5394c3#0" - , "--auxiliary-script-file", "test/cardano-cli-test/files/golden/shelley/multisig/scripts/all" - , "--tx-in", "91999ea21177b33ebe6b8690724a0c026d410a11ad7521caa350abdafa5394c3#0" - , "--auxiliary-script-file", "test/cardano-cli-test/files/golden/shelley/multisig/scripts/all" - , "--tx-out", "addr1v9wmu83pzajplrtpsq6tsqdgwr98x888trpmah2u0ezznsge7del3+100000000" - , "--fee", "1000000" - , "--invalid-hereafter", "500000" - , "--out-file", transactionBodyFile - ] - - H.assertFilesExist [transactionBodyFile] - - -- Sign transaction - void $ execCardanoCLI - [ "transaction", "sign" - , "--tx-body-file", transactionBodyFile - , "--signing-key-file", paymentSignKey - , "--mainnet" - , "--out-file", transactionFile - ] - - H.assertFilesExist [paymentVerKey, paymentSignKey, transactionBodyFile, transactionFile] - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - H.checkSequential - $ H.Group "Pioneers Example 2" - [ ("prop_createTransaction", prop_createTransaction) - ] diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise3.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise3.hs deleted file mode 100644 index 8b9f9e5b552..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise3.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Cli.Pioneers.Exercise3 - ( tests - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - --- | 1. Create KES key pair. --- 2. Create cold keys. --- 3. Create operational certificate. --- 4. Create VRF key pair. -prop_createOperationalCertificate :: Property -prop_createOperationalCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Key filepaths - kesVerKey <- noteTempFile tempDir "KES-verification-key-file" - kesSignKey <- noteTempFile tempDir "KES-signing-key-file" - coldVerKey <- noteTempFile tempDir "cold-verification-key-file" - coldSignKey <- noteTempFile tempDir "cold-signing-key-file" - operationalCertCounter <- noteTempFile tempDir "operational-certificate-counter-file" - operationalCert <- noteTempFile tempDir "operational-certificate-file" - - -- Create KES key pair - void $ execCardanoCLI - [ "node","key-gen-KES" - , "--verification-key-file", kesVerKey - , "--signing-key-file", kesSignKey - ] - - H.assertFilesExist [kesSignKey, kesVerKey] - - -- Create cold key pair - void $ execCardanoCLI - [ "node","key-gen" - , "--cold-verification-key-file", coldVerKey - , "--cold-signing-key-file", coldSignKey - , "--operational-certificate-issue-counter", operationalCertCounter - ] - - H.assertFilesExist [coldVerKey, coldSignKey, operationalCertCounter] - - -- Create operational certificate - void $ execCardanoCLI - [ "node","issue-op-cert" - , "--kes-verification-key-file", kesVerKey - , "--cold-signing-key-file", coldSignKey - , "--operational-certificate-issue-counter", operationalCertCounter - , "--kes-period", "1000" - , "--out-file", operationalCert - ] - - H.assertFilesExist [kesVerKey, kesSignKey, coldVerKey, coldSignKey, operationalCertCounter, operationalCert] - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - H.checkSequential - $ H.Group "Pioneers Example 3" - [ ("prop_createOperationalCertificate", prop_createOperationalCertificate) - ] diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise4.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise4.hs deleted file mode 100644 index e40ee955129..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise4.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Cli.Pioneers.Exercise4 - ( tests - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - --- | 1. Generate a stake verification key --- 2. Create a stake address registration certificate -prop_createStakeAddressRegistrationCertificate :: Property -prop_createStakeAddressRegistrationCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Key filepaths - verKey <- noteTempFile tempDir "stake-verification-key-file" - signKey <- noteTempFile tempDir "stake-signing-key-file" - stakeRegCert <- noteTempFile tempDir "stake-registration-certificate-file" - - -- Generate stake verification key - void $ execCardanoCLI - [ "stake-address","key-gen" - , "--verification-key-file", verKey - , "--signing-key-file", signKey - ] - H.assertFilesExist [verKey, signKey] - - -- Create stake address registration certificate - void $ execCardanoCLI - [ "stake-address","registration-certificate" - , "--stake-verification-key-file", verKey - , "--out-file", stakeRegCert - ] - - H.assertFilesExist [verKey, signKey, stakeRegCert] - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - H.checkSequential - $ H.Group "Pioneers Example 4" - [ ("prop_createStakeAddressRegistrationCertificate", prop_createStakeAddressRegistrationCertificate) - ] diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise5.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise5.hs deleted file mode 100644 index a8d1828f468..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise5.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Cli.Pioneers.Exercise5 - ( tests - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - --- | 1. We generate a payment signing key --- 2. We create a tx body --- 3. We sign the tx body with the generated payment signing key -prop_createLegacyZeroTxOutTransaction :: Property -prop_createLegacyZeroTxOutTransaction = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Key filepaths - paymentVerKey <- noteTempFile tempDir "payment-verification-key-file" - paymentSignKey <- noteTempFile tempDir "payment-signing-key-file" - transactionBodyFile <- noteTempFile tempDir "transaction-body" - transactionFile <- noteTempFile tempDir "transaction-file" - - -- Generate payment signing key to sign transaction - void $ execCardanoCLI - [ "address","key-gen" - , "--verification-key-file", paymentVerKey - , "--signing-key-file", paymentSignKey - ] - - H.assertFilesExist [paymentVerKey, paymentSignKey] - - -- Create transaction body - void $ execCardanoCLI - [ "transaction", "build-raw" - , "--tx-in", "91999ea21177b33ebe6b8690724a0c026d410a11ad7521caa350abdafa5394c3#0" - , "--tx-out", "addr1v9wmu83pzajplrtpsq6tsqdgwr98x888trpmah2u0ezznsge7del3+0" - , "--fee", "1000000" - , "--invalid-hereafter", "500000" - , "--out-file", transactionBodyFile - ] - - H.assertFilesExist [transactionBodyFile] - - -- Sign transaction - void $ execCardanoCLI - [ "transaction", "sign" - , "--tx-body-file", transactionBodyFile - , "--signing-key-file", paymentSignKey - , "--mainnet" - , "--out-file", transactionFile - ] - - H.assertFilesExist [paymentVerKey, paymentSignKey, transactionBodyFile, transactionFile] - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - H.checkSequential - $ H.Group "Pioneers Example 5" - [ ("prop_createLegacyZeroTxOutTransaction", prop_createLegacyZeroTxOutTransaction) - ] diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise6.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise6.hs deleted file mode 100644 index 11df4bfbd65..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise6.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Test.Cli.Pioneers.Exercise6 - ( tests - ) where - -import Control.Monad (void) -import Hedgehog (Property) -import Test.Cardano.CLI.Util - -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H - --- | 1. We generate a payment signing key --- 2. We create a tx body --- 3. We sign the tx body with the generated payment signing key -prop_createZeroLovelaceTxOutTransaction :: Property -prop_createZeroLovelaceTxOutTransaction = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - -- Key filepaths - paymentVerKey <- noteTempFile tempDir "payment-verification-key-file" - paymentSignKey <- noteTempFile tempDir "payment-signing-key-file" - transactionBodyFile <- noteTempFile tempDir "transaction-body" - transactionFile <- noteTempFile tempDir "transaction-file" - - -- Generate payment signing key to sign transaction - void $ execCardanoCLI - [ "address","key-gen" - , "--verification-key-file", paymentVerKey - , "--signing-key-file", paymentSignKey - ] - - H.assertFilesExist [paymentVerKey, paymentSignKey] - - -- Create transaction body - void $ execCardanoCLI - [ "transaction", "build-raw" - , "--tx-in", "91999ea21177b33ebe6b8690724a0c026d410a11ad7521caa350abdafa5394c3#0" - , "--tx-out", "addr1v9wmu83pzajplrtpsq6tsqdgwr98x888trpmah2u0ezznsge7del3 0 lovelace" - , "--fee", "1000000" - , "--invalid-hereafter", "500000" - , "--out-file", transactionBodyFile - ] - - H.assertFilesExist [transactionBodyFile] - - -- Sign transaction - void $ execCardanoCLI - [ "transaction", "sign" - , "--tx-body-file", transactionBodyFile - , "--signing-key-file", paymentSignKey - , "--mainnet" - , "--out-file", transactionFile - ] - - H.assertFilesExist [paymentVerKey, paymentSignKey, transactionBodyFile, transactionFile] - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - H.checkSequential - $ H.Group "Pioneers Example 6" - [ ("prop_createZeroLovelaceTxOutTransaction", prop_createZeroLovelaceTxOutTransaction) - ] diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs deleted file mode 100644 index e4862923949..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module Test.Cli.Pipes - ( tests - ) where - -#if !defined(mingw32_HOST_OS) -#define UNIX -#endif - -import Prelude - -#ifdef UNIX -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as LBS -import System.IO (hClose, hFlush, hPutStr) -import System.Posix.IO (closeFd, createPipe, fdToHandle) - -import Cardano.CLI.Shelley.Run.Read -import Test.Cardano.CLI.Util - -import Hedgehog (Property, discover, forAll, (===)) -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H -import qualified Hedgehog.Gen as G -import Hedgehog.Internal.Property (failWith) -import qualified Hedgehog.Range as R -import System.FilePath (()) - -#else - -import Hedgehog (Property, discover, property, success) -#endif - -import qualified Hedgehog as H - -#ifdef UNIX - -prop_readFromPipe :: Property -prop_readFromPipe = H.withTests 10 . H.property . H.moduleWorkspace "tmp" $ \ws -> do - - s <- forAll $ G.string (R.linear 1 8192) G.ascii - - let testFile = ws "test-file" - - H.writeFile testFile s - - -- We first test that we can read a filepath - testFp <- noteInputFile testFile - testFileOrPipe <- H.evalIO $ fileOrPipe testFp - testBs <- H.evalIO $ readFileOrPipe testFileOrPipe - - if LBS.null testBs - then failWith Nothing - $ "readFileOrPipe failed to read file: " <> fileOrPipePath testFileOrPipe - else do - -- We now test that we can read from a pipe. - -- We first check that the IORef has Nothing - mContents <- H.evalIO $ fileOrPipeCache testFileOrPipe - case mContents of - Just{} -> failWith Nothing "readFileOrPipe has incorrectly populated its IORef with contents read from a filepath." - Nothing -> do - -- We can reuse testFileOrPipe because we know the cache (IORef) is empty - let txBodyStr = BSC.unpack $ LBS.toStrict testBs - fromPipeBs <- H.evalIO $ withPipe txBodyStr - if LBS.null fromPipeBs - then failWith Nothing "readFileOrPipe failed to read from a pipe" - else testBs === fromPipeBs - --- | Create a pipe, write some String into it, read its contents and return the contents -withPipe :: String -> IO LBS.ByteString -withPipe contents = do - (readEnd, writeEnd) <- createPipe - - writeHandle <- fdToHandle writeEnd - - -- Write contents to pipe - hPutStr writeHandle contents - hFlush writeHandle - hClose writeHandle - pipe <- fileOrPipe $ "/dev/fd/" ++ show readEnd - - -- Read contents from pipe - readContents <- readFileOrPipe pipe - closeFd readEnd - pure readContents - -#else -prop_readFromPipe :: Property -prop_readFromPipe = property success -#endif - --- ----------------------------------------------------------------------------- - -tests :: IO Bool -tests = - H.checkParallel $$discover diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs deleted file mode 100644 index 79ef4fff934..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Test.Cli.Shelley.Run.Query - ( tests - ) where - -import Cardano.Slotting.Time (RelativeTime (..)) -import Hedgehog (Property, (===)) - -import qualified Cardano.CLI.Shelley.Run.Query as Q -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H - -unit_percentage :: Property -unit_percentage = H.propertyOnce $ do - Q.percentage (RelativeTime 10) (RelativeTime 1000) (RelativeTime 1000) === "100.00" - Q.percentage (RelativeTime 10) (RelativeTime 990) (RelativeTime 1000) === "100.00" - Q.percentage (RelativeTime 10) (RelativeTime 980) (RelativeTime 1000) === "99.00" - Q.percentage (RelativeTime 10) (RelativeTime 500) (RelativeTime 1000) === "51.05" - Q.percentage (RelativeTime 10) (RelativeTime 0) (RelativeTime 1000) === "1.10" - return () - -tests :: IO Bool -tests = - H.checkSequential - $ H.Group "Pioneers Example 6" - [ ("prop_createZeroLovelaceTxOutTransaction", unit_percentage) - ] diff --git a/cardano-cli/test/cardano-cli-test/Test/Config/Mainnet.hs b/cardano-cli/test/cardano-cli-test/Test/Config/Mainnet.hs deleted file mode 100644 index ef71e4ea884..00000000000 --- a/cardano-cli/test/cardano-cli-test/Test/Config/Mainnet.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Test.Config.Mainnet - ( tests - ) where - -import Cardano.Api (File (..), initialLedgerState, renderInitialLedgerStateError) -import Control.Monad.Trans.Except -import Hedgehog (Property, (===)) -import System.FilePath (()) - -import qualified Data.Aeson as J -import qualified Data.Text as T -import qualified Data.Yaml as Y -import qualified GHC.Stack as GHC -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.Process as H -import qualified System.Directory as IO - -hprop_configMainnetHash :: Property -hprop_configMainnetHash = H.propertyOnce $ do - base <- H.note =<< H.evalIO . IO.canonicalizePath =<< H.getProjectBase - result <- H.evalIO $ runExceptT $ initialLedgerState $ File $ base "configuration/cardano/mainnet-config.json" - case result of - Right (_, _) -> return () - Left e -> H.failWithCustom GHC.callStack Nothing (T.unpack (renderInitialLedgerStateError e)) - -hprop_configMainnetYaml :: Property -hprop_configMainnetYaml = H.propertyOnce $ do - base <- H.note =<< H.evalIO . IO.canonicalizePath =<< H.getProjectBase - yamlResult <- H.evalIO . Y.decodeFileEither $ base "configuration/cardano/mainnet-config.yaml" - yaml :: J.Value <- case yamlResult of - Right v -> return v - Left e -> H.failWithCustom GHC.callStack Nothing (Y.prettyPrintParseException e) - jsonResult <- H.evalIO . J.eitherDecodeFileStrict $ base "configuration/cardano/mainnet-config.json" - json :: J.Value <- case jsonResult of - Right v -> return v - Left e -> H.failWithCustom GHC.callStack Nothing (show e) - yaml === json - -tests :: IO Bool -tests = - H.checkSequential - $ H.Group "Test.Config.Mainnet" - [ ("hprop_configMainnetHash", hprop_configMainnetHash) - , ("hprop_configMainnetYaml", hprop_configMainnetYaml) - ] diff --git a/cardano-cli/test/cardano-cli-test/cardano-cli-test.hs b/cardano-cli/test/cardano-cli-test/cardano-cli-test.hs deleted file mode 100644 index ae1aaad505e..00000000000 --- a/cardano-cli/test/cardano-cli-test/cardano-cli-test.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Main where - -import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8) - -import qualified Test.Cli.CliIntermediateFormat -import qualified Test.Cli.FilePermissions -import qualified Test.Cli.ITN -import qualified Test.Cli.JSON -import qualified Test.Cli.MultiAssetParsing -import qualified Test.Cli.Pioneers.Exercise1 -import qualified Test.Cli.Pioneers.Exercise2 -import qualified Test.Cli.Pioneers.Exercise3 -import qualified Test.Cli.Pioneers.Exercise4 -import qualified Test.Cli.Pipes -import qualified Test.Cli.Shelley.Run.Query -import qualified Test.Config.Mainnet - -import Hedgehog.Extras.Stock.OS (isWin32) -import Hedgehog.Main (defaultMain) - -import Test.Gen.Cardano.Api.Empty () - -main :: IO () -main = do - hSetBuffering stdout LineBuffering - hSetEncoding stdout utf8 - defaultMain - [ Test.Cli.CliIntermediateFormat.tests - , Test.Cli.FilePermissions.tests - , Test.Cli.ITN.tests - , Test.Cli.JSON.tests - , Test.Cli.MultiAssetParsing.tests - , ignoreOnWindows Test.Cli.Pipes.tests - , Test.Cli.Pioneers.Exercise1.tests - , Test.Cli.Pioneers.Exercise2.tests - , Test.Cli.Pioneers.Exercise3.tests - , Test.Cli.Pioneers.Exercise4.tests - , Test.Cli.Shelley.Run.Query.tests - , Test.Config.Mainnet.tests - ] - -ignoreOnWindows :: IO Bool -> IO Bool -ignoreOnWindows test = - if isWin32 - then return True - else test diff --git a/cardano-cli/test/cardano-cli-test/files/golden/babbage/deprecated-cli-format.body b/cardano-cli/test/cardano-cli-test/files/golden/babbage/deprecated-cli-format.body deleted file mode 100644 index 9d0ae5d47a7..00000000000 --- a/cardano-cli/test/cardano-cli-test/files/golden/babbage/deprecated-cli-format.body +++ /dev/null @@ -1,5 +0,0 @@ -{ - "type": "TxBodyBabbage", - "description": "", - "cborHex": "86a3008182582097c7a4b969dbab432c66ac034c023fb5861b73d198d700b55b9818b9bb1c2dba000182a200581d604088059bbeb6add02eecd0c6a2a52c06910f2a6b4ba0029e9fe6ed13011a00989680a20058390076619da7963eaa588252c45e960667a4647eed69135f51f5a10f2888d2c20ac07056fc8899c47d825cefd9dcf5efba150236e043262e2b43011b0000011764f7bd57021a00028c299fff8080f5f6" -} diff --git a/cardano-cli/test/cardano-cli-test/files/golden/babbage/tx-key-witness b/cardano-cli/test/cardano-cli-test/files/golden/babbage/tx-key-witness deleted file mode 100644 index d4b487926e6..00000000000 --- a/cardano-cli/test/cardano-cli-test/files/golden/babbage/tx-key-witness +++ /dev/null @@ -1,5 +0,0 @@ -{ - "type": "TxWitness BabbageEra", - "description": "", - "cborHex": "8200825820de40a0376a4953d0fd0ea543c0f5317269a40258f2986153f6304494b430eaab58403d6fcac7d92c75d564b88415c0df07e6442db08049abfeb11b58d1084db82a3480fdb6aa4cb34564b0dd2abb7e7e7d3acd954d0a2b9145939c80e967e0d5cb07" -} diff --git a/cardano-cli/test/cardano-cli-test/files/golden/shelley/keys/payment_keys/signing_key b/cardano-cli/test/cardano-cli-test/files/golden/shelley/keys/payment_keys/signing_key deleted file mode 100644 index 503fcdb10a1..00000000000 --- a/cardano-cli/test/cardano-cli-test/files/golden/shelley/keys/payment_keys/signing_key +++ /dev/null @@ -1,5 +0,0 @@ -{ - "type": "PaymentSigningKeyShelley_ed25519", - "description": "Payment Signing Key", - "cborHex": "58208547281266bc5467a10f2f50ddf10e2d0c05ebf780785ebee40c1869b08c1c35" -} \ No newline at end of file diff --git a/cardano-cli/test/cardano-cli-test/files/golden/shelley/multisig/scripts/all b/cardano-cli/test/cardano-cli-test/files/golden/shelley/multisig/scripts/all deleted file mode 100644 index eb9d421212d..00000000000 --- a/cardano-cli/test/cardano-cli-test/files/golden/shelley/multisig/scripts/all +++ /dev/null @@ -1,37 +0,0 @@ -{ - "scripts": [ - { - "keyHash": "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a", - "type": "sig" - }, - { - "keyHash": "a687dcc24e00dd3caafbeb5e68f97ca8ef269cb6fe971345eb951756", - "type": "sig" - }, - { - "keyHash": "0bd1d702b2e6188fe0857a6dc7ffb0675229bab58c86638ffa87ed6d", - "type": "sig" - }, - { - "keyHash": "dd0044a26cf7d4491ecea720fda11afb59d5725b53afa605fdf695e6", - "type": "sig" - }, - { - "keyHash": "cf223afe150cc8e89f11edaacbbd55b011ba44fbedef66fbd37d8c9d", - "type": "sig" - }, - { - "keyHash": "372643e7ef4b41fd2649ada30a89d35cb90b7c14cb5de252e6ce6cb7", - "type": "sig" - }, - { - "keyHash": "aa453dc184c5037d60e3fbbadb023f4a41bac112f249b76be9bb37ad", - "type": "sig" - }, - { - "keyHash": "6b732c60c267bab894854d6dd57a04a94e603fcc4c36274c9ed75952", - "type": "sig" - } - ], - "type": "all" -} \ No newline at end of file