diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,27 @@ +# Contributing to cardano-addresses + +If you find a bug or you'd like to propose a feature, please feel free to raise +an issue on our [issue tracker](https://github.com/IntersectMBO/cardano-addresses/issues). + +Pull requests are welcome! + +When creating a pull request, please make sure that your code adheres to our +[coding standards](https://github.com/input-output-hk/adrestia/blob/master/docs/code/Coding-Standards.md). + +## Roles and Responsibilities + +The `cardano-addresses` repository is co-maintained by @intersectmbo and @cardano-foundation. + +The following people hold key responsibilities: + +* @disassembler is responsible for releases +* @Crypto2099 is responsible for compilation to JavaScript and CI +* @paweljakubas is responsible for the Haskell components + +Regular contributors for the Haskell components are + +* @Anviking @HeinrichApfelmus @jonathanknowles @paweljakubas @paolino + +all of whom can merge PRs and be asked to review them. + +In addition, the CODEOWNERS file identifies specific reviewers who are required for PRs that affect specific components. diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,292 @@ +## [4.0.0] - 2025-02-04 + +### Added + +- Unify core and command-line packages into one +- Drop JavaScript support and get rid of JavaScript codebase +- CIP-0129 support added, affecting `cardano-address key hash` and `cardano-address script hash` +- CIP-0129 support with backward compatibility added, affecting `cardano-address key hash` and `cardano-address script hash` +- `scriptHashToText`, `scriptHashFromText` and `prettyErrScriptHashFromText` added to `Cardano.Address.Script` +- Simplify filenames by using a hashed prefix instead of the full mnemonic, enhancing portability). +- `hashKey` for Shelley style +- Key derivation support for DRep, CCCold and CCHot in accordance with [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105). Also supported in CLI. +- Fix field for staking scripts in AddressInfo. +- Rename infoScriptHash field in AddressInfo to infoSpendingScriptHash. +- Get signing key and chain code from extended signing key via `cardano-address key private` +- Support for new environments `preview` and `preprod`. +- Supported derivation of root private key using second factor mnemonic or its base16/base64/plain text equivalent + +## [3.12.0] - 2022-08-17 + +### Added + +- Supported credential construction from key hashes in both payment and delegation credential. The construction scheme is also supported in CLI. + +## [3.11.0] - 2022-06-21 + +### Added + +- Compatibility with Aeson 2 library. + +## [3.10.0] - 2022-05-26 + +### Added + +- `cardano-address key walletid` support for Shared wallets. + +## [3.9.0] - 2022-03-08 + +### Added + +- Support for policy key derivation and hashing according to [CIP-1855](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1855). + +## [3.8.0] - 2022-02-11 + +### Added + +- Adds the `cardano-address key walletid` command, which derives a + [`cardano-wallet` wallet ID](https://input-output-hk.github.io/adrestia/cardano-wallet/design/WalletId) + from a wallet key. + +### Changed + +- Several nodejs package dependencies updated according to `npm audit` and dependabot alerts. + + +## [3.7.0] - 2021-12-15 + +### Added + +- Address type in address inspect command. + + +## [3.6.0] - 2021-09-08 + +### Changed + +- Bech32 prefixes for shared account addresses were fixed to match the + latest draft of [CIP-1854][]. + +[CIP-1854]: https://github.com/cardano-foundation/CIPs/blob/master/CIP-1854/CIP-1854.md + + +## [3.5.0] - 2021-06-28 + +### Added + +- Initial release of a [NPM Package](https://www.npmjs.com/package/cardano-addresses) + which uses the GHCJS build. + +### Changed + +- The supported compiler version is now GHC 8.10.4. + +- Updated `validateScriptTemplate` and `validateScriptOfTemplate` + functions for multi-signature wallets. + + +## [3.4.0] - 2021-04-30 + +### Added + +- Added `Cardano.Address.Style.Shelley.eitherInspectAddress` function + with stronger result and error types. + +- Added `Cardano.Address.Style.Shared` module which defines a shared + wallet style enabling multisig. + +### Changed + +- The constructors of `Cardano.Address.Style.Shelley.ErrInspectAddress` + have changed. + Any code which pattern matches on this type will need minor changes. + +- A number of Bech32 prefixes were changed to account for CIP changes. + The whole family of `*_shared_*` prefixes were introduced to accommodate + newly added shared wallet style. In specific, there in no longer `script_vkh` + but `addr_shared_vkh` and `stake_shared_vkh` to denote spending and stake + verification key hashes, respectively. + +- `KeyHash` now needs `KeyRole` values to be specified, except binary + payload. It was needed change to enable differentiating between + spending and stake key hashes. + +### Removed + +- Multisig related functions were deleted from `Cardano.Address.Style.Shelley` as they + found a new place in `Cardano.Address.Style.Shared`. + + +## [3.3.0] - 2021-04-09 + +### Added + +- The library now builds with ghcjs and passes tests running on nodejs. + +- The `cardano-address inspect` command now includes bech32 + encodings. In the output, the JSON attribute will have a `_bech32` + suffix. For example, `stake_key_hash_bech32`. + +### Changed + +- The `Index` type no longer has an `Enum` instance. Use + `indexFromWord32` and `indexToWord32` instead. + +- (Breaking change) The `Cardano.Address.bech32` function will now use + the `addr_test` prefix instead of `addr`, if the given address is + not a mainnet address. + +### Removed + +N/A + + +## [3.2.0] - 2020-01-22 + +### Added + +- Added definition for 'Cosigner'. + +- Added definition for 'ScriptTemplate', `ToJSON` and `FromJSON` instances added. + +- Added validation of 'ScriptTemplate'. + +- Added command-line for 'cardano-address script validate' + +- Introduced 'foldScript' function. + +### Changed + +- Fixed `cardano-address --version` reporting. + +- Added Ord instance for 'ScriptHash'. + +- Extended script to account for ActiveFromSlot and ActiveUntilSlot, ie., introducing timelocks. `ToJSON` and `FromJSON` instances were updated. Also command-line supports + timelocks now via 'active_from' and 'active_until`. + +- Introduced Required and Recommended validation and adjusted the current one. + +- Fixed cardano-address address bootstrap example in command-line help. + +- Add missing crc32 integrity check when decoding Byron/Icarus addresses. + +- Parametrized 'Script', and use it with 'ScriptHash' and 'Cosigner'. + +- Better error reporting upon validation. + +- Correcting cardano-address hash example in command-line help. + +- Adding more examples to README.md + +### Removed + +N/A + +## [3.1.0] - 2020-11-13 + +### Added + +N/A + +### Changed + +- 'keyHashFromText' now works seamlessly with key, extended keys or key hashes. In case a key or extended key is given, the relevant part will be hashed on the fly. Said differently, it means that + the command-line and the JSON instance for 'Script' works transparently with keys or key hashes. + +- Fixed a bug with the `key hash` command which failed when provided with extended keys. + +- The 'FromJSON' instance for 'Script' now runs the validation within the JSON parser, such that when the parser succeeds the resulting 'Script' is indeed valid. + +- The 'FromJSON' instance for 'Script' is now much better at showing errors. + +### Removed + +N/A + +## [3.0.0] - 2020-11-12 + +### Added + +- Support for (multisig) scripts and script addresses in modules: + - `Cardano.Address.Script` + - `Cardano.Address.Script.Parser` + +- Support for constructing scripts and script addresses via the command-line. + +- Support for constructing rewards addresses via the library and command-line. + +- New command for computing key and script hashes that are required in the construction of larger objects (e.g. addresses). + +- Support for cabal build. + +### Changed + +- The command-line API no longer support multi-encoding (base16, bech32 and base58) but instead, enforces bech32 for keys and addresses, with specific human readable prefixes. It is still possible to easily go from base16-encoded data to bech32 by piping data through the [`bech32`](https://github.com/input-output-hk/bech32/) command-line. + +- It is no longer possible to derive child keys to and from any path. Are only allowed: + - root -> account + - root -> address + - account -> address + This is reflected in the bech32 prefixes of the inputs and outputs. + +- Allow constructing delegation addresses from a script. This works transparently from previous version of the command-line, but the command now also accepts script hashes as possible valid inputs. + +### Removed + +- No more `--legacy` option on the `key child` command. Which derivation scheme to use is now inferred from the bech32 prefixe used and the derivation path. + +- `Cardano.Address.Errors` module. Errors data-types have been moved to their respective module `Cardano.Address.Styles.{Byron,Icarus,Shelley}` + +- Anything related to Jormungandr in both the library and the command-line. + +## [2.1.0] - 2020-09-29 + +### Added + +- Added constructors to derive keys on the multisig role. +- Made the parser for `--network-tag` more user friendly by now accepting pre-defined keywords such as "mainnet" or "testnet". + +### Changed + +- Renamed `AccountingStyle` into `Role` to better capture the semantic of the 4th level in derivation paths. +- Made script hashes 28-byte long again, after this was fixed upstream in the Cardano ledger. + +### Removed + +N/A + + +## [2.0.0] - 2020-09-10 + +### Added + +- Command-line interface `cardano-address` for managing recovery-phrases, keys and addresses. +- Support for Shelley-specific address types. +- Support for Jormungandr-specific address types. + +### Changed + +- Repository structure re-organized in two packages: core & command-line. + +### Removed + +N/A + + +## [1.0.0] - 2020-04-21 + +### Added + +- 'Cardano.Mnemonic' module for mnemonic generation and manipulation. +- 'Cardano.Address' module for address creation, encoding and decoding. +- 'Cardano.Address.Derivation' module for primitives and abstractions regarding hierarchical derivation of credentials. +- 'Cardano.Address.Style.Byron' module implementing derivation primitives for 'Byron' addresses. +- 'Cardano.Address.Style.Icarus' module implementing derivation primitives for 'Icarus' addresses. + +### Changed + +N/A + +### Removed + +N/A diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,201 @@ + 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 + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright © 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect + + 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/NOTICE b/NOTICE new file mode 100644 --- /dev/null +++ b/NOTICE @@ -0,0 +1,13 @@ +Copyright © 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect + + 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,950 @@ +

+ Cardano Addresses +

+ +

+ + + +
+

+ + +
+ + [![Coding Standards](https://github.com/IntersectMBO/cardano-addresses/actions/workflows/style.yml/badge.svg?branch=master)](https://github.com/IntersectMBO/cardano-addresses/actions/workflows/style.yml) + [![Haskell CI using Cabal](https://github.com/IntersectMBO/cardano-addresses/actions/workflows/haskell.yml/badge.svg)](https://github.com/IntersectMBO/cardano-addresses/actions/workflows/haskell.yml) + +
+ +## Overview + +This module provides mnemonic (backup phrase) creation, and conversion of a +mnemonic to seed for wallet restoration, and address derivation functionalities. + +![](.github/example.gif) + +## Documentation + +API documentation is available [here](https://IntersectMBO.github.io/cardano-addresses/haddock). + +## Command-Line + +`cardano-address` comes with a command-line interface for Linux. See the [release artifacts](https://github.com/IntersectMBO/cardano-addresses/releases) or [continuous integration artifacts](https://github.com/IntersectMBO/cardano-addresses/actions?query=workflow%3A%22Continuous+Integration%22) to get a pre-compiled binary, or [build a Docker image](#docker-image). The command-line is self explanatory by using `--help` on various commands and sub-commands. + +> :bulb: Most commands read argument from the standard input. This prevent sensitive information from appearing into your shell history and, makes it easy to pipe commands! + +### How to generate a recovery phrase (phrase.prv) + +```console +$ cardano-address recovery-phrase generate --size 15 > phrase.prv +exercise club noble adult miracle awkward problem olympic puppy private goddess piano fatal fashion vacuum +``` + + +### How to generate a root private key (root.xsk) + +```console +$ cardano-address key from-recovery-phrase Shelley < phrase.prv > root.xsk +root_xsk1hqzfzrgskgnpwskxxrv5khs7ess82ecy8za9l5ef7e0afd2849p3zryje8chk39nxtva0sww5me3pzkej4rvd5cae3q3v8eu7556n6pdrp4fdu8nsglynpmcppxxvfdyzdz5gfq3fefjepxhvqspmuyvmvqg8983 + +-- which is equivalent to empty passphrase +$ cardano-address key from-recovery-phrase Shelley --passphrase from-hex +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: +exercise club noble adult miracle awkward problem olympic puppy private goddess piano fatal fashion vacuum +Please enter hex-encoded passphrase: + +root_xsk1hqzfzrgskgnpwskxxrv5khs7ess82ecy8za9l5ef7e0afd2849p3zryje8chk39nxtva0sww5me3pzkej4rvd5cae3q3v8eu7556n6pdrp4fdu8nsglynpmcppxxvfdyzdz5gfq3fefjepxhvqspmuyvmvqg8983 +``` + +> :information_source: Notice the `root_xsk` prefix to identify a root extended signing (private) key. + + +### How to generate a root private key with passphrase (root.xsk) + +```console +$ cardano-address recovery-phrase generate --size 9 > sndfactor.prv +swing payment diagram happy chimney mammal flip become lyrics + +$ cardano-address key from-recovery-phrase Shelley --passphrase from-mnemonic +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: +exercise club noble adult miracle awkward problem olympic puppy private goddess piano fatal fashion vacuum +Please enter a 9–12 word second factor: +swing payment diagram happy chimney mammal flip become lyrics +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + + cardano-address key from-recovery-phrase Shelley --passphrase from-mnemonic --sensitive +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: +********************************************************************************************************** +Please enter a 9–12 word second factor: +************************************************************* +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ cardano-address key from-recovery-phrase Shelley --passphrase from-mnemonic --silent +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: + +Please enter a 9–12 word second factor: + +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ cardano-address key from-recovery-phrase Shelley --passphrase from-mnemonic --from-file "./sndfactor.prv" < phrase.prv +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ cardano-address key from-recovery-phrase Shelley --passphrase from-hex +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: +exercise club noble adult miracle awkward problem olympic puppy private goddess piano fatal fashion vacuum +Please enter hex-encoded passphrase: +dc1434f3b472810d56409f85 +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ echo "dc1434f3b472810d56409f85" > base16.prv +$ cardano-address key from-recovery-phrase Shelley --passphrase from-hex --from-file "./base16.prv" < phrase.prv +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ cardano-address key from-recovery-phrase Shelley --passphrase from-base64 +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: +exercise club noble adult miracle awkward problem olympic puppy private goddess piano fatal fashion vacuum +Please enter base64-encoded passphrase: +3BQ087RygQ1WQJ+F +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ echo "3BQ087RygQ1WQJ+F" > base64.prv +$ cardano-address key from-recovery-phrase Shelley --passphrase from-base64 --from-file "./base64.prv" < phrase.prv +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ cardano-address key from-recovery-phrase Shelley --passphrase from-octets +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: +exercise club noble adult miracle awkward problem olympic puppy private goddess piano fatal fashion vacuum +Please enter passphrase in the form of octet array: +[220,20,52,243,180,114,129,13,86,64,159,133] +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ echo "[220,20,52,243,180,114,129,13,86,64,159,133]" > octets.prv +$ cardano-address key from-recovery-phrase Shelley --passphrase from-octets --from-file "./octets.prv" < phrase.prv +root_xsk1jqx0xpke7de69ceyk20tdl9rq7nsava7cfnyeu42yqum8usnpppwmsxn2qsfj0nn2ur2kuq0kmrll67ryvkdhd6pgpsls6s6qx7hlyv6uqt0907t73eflkpw3xz45lcg5fsh6dunfk56j08jslh6x6rttspfny8c + +$ cardano-address key from-recovery-phrase Shelley --passphrase from-utf8 +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: +exercise club noble adult miracle awkward problem olympic puppy private goddess piano fatal fashion vacuum +Please enter utf8-encoded passphrase: +my secret passphrase +root_xsk1aq5jduvnx7s6a4wl845jggvnhey5agqjv55dsexsx43np59pse0u4yfxpdfecz9h95jwecduqpt7zlk97j9mprmvjcfeyrcu9nyagpjq6k5cxpnwve5pj3cu24m9my94xtrqvzrlmu0893guffzazyk95cvprwzp + +$ cardano-address key from-recovery-phrase Shelley --passphrase "" +Please enter a [9, 12, 15, 18, 21, 24] word mnemonic: +exercise club noble adult miracle awkward problem olympic puppy private goddess piano fatal fashion vacuum +Please enter utf8-encoded passphrase: +my secret passphrase +root_xsk1aq5jduvnx7s6a4wl845jggvnhey5agqjv55dsexsx43np59pse0u4yfxpdfecz9h95jwecduqpt7zlk97j9mprmvjcfeyrcu9nyagpjq6k5cxpnwve5pj3cu24m9my94xtrqvzrlmu0893guffzazyk95cvprwzp + +$ echo "my secret passphrase" > utf8.prv +$ cardano-address key from-recovery-phrase Shelley --passphrase from-utf8 --from-file "./utf8.prv" < phrase.prv +root_xsk1aq5jduvnx7s6a4wl845jggvnhey5agqjv55dsexsx43np59pse0u4yfxpdfecz9h95jwecduqpt7zlk97j9mprmvjcfeyrcu9nyagpjq6k5cxpnwve5pj3cu24m9my94xtrqvzrlmu0893guffzazyk95cvprwzp + +-- NOTE: +--λ> let (Right m) = mkSomeMnemonic @'[ 9 ] ["swing", "payment", "diagram", "happy", "chimney", "mammal", "flip", "become", "lyrics"] +--λ> m +--SomeMnemonic (Mnemonic {mnemonicToEntropy = Entropy {entropyRaw = "\220\DC44\243\180r\129\rV@\159\133", entropyChecksum = Checksum 3}, mnemonicToSentence = MnemonicSentence {mnemonicSentenceToListN = [WordIndex {unWordIndex = Offset 1760},WordIndex {unWordIndex = Offset 1293},WordIndex {unWordIndex = Offset 487},WordIndex {unWordIndex = Offset 839},WordIndex {unWordIndex = Offset 320},WordIndex {unWordIndex = Offset 1077},WordIndex {unWordIndex = Offset 712},WordIndex {unWordIndex = Offset 159},WordIndex {unWordIndex = Offset 1067}]}}) +--λ> let bytes = BA.convert $ someMnemonicToBytes m :: ByteString +--λ> bytes +--"\220\DC44\243\180r\129\rV@\159\133" +--λ> encode EBase16 bytes +--"dc1434f3b472810d56409f85" +--λ> decodeUtf8 $ convertToBase Base64 bytes +-- "3BQ087RygQ1WQJ+F" +--λ> BS.unpack bytes +-- [220,20,52,243,180,114,129,13,86,64,159,133] +``` +> :information_source: Notice the `root_xsk` prefix to identify a root extended signing (private) key. + + + +### How to generate a wallet id based on extended root or account keys (phrase.prv) + +```console +$ cat root.xsk +root_xsk1hqzfzrgskgnpwskxxrv5khs7ess82ecy8za9l5ef7e0afd2849p3zryje8chk39nxtva0sww5me3pzkej4rvd5cae3q3v8eu7556n6pdrp4fdu8nsglynpmcppxxvfdyzdz5gfq3fefjepxhvqspmuyvmvqg8983 +$ cardano-address key walletid < root.xsk +163ea20ad0611e4815a61c44bb32c82a81538999 + +$ cardano-address key public --with-chain-code < root.xsk | cardano-address key walletid +163ea20ad0611e4815a61c44bb32c82a81538999 + +$ cardano-address key child 1852H/1815H/0H < root.xsk > acct.xsk +$ cat acct.xsk +acct_xsk15ztha8ws7qjze5vmdkwqh0ddzvtlgstkg79swazhc5lxns2849plr3msjx082mcmd9hc24ujczk2cjnjwrcz4tjaucw9jqf8h5yc7d84rac0zdckkuhazpam0kleg4sq52ph3e0wn98a64hr8g5cpmh9zqpwtrhy +$ cardano-address key walletid < acct.xsk +15fd6c2130b0758ec7995bf9771d2a6602417c39 +$ cardano-address key public --with-chain-code < acct.xsk | cardano-address key walletid +15fd6c2130b0758ec7995bf9771d2a6602417c39 +``` + + +### How to generate a wallet id based on account keys of shared wallet (phrase.prv) + +```console +$ cardano-address key from-recovery-phrase Shared < phrase.prv > root.shared_xsk +root_shared_xsk1hqzfzrgskgnpwskxxrv5khs7ess82ecy8za9l5ef7e0afd2849p3zryje8chk39nxtva0sww5me3pzkej4rvd5cae3q3v8eu7556n6pdrp4fdu8nsglynpmcppxxvfdyzdz5gfq3fefjepxhvqspmuyvmvzteqlc + +$ cardano-address key child 1854H/1815H/0H < root.shared_xsk > acct.shared_xsk +acct_shared_xsk14zh0kh0geaz9qpxv6q0n5upq8ux4n97u2gyl69mnhan74w6849pa3hj2p40xg0nugw8tzqu5eynzjunay6tffru9wdjank0phsfuc7vngjsmtktel05g6mx555tw8nxr8rpn2gac6km5plu9mwqsz54rfyhwd7pd + +$ cardano-address key walletid < acct.shared_xsk +user error (shared wallet needs to have at least spending script specified) + +$ cardano-address key walletid --spending "cosigner#0" < acct.shared_xsk +185d3582fc4892c4528614210b13e9a775dd7d02 + +$ cardano-address key public --with-chain-code < acct.shared_xsk | cardano-address key walletid --spending "cosigner#0" +185d3582fc4892c4528614210b13e9a775dd7d02 + +$ cardano-address key walletid --spending "all [cosigner#0, active_until 1000]" < acct.shared_xsk +42ecb214586dcbcb593688fb081784fa0aebb2c0 + +$ cardano-address key walletid --spending "all [cosigner#0, active_until 1000]" --staking "cosigner#1" < acct.shared_xsk +12dc98557a4c5aa00575c5d1f0dbfa3837261e32 +``` + + + +### How to generate a private policy key (policy.xsk), a public policy key (policy.vk) and its hash (policy.vkh) + +```console +$ cardano-address key child 1855H/1815H/0H < root.xsk > policy.xsk +policy_xsk1hr47zvxgzeeutgq50r965ygwxys86cwp8wdjqftlhan8mw6849pus6vc50dznjs5vkyjcz9usl6964u6nha88slrh8hyex74xnlfehcrkp80cp8wgzkqh22dzy7c48ekhhvvf2zz8hqakjwgfzgrjq5lx538et75 + +$ cardano-address key child 1855H/1815H/0H < root.xsk | cardano-address key public --with-chain-code > policy.xvk +policy_xvk1e9ngmlhcwhszwyuxwc7anwk6tvzwndldz7j262rvfpd049tq74mq8vzwlszwus9vpw556yfa320nd0wccj5yy0wpmdyusjys8ypf7dgaauf0m + +$ cardano-address key child 1855H/1815H/0H < root.xsk | cardano-address key public --without-chain-code > policy.vk +policy_vk1e9ngmlhcwhszwyuxwc7anwk6tvzwndldz7j262rvfpd049tq74mq0ylkrs + +$ cardano-address key hash < policy.xvk +policy_vkh1qpc9xly4lc7yt98gcf59kdcqcss6dda4u9g72e775yxpxeypamc +$ cardano-address key hash < policy.vk +policy_vkh1qpc9xly4lc7yt98gcf59kdcqcss6dda4u9g72e775yxpxeypamc +$ cardano-address key hash < policy.vk | bech32 +0070537c95fe3c4594e8c2685b3700c421a6b7b5e151e567dea10c13 +``` + +> :information_source: The last segment in the path is the key index and can be incremented up to `2^31-1` to derive more keys. + + + +### How to generate a payment verification key (addr.xvk) + +```console +$ cardano-address key child 1852H/1815H/0H/0/0 < root.xsk | cardano-address key public --with-chain-code > addr.xvk +addr_xvk1grvg8qzmkmw2n0dm4pd0h3j4dv6yglyammyp733eyj629dc3z28v6wk22nfmru6xz0vl2s3y5xndyd57fu70hrt84c6zkvlwx6fdl7ct9j7yc +``` + +> :information_source: The last segment in the path is the key index and can be incremented up to `2^31-1` to derive more keys. + + + +### How to generate an extended stake verification key (stake.xvk) + +```console +$ cardano-address key child 1852H/1815H/0H/2/0 < root.xsk | cardano-address key public --with-chain-code > stake.xvk +stake_xvk1658atzttunamzn80204khrg0qfdk5nvmrutlmmpg7xlsyaggwa7h9z4smmeqsvs67qhyqmc2lqa0vy36rf2la74ym8a5p93zp4qtpuq6ky3ve +``` + +> :information_source: The last segment in the path is the key index and can be incremented up to `2^31-1` to derive more keys. + + +### How to generate a non-extended stake verification key (stake.vk) + +```console +$ cardano-address key child 1852H/1815H/0H/2/0 < root.xsk | cardano-address key public --without-chain-code > stake.vk +stake_vk1658atzttunamzn80204khrg0qfdk5nvmrutlmmpg7xlsyaggwa7sg87an2 +``` + +> :information_source: The last segment in the path is the key index and can be incremented up to `2^31-1` to derive more keys. + + +### How to generate a hash for payment verification key (addr.xvk) + +```console +$ cardano-address key child 1852H/1815H/0H/0/0 < root.xsk | cardano-address key public --with-chain-code > addr.xvk +addr_xvk1grvg8qzmkmw2n0dm4pd0h3j4dv6yglyammyp733eyj629dc3z28v6wk22nfmru6xz0vl2s3y5xndyd57fu70hrt84c6zkvlwx6fdl7ct9j7yc +$ cardano-address key hash < addr.xvk +addr_vkh12j28hnmtwcp3n08vy58vyf0arnnrhtavu3lrfdztw0j0jng3d6v +$ cardano-address key hash < addr.xvk | bech32 +54947bcf6b760319bcec250ec225fd1ce63baface47e34b44b73e4f9 +``` + +> :information_source: The hashing is available for both stake and payment verification keys. Hex encoding can be achieved by redirecting to `bech32` tool. + + + +### How to generate a payment address from an extended payment key (payment.addr) + +```console +$ cardano-address address payment --network-tag testnet < addr.xvk > payment.addr +addr_test1vp2fg770ddmqxxduasjsas39l5wwvwa04nj8ud95fde7f7guscp6v +``` + + + +### How to generate a payment address from a non-extended payment key (payment.addr) + +```console +$ cardano-address key child 1852H/1815H/0H/0/0 < root.xsk | cardano-address key public --without-chain-code > addr.vk +addr_vk1grvg8qzmkmw2n0dm4pd0h3j4dv6yglyammyp733eyj629dc3z28qwq4y73 +$ cardano-address address payment --network-tag testnet < addr.vk > payment.addr +addr_test1vp2fg770ddmqxxduasjsas39l5wwvwa04nj8ud95fde7f7guscp6v +``` + + + +### How to generate a payment address from a payment key hash (payment.addr) + +```console +$ cardano-address key hash < addr.xvk > addr.vkh +addr_vkh12j28hnmtwcp3n08vy58vyf0arnnrhtavu3lrfdztw0j0jng3d6v +$ cardano-address address payment --network-tag testnet < addr.vkh > payment.addr +addr_test1vp2fg770ddmqxxduasjsas39l5wwvwa04nj8ud95fde7f7guscp6v +``` + + + +### How to generate a delegated payment address, i.e. base address, from an extended stake key (base.addr) + +```console +$ cardano-address address delegation $(cat stake.xvk) < payment.addr > base.addr +addr_test1qp2fg770ddmqxxduasjsas39l5wwvwa04nj8ud95fde7f70k6tew7wrnx0s4465nx05ajz890g44z0kx6a3gsnms4c4qq8ve0n +``` + + +### How to generate a delegated payment address, i.e. base address, from a non-extended stake key (base.addr) + +```console +$ cardano-address key child 1852H/1815H/0H/2/0 < root.xsk | cardano-address key public --without-chain-code > stake.vk +stake_vk1658atzttunamzn80204khrg0qfdk5nvmrutlmmpg7xlsyaggwa7sg87an2 +$ cardano-address address delegation $(cat stake.vk) < payment.addr > base.addr +addr_test1qp2fg770ddmqxxduasjsas39l5wwvwa04nj8ud95fde7f70k6tew7wrnx0s4465nx05ajz890g44z0kx6a3gsnms4c4qq8ve0n +``` + + +### How to generate a delegated payment address, i.e. base address, from a stake key hash (base.addr) + +```console +$ cardano-address key hash < stake.xvk > stake.vkh +stake_vkh17mf09mecwve7zkh2jve7nkggu4azk5f7cmtk9zz0wzhz5efq2w6 +$ cardano-address address delegation $(cat stake.vkh) < payment.addr > base.addr +addr_test1qp2fg770ddmqxxduasjsas39l5wwvwa04nj8ud95fde7f70k6tew7wrnx0s4465nx05ajz890g44z0kx6a3gsnms4c4qq8ve0n +``` + + +### How to generate a stake address from an extended stake key (stake.addr) + +```console +$ cardano-address address stake --network-tag testnet < stake.xvk > stake.addr +stake_test1urmd9uh08pen8c26a2fn86weprjh52638mrdwc5gfac2u2s25zpat +``` + + +### How to generate a stake address from a non-extended stake key (stake.addr) + +```console +$ cardano-address address stake --network-tag testnet < stake.vk > stake.addr +stake_test1urmd9uh08pen8c26a2fn86weprjh52638mrdwc5gfac2u2s25zpat +``` + + +### How to generate a stake address from a stake key hash (stake.addr) + +```console +$ cardano-address key hash < stake.xvk > stake.vkh +stake_vkh17mf09mecwve7zkh2jve7nkggu4azk5f7cmtk9zz0wzhz5efq2w6 +$ cardano-address address stake --network-tag testnet < stake.vkh > stake.addr +stake_test1urmd9uh08pen8c26a2fn86weprjh52638mrdwc5gfac2u2s25zpat +``` + + +### How to inspect address + +```console +$ echo addr_test1vp2fg770ddmqxxduasjsas39l5wwvwa04nj8ud95fde7f7guscp6v | cardano-address address inspect +{ + "stake_reference": "none", + "spending_key_hash_bech32": "addr_vkh12j28hnmtwcp3n08vy58vyf0arnnrhtavu3lrfdztw0j0jng3d6v", + "address_style": "Shelley", + "spending_key_hash": "54947bcf6b760319bcec250ec225fd1ce63baface47e34b44b73e4f9", + "network_tag": 0, + "address_type": 6 +} + +$ echo addr_test1qp2fg770ddmqxxduasjsas39l5wwvwa04nj8ud95fde7f70k6tew7wrnx0s4465nx05ajz890g44z0kx6a3gsnms4c4qq8ve0n | cardano-address address inspect +{ + "stake_reference": "by value", + "stake_key_hash_bech32": "stake_vkh17mf09mecwve7zkh2jve7nkggu4azk5f7cmtk9zz0wzhz5efq2w6", + "stake_key_hash": "f6d2f2ef387333e15aea9333e9d908e57a2b513ec6d762884f70ae2a", + "spending_key_hash_bech32": "addr_vkh12j28hnmtwcp3n08vy58vyf0arnnrhtavu3lrfdztw0j0jng3d6v", + "address_style": "Shelley", + "spending_key_hash": "54947bcf6b760319bcec250ec225fd1ce63baface47e34b44b73e4f9", + "network_tag": 0, + "address_type": 0 +} +``` + +Details about possible address types are following (refer also to [cddl](https://github.com/input-output-hk/cardano-ledger/blob/master/eras/alonzo/test-suite/cddl-files/alonzo.cddl) ) +| address_type | binary prefix | Meaning | +| ------------ |:--------------:|:--------------------------------------------------------:| +| 0 | 0000 | base address: keyhash28,keyhash28 | +| 1 | 0001 | base address: scripthash28,keyhash28 | +| 2 | 0010 | base address: keyhash28,scripthash28 | +| 3 | 0011 | base address: scripthash28,scripthash28 | +| 4 | 0100 | pointer address: keyhash28, 3 variable length uint | +| 5 | 0101 | pointer address: scripthash28, 3 variable length uint | +| 6 | 0110 | enterprise address: keyhash28 | +| 7 | 0111 | enterprise address: scripthash28 | +| 8 | 1000 | byron/icarus | +| 14 | 1110 | reward account: keyhash28 | +| 15 | 1111 | reward account: scripthash28 | + + + +### How to generate a payment verification key for shared wallet (addr_shared.vk, stake_shared.vk) + +Let's generate extended root private key for shared style: + +``` console +$ cardano-address key from-recovery-phrase Shared < phrase.prv > root_shared.xsk +root_shared_xsk1hqzfzrgskgnpwskxxrv5khs7ess82ecy8za9l5ef7e0afd2849p3zryje8chk39nxtva0sww5me3pzkej4rvd5cae3q3v8eu7556n6pdrp4fdu8nsglynpmcppxxvfdyzdz5gfq3fefjepxhvqspmuyvmvzteqlc +``` + +Now generate payment verification key (`role=0` is used). Please note that purpose `1854H` is used for multisig. + +```console +$ cardano-address key child 1854H/1815H/0H/0/0 < root_shared.xsk | cardano-address key public --without-chain-code > addr_shared.vk +addr_shared_vk1a9h46rvjnqquxz02zyesh0ct29szh7vv9x7r2h87ttmnkgrfgguqhz0mtc +``` + +Generating delegation verification key is the similar (the only difference is role=2) + +```console +$ cardano-address key child 1854H/1815H/0H/2/0 < root_shared.xsk | cardano-address key public --without-chain-code > stake_shared.vk +stake_shared_vk18a8z5dcrlwene88n84j6dm9yvj5rt296fjtresqnunmacetdcymquyq43z +``` + +> :information_source: The last segment in the path is the key index, which can be incremented to derive more keys. Up `2^31-1` keys are possible. + + +### How to construct a multisig script hash (script.hash) + +We consider `addr_shared.1.vk` and `addr_shared.2.vk` obtained like `addr_shared.vk` but by replacing the final index by `1` and `2` respectively. + +```console +$ cardano-address key child 1854H/1815H/0H/0/1 < root_shared.xsk | cardano-address key public --without-chain-code > addr_shared.1.vk +addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3 +$ cardano-address key child 1854H/1815H/0H/0/2 < root_shared.xsk | cardano-address key public --without-chain-code > addr_shared.2.vk +addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44 +$ cardano-address script hash "all [$(cat addr_shared.1.vk), $(cat addr_shared.2.vk)]" > script.hash +script1gr69m385thgvkrtspk73zmkwk537wxyxuevs2u9cukglvtlkz4k +``` + +This script requires the signature from both signing keys corresponding to `shared_addr.1.vk` and `shared_addr.2.vk` (i.e., shared_addr.1.sk and shared_addr.2.sk) in order to be valid. Similarly, we could require only one of the two signatures: + +We can also use extended verification, eiher payment or delegation, keys. They can be obtained as the non-extended ones by using `--with-chain-code` option rather than `--without-chain-option` as above. They will give rise to the same script hash as for verification keys chain code is stripped upon calculation. + +```console +$ cardano-address key child 1854H/1815H/0H/0/1 < root_shared.xsk | cardano-address key public --with-chain-code > addr_shared.1.xvk +addr_shared_xvk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqhlfft3dn0qcn6q99dvlfl2ws5duy6w65zks5jgufe60fg839sysavl5pc +$ cardano-address key child 1854H/1815H/0H/0/2 < root_shared.xsk | cardano-address key public --with-chain-code > addr_shared.2.xvk +addr_shared_xvk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xq3zegcxtslhpghmadrlvsphssfjqp3mxg9gca27e35wpu43lqjqnsmjvxuw +$ cardano-address script hash "all [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk)]" +script1gr69m385thgvkrtspk73zmkwk537wxyxuevs2u9cukglvtlkz4k +``` + +which is equivalent (functionally, but not in terms of hash value) to : + +```console +$ cardano-address script hash "at_least 1 [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk)]" +script13uf3fz3ts5srpjc5zcfe977uvnyvp36wcvxuudryegz0zpjlx6a +``` + + +### How to construct a multisig script hash with timelocks + +```console +$ cardano-address script hash "all [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk), active_from 100, active_until 120]" +script1nugjzwfs2t9htl7s3dv9ajnd5us8pctpa8aj4ank8dnd6d6unul +``` + + + +### How to validate a script + +```console +$ cardano-address script validate "at_least 1 [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk), $(cat addr_shared.2.xvk)]" +Validated. + +$ cardano-address script validate --recommended "at_least 1 [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk), $(cat addr_shared.2.xvk)]" +Not validated: The list inside a script has duplicate keys (which is not recommended).. +``` + + +### How to get preimage for a script + +```console +$ cardano-address script preimage "all [addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq, addr_shared_vkh1y3zl4nqgm96ankt96dsdhc86vd5geny0wr7hu8cpzdfcqskq2cp]" +008201828200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f01135380 + +$ cardano-address script preimage "all [addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq, active_from 100, active_until 150]" +008201838200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d8204186482051896 +``` + + +### How to generate a payment script address from a script hash (script.addr) + +```console +$ cardano-address address payment --network-tag testnet < script.hash > script.addr +addr_test1wpq0ghwy73wapjcdwqxm6ytwe66j8eccsmn9jptshrjerashp7y82 +``` + + +### How to generate a payment script address from a script (script.addr) + +```console +$ cardano-address address payment --network-tag testnet "all [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk)]" > script.addr +addr_test1wpq0ghwy73wapjcdwqxm6ytwe66j8eccsmn9jptshrjerashp7y82 +``` + + +### How to generate a delegated payment address, i.e. base address, from a script hash (base.addr) + +```console +$ cardano-address script hash "all [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk), active_from 100, active_until 120]" > script.stake.hash +script1nugjzwfs2t9htl7s3dv9ajnd5us8pctpa8aj4ank8dnd6d6unul +$ cardano-address address delegation $(cat script.stake.hash) < script.addr > base.addr +addr_test1xpq0ghwy73wapjcdwqxm6ytwe66j8eccsmn9jptshrjera5lzysnjvzjed6ll5yttp0v5md8ypcwzc0flv40va3mvmwsl7grs3 +``` + + +### How to generate a delegated payment address, i.e. base address, from a script (base.addr) + +```console +$ cardano-address address delegation "all [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk), active_from 100, active_until 120]" < script.addr > base.addr +addr_test1xpq0ghwy73wapjcdwqxm6ytwe66j8eccsmn9jptshrjera5lzysnjvzjed6ll5yttp0v5md8ypcwzc0flv40va3mvmwsl7grs3 +``` + + +### How to generate a stake address from a script hash (stake.addr) + +```console +$ cardano-address address stake --network-tag testnet < script.stake.hash > stake.addr +stake_test17z03zgfexpfvka0l6z94shk2dknjqu8pv85lk2hkwcakdhgx52yaj +``` + + +### How to generate a stake address from a script (stake.addr) + +```console +$ cardano-address address stake --network-tag testnet "all [$(cat addr_shared.1.xvk), $(cat addr_shared.2.xvk), active_from 100, active_until 120]" > stake.addr +stake_test17z03zgfexpfvka0l6z94shk2dknjqu8pv85lk2hkwcakdhgx52yaj +``` + + +### How to generate drep keys (drep) + +```console +$ cat root.xsk +root_xsk1hqzfzrgskgnpwskxxrv5khs7ess82ecy8za9l5ef7e0afd2849p3zryje8chk39nxtva0sww5me3pzkej4rvd5cae3q3v8eu7556n6pdrp4fdu8nsglynpmcppxxvfdyzdz5gfq3fefjepxhvqspmuyvmvqg8983 + +$ cardano-address key child 1852H/1815H/0H/3/0 < root.xsk > drep.xsk +drep_xsk1vpdsm49smzmdwhd4kjmm2mdyljjysm746rafjr7r8kgfanj849psw8pfm305g59wng0akw3qzppmfh6k5z7gx66h2vppu022m4eqaj26rh6d7en9tf9fu52hmysjzuacaxfmfya65h8jmddrclwf3kxl8snfs3eg + +$ cardano-address key public --with-chain-code < drep.xsk > drep.xvk +drep_xvk1mg7xae48d7z4nntd35tey0jmclxaavwmk3kw2lkkt07p3s3x3yy45805manx2kj2neg40kfpy9em36vnkjfm4fw09k66837unrvd70qq8ewzf + +$ cardano-address key public --without-chain-code < drep.xsk > drep.vk +drep_vk1mg7xae48d7z4nntd35tey0jmclxaavwmk3kw2lkkt07p3s3x3yysra6588 + +$ cardano-address key hash --cip-0105 < drep.xvk > drep.vkh +drep_vkh1sp5xhvmj0asztqfsjyta3cwvq7jppc2rwmfcsggp62va5hqgpg4 + +$ cat drep.vkh | bech32 +80686bb3727f602581309117d8e1cc07a410e14376d3882101d299da + +$ cat drep.vkh | bech32 drep > drep.deprecated +drep1sp5xhvmj0asztqfsjyta3cwvq7jppc2rwmfcsggp62va538nup0 + +$ cat drep.deprecated | bech32 +80686bb3727f602581309117d8e1cc07a410e14376d3882101d299da + +$ cardano-address key hash < drep.xvk > drep.credential +drep1y2qxs6anwflkqfvpxzg30k8pesr6gy8pgdmd8zppq8ffnksapjznm + +$ cat drep.credential | bech32 +2280686bb3727f602581309117d8e1cc07a410e14376d3882101d299da + +(there is the expected 0x22 prepended byte as it is drep key hash credential in accordance to CIP-0129. The corresponding key hash credential is '80686bb3727f602581309117d8e1cc07a410e14376d3882101d299da' and it is the same as in case of both `drep.vkh` and `drep.deprecated`). +``` + + +### How to create script and its hash from drep keys (drep) + +```console + +$ cat drep.vkh +drep_vkh1sp5xhvmj0asztqfsjyta3cwvq7jppc2rwmfcsggp62va5hqgpg4 +$ cat drep.deprecated +drep1sp5xhvmj0asztqfsjyta3cwvq7jppc2rwmfcsggp62va538nup0 +$ cat drep.credential +drep1y2qxs6anwflkqfvpxzg30k8pesr6gy8pgdmd8zppq8ffnksapjznm + +$ cardano-address script hash "all [$(cat drep.xvk), active_from 100, active_until 120]" +drep_script1eeccqnkak63vtp32l3epv5hcn8qpc2nxz4drxzadvj9q78ysk3q +$ cardano-address script hash "all [$(cat drep.deprecated), active_from 100, active_until 120]" +drep_script1eeccqnkak63vtp32l3epv5hcn8qpc2nxz4drxzadvj9q78ysk3q +$ cardano-address script hash "all [$(cat drep.credential), active_from 100, active_until 120]" +drep_script1eeccqnkak63vtp32l3epv5hcn8qpc2nxz4drxzadvj9q78ysk3q + +$ cardano-address script hash "all [$(cat drep.credential), active_from 100, active_until 120]" | bech32 +ce71804eddb6a2c5862afc721652f899c01c2a66155a330bad648a0f + +$ cardano-address script hash --with-byte "all [$(cat drep.credential), active_from 100, active_until 120]" +drep1y088rqzwmkm293vx9t78y9jjlzvuq8p2vc245vct44jg5rcyp8s2d +$ cardano-address script hash --with-byte "all [$(cat drep.credential), active_from 100, active_until 120]" | bech32 +23ce71804eddb6a2c5862afc721652f899c01c2a66155a330bad648a0f + +(there is the expected 0x23 prepended byte as it is drep script hash credential in accordance to CIP-0129. The corresponding script hash credential is 'ce71804eddb6a2c5862afc721652f899c01c2a66155a330bad648a0f' and it is the same irrespective of how the script hash is constructed, i.e., from `drep.vkh`, `drep.credential` or `drep.deprecated`). +``` + + + +### How to generate cold committee keys (cc_cold) + +```console +$ cat root.xsk +root_xsk1hqzfzrgskgnpwskxxrv5khs7ess82ecy8za9l5ef7e0afd2849p3zryje8chk39nxtva0sww5me3pzkej4rvd5cae3q3v8eu7556n6pdrp4fdu8nsglynpmcppxxvfdyzdz5gfq3fefjepxhvqspmuyvmvqg8983 + +$ cardano-address key child 1852H/1815H/0H/4/0 < root.xsk > cold.xsk +cc_cold_xsk1fp4megtpn4vu4cug2lmsyhg4xvnnar55q6k8wp5e6f2h8jz849ph8v8jhm0qffw8v6ut7x8wqvr07m9ccaspezrkexcafu284w6gpqexspqujj8glw0d70rwuemk0924zjhscgcfnevy29zr0fc57tvjmg7jvvqh + +$ cardano-address key public --with-chain-code < cold.xsk > cold.xvk +cc_cold_xvk1dg8d5du0v4ukqkfgset50xncudhwlfzz2p6epv096x0ndl8jsgzzdqzpe9yw37u7mu7xaenhv7242990ps3sn8jcg52yx7n3fuke9kst5t2py + +$ cardano-address key public --without-chain-code < cold.xsk > cold.vk +cc_cold_vk1dg8d5du0v4ukqkfgset50xncudhwlfzz2p6epv096x0ndl8jsgzqmwj2x5 + +$ cardano-address key hash --cip-0105 < cold.xvk > cold.vkh +cc_cold_vkh1d7yw362prvnae5fc8063xdeapws9ptzdgjkqd4dk3qddctn5rch + +$ cat cold.vkh | bech32 +6f88e8e9411b27dcd1383bf513373d0ba050ac4d44ac06d5b6881adc + +$ cat cold.vkh | bech32 cc_cold > cold.deprecated +cc_cold1d7yw362prvnae5fc8063xdeapws9ptzdgjkqd4dk3qddccyzfjm + +$ cat cold.deprecated | bech32 +6f88e8e9411b27dcd1383bf513373d0ba050ac4d44ac06d5b6881adc + +$ cardano-address key hash < cold.xvk > cold.credential +cc_cold1zfhc368fgydj0hx38qal2yeh8596q59vf4z2cpk4k6yp4hqy3mpsx + +$ cat cold.credential | bech32 +126f88e8e9411b27dcd1383bf513373d0ba050ac4d44ac06d5b6881adc + +(there is the expected 0x12 prepended byte as it is cc cold key hash credential in accordance to CIP-0129. The corresponding key hash is '6f88e8e9411b27dcd1383bf513373d0ba050ac4d44ac06d5b6881adc' and it is the same as in case of both `cold.vkh` and `cold.deprecated`). +``` + + +### How to create script and its hash from cold committee keys (drep) + +```console + +$ cat cold.vkh +cc_cold_vkh1d7yw362prvnae5fc8063xdeapws9ptzdgjkqd4dk3qddctn5rch +$ cat cold.deprecated +cc_cold1d7yw362prvnae5fc8063xdeapws9ptzdgjkqd4dk3qddccyzfjm +$ cat cold.credential +cc_cold1zfhc368fgydj0hx38qal2yeh8596q59vf4z2cpk4k6yp4hqy3mpsx + +$ cardano-address script hash "all [$(cat cold.xvk), active_from 100, active_until 120]" +cc_cold_script18zy6g0vu7ajzmzamkvysfzc0nnfpf8w3n7404xxhaz2jqexhzw5 +$ cardano-address script hash "all [$(cat cold.deprecated), active_from 100, active_until 120]" +cc_cold_script18zy6g0vu7ajzmzamkvysfzc0nnfpf8w3n7404xxhaz2jqexhzw5 +$ cardano-address script hash "all [$(cat cold.credential), active_from 100, active_until 120]" +cc_cold_script18zy6g0vu7ajzmzamkvysfzc0nnfpf8w3n7404xxhaz2jqexhzw5 + +$ cardano-address script hash "all [$(cat cold.credential), active_from 100, active_until 120]" | bech32 +3889a43d9cf7642d8bbbb309048b0f9cd2149dd19faafa98d7e89520 + +$ cardano-address script hash --with-byte "all [$(cat cold.credential), active_from 100, active_until 120]" +cc_cold1zvugnfpannmkgtvthwesjpytp7wdy9ya6x06475c6l5f2gqcxtssu +$ cardano-address script hash --with-byte "all [$(cat cold.credential), active_from 100, active_until 120]" | bech32 +133889a43d9cf7642d8bbbb309048b0f9cd2149dd19faafa98d7e89520 + +(there is the expected 0x13 prepended byte as it is cc cold script hash credential in accordance to CIP-0129. The corresponding script hash credential is '3889a43d9cf7642d8bbbb309048b0f9cd2149dd19faafa98d7e89520' and it is the same irrespective of how the script hash is constructed, i.e., from `cold.vkh`, `cold.credential` or `cold.deprecated`). +``` + + +### How to generate hot committee keys (cc_hot) + +```console +$ cat root.xsk +root_xsk1hqzfzrgskgnpwskxxrv5khs7ess82ecy8za9l5ef7e0afd2849p3zryje8chk39nxtva0sww5me3pzkej4rvd5cae3q3v8eu7556n6pdrp4fdu8nsglynpmcppxxvfdyzdz5gfq3fefjepxhvqspmuyvmvqg8983 + +$ cardano-address key child 1852H/1815H/0H/5/0 < root.xsk > hot.xsk +cc_hot_xsk14z9ktfggpsm8sqd5ecepv9f4estxkukfualezuxrfry0mjj849puxsq7ch3tw67d7rfr4smvaa2u3tkfu675mxw85zlpafp6llfex7re88wh22s8f83ehn6uejgfrm74x8y98xlwdmgy64ufctwernp64umnr5uk + +$ cardano-address key public --with-chain-code < hot.xsk > hot.xvk +cc_hot_xvk1a5q4r34xzm0r6y728d4gmrl7jvrfuh7r022k7wh5mzwmyg7d7l3hjwwaw54qwj0rn084enysj8ha2vwg2wd7umksf4tcnskaj8xr4tcempwly + +$ cardano-address key public --without-chain-code < hot.xsk > hot.vk +cc_hot_vk1a5q4r34xzm0r6y728d4gmrl7jvrfuh7r022k7wh5mzwmyg7d7l3s3fzqkv + +$ cardano-address key hash --cip-0105 < hot.xvk > hot.vkh +cc_hot_vkh1xk94yxqufrm5sjfv535hlnky8cf9fzg5kvp3r4qz9d5ezk2qmuz + +$ cat hot.vkh | bech32 +358b52181c48f748492ca4697fcec43e12548914b30311d4022b6991 + +$ cat hot.vkh | bech32 cc_hot > hot.deprecated +cc_hot1xk94yxqufrm5sjfv535hlnky8cf9fzg5kvp3r4qz9d5ezua5p8v + +$ cat hot.deprecated | bech32 +358b52181c48f748492ca4697fcec43e12548914b30311d4022b6991 + +$ cardano-address key hash < hot.xvk > hot.credential +cc_hot1qg6ck5scr3y0wjzf9jjxjl7wcslpy4yfzjesxyw5qg4knyg9ckh0d + +$ cat hot.credential | bech32 +02358b52181c48f748492ca4697fcec43e12548914b30311d4022b6991 + +(there is the expected 0x02 prepended byte as it is cc cold key hash credential in accordance to CIP-0129. The corresponding key hash credential is '358b52181c48f748492ca4697fcec43e12548914b30311d4022b6991' and it is the same as in case of both `hot.vkh` and `hot.deprecated`). +``` + + +### How to create script and its hash from hot committee keys (drep) + +```console + +$ cat hot.vkh +cc_hot_vkh1xk94yxqufrm5sjfv535hlnky8cf9fzg5kvp3r4qz9d5ezk2qmuz +$ cat hot.deprecated +cc_hot1xk94yxqufrm5sjfv535hlnky8cf9fzg5kvp3r4qz9d5ezua5p8v +$ cat hot.credential +cc_hot1qg6ck5scr3y0wjzf9jjxjl7wcslpy4yfzjesxyw5qg4knyg9ckh0d + +$ cardano-address script hash "all [$(cat hot.xvk), active_from 100, active_until 120]" +cc_hot_script14xptkz0f6kv85nctxuycj0vm73u7ajuz4rglxn5qgzncsdq80mv +$ cardano-address script hash "all [$(cat hot.deprecated), active_from 100, active_until 120]" +cc_hot_script14xptkz0f6kv85nctxuycj0vm73u7ajuz4rglxn5qgzncsdq80mv +$ cardano-address script hash "all [$(cat hot.credential), active_from 100, active_until 120]" +cc_hot_script14xptkz0f6kv85nctxuycj0vm73u7ajuz4rglxn5qgzncsdq80mv + +$ cardano-address script hash "all [$(cat hot.credential), active_from 100, active_until 120]" | bech32 +a982bb09e9d5987a4f0b3709893d9bf479eecb82a8d1f34e8040a788 + +$ cardano-address script hash --with-byte "all [$(cat hot.credential), active_from 100, active_until 120]" +cc_hot1qw5c9wcfa82es7j0pvmsnzfan068nmkts25dru6wspq20zqsumm4q +$ cardano-address script hash --with-byte "all [$(cat hot.credential), active_from 100, active_until 120]" | bech32 +03a982bb09e9d5987a4f0b3709893d9bf479eecb82a8d1f34e8040a788 + +(there is the expected 0x03 prepended byte as it is cc hot script hash credential in accordance to CIP-0129. The corresponding script hash credential is 'a982bb09e9d5987a4f0b3709893d9bf479eecb82a8d1f34e8040a788' and it is the same irrespective of how the script hash is constructed, i.e., from `hot.vkh`, `hot.credential` or `hot.deprecated`). +``` + + + +### How to get signing key and chain code from an extended signing key (drep.sk) + +```console +$ cat drep.xsk +drep_xsk1vpdsm49smzmdwhd4kjmm2mdyljjysm746rafjr7r8kgfanj849psw8pfm305g59wng0akw3qzppmfh6k5z7gx66h2vppu022m4eqaj26rh6d7en9tf9fu52hmysjzuacaxfmfya65h8jmddrclwf3kxl8snfs3eg + +$ cardano-address key private --signing-key < drep.xsk +drep_sk1vpdsm49smzmdwhd4kjmm2mdyljjysm746rafjr7r8kgfanj849psw8pfm305g59wng0akw3qzppmfh6k5z7gx66h2vppu022m4eqajg5xmwma + +$ cardano-address key private --signing-key < drep.xsk | bech32 +605b0dd4b0d8b6d75db5b4b7b56da4fca4486fd5d0fa990fc33d909ece47a943071c29dc5f4450ae9a1fdb3a201043b4df56a0bc836b5753021e3d4add720ec9 + +$ cardano-address key private --chain-code < drep.xsk +5a1df4df66655a4a9e5157d9212173b8e993b493baa5cf2db5a3c7dc98d8df3c + +$ echo drep_xsk1vpdsm49smzmdwhd4kjmm2mdyljjysm746rafjr7r8kgfanj849psw8pfm305g59wng0akw3qzppmfh6k5z7gx66h2vppu022m4eqaj26rh6d7en9tf9fu52hmysjzuacaxfmfya65h8jmddrclwf3kxl8snfs3eg | cardano-address key inspect +{ + "chain_code": "5a1df4df66655a4a9e5157d9212173b8e993b493baa5cf2db5a3c7dc98d8df3c", + "extended_key": "605b0dd4b0d8b6d75db5b4b7b56da4fca4486fd5d0fa990fc33d909ece47a943071c29dc5f4450ae9a1fdb3a201043b4df56a0bc836b5753021e3d4add720ec9", + "key_type": "private" +} +``` + + + + +### How to generate script validation, preimage and script hash from script composed of drep (drep_script) + +```console +$ cat drep +drep1sp5xhvmj0asztqfsjyta3cwvq7jppc2rwmfcsggp62va538nup0 + +$ cardano-address script validate "all [$(cat drep),active_from 5001]" +Validated. + +$ cardano-address script validate "all [$(cat drep),$(cat hot)]" +Not validated: All keys of a script must have the same role: payment, delegation, policy, representative, committee cold or committee hot. + +$ cardano-address script preimage "all [$(cat drep),active_from 5001]" +008201828200581c80686bb3727f602581309117d8e1cc07a410e14376d3882101d299da8204191389 + +$ cardano-address script hash "all [$(cat drep),active_from 5001]" +drep_script1608hfeauc3hvfpvdcqwfdhyd2cfm6j42rp62ckqrskazy57w2zt +``` + + + +### Correspondence between keys in cardano-addresses and cardano-cli (key.xsk key.xvk key.vk key.hash) + +```console +Let's assume we have mnemonic +$ cat recovery-phrase.prv +nothing heart matrix fly sleep slogan tomato pulse what roof rail since plastic false enlist + +Construct root extended private key +$ cardano-address key from-recovery-phrase Shelley < recovery-phrase.prv > root.xprv +root_xsk1apjwjs3ksgm5mnnk0cc5v5emgv0hmafmmy8tffay5s2ffk69830whwznr46672ruucdzwwtv9upv72e4ylrypyz5m6cyh0p00t7n3u3agt20lv32j4kxcqlkzu78nzjx0ysxxlc2ghfz9prxfmrds802xsuhh404~ + +Construct extended private key for account ix=0H, role=0 and address ix=0 +$ cardano-address key child 1852H/1815H/0H/0/0 < root.xprv > key.xsk +addr_xsk1kzl5vgev0u843tfnxqcwg0lmaf7zhdhczddaqhas6dp6m6z98302e3avp8mhu94kxkpj2gss064f74km3rrptafh4fsztekz8k5c469shcvx35wrdmus3xemp984lcwhs0jdtl4pfcsrfspe00h9pej6rg8drvcv + +Create extended signing key using cardano-cli +$ cardano-cli key convert-cardano-address-key --shelley-payment-key --signing-key-file key.xsk --out-file key.skey +{ + "type": "PaymentExtendedSigningKeyShelley_ed25519_bip32", + "description": "", + "cborHex": "5880b0bf46232c7f0f58ad333030e43ffbea7c2bb6f8135bd05fb0d343ade8453c5eacc7ac09f77e16b635832522107eaa9f56db88c615f537aa6025e6c23da98ae8fbbbf6410e24532f35e9279febb085d2cc05b3b2ada1df77ea1951eb694f3834b0be1868d1c36ef9089b3b094f5fe1d783e4d5fea14e2034c0397bee50e65a1a" +} + +The cborhex here contains of 4 parts: +1. prefix 5880 - bytestring of 128 bytes +2. signing key (64 bytes) - b0bf46232c7f0f58ad333030e43ffbea7c2bb6f8135bd05fb0d343ade8453c5eacc7ac09f77e16b635832522107eaa9f56db88c615f537aa6025e6c23da98ae8 +3. verification key (32 bytes) - fbbbf6410e24532f35e9279febb085d2cc05b3b2ada1df77ea1951eb694f3834 +4. chain code (32 bytes) - b0be1868d1c36ef9089b3b094f5fe1d783e4d5fea14e2034c0397bee50e65a1a + +Create corresponding verification key using cardano-cli +$ cardano-cli key verification-key --signing-key-file key.skey --verification-key-file key.vkey +{ + "type": "PaymentExtendedVerificationKeyShelley_ed25519_bip32", + "description": "", + "cborHex": "5840fbbbf6410e24532f35e9279febb085d2cc05b3b2ada1df77ea1951eb694f3834b0be1868d1c36ef9089b3b094f5fe1d783e4d5fea14e2034c0397bee50e65a1a" +} +The cborhex here contains of 3 parts: +1. prefix 5840 - bytestring of 64 bytes +2. verification key (32 bytes) - fbbbf6410e24532f35e9279febb085d2cc05b3b2ada1df77ea1951eb694f3834 +3. chain code (32 bytes) - b0be1868d1c36ef9089b3b094f5fe1d783e4d5fea14e2034c0397bee50e65a1a + +Rule for prefixes: + - CBOR-encoded bytestring (which is what the 58 identifies) + - size (80 means 128 bytes, whereas 40 means 64 bytes, 20 means 32 bytes) + +Create verification key hash using cardano-cli +$ cardano-cli address key-hash --payment-verification-key-file key.vkey > key.hash +0185545935760c5e370d01e6f4fedbb89b7fd79e115f2837cfab9ea8 + +Alternatively, we can create non-extended key +$ cardano-address key public --without-chain-code < key.xsk > key.vk +addr_vk1lwalvsgwy3fj7d0fy707hvy96txqtvaj4ksa7al2r9g7k6208q6qmrv9k3 + +Also, take notice that signing key can be translated to cborhex: +$ cat key.xsk | bech32 +b0bf46232c7f0f58ad333030e43ffbea7c2bb6f8135bd05fb0d343ade8453c5eacc7ac09f77e16b635832522107eaa9f56db88c615f537aa6025e6c23da98ae8b0be1868d1c36ef9089b3b094f5fe1d783e4d5fea14e2034c0397bee50e65a1a +(signing key and chain code appended) + +Moreover, basing on key.vk one can get hash +$ cardano-cli address key-hash --payment-verification-key $(cat key.vk) > key1.hash +0185545935760c5e370d01e6f4fedbb89b7fd79e115f2837cfab9ea8 + +Within cardano-addresses one can get cborhex of verification key (with chain code) +$ cardano-address key public --with-chain-code < key.xsk | bech32 +fbbbf6410e24532f35e9279febb085d2cc05b3b2ada1df77ea1951eb694f3834b0be1868d1c36ef9089b3b094f5fe1d783e4d5fea14e2034c0397bee50e65a1a +(verification key and chain code appended) + +Within cardano-addresses one can get cborhex of verification key (without chain code) +$ cardano-address key public --without-chain-code < key.xsk | bech32 +fbbbf6410e24532f35e9279febb085d2cc05b3b2ada1df77ea1951eb694f3834 +(verification key without chain code) + +Then, we can get compute hash (but here we need to use without chain code): +$ cardano-address key public --without-chain-code < key.xsk | cardano-address key hash | bech32 +0185545935760c5e370d01e6f4fedbb89b7fd79e115f2837cfab9ea8 + +``` + +## Building/testing from source using nix + +``` console +$ nix develop + +# building +$ cabal build all + +# testing +$ export LANG=C.UTF-8 +$ cabal test cardano-addresses:unit + +# installing executable locally +$ cabal install cardano-address +``` + +## Docker Image + +Please make sure you have [just](https://github.com/casey/just) installed as `justfile` is used for building Docker image + +### Build + +```console +$ just clean-build-docker +``` + +### Run + +Use the auto-remove flag `--rm` when running commands. + +```console +$ docker run --rm cardano-address recovery-phrase generate --size 15 +dismiss grit bacon glare napkin satisfy tribe proud carpet bench fantasy rich history face north +``` + +Use the interactive flag `-i` when piping stdin + +```console +$ echo "addr1gqtnpvdhqrtpd4g424fcaq7k0ufuzyadt7djygf8qdyzevuph3wczvf2dwyx5u" | docker run --rm -i cardano-addresses address inspect +{ + "address_style": "Shelley", + "stake_reference": "by pointer", + "spending_key_hash": "1730b1b700d616d51555538e83d67f13c113ad5f9b22212703482cb3", + "pointer": { + "slot_num": 24157, + "output_index": 42, + "transaction_index": 177 + }, + "network_tag": 0 +} +``` + +## Javascript support + +Javascript support was dicontinued and dropped. One could look at the following now: + +1. [MeshJS](https://github.com/MeshJS/mesh) +2. [blaze-cardano](https://github.com/butaneprotocol/blaze-cardano) + +Alternatively one could lean back on release [4.0.0](https://github.com/IntersectMBO/cardano-addresses/releases/tag/4.0.0) +where Javascript was still present. + +## Contributing + +Pull requests are welcome. + +When creating a pull request, please make sure that your code adheres to our +[coding standards](https://input-output-hk.github.io/adrestia/code/Coding-Standards). + +
+ +

+ +

diff --git a/SECURITY.md b/SECURITY.md new file mode 100644 --- /dev/null +++ b/SECURITY.md @@ -0,0 +1,107 @@ +# Security Vulnerability Disclosure Policy + +## Introduction + +The cardano-address open source project is committed to ensuring the security of +its software and the privacy of its users. We value the contributions +of the security community in helping us identify and address +vulnerabilities in our code. This _Security Vulnerability Disclosure +Policy_ outlines how security vulnerabilities should be reported and +how we will respond to and remediate such reports. + +## Security Vulnerability Handling Process + +### Reporting a Vulnerability + +If you discover a security vulnerability in cardano-address, we encourage you to +responsibly disclose it to us. To report a vulnerability, please use +the [private reporting form on +GitHub](https://github.com/IntersectMBO/cardano-addresses/security/advisories/new) +to draft a new _Security advisory_. + +Please include as much details as needed to clearly qualify the issue: + +* A description of the vulnerability and its potential impact. +* Steps to reproduce the vulnerability. +* The version of `cardano-address` package where the vulnerability exists. +* Any relevant proof-of-concept or exploit code (if applicable). + +### Processing Vulnerability + +1. **Acknowledgment**: The team acknowledges the receipt of your report + within 3 business days by commenting on the issue reporting it or replying to email. + +2. **Validation**: The team investigates the issue and either _reject_ or _validate_ the + reported vulnerability. + + a. **Rejection**: If the team rejects the report, detailed explanations will be provided by email or commenting on the relevant issue and the latter will be made public and closed as `Won't fix`. + + b. **Acceptance**: If the team accepts the report, a CVE identifier will be requested through GitHub and a [private fork](https://docs.github.com/en/code-security/security-advisories/working-with-repository-security-advisories/collaborating-in-a-temporary-private-fork-to-resolve-a-repository-security-vulnerability) opened to work on a fix to the issue + +3. **Resolution**: The team works to resolve the vulnerability in a + timely manner. The timeline for resolution will depend on the + complexity and severity of the vulnerability, but we will strive to + address critical vulnerabilities as quickly as possible. + +4. **Collaboration**: While working on a fix, the team maintains open and transparent + communication with the reporter throughout the process, providing + updates on the status of the vulnerability and any steps taken to + remediate it. In particular this means that the reporter will be asked to review any proposed fix and to advise on the timing for public disclosure. + +5. **Fixing Issue**: The team agrees on the fix, the announcement, and the release schedule with the reporter. If the reporter is not responsive in a reasonable time frame this should not block the team from moving to the next steps particularly in the face of a high impact or high severity issue. + + a. **Mitigation**: Depending on the severity and criticity of the issue, the team can decide to disclose the issue publicly in the absence of a fix _if and only if_ a clear, simple, and effective mitigation plan is defined. This _must_ include instructions for users and operators of the software, and a time horizon at which the issue will be properly fixed (eg. version number). + + b. **Fix**: When a fix is available and approved, it should be merged and made available as quickly as possible: + + * All commits to the private repository are squashed into a single commit whose description _should not_ make any reference it relates to a security vulnerability + * A new Pull Request is created with this single commit + * This PR's review and merging is expedited as all the work as already been done + +6. **Release**: The team creates and publish a release that includes the fix + +7. **Announcement**: Concommitant to the release annoucement, the team announces the security vulnerability by making the GitHub issue public. This is the first point that any information regarding the vulnerability is made public. + + a. **Credit**: The team publicly acknowledges the contributions of the + reporter once the vulnerability is resolved, subject to the + reporter's preferences for attribution. + +7. **Disagreements**: In case of disagreements with the reporter on the fix, mitigation, timing, or announcement, the team has the final say. + +## Responsible Disclosure + +We kindly request that reporters adhere to responsible disclosure +practices, which include: + +- **Do not disclose the vulnerability publicly**: Please refrain from + posting details of the vulnerability on public forums or social + media until it has been resolved. +- **Do not exploit the vulnerability**: Do not attempt to exploit the + vulnerability to cause harm or gain unauthorized access to systems. +- **Work with us**: Allow us a reasonable amount of time to + investigate and address the vulnerability before publicly disclosing + any details. + +## Legal Protections + +We will not pursue legal action against individuals who +report security vulnerabilities to us. + +## Contact Information + +To report a security vulnerability, please use [GitHub +form](https://github.com/IntersectMBO/cardano-addresses/security/advisories/new). + +## Revision of Policy + +This Security Vulnerability Disclosure Policy may be updated or +revised as necessary. Please check the latest version of this policy +on the [cardano-addresses repository](https://github.com/IntersectMBO/cardano-addresses/blob/master/SECURITY.md). + +## Conclusion + +The cardano-addresses project greatly appreciates the assistance of the security +community in helping us maintain the security of our software while +upholding the highest standards of privacy. Together, we can work to +identify and address vulnerabilities, ensuring a safer and more secure +experience for all users. diff --git a/cardano-addresses.cabal b/cardano-addresses.cabal new file mode 100644 --- /dev/null +++ b/cardano-addresses.cabal @@ -0,0 +1,223 @@ +cabal-version: 1.12 + +name: cardano-addresses +version: 4.0.0 +synopsis: Utils for constructing a command-line on top of cardano-addresses. +description: Please see the README on GitHub at +category: Cardano +homepage: https://github.com/IntersectMBO/cardano-addresses#readme +bug-reports: https://github.com/IntersectMBO/cardano-addresses/issues +author: IOHK +maintainer: hal@cardanofoundation.org +copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +license: Apache-2.0 +license-file: LICENSE +build-type: Simple +extra-source-files: + ChangeLog.md + CONTRIBUTING.md + LICENSE + NOTICE + README.md + SECURITY.md + ./schemas/address-inspect.json + +source-repository head + type: git + location: https://github.com/IntersectMBO/cardano-addresses + +flag release + description: Compile executables for a release. + manual: True + default: False + +library + exposed-modules: + Cardano.Address + Cardano.Address.Derivation + Cardano.Address.Internal + Cardano.Address.KeyHash + Cardano.Address.Script + Cardano.Address.Script.Parser + Cardano.Address.Style.Byron + Cardano.Address.Style.Icarus + Cardano.Address.Style.Shared + Cardano.Address.Style.Shelley + Cardano.Codec.Bech32.Prefixes + Cardano.Codec.Cbor + Cardano.Mnemonic + Codec.Binary.Encoding + Command + Command.Address + Command.Address.Bootstrap + Command.Address.Delegation + Command.Address.Inspect + Command.Address.Payment + Command.Address.Pointer + Command.Address.Reward + Command.Key + Command.Key.Child + Command.Key.FromRecoveryPhrase + Command.Key.Hash + Command.Key.Inspect + Command.Key.Public + Command.Key.Private + Command.Key.WalletId + Command.RecoveryPhrase + Command.RecoveryPhrase.Generate + Command.Script + Command.Script.Hash + Command.Script.Preimage + Command.Script.Validation + Command.Version + Data.Word7 + Options.Applicative.Credential + Options.Applicative.Derivation + Options.Applicative.Discrimination + Options.Applicative.Governance + Options.Applicative.MnemonicSize + Options.Applicative.Public + Options.Applicative.Script + Options.Applicative.Private + Options.Applicative.Style + System.Git.TH + System.IO.Extra + other-modules: + Paths_cardano_addresses + hs-source-dirs: + lib + default-extensions: + NoImplicitPrelude + ghc-options: -Wall -Wcompat -fwarn-redundant-constraints + build-depends: + aeson >= 2.0 + , aeson-pretty + , ansi-terminal + , ansi-wl-pprint + , base >= 4.7 && < 5 + , base58-bytestring >= 0.1.0 && < 0.2 + , basement + , bech32 >= 1.1.7 && < 1.2 + , bech32-th >= 1.1.7 && < 1.2 + , binary + , bytestring >= 0.10.6 && < 0.13 + , cardano-crypto >= 1.2.0 && < 1.4.0 + , cborg >= 0.2.1 && <0.3 + , containers >= 0.5 && < 0.8 + , crypton >= 0.32 && < 1.1 + , deepseq >= 1.4.4.0 && < 1.6 + , digest + , either + , exceptions + , extra >= 1.7.14 && < 1.9 + , fmt >= 0.6.3 && < 0.7 + , hashable + , memory >= 0.18.0 && < 0.19 + , mtl >= 2.2.2 + , optparse-applicative >= 0.18.1.0 && < 0.19 + , process >= 1.6.13.2 && < 1.7 + , safe >= 0.3.19 && < 0.4 + , template-haskell >= 2.16.0.0 && < 2.24 + , text >= 1.2 && < 2.2 + , transformers >= 0.5.6.2 && < 0.7 + , unordered-containers + if flag(release) + ghc-options: -Werror + default-language: Haskell2010 + +executable cardano-address + main-is: Main.hs + other-modules: + Paths_cardano_addresses + hs-source-dirs: + exe + ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >= 4.7 && < 5 + , cardano-addresses + , with-utf8 >= 1.1.0.0 && < 1.2 + if flag(release) && !impl(ghcjs) && !os(ghcjs) + ghc-options: -Werror -static -O2 + cc-options: -static + ld-options: -static -pthread + default-language: Haskell2010 + +test-suite unit + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + AutoDiscover + Cardano.Address.DerivationSpec + Cardano.Address.Script.ParserSpec + Cardano.Address.ScriptSpec + Cardano.Address.Style.ByronSpec + Cardano.Address.Style.IcarusSpec + Cardano.Address.Style.SharedSpec + Cardano.Address.Style.ShelleySpec + Cardano.AddressSpec + Cardano.Codec.CborSpec + Cardano.MnemonicSpec + Codec.Binary.EncodingSpec + Command.Address.BootstrapSpec + Command.Address.DelegationSpec + Command.Address.InspectSpec + Command.Address.PaymentSpec + Command.Address.PointerSpec + Command.Address.RewardSpec + Command.Key.ChildSpec + Command.Key.FromRecoveryPhraseSpec + Command.Key.HashSpec + Command.Key.InspectSpec + Command.Key.PrivateSpec + Command.Key.PublicSpec + Command.Key.WalletIdSpec + Command.KeySpec + Command.RecoveryPhrase.GenerateSpec + Command.RecoveryPhraseSpec + Command.Script.HashSpec + Command.Script.PreimageSpec + Command.Script.ValidationSpec + CommandSpec + Data.Word7Spec + Options.Applicative.DerivationSpec + System.IO.ExtraSpec + Test.Arbitrary + Test.Utils + Paths_cardano_addresses + hs-source-dirs: + test + default-extensions: + NoImplicitPrelude + ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-tools: + cardano-address + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + QuickCheck >= 2.14 && < 2.16 + , aeson >= 2.0 + , aeson-pretty + , base >= 4.7 && < 5 + , bech32 >= 1.1.7 && < 1.2 + , bech32-th >= 1.1.7 && < 1.2 + , binary + , bytestring >= 0.10.6 && < 0.13 + , cardano-addresses + , cardano-crypto + , crypton + , containers >= 0.5 && < 0.8 + , hspec >= 2.11.0 && < 2.12 + , hspec-golden >=0.1.0.3 && <0.2 + , memory + , pretty-simple + , process + , string-interpolate + , temporary + , text >= 1.2 && < 2.2 + , with-utf8 >= 1.1.0.0 && < 1.2 + if os(windows) + build-depends: + Win32 + if flag(release) + ghc-options: -Werror + default-language: Haskell2010 diff --git a/exe/Main.hs b/exe/Main.hs new file mode 100644 --- /dev/null +++ b/exe/Main.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Main where + +import Prelude + +import Main.Utf8 + ( withUtf8 ) + +import qualified Command as CLI + +main :: IO () +main = do + withUtf8 (CLI.setup >> CLI.parse >>= CLI.run) diff --git a/lib/Cardano/Address.hs b/lib/Cardano/Address.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address.hs @@ -0,0 +1,269 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address + ( -- * Address + Address + , PaymentAddress (..) + , StakeAddress (..) + , DelegationAddress (..) + , PointerAddress (..) + , ChainPointer (..) + , unsafeMkAddress + , unAddress + + -- * Conversion From / To Text + , base58 + , fromBase58 + , bech32 + , bech32With + , fromBech32 + + -- Internal / Network Discrimination + , HasNetworkDiscriminant (..) + , AddressDiscrimination (..) + , NetworkTag (..) + , invariantSize + , invariantNetworkTag + ) where + +import Prelude + +import Cardano.Address.Derivation + ( Depth (..), XPub ) +import Cardano.Codec.Cbor + ( decodeAddress, deserialiseCbor ) +import Codec.Binary.Bech32 + ( HumanReadablePart ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode ) +import Control.DeepSeq + ( NFData ) +import Control.Monad + ( (<=<) ) +import Data.Aeson + ( ToJSON (..), Value (..), object, (.=) ) +import Data.Bits + ( Bits (testBit) ) +import Data.ByteString + ( ByteString ) +import Data.Either.Extra + ( eitherToMaybe ) +import Data.Kind + ( Type ) +import Data.Text + ( Text ) +import Data.Word + ( Word32, Word8 ) +import GHC.Generics + ( Generic ) +import GHC.Stack + ( HasCallStack ) +import Numeric.Natural + ( Natural ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Codec.Binary.Encoding as E +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as T + +-- | An 'Address' type representing 'Cardano' addresses. Internals are +-- irrevelant to the user. +-- +-- @since 1.0.0 +newtype Address = Address + { unAddress :: ByteString + } deriving stock (Generic, Show, Eq, Ord) +instance NFData Address + +-- Unsafe constructor for easily lifting bytes inside an 'Address'. +-- +-- /!\ Use at your own risks. +unsafeMkAddress :: ByteString -> Address +unsafeMkAddress = Address + +-- | Encode an 'Address' to a base58 'Text'. +-- +-- @since 1.0.0 +base58 :: Address -> Text +base58 = T.decodeUtf8 . encode EBase58 . unAddress + +-- | Decode a base58-encoded 'Text' into an 'Address' +-- +-- @since 1.0.0 +fromBase58 :: Text -> Maybe Address +fromBase58 = + (eitherToMaybe . deserialiseCbor (unsafeMkAddress <$> decodeAddress) + <=< (eitherToMaybe . E.fromBase58 . T.encodeUtf8)) + +-- | Encode a Shelley 'Address' to bech32 'Text', using @addr@ or @addr_test@ as +-- a human readable prefix (depending on the network tag in the address). +-- +-- @since 1.0.0 +bech32 :: Address -> Text +bech32 addr = bech32With (addressHrp addr) addr + +-- | Encode an 'Address' to bech32 'Text', using the specified human readable +-- prefix. +-- +-- @since 2.0.0 +bech32With :: HumanReadablePart -> Address -> Text +bech32With hrp = T.decodeLatin1 . encode (EBech32 hrp) . unAddress + +-- | Decode a bech32-encoded 'Text' into an 'Address' +-- +-- @since 1.0.0 +fromBech32 :: Text -> Maybe Address +fromBech32 = eitherToMaybe + . fmap (unsafeMkAddress . snd) + . E.fromBech32 (const id) + . T.encodeUtf8 + +-- | Returns the HRP for a shelley address, using the network tag. +addressHrp :: Address -> HumanReadablePart +addressHrp (Address bs) = case BS.uncons bs of + Just (w8, _) | testBit w8 0 -> CIP5.addr + _ -> CIP5.addr_test + +-- | Encoding of addresses for certain key types and backend targets. +-- +-- @since 2.0.0 +class HasNetworkDiscriminant key => StakeAddress key where + -- | Convert a delegation key to a stake 'Address' (aka: reward account address) + -- valid for the given network discrimination. + -- + -- @since 2.0.0 + stakeAddress :: NetworkDiscriminant key -> key 'DelegationK XPub -> Address + +-- | Encoding of addresses for certain key types and backend targets. +-- +-- @since 1.0.0 +class HasNetworkDiscriminant key => PaymentAddress key where + -- | Convert a public key to a payment 'Address' valid for the given + -- network discrimination. + -- + -- @since 1.0.0 + paymentAddress :: NetworkDiscriminant key -> key 'PaymentK XPub -> Address + +-- | Encoding of delegation addresses for certain key types and backend targets. +-- +-- @since 2.0.0 +class PaymentAddress key + => DelegationAddress key where + -- | Convert a public key and a delegation key to a delegation 'Address' valid + -- for the given network discrimination. Funds sent to this address will be + -- delegated according to the delegation settings attached to the delegation + -- key. + -- + -- @since 2.0.0 + delegationAddress + :: NetworkDiscriminant key + -> key 'PaymentK XPub + -- ^ Payment key + -> key 'DelegationK XPub + -- ^ Delegation key + -> Address + +-- | A 'ChainPointer' type representing location of some object +-- in the blockchain (eg., delegation certificate). This can be achieved +-- unambiguously by specifying slot number, transaction index and the index +-- in the object list (eg., certification list). +-- For delegation certificates, alternatively, the delegation key can be used and +-- then 'DelegationAddress' can be used. +-- +-- @since 2.0.0 +data ChainPointer = ChainPointer + { slotNum :: Natural + -- ^ Pointer to the slot + , transactionIndex :: Natural + -- ^ transaction index + , outputIndex :: Natural + -- ^ output list index + } deriving stock (Generic, Show, Eq, Ord) +instance NFData ChainPointer + +instance ToJSON ChainPointer where + toJSON ChainPointer{..} = object + [ "slot_num" .= slotNum + , "transaction_index" .= transactionIndex + , "output_index" .= outputIndex + ] + +-- | Encoding of pointer addresses for payment key type, pointer to delegation +-- certificate in the blockchain and backend targets. +-- +-- @since 2.0.0 +class PaymentAddress key + => PointerAddress key where + -- | Convert a payment public key and a pointer to delegation key in the + -- blockchain to a delegation 'Address' valid for the given network + -- discrimination. Funds sent to this address will be delegated according to + -- the delegation settings attached to the delegation key located by + -- 'ChainPointer'. + -- + -- @since 2.0.0 + pointerAddress + :: NetworkDiscriminant key + -> key 'PaymentK XPub + -- ^ Payment key + -> ChainPointer + -- ^ Pointer to locate delegation key in blockchain + -> Address + +class HasNetworkDiscriminant (key :: Depth -> Type -> Type) where + type NetworkDiscriminant key :: Type + + addressDiscrimination :: NetworkDiscriminant key -> AddressDiscrimination + networkTag :: NetworkDiscriminant key -> NetworkTag + +-- Magic constant associated with a given network. This is mainly used in two +-- places: +-- +-- (1) In 'Address' payloads, to discriminate addresses between networks. +-- (2) At the network-level, when doing handshake with nodes. +newtype NetworkTag + = NetworkTag { unNetworkTag :: Word32 } + deriving (Generic, Show, Eq) +instance NFData NetworkTag + +instance ToJSON NetworkTag where + toJSON (NetworkTag net) = Number (fromIntegral net) + +-- Describe requirements for address discrimination on the Byron era. +data AddressDiscrimination + = RequiresNetworkTag + | RequiresNoTag + deriving (Generic, Show, Eq) +instance NFData AddressDiscrimination + +invariantSize :: HasCallStack => Int -> ByteString -> ByteString +invariantSize expectedLength bytes + | BS.length bytes == expectedLength = bytes + | otherwise = error + $ "length was " + ++ show (BS.length bytes) + ++ ", but expected to be " + ++ (show expectedLength) + +invariantNetworkTag :: HasCallStack => Word32 -> NetworkTag -> Word8 +invariantNetworkTag limit (NetworkTag num) + | num < limit = fromIntegral num + | otherwise = error + $ "network tag was " + ++ show num + ++ ", but expected to be less than " + ++ show limit diff --git a/lib/Cardano/Address/Derivation.hs b/lib/Cardano/Address/Derivation.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/Derivation.hs @@ -0,0 +1,516 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address.Derivation + ( + -- * Overview + -- $overview + + -- * Key Derivation + -- ** Types + Index + , indexToWord32 + , indexFromWord32 + , wholeDomainIndex + , coerceWholeDomainIndex + , nextIndex + , Depth (..) + , DerivationType (..) + + -- * Abstractions + , GenMasterKey (..) + , HardDerivation (..) + , SoftDerivation (..) + + -- * Low-Level Cryptography Primitives + -- ** XPrv + , XPrv + , xprvFromBytes + , xprvToBytes + , xprvPrivateKey + , xprvChainCode + , toXPub + + -- ** XPub + , XPub + , xpubFromBytes + , xpubToBytes + , xpubPublicKey + , xpubChainCode + + -- ** Pub + , Pub + , pubFromBytes + , pubToBytes + , xpubToPub + + -- ** XSignature + , XSignature + , sign + , verify + + -- Internal / Not exposed by Haddock + , DerivationScheme (..) + , deriveXPrv + , deriveXPub + , generate + , generateNew + , hashCredential + , hashWalletId + , credentialHashSize + , unsafeMkIndex + ------------------ + ) where + +import Prelude + +import Cardano.Crypto.Wallet + ( DerivationScheme (..) ) +import Cardano.Mnemonic + ( SomeMnemonic ) +import Control.DeepSeq + ( NFData ) +import Crypto.Error + ( eitherCryptoError ) +import Crypto.Hash + ( hash ) +import Crypto.Hash.Algorithms + ( Blake2b_160 (..), Blake2b_224 (..) ) +import Crypto.Hash.IO + ( HashAlgorithm (hashDigestSize) ) +import Data.ByteArray + ( ByteArrayAccess, ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Coerce + ( coerce ) +import Data.Either.Extra + ( eitherToMaybe ) +import Data.Kind + ( Type ) +import Data.String + ( fromString ) +import Data.Word + ( Word32 ) +import Fmt + ( Buildable (..) ) +import GHC.Generics + ( Generic ) +import GHC.Stack + ( HasCallStack ) + +import qualified Cardano.Crypto.Wallet as CC +import qualified Crypto.ECC.Edwards25519 as Ed25519 +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS + +-- $overview +-- +-- These abstractions allow generating root private key, also called /Master Key/ +-- and then basing on it enable address derivation + +-- +-- Low-Level Cryptography Primitives +-- + +-- | An opaque type representing an extended private key. +-- +-- __Properties:__ +-- +-- ===== Roundtripping +-- +-- @forall xprv. 'xprvFromBytes' ('xprvToBytes' xprv) == 'Just' xprv@ +-- +-- ===== Chain Code Invariance +-- +-- @forall xprv. 'xprvChainCode' xprv == 'xpubChainCode' ('toXPub' xprv)@ +-- +-- ===== Public Key Signature +-- +-- @forall xprv msg. 'verify' ('toXPub' xprv) msg ('sign' xprv msg) == 'True'@ +-- +-- @since 1.0.0 +type XPrv = CC.XPrv + +-- | An opaque type representing an extended public key. +-- +-- __Properties:__ +-- +-- ===== Roundtripping +-- +-- @forall xpub. 'xpubFromBytes' ('xpubToBytes' xpub) == 'Just' xpub@ +-- +-- @since 1.0.0 +type XPub = CC.XPub + +-- | An opaque type representing a signature made from an 'XPrv'. +-- +-- @since 1.0.0 +type XSignature = CC.XSignature + +-- | Construct an 'XPub' from raw 'ByteString' (64 bytes). +-- +-- @since 1.0.0 +xpubFromBytes :: ByteString -> Maybe XPub +xpubFromBytes = eitherToMaybe . CC.xpub + +-- | Convert an 'XPub' to a raw 'ByteString' (64 bytes). +-- +-- @since 1.0.0 +xpubToBytes :: XPub -> ByteString +xpubToBytes xpub = xpubPublicKey xpub <> xpubChainCode xpub + +-- | Extract the public key from an 'XPub' as a raw 'ByteString' (32 bytes). +-- +-- @since 2.0.0 +xpubPublicKey :: XPub -> ByteString +xpubPublicKey (CC.XPub pub _cc) = pub + +-- | Extract the chain code from an 'XPub' as a raw 'ByteString' (32 bytes). +-- +-- @since 2.0.0 +xpubChainCode :: XPub -> ByteString +xpubChainCode (CC.XPub _pub (CC.ChainCode cc)) = cc + +-- | An opaque type representing a non-extended public key. +-- +-- __Properties:__ +-- +-- ===== Roundtripping +-- +-- @forall pub. 'pubFromBytes' ('pubToBytes' pub) == 'Just' pub@ +-- +-- @since 3.12.0 +newtype Pub = Pub ByteString + deriving (Show, Eq) + +-- | Construct a 'Pub' from raw 'ByteString' (32 bytes). +-- +-- @since 3.12.0 +pubFromBytes :: ByteString -> Maybe Pub +pubFromBytes bytes + | BS.length bytes /= 32 = Nothing + | otherwise = Just $ Pub bytes + +-- | Convert an 'Pub' to a raw 'ByteString' (32 bytes). +-- +-- @since 3.12.0 +pubToBytes :: Pub -> ByteString +pubToBytes (Pub pub) = pub + +-- | Extract the public key from an 'XPub' as a 'Pub' (32 bytes). +-- +-- @since 3.12.0 +xpubToPub :: XPub -> Pub +xpubToPub (CC.XPub pub _cc) = Pub pub + +-- | Construct an 'XPrv' from raw 'ByteString' (96 bytes). +-- +-- @since 1.0.0 +xprvFromBytes :: ByteString -> Maybe XPrv +xprvFromBytes bytes + | BS.length bytes /= 96 = Nothing + | otherwise = do + let (prv, cc) = BS.splitAt 64 bytes + pub <- ed25519ScalarMult (BS.take 32 prv) + eitherToMaybe $ CC.xprv $ prv <> pub <> cc + where + ed25519ScalarMult :: ByteString -> Maybe ByteString + ed25519ScalarMult bs = do + scalar <- eitherToMaybe $ eitherCryptoError $ Ed25519.scalarDecodeLong bs + pure $ Ed25519.pointEncode $ Ed25519.toPoint scalar + +-- From < xprv | pub | cc > +-- ↳ To < xprv | | cc > +-- +-- | Convert an 'XPrv' to a raw 'ByteString' (96 bytes). +-- +-- @since 1.0.0 +xprvToBytes :: XPrv -> ByteString +xprvToBytes xprv = + xprvPrivateKey xprv <> xprvChainCode xprv + +-- | Extract the private key from an 'XPrv' as a raw 'ByteString' (64 bytes). +-- +-- @since 2.0.0 +xprvPrivateKey :: XPrv -> ByteString +xprvPrivateKey = BS.take 64 . CC.unXPrv + +-- | Extract the chain code from an 'XPrv' as a raw 'ByteString' (32 bytes). +-- +-- @since 2.0.0 +xprvChainCode :: XPrv -> ByteString +xprvChainCode = BS.drop 96 . CC.unXPrv + +-- | Derive the 'XPub' associated with an 'XPrv'. +-- +-- @since 1.0.0 +toXPub :: HasCallStack => XPrv -> XPub +toXPub = CC.toXPub + +-- | Produce a signature of the given 'msg' from an 'XPrv'. +-- +-- @since 1.0.0 +sign + :: ByteArrayAccess msg + => XPrv + -> msg + -> XSignature +sign = + CC.sign (mempty :: ScrubbedBytes) + +-- | Verify the 'XSignature' of a 'msg' with the 'XPub' associated with the +-- 'XPrv' used for signing. +-- +-- @since 1.0.0 +verify + :: ByteArrayAccess msg + => XPub + -> msg + -> XSignature + -> Bool +verify = + CC.verify -- re-exported for the sake of documentation. + +-- Derive a child extended private key from an extended private key +-- +-- __internal__ +deriveXPrv + :: DerivationScheme + -> XPrv + -> Index derivationType depth + -> XPrv +deriveXPrv ds prv (Index ix) = + CC.deriveXPrv ds (mempty :: ScrubbedBytes) prv ix + +-- Derive a child extended public key from an extended public key +-- +-- __internal__ +deriveXPub + :: DerivationScheme + -> XPub + -> Index derivationType depth + -> Maybe XPub +deriveXPub ds pub (Index ix) = + CC.deriveXPub ds pub ix + +-- Generate an XPrv using the legacy method (Byron). +-- +-- The seed needs to be at least 32 bytes, otherwise an asynchronous error is thrown. +-- +-- __internal__ +generate + :: ByteArrayAccess seed + => seed + -> XPrv +generate seed = + CC.generate seed (mempty :: ScrubbedBytes) + +-- Generate an XPrv using the new method (Icarus). +-- +-- The seed needs to be at least 16 bytes. +-- +-- __internal__ +generateNew + :: (ByteArrayAccess seed, ByteArrayAccess sndFactor) + => seed + -> sndFactor + -> XPrv +generateNew seed sndFactor = + CC.generateNew seed sndFactor (mempty :: ScrubbedBytes) + +-- Hash a credential (pub key or script). +-- +-- __internal__ +hashCredential :: ByteString -> ByteString +hashCredential = + BA.convert . hash @_ @Blake2b_224 + +-- Hash a extended root or account key to calculate walletid. +-- +-- __internal__ +hashWalletId :: ByteString -> ByteString +hashWalletId = + BA.convert . hash @_ @Blake2b_160 + +-- Size, in bytes, of a hash of credential (pub key or script). +-- +-- __internal__ +credentialHashSize :: Int +credentialHashSize = hashDigestSize Blake2b_224 + +-- +-- Key Derivation +-- + +-- | Key Depth in the derivation path, according to BIP-0039 / BIP-0044 +-- +-- @ +-- root | purpose' | cointype' | account' | role | address@ +-- 0th 1st 2nd 3rd 4th 5th +-- @ +-- +-- We do not manipulate purpose, cointype and change paths directly, so there +-- are no constructors for these. +-- +-- @since 1.0.0 +data Depth = RootK | AccountK | PaymentK | DelegationK | DRepK | CCColdK | CCHotK | ScriptK | PolicyK + +-- | A derivation index, with phantom-types to disambiguate derivation type. +-- +-- @ +-- let accountIx = Index 'Hardened 'AccountK +-- let addressIx = Index 'Soft 'PaymentK +-- @ +-- +-- @since 1.0.0 +newtype Index (derivationType :: DerivationType) (depth :: Depth) = Index + { indexToWord32 :: Word32 + -- ^ Get the index as a 'Word32' + -- @since 3.3.0 + } + deriving stock (Generic, Show, Eq, Ord) + +instance NFData (Index derivationType depth) + +instance Bounded (Index 'Hardened depth) where + minBound = Index 0x80000000 + maxBound = Index maxBound + +instance Bounded (Index 'Soft depth) where + minBound = Index minBound + maxBound = let (Index ix) = minBound @(Index 'Hardened _) in Index (ix - 1) + +instance Bounded (Index 'WholeDomain depth) where + minBound = Index minBound + maxBound = Index maxBound + +-- Construct an 'Index' from any Word32 value, without any validation, for +-- internal use only. +-- +-- Always use 'indexFromWord32' or 'wholeDomainIndex' instead of this function. +unsafeMkIndex :: Word32 -> Index ty depth +unsafeMkIndex = Index + +-- | Construct derivation path indices from raw 'Word32' values. +indexFromWord32 + :: forall ix derivationType depth. + (ix ~ Index derivationType depth, Bounded ix) + => Word32 -> Maybe ix +indexFromWord32 ix + | ix >= indexToWord32 (minBound @ix) && ix <= indexToWord32 (maxBound @ix) = + Just (Index ix) + | otherwise = + Nothing + +-- | Increment an index, if possible. +-- +-- @since 3.3.0 +nextIndex + :: forall ix derivationType depth. + (ix ~ Index derivationType depth, Bounded ix) + => ix -> Maybe ix +nextIndex (Index ix) = indexFromWord32 (ix + 1) + +-- | Constructs a full domain 'Index'. This can't fail, unlike 'fromWord32'. +-- +-- @since 3.3.0 +wholeDomainIndex :: Word32 -> Index 'WholeDomain depth +wholeDomainIndex = Index + +-- | Upcasts an 'Index' to one with the full 'Word32' domain. +-- +-- @since 3.3.0 +coerceWholeDomainIndex :: Index ty depth0 -> Index 'WholeDomain depth1 +coerceWholeDomainIndex = coerce + +instance Buildable (Index derivationType depth) where + build (Index ix) = fromString (show ix) + + +-- | Type of derivation that should be used with the given indexes. +-- +-- In theory, we should only consider two derivation types: soft and hard. +-- +-- However, historically, addresses in Cardano used to be generated across both +-- the soft and the hard domain. We therefore introduce a 'WholeDomain' derivation +-- type that is the exact union of `Hardened` and `Soft`. +-- +-- @since 1.0.0 +data DerivationType = Hardened | Soft | WholeDomain + +-- | An interface for doing hard derivations from the root private key, /Master Key/ +-- +-- @since 1.0.0 +class HardDerivation (key :: Depth -> Type -> Type) where + type AccountIndexDerivationType key :: DerivationType + type AddressIndexDerivationType key :: DerivationType + type WithRole key :: Type + + -- | Derives account private key from the given root private key, using + -- derivation scheme 2 (see + -- package for more details). + -- + -- @since 1.0.0 + deriveAccountPrivateKey + :: key 'RootK XPrv + -> Index (AccountIndexDerivationType key) 'AccountK + -> key 'AccountK XPrv + + -- | Derives address private key from the given account private key, using + -- derivation scheme 2 (see + -- package for more details). + -- + -- @since 1.0.0 + deriveAddressPrivateKey + :: key 'AccountK XPrv + -> WithRole key + -> Index (AddressIndexDerivationType key) 'PaymentK + -> key 'PaymentK XPrv + +-- | An interface for doing soft derivations from an account public key +class HardDerivation key => SoftDerivation (key :: Depth -> Type -> Type) where + -- | Derives address public key from the given account public key, using + -- derivation scheme 2 (see + -- package for more details). + -- + -- This is the preferred way of deriving new sequential address public keys. + -- + -- @since 1.0.0 + deriveAddressPublicKey + :: key 'AccountK XPub + -> WithRole key + -> Index 'Soft 'PaymentK + -> key 'PaymentK XPub + + +-- | Abstract interface for constructing a /Master Key/. +-- +-- @since 1.0.0 +class GenMasterKey (key :: Depth -> Type -> Type) where + type SecondFactor key :: Type + + -- | Generate a root key from a corresponding mnemonic. + -- + -- @since 1.0.0 + genMasterKeyFromMnemonic + :: SomeMnemonic -> SecondFactor key -> key 'RootK XPrv + + -- | Generate a root key from a corresponding root 'XPrv' + -- + -- @since 1.0.0 + genMasterKeyFromXPrv + :: XPrv -> key 'RootK XPrv diff --git a/lib/Cardano/Address/Internal.hs b/lib/Cardano/Address/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/Internal.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 +-- +-- Utility functions for internal use of the library. + +module Cardano.Address.Internal + ( orElse + , WithErrorMessage (..) + , DeserialiseFailure (..) + ) where + +import Prelude + +import Codec.CBOR.Read + ( DeserialiseFailure (..) ) +import Control.Exception + ( Exception (..) ) +import Data.Aeson + ( GToJSON + , Options (..) + , SumEncoding (..) + , ToJSON (..) + , Value (..) + , Zero + , defaultOptions + , genericToJSON + , object + , toJSON + , (.=) + ) +import GHC.Generics + ( Generic, Rep ) + +orElse :: Either e a -> Either e a -> Either e a +orElse (Right a) _ = Right a +orElse (Left _) ea = ea + +errToJSON :: (Exception e, Generic e, GToJSON Zero (Rep e)) => e -> Value +errToJSON err = object + [ "error" .= genericToJSON opts err + , "message" .= toJSON (displayException err) + ] + where + opts = defaultOptions { sumEncoding = errorCodes } + errorCodes = TaggedObject "code" "details" + +newtype WithErrorMessage e = WithErrorMessage { withErrorMessage :: e } + +instance (Exception e, Generic e, GToJSON Zero (Rep e)) => ToJSON (WithErrorMessage e) where + toJSON = errToJSON . withErrorMessage + +instance ToJSON DeserialiseFailure where + toJSON (DeserialiseFailure off msg) = object + [ "code" .= String "Codec.CBOR.DeserialiseFailure" + , "details" .= object [ "byteOffset" .= off, "message" .= msg ] + ] diff --git a/lib/Cardano/Address/KeyHash.hs b/lib/Cardano/Address/KeyHash.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/KeyHash.hs @@ -0,0 +1,337 @@ +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address.KeyHash + ( + KeyHash (..) + , KeyRole (..) + , GovernanceType (..) + , keyHashFromBytes + , keyHashFromText + , keyHashToText + , ErrKeyHashFromText + , prettyErrKeyHashFromText + ) where + +import Prelude + +import Cardano.Address.Derivation + ( credentialHashSize, hashCredential ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode, fromBase16 ) +import Control.DeepSeq + ( NFData ) +import Data.Aeson + ( ToJSON (..), Value (..) ) +import Data.Bifunctor + ( first ) +import Data.ByteString + ( ByteString ) +import Data.Either.Combinators + ( maybeToRight ) +import Data.Text + ( Text ) +import GHC.Generics + ( Generic ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Codec.Binary.Bech32 as Bech32 +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as T + +-- | Determines if one asks for deprecated HRP prefixes, '*_vkh' and '*_script' +-- in accordance to CIP-0105 (on demand when flag 'cip-0105' is used) or uses default format +-- specified in CIP-0129 (where additional byte is prepended to 28-byte hash). +data GovernanceType = NoGovernance | CIP0129 | CIP0105 + deriving (Eq, Show) + +-- | Determines the role a given key plays. The role basically can be mapped into derivation path +-- which was used to derive it from the parent. Also it has a dedicated user facing HRP +-- when presented in bech32 format - see 'keyHashToText' for more details. +-- Take notice that purpose/role (except 'Policy') are as defined below in derivation path: +-- m / purpose' / coin_type' / account_ix' / role / index +-- 'Policy' has a dedicated derivation path as follows: +-- m / purpose' / coin_type' / policy_ix' +-- +-- | KeyRole | purpose | role | CIP | +-- ------------------------------------------------------------------------------------------------------------------------| +-- | PaymentShared | 1854H | 0,1 | [CIP-1854](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1854) | +-- | DelegationShared | 1854H | 2 | [CIP-1854](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1854) | +-- | Payment | 1852H | 0,1 | [CIP-1852](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1852) | +-- | Delegation | 1852H | 2 | [CIP-0011](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0011) | +-- | Representative | 1852H | 3 | [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105) | +-- | CommitteeCold | 1852H | 4 | [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105) | +-- | CommitteeHot | 1852H | 5 | [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105) | +-- | Policy | 1855H | - | [CIP-1855](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1855) | +data KeyRole = + PaymentShared + | DelegationShared + | Payment + | Delegation + | Policy + | Representative + | CommitteeCold + | CommitteeHot + | Unknown + deriving (Generic, Show, Ord, Eq) +instance NFData KeyRole + +-- | A 'KeyHash' type represents verification key hash that participate in building +-- multi-signature script. The hash is expected to have size of 28-byte. +-- +-- @since 3.0.0 +data KeyHash = KeyHash + { role :: KeyRole + , digest :: ByteString } + deriving (Generic, Show, Ord, Eq) +instance NFData KeyHash + +-- | Construct an 'KeyHash' from raw 'ByteString' (28 bytes). +-- +-- @since 3.0.0 +keyHashFromBytes :: (KeyRole, ByteString) -> Maybe KeyHash +keyHashFromBytes (cred, bytes) + | BS.length bytes /= credentialHashSize = Nothing + | otherwise = Just $ KeyHash cred bytes + +-- | Encode a 'KeyHash' to bech32 'Text' or hex is key role unknown. +-- If one wants to include, valid in governance roles only, additional byte +-- as specified in CIP-0129, the function needs to be called with withByte=true. +-- +-- @since 3.0.0 +keyHashToText :: KeyHash -> GovernanceType -> Text +keyHashToText (KeyHash cred keyHash) govType = case cred of + PaymentShared -> + T.decodeUtf8 $ encode (EBech32 CIP5.addr_shared_vkh) keyHash + DelegationShared -> + T.decodeUtf8 $ encode (EBech32 CIP5.stake_shared_vkh) keyHash + Payment -> + T.decodeUtf8 $ encode (EBech32 CIP5.addr_vkh) keyHash + Delegation -> + T.decodeUtf8 $ encode (EBech32 CIP5.stake_vkh) keyHash + Policy -> + T.decodeUtf8 $ encode (EBech32 CIP5.policy_vkh) keyHash + Representative -> case govType of + CIP0105 -> + T.decodeUtf8 $ encode (EBech32 CIP5.drep_vkh) keyHash + _ -> + T.decodeUtf8 $ encode (EBech32 CIP5.drep) $ keyHashAppendByteCIP0129 keyHash cred + CommitteeCold -> case govType of + CIP0105 -> + T.decodeUtf8 $ encode (EBech32 CIP5.cc_cold_vkh) keyHash + _ -> + T.decodeUtf8 $ encode (EBech32 CIP5.cc_cold) $ keyHashAppendByteCIP0129 keyHash cred + CommitteeHot -> case govType of + CIP0105 -> + T.decodeUtf8 $ encode (EBech32 CIP5.cc_hot_vkh) keyHash + _ -> + T.decodeUtf8 $ encode (EBech32 CIP5.cc_hot) $ keyHashAppendByteCIP0129 keyHash cred + Unknown -> + T.decodeUtf8 $ encode EBase16 keyHash + +-- | In accordance to CIP-0129 (https://github.com/cardano-foundation/CIPs/tree/master/CIP-0129) +-- one byte is prepended to vkh only in governance context. The rules how to contruct it are summarized +-- below +-- +-- drep 0010.... +-- hot 0000.... key type +-- cold 0001.... +-- +-- keyhash ....0010 +-- This is on top of X_vkh, where X={drep, cc_hot, cc_hot}, which lacks the additional byte. +-- In `keyHashFromText` we additionally +-- support reading legacy X which also lacks the additional byte, and has the same payload as +-- as the corresponding X_vkh. +keyHashAppendByteCIP0129 :: ByteString -> KeyRole -> ByteString +keyHashAppendByteCIP0129 payload cred = + maybe payload (`BS.cons` payload) bytePrefix + where + bytePrefix = case cred of + Representative -> Just 0b00100010 + CommitteeCold -> Just 0b00010010 + CommitteeHot -> Just 0b00000010 + _ -> Nothing + +-- | Construct a 'KeyHash' from 'Text'. It should be +-- Bech32 encoded text with one of following hrp: + +-- - `addr_shared_vkh` +-- - `stake_shared_vkh` +-- - `addr_vkh` +-- - `stake_vkh` +-- - `policy_vkh` +-- - `drep` +-- - `cc_cold` +-- - `cc_hot` +-- - `drep_vkh` +-- - `cc_cold_vkh` +-- - `cc_hot_vkh` +-- - `addr_shared_vk` +-- - `stake_shared_vk` +-- - `addr_vk` +-- - `stake_vk` +-- - `policy_vk` +-- - `cc_cold_vk` +-- - `cc_hot_vk` +-- - `addr_shared_xvk` +-- - `stake_shared_xvk` +-- - `addr_xvk` +-- - `stake_xvk` +-- - `policy_xvk` +-- - `drep_xvk` +-- - `cc_cold_xvk` +-- - `cc_hot_xvk` + +-- Raw keys will be hashed on the fly, whereas hash that are directly +-- provided will remain as such. +-- If if hex is encountered 'Unknown' policy key is assumed. +-- +-- @since 3.1.0 +keyHashFromText :: Text -> Either ErrKeyHashFromText KeyHash +keyHashFromText txt = + case (fromBase16 $ T.encodeUtf8 txt) of + Right bs -> + if checkBSLength bs 28 then + pure $ KeyHash Unknown bs + else if checkBSLength bs 32 then + pure $ KeyHash Unknown (hashCredential bs) + else if checkBSLength bs 64 then + pure $ KeyHash Unknown (hashCredential $ BS.take 32 bs) + else + Left (ErrKeyHashFromTextInvalidHex $ BS.length bs) + Left _ -> do + (hrp, dp) <- first (const ErrKeyHashFromTextInvalidString) $ + Bech32.decodeLenient txt + + maybeToRight ErrKeyHashFromTextWrongDataPart (Bech32.dataPartToBytes dp) + >>= maybeToRight ErrKeyHashFromTextWrongHrp . convertBytes hrp + >>= maybeToRight ErrKeyHashFromTextWrongPayload . keyHashFromBytes + where + convertBytes hrp bytes + | hrp == CIP5.addr_shared_vkh && checkBSLength bytes 28 = + Just (Payment, bytes) + | hrp == CIP5.stake_shared_vkh && checkBSLength bytes 28 = + Just (Delegation, bytes) + | hrp == CIP5.addr_vkh && checkBSLength bytes 28 = + Just (Payment, bytes) + | hrp == CIP5.stake_vkh && checkBSLength bytes 28 = + Just (Delegation, bytes) + | hrp == CIP5.policy_vkh && checkBSLength bytes 28 = + Just (Policy, bytes) + | hrp == CIP5.drep && checkBSLength bytes 29 = + let (fstByte, payload) = first BS.head $ BS.splitAt 1 bytes + -- drep 0010.... + -- keyhash ....0010 + in if fstByte == 0b00100010 then + Just (Representative, payload) + else + Nothing + | hrp == CIP5.drep && checkBSLength bytes 28 = + Just (Representative, bytes) + | hrp == CIP5.drep_vkh && checkBSLength bytes 28 = + Just (Representative, bytes) + | hrp == CIP5.cc_cold && checkBSLength bytes 29 = + let (fstByte, payload) = first BS.head $ BS.splitAt 1 bytes + -- cold 0001.... + -- keyhash ....0010 + in if fstByte == 0b00010010 then + Just (CommitteeCold, payload) + else + Nothing + | hrp == CIP5.cc_cold && checkBSLength bytes 28 = + Just (CommitteeCold, bytes) + | hrp == CIP5.cc_cold_vkh && checkBSLength bytes 28 = + Just (CommitteeCold, bytes) + | hrp == CIP5.cc_hot && checkBSLength bytes 29 = + let (fstByte, payload) = first BS.head $ BS.splitAt 1 bytes + -- hot 0000.... + -- keyhash ....0010 + in if fstByte == 0b00000010 then + Just (CommitteeHot, payload) + else + Nothing + | hrp == CIP5.cc_hot && checkBSLength bytes 28 = + Just (CommitteeHot, bytes) + | hrp == CIP5.cc_hot_vkh && checkBSLength bytes 28 = + Just (CommitteeHot, bytes) + | hrp == CIP5.addr_shared_vk && checkBSLength bytes 32 = + Just (Payment, hashCredential bytes) + | hrp == CIP5.addr_vk && checkBSLength bytes 32 = + Just (Payment, hashCredential bytes) + | hrp == CIP5.addr_shared_xvk && checkBSLength bytes 64 = + Just (Payment, hashCredential $ BS.take 32 bytes) + | hrp == CIP5.addr_xvk && checkBSLength bytes 64 = + Just (Payment, hashCredential $ BS.take 32 bytes) + | hrp == CIP5.stake_shared_vk && checkBSLength bytes 32 = + Just (Delegation, hashCredential bytes) + | hrp == CIP5.stake_vk && checkBSLength bytes 32 = + Just (Delegation, hashCredential bytes) + | hrp == CIP5.stake_shared_xvk && checkBSLength bytes 64 = + Just (Delegation, hashCredential $ BS.take 32 bytes) + | hrp == CIP5.stake_xvk && checkBSLength bytes 64 = + Just (Delegation, hashCredential $ BS.take 32 bytes) + | hrp == CIP5.policy_vk && checkBSLength bytes 32 = + Just (Policy, hashCredential bytes) + | hrp == CIP5.policy_xvk && checkBSLength bytes 64 = + Just (Policy, hashCredential $ BS.take 32 bytes) + | hrp == CIP5.drep_vk && checkBSLength bytes 32 = + Just (Representative, hashCredential bytes) + | hrp == CIP5.drep_xvk && checkBSLength bytes 64 = + Just (Representative, hashCredential $ BS.take 32 bytes) + | hrp == CIP5.cc_cold_vk && checkBSLength bytes 32 = + Just (CommitteeCold, hashCredential bytes) + | hrp == CIP5.cc_cold_xvk && checkBSLength bytes 64 = + Just (CommitteeCold, hashCredential $ BS.take 32 bytes) + | hrp == CIP5.cc_hot_vk && checkBSLength bytes 32 = + Just (CommitteeHot, hashCredential bytes) + | hrp == CIP5.cc_hot_xvk && checkBSLength bytes 64 = + Just (CommitteeHot, hashCredential $ BS.take 32 bytes) + | otherwise = Nothing + checkBSLength :: ByteString -> Int -> Bool + checkBSLength bytes expLength = + BS.length bytes == expLength + +-- Possible errors when deserializing a key hash from text. +-- +-- @since 3.0.0 +data ErrKeyHashFromText + = ErrKeyHashFromTextInvalidString + | ErrKeyHashFromTextWrongPayload + | ErrKeyHashFromTextWrongHrp + | ErrKeyHashFromTextWrongDataPart + | ErrKeyHashFromTextInvalidHex Int + deriving (Show, Eq) + +-- Possible errors when deserializing a key hash from text. +-- +-- @since 3.0.0 +prettyErrKeyHashFromText :: ErrKeyHashFromText -> String +prettyErrKeyHashFromText = \case + ErrKeyHashFromTextInvalidString -> + "Invalid encoded string: must be either bech32 or hex-encoded." + ErrKeyHashFromTextWrongPayload -> + "Verification key hash must contain exactly 28 bytes." + ErrKeyHashFromTextWrongHrp -> + "Invalid human-readable prefix: must be 'X_vkh', 'X_vk', 'X_xvk' where X is 'addr_shared', 'stake_shared' or 'policy'." + ErrKeyHashFromTextWrongDataPart -> + "Verification key hash is Bech32-encoded but has an invalid data part." + ErrKeyHashFromTextInvalidHex size-> + "Invalid hex-encoded string: must be either 28, 32 or 64 bytes, but has " <> show size <> " bytes." + +instance ToJSON KeyHash where + toJSON = String . flip keyHashToText CIP0129 diff --git a/lib/Cardano/Address/Script.hs b/lib/Cardano/Address/Script.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/Script.hs @@ -0,0 +1,853 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address.Script + ( + -- * Script + Script (..) + , serializeScript + , foldScript + + -- * Script template + , ScriptTemplate (..) + , Cosigner (..) + , cosignerToText + + -- * Validation + , ValidationLevel (..) + , ErrValidateScript (..) + , ErrRecommendedValidateScript (..) + , ErrValidateScriptTemplate (..) + , validateScript + , validateScriptTemplate + , validateScriptOfTemplate + , prettyErrValidateScript + , prettyErrValidateScriptTemplate + + -- * Hashing + , ScriptHash (..) + , toScriptHash + , scriptHashFromBytes + , scriptHashToText + , scriptHashFromText + , prettyErrScriptHashFromText + + ) where + +import Prelude + +import Cardano.Address.Derivation + ( XPub, credentialHashSize, hashCredential, xpubFromBytes, xpubToBytes ) +import Cardano.Address.KeyHash + ( GovernanceType (..) + , KeyHash (..) + , KeyRole (..) + , keyHashFromText + , prettyErrKeyHashFromText + ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode, fromBase16 ) +import Control.Applicative + ( (<|>) ) +import Control.DeepSeq + ( NFData ) +import Control.Monad + ( foldM, unless, when ) +import Data.Aeson + ( FromJSON (..) + , ToJSON (..) + , Value (..) + , object + , withObject + , withText + , (.:) + , (.:?) + , (.=) + ) +import Data.Aeson.Key + ( fromText, toText ) +import Data.Aeson.Types + ( Parser ) +import Data.Bifunctor + ( first ) +import Data.ByteString + ( ByteString ) +import Data.Either.Combinators + ( maybeToRight ) +import Data.Foldable + ( asum, foldl', traverse_ ) +import Data.Functor.Identity + ( Identity (..) ) +import Data.Hashable + ( Hashable ) +import Data.Kind + ( Type ) +import Data.Map.Strict + ( Map ) +import Data.Text + ( Text ) +import Data.Traversable + ( for ) +import Data.Word + ( Word8 ) +import GHC.Generics + ( Generic ) +import Numeric.Natural + ( Natural ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Cardano.Codec.Cbor as CBOR +import qualified Codec.Binary.Bech32 as Bech32 +import qualified Codec.CBOR.Encoding as CBOR +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.Aeson.Types as Json +import qualified Data.ByteString as BS +import qualified Data.HashSet as Set +import qualified Data.List as L +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Read as T + +-- | A 'Script' type represents multi signature script. The script embodies conditions +-- that need to be satisfied to make it valid. +-- +-- @since 3.0.0 +data Script (elem :: Type) + = RequireSignatureOf !elem + | RequireAllOf ![Script elem] + | RequireAnyOf ![Script elem] + | RequireSomeOf Word8 ![Script elem] + | ActiveFromSlot Natural + | ActiveUntilSlot Natural + deriving stock (Generic, Show, Eq) +instance NFData elem => NFData (Script elem) + +-- | This function realizes what cardano-node's `Api.serialiseToCBOR script` realizes +-- This is basically doing the symbolically following: +-- toCBOR [0,multisigScript] +-- +-- @since 3.0.0 +serializeScript :: Script KeyHash -> ByteString +serializeScript script = + multisigTag <> CBOR.toStrictByteString (toCBOR script) + where + -- | Magic number representing the tag of the native multi-signature script + -- language. For each script language included, a new tag is chosen. + multisigTag :: ByteString + multisigTag = "\00" + + toCBOR :: Script KeyHash -> CBOR.Encoding + toCBOR = \case + RequireSignatureOf (KeyHash _ verKeyHash) -> + encodeMultiscriptCtr 0 2 <> CBOR.encodeBytes verKeyHash + RequireAllOf contents -> + encodeMultiscriptCtr 1 2 <> encodeFoldable toCBOR contents + RequireAnyOf contents -> + encodeMultiscriptCtr 2 2 <> encodeFoldable toCBOR contents + RequireSomeOf m contents -> mconcat + [ encodeMultiscriptCtr 3 3 + , CBOR.encodeInt (fromInteger $ toInteger m) + , encodeFoldable toCBOR contents + ] + ActiveFromSlot slotNum -> + encodeMultiscriptCtr 4 2 <> CBOR.encodeWord64 (fromInteger $ toInteger slotNum) + ActiveUntilSlot slotNum -> + encodeMultiscriptCtr 5 2 <> CBOR.encodeWord64 (fromInteger $ toInteger slotNum) + + encodeMultiscriptCtr :: Word -> Word -> CBOR.Encoding + encodeMultiscriptCtr ctrIndex listLen = + CBOR.encodeListLen listLen <> CBOR.encodeWord ctrIndex + + encodeFoldable :: (Foldable f) => (a -> CBOR.Encoding) -> f a -> CBOR.Encoding + encodeFoldable encode' xs = wrapArray len contents + where + (len, contents) = foldl' go (0, mempty) xs + go (!l, !enc) next = (l + 1, enc <> encode' next) + + wrapArray :: Word -> CBOR.Encoding -> CBOR.Encoding + wrapArray len' contents' + | len' <= 23 = CBOR.encodeListLen len' <> contents' + | otherwise = CBOR.encodeListLenIndef <> contents' <> CBOR.encodeBreak + +-- | Represents the cosigner of the script, ie., party that co-shares the script. +-- +-- @since 3.2.0 +newtype Cosigner = Cosigner Word8 + deriving (Generic, Ord, Eq) +instance Hashable Cosigner +instance NFData Cosigner + +instance Show Cosigner where + show = T.unpack . cosignerToText + +-- | Represents the script template that show the structure of the script and determines +-- the expected place of verification keys corresponding to given cosigners. +-- +-- @since 3.2.0 +data ScriptTemplate = ScriptTemplate + { cosigners :: Map Cosigner XPub + , template :: Script Cosigner + } deriving (Generic, Show, Eq) +instance NFData ScriptTemplate + +-- | Computes the hash of a given script, by first serializing it to CBOR. +-- +-- @since 3.0.0 +toScriptHash :: Script KeyHash -> ScriptHash +toScriptHash = ScriptHash . hashCredential . serializeScript + +-- | A 'ScriptHash' type represents script hash. The hash is expected to have size of +-- 28-byte. +-- +-- @since 3.0.0 +newtype ScriptHash = ScriptHash { unScriptHash :: ByteString } + deriving (Generic, Show, Ord, Eq) +instance NFData ScriptHash + +-- | Construct an 'ScriptHash' from raw 'ByteString' (28 bytes). +-- +-- @since 3.0.0 +scriptHashFromBytes :: ByteString -> Maybe ScriptHash +scriptHashFromBytes bytes + | BS.length bytes /= credentialHashSize = Nothing + | otherwise = Just $ ScriptHash bytes + +-- | Encode a 'ScriptHash' to bech32 'Text' or hex if key role is unknown. +-- In the case of governance role, if one wants to include additional byte +-- as specified in [CIP-0129](https://github.com/cardano-foundation/CIPs/blob/master/CIP-0129/README.md) +-- unless the function is called with CIP0105. +-- +-- One byte is prepended to script hash only in governance context. The rules how to contruct it are summarized +-- below +-- +-- drep 0010.... +-- hot 0000.... key type +-- cold 0001.... +-- +-- scripthash ....0011 credential type +-- +-- This is on top of X_script, where X={drep, cc_hot, cc_hot}, which lacks the additional byte. +-- In `scriptHashFromText` we additionally +-- support reading legacy X which also lacks the additional byte, and has the same payload as +-- as the corresponding X_script. +-- +-- @since 4.0.0 +scriptHashToText :: ScriptHash -> KeyRole -> Maybe GovernanceType -> Text +scriptHashToText (ScriptHash scriptHash) cred govType = case cred of + Representative -> case govType of + Just CIP0105 -> + T.decodeUtf8 $ encode (EBech32 CIP5.drep_script) scriptHash + _ -> + T.decodeUtf8 $ encode (EBech32 CIP5.drep) $ appendByte scriptHash + CommitteeCold -> case govType of + Just CIP0105 -> + T.decodeUtf8 $ encode (EBech32 CIP5.cc_cold_script) scriptHash + _ -> + T.decodeUtf8 $ encode (EBech32 CIP5.cc_cold) $ appendByte scriptHash + CommitteeHot -> case govType of + Just CIP0105 -> + T.decodeUtf8 $ encode (EBech32 CIP5.cc_hot_script) scriptHash + _ -> + T.decodeUtf8 $ encode (EBech32 CIP5.cc_hot) $ appendByte scriptHash + Unknown -> + T.decodeUtf8 $ encode EBase16 scriptHash + _ -> + T.decodeUtf8 $ encode (EBech32 CIP5.script) scriptHash + where + appendByte payload = maybe payload (`BS.cons` payload) bytePrefix + bytePrefix = case cred of + Representative -> Just 0b00100011 + CommitteeCold -> Just 0b00010011 + CommitteeHot -> Just 0b00000011 + _ -> Nothing + +-- | Construct a 'ScriptHash' from 'Text'. It should be +-- Bech32 encoded text with one of following hrp: +-- - `script` +-- - `drep` +-- - `cc_cold` +-- - `cc_hot` +-- - `drep_script` +-- - `cc_cold_script` +-- - `cc_hot_script` +-- If if hex is encountered it is converted in rawly fashion +-- +-- @since 4.0.0 +scriptHashFromText :: Text -> Either ErrScriptHashFromText ScriptHash +scriptHashFromText txt = + case (fromBase16 $ T.encodeUtf8 txt) of + Right bs -> + if checkBSLength bs 28 then + pure $ ScriptHash bs + else + Left ErrScriptHashFromTextInvalidHex + Left _ -> do + (hrp, dp) <- first (const ErrScriptHashFromTextInvalidString) $ + Bech32.decodeLenient txt + + maybeToRight ErrScriptHashFromTextWrongDataPart (Bech32.dataPartToBytes dp) + >>= maybeToRight ErrScriptHashFromTextWrongHrp . convertBytes hrp + >>= maybeToRight ErrScriptHashFromTextWrongPayload . scriptHashFromBytes + where + convertBytes hrp bytes + | hrp == CIP5.drep && checkBSLength bytes 29 = + let (fstByte, payload) = first BS.head $ BS.splitAt 1 bytes + -- drep 0010.... + -- scripthash ....0011 + in if fstByte == 0b00100011 then + Just payload + else + Nothing + | hrp == CIP5.drep_script && checkBSLength bytes 28 = + Just bytes + | hrp == CIP5.cc_cold && checkBSLength bytes 29 = + let (fstByte, payload) = first BS.head $ BS.splitAt 1 bytes + -- cold 0001.... + -- scripthash ....0011 + in if fstByte == 0b00010011 then + Just payload + else + Nothing + | hrp == CIP5.cc_cold_script && checkBSLength bytes 28 = + Just bytes + | hrp == CIP5.cc_hot && checkBSLength bytes 29 = + let (fstByte, payload) = first BS.head $ BS.splitAt 1 bytes + -- hot 0000.... + -- scripthash ....0011 + in if fstByte == 0b00000011 then + Just payload + else + Nothing + | hrp == CIP5.cc_hot_script && checkBSLength bytes 28 = + Just bytes + | hrp == CIP5.script && checkBSLength bytes 28 = + Just bytes + | otherwise = Nothing + checkBSLength :: ByteString -> Int -> Bool + checkBSLength bytes expLength = + BS.length bytes == expLength + +-- Validation level. Required level does basic check that will make sure the script +-- is accepted in ledger. Recommended level collects a number of checks that will +-- warn about dangerous, unwise and redundant things present in the script. +-- +-- @since 3.2.0 +data ValidationLevel = RequiredValidation | RecommendedValidation + deriving (Show, Eq, Generic) +instance NFData ValidationLevel + +-- Possible errors when deserializing a script hash from text. +-- +-- @since 4.0.0 +data ErrScriptHashFromText + = ErrScriptHashFromTextInvalidString + | ErrScriptHashFromTextWrongPayload + | ErrScriptHashFromTextWrongHrp + | ErrScriptHashFromTextWrongDataPart + | ErrScriptHashFromTextInvalidHex + deriving (Show, Eq) + +-- Possible errors when deserializing a script hash from text. +-- +-- @since 4.0.0 +prettyErrScriptHashFromText :: ErrScriptHashFromText -> String +prettyErrScriptHashFromText = \case + ErrScriptHashFromTextInvalidString -> + "Invalid encoded string: must be either bech32 or hex-encoded." + ErrScriptHashFromTextWrongPayload -> + "Script hash must contain exactly 28-byte payload and one specific prepended byte." + ErrScriptHashFromTextWrongHrp -> + "Invalid human-readable prefix: must be 'drep', 'cc_hot' or 'cc_cold'." + ErrScriptHashFromTextWrongDataPart -> + "Script hash is Bech32-encoded but has an invalid data part." + ErrScriptHashFromTextInvalidHex -> + "Invalid hex-encoded string: must be 28 bytes." + +-- +-- Script folding +-- + +-- | 'Script' folding +-- +-- @since 3.2.0 +foldScript :: (a -> b -> b) -> b -> Script a -> b +foldScript fn zero = \case + RequireSignatureOf k -> fn k zero + RequireAllOf xs -> foldMScripts xs + RequireAnyOf xs -> foldMScripts xs + RequireSomeOf _ xs -> foldMScripts xs + ActiveFromSlot _ -> zero + ActiveUntilSlot _ -> zero + where + foldMScripts = + runIdentity . foldM (\acc -> Identity . foldScript fn acc) zero + +-- +-- Script validation +-- + +-- | Validate a 'Script', semantically +-- +-- @since 3.0.0 +validateScript + :: ValidationLevel + -> Script KeyHash + -> Either ErrValidateScript () +validateScript level script = do + let validateKeyHash (KeyHash _ bytes) = + (BS.length bytes == credentialHashSize) + let allSigs = foldScript (:) [] script + unless (L.all validateKeyHash allSigs) $ Left WrongKeyHash + + when (L.length (L.nub $ map role allSigs) > 1) $ + Left NotUniformKeyType + + requiredValidation script + + when (level == RecommendedValidation) $ + first NotRecommended (recommendedValidation script) + +requiredValidation + :: Script elem + -> Either ErrValidateScript () +requiredValidation script = + unless (check script) $ Left LedgerIncompatible + where + check = \case + RequireSignatureOf _ -> True + + RequireAllOf xs -> + L.all check xs + + RequireAnyOf xs -> + L.any check xs + + RequireSomeOf m xs -> + m <= sum (fmap (\x -> if check x then 1 else 0) xs) + + ActiveFromSlot _ -> True + + ActiveUntilSlot _ -> True + +recommendedValidation + :: Eq elem + => Script elem + -> Either ErrRecommendedValidateScript () +recommendedValidation = \case + RequireSignatureOf _ -> pure () + + RequireAllOf script -> do + when (L.null (omitTimelocks script)) $ Left EmptyList + when (hasDuplicate script) $ Left DuplicateSignatures + when (redundantTimelocks script) $ Left RedundantTimelocks + when (timelockTrap script) $ Left TimelockTrap + traverse_ recommendedValidation script + + RequireAnyOf script -> do + when (hasDuplicate script) $ Left DuplicateSignatures + when (redundantTimelocks script) $ Left RedundantTimelocks + when (redundantTimelocksInAny script) $ Left RedundantTimelocks + traverse_ recommendedValidation script + + RequireSomeOf m script -> do + when (m == 0) $ Left MZero + when (length (omitTimelocks script) < fromIntegral m) $ Left ListTooSmall + when (hasDuplicate script) $ Left DuplicateSignatures + when (redundantTimelocks script) $ Left RedundantTimelocks + traverse_ recommendedValidation script + + ActiveFromSlot _ -> pure () + + ActiveUntilSlot _ -> pure () + where + hasDuplicate xs = + length sigs /= length (L.nub sigs) + where + sigs = [ sig | RequireSignatureOf sig <- xs ] + hasTimelocks = \case + ActiveFromSlot _ -> True + ActiveUntilSlot _ -> True + _ -> False + redundantTimelocks xs = case L.filter hasTimelocks xs of + [] -> False + [_] -> False + [_, _] -> False + _ -> True + -- situation where any [active_until slot1, active_from slot2] + -- (a) acceptable when slot1 < slot2 as either it is satisfied + -- (0, slot1) or False + [_] -> False + [ActiveFromSlot s1, ActiveUntilSlot s2] -> s2 >= s1 + [ActiveUntilSlot s2, ActiveFromSlot s1] -> s2 >= s1 + _ -> True + -- situation where all [active_until slot1, active_from slot2] + -- (a) trap when slot1 < slot2 as both can never be satisfied + -- (0, slot1) + -- (slot2, +inf) + -- (b) acceptable when slot1 == slot2 + -- then all satisfied at slot1 + -- (c) acceptable when slot1 >= slot2 + -- then all satisfied at s2 < s1 + [ActiveUntilSlot s2, ActiveFromSlot s1] -> s2 < s1 + _ -> False + omitTimelocks = filter (not . hasTimelocks) +-- +-- ScriptTemplate validation +-- + +-- | Validate a 'ScriptTemplate', semantically +-- +-- @since 3.2.0 +validateScriptTemplate + :: ValidationLevel + -> ScriptTemplate + -> Either ErrValidateScriptTemplate () +validateScriptTemplate level (ScriptTemplate cosigners_ script) = do + first WrongScript (validateScriptOfTemplate level script) + check NoCosignerInScript (nonEmpty scriptCosigners) + check NoCosignerXPub (nonEmpty cosignerKeys) + check DuplicateXPubs (Set.size cosignerKeys == Map.size cosigners_) + check UnknownCosigner (cosignerSet `Set.isSubsetOf` scriptCosigners) + check MissingCosignerXPub (scriptCosigners `Set.isSubsetOf` cosignerSet) + where + scriptCosigners = Set.fromList $ foldScript (:) [] script + cosignerKeys = Set.fromList $ Map.elems cosigners_ + cosignerSet = Set.fromList $ Map.keys cosigners_ + + -- throws error if condition doesn't apply + check err cond = unless cond (Left err) + nonEmpty = not . Set.null + +-- | Validate a script in 'ScriptTemplate' +-- +-- @since 3.5.0 +validateScriptOfTemplate + :: ValidationLevel + -> Script Cosigner + -> Either ErrValidateScript () +validateScriptOfTemplate level script = do + requiredValidation script + when (level == RecommendedValidation ) $ + first NotRecommended (recommendedValidation script) + +-- | Possible validation errors when validating a script +-- +-- @since 3.0.0 +data ErrValidateScript + = LedgerIncompatible + | WrongKeyHash + | NotUniformKeyType + | Malformed + | NotRecommended ErrRecommendedValidateScript + deriving (Eq, Show) + +-- | Possible recommended validation errors when validating a script +-- +-- @since 3.2.0 +data ErrRecommendedValidateScript + = EmptyList + | ListTooSmall + | MZero + | DuplicateSignatures + | RedundantTimelocks + | TimelockTrap + deriving (Eq, Show) + +-- | Possible validation errors when validating a script template +-- +-- @since 3.2.0 +data ErrValidateScriptTemplate + = WrongScript ErrValidateScript + | DuplicateXPubs + | UnknownCosigner + | MissingCosignerXPub + | NoCosignerInScript + | NoCosignerXPub + deriving (Eq, Show) + +-- | Pretty-print a script validation error. +-- +-- @since 3.0.0 +prettyErrValidateScript + :: ErrValidateScript + -> String +prettyErrValidateScript = \case + LedgerIncompatible -> + "The script is ill-formed and is not going to be accepted by the ledger." + WrongKeyHash -> + "The hash of verification key is expected to have " + <> show credentialHashSize <> " bytes." + NotUniformKeyType -> + "All keys of a script must have the same role: payment, delegation, policy, \ + \representative, committee cold or committee hot." + Malformed -> + "Parsing of the script failed. The script should be composed of nested \ + \lists, the verification keys should be bech32-encoded with prefix \ + \'X_vkh', 'X_vk', 'X_xvk' where X is 'addr_shared', 'stake_shared', 'policy', \ + \'drep', 'cc_cold' or 'cc_hot' and timelocks must use non-negative \ + \numbers as slots." + NotRecommended EmptyList -> + "The list inside a script is empty or only contains timelocks \ + \(which is not recommended)." + NotRecommended MZero -> + "At least's coefficient is 0 (which is not recommended)." + NotRecommended ListTooSmall -> + "At least's coefficient is larger than the number of non-timelock \ + \elements in the list (which is not recommended)." + NotRecommended DuplicateSignatures -> + "The list inside a script has duplicate keys (which is not recommended)." + NotRecommended RedundantTimelocks -> + "Some timelocks used are redundant (which is not recommended)." + NotRecommended TimelockTrap -> + "The timelocks used are contradictory when used with 'all' (which is not recommended)." + +-- | Pretty-print a script template validation error. +-- +-- @since 3.2.0 +prettyErrValidateScriptTemplate + :: ErrValidateScriptTemplate + -> String +prettyErrValidateScriptTemplate = \case + WrongScript err -> prettyErrValidateScript err + DuplicateXPubs -> + "The cosigners in a script template must stand behind an unique extended public key." + MissingCosignerXPub -> + "Each cosigner in a script template must have an extended public key." + NoCosignerInScript -> + "The script of a template must have at least one cosigner defined." + NoCosignerXPub -> + "The script template must have at least one cosigner with an extended public key." + UnknownCosigner -> + "The specified cosigner must be present in the script of the template." +-- +-- Internal +-- + +-- Examples of Script jsons: +--"addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" +--"stake_shared_vkh1nqc00hvlc6cq0sfhretk0rmzw8dywmusp8retuqnnxzajtzhjg5" +--{ "all" : [ "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" +-- , "addr_shared_vkh1y3zl4nqgm96ankt96dsdhc86vd5geny0wr7hu8cpzdfcqskq2cp" +-- ] +--} +--{ "all" : [ "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" +-- , {"any": [ "addr_shared_vkh1y3zl4nqgm96ankt96dsdhc86vd5geny0wr7hu8cpzdfcqskq2cp" +-- , "addr_shared_vkh175wsm9ckhm3snwcsn72543yguxeuqm7v9r6kl6gx57h8gdydcd9" +-- ] +-- } +-- ] +--} +--{ "all" : [ "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" +-- , {"some": { "from" :[ "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" +-- , "addr_shared_vkh1y3zl4nqgm96ankt96dsdhc86vd5geny0wr7hu8cpzdfcqskq2cp" +-- , "addr_shared_vkh175wsm9ckhm3snwcsn72543yguxeuqm7v9r6kl6gx57h8gdydcd9" +-- ] +-- , "at_least" : 2 +-- } +-- } +-- ] +--} +--{ "all" : [ "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" +-- , {"active_from": 120 } +-- ] +--} +--{ "all" : [ "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" +-- , any [{"active_until": 100 }, {"active_from": 120 }] +-- ] +--} + +instance ToJSON elem => ToJSON (Script elem) where + toJSON (RequireSignatureOf content) = toJSON content + toJSON (RequireAllOf content) = + object ["all" .= fmap toJSON content] + toJSON (RequireAnyOf content) = + object ["any" .= fmap toJSON content] + toJSON (RequireSomeOf count scripts) = + object ["some" .= object ["at_least" .= count, "from" .= scripts]] + toJSON (ActiveFromSlot slot) = + object ["active_from" .= slot] + toJSON (ActiveUntilSlot slot) = + object ["active_until" .= slot] + +instance FromJSON (Script KeyHash) where + parseJSON v = + fromScriptJson parseKey backtrack v + where + parseKey = withText "Script KeyHash" $ + either + (fail . prettyErrKeyHashFromText) + (pure . RequireSignatureOf) + . keyHashFromText + + -- NOTE: Because we use an alternative sum to define all parsers, in + -- case all parser fails, only the last error is returned which can be + -- very misleading. For example, sending {"any": []} yields an error + -- telling us that the key `"some"` is missing. + -- + -- To cope with this, we add a last parser 'backtrack' which always + -- fail but with a more helpful error which tries its best at + -- identifying the right constructor. + backtrack = \case + Object o -> do + mAny <- o .:? "any" :: Parser (Maybe Value) + mAll <- o .:? "all" :: Parser (Maybe Value) + mSome <- o .:? "some" :: Parser (Maybe Value) + case (mAny, mAll, mSome) of + (Just{}, Nothing, Nothing) -> parseAnyOf v + (Nothing, Just{}, Nothing) -> parseAllOf v + (Nothing, Nothing, Just{}) -> parseAtLeast v + (Nothing, Nothing, Nothing) -> fail + "Found object with unknown key. Expecting 'any', 'all' or 'some'" + ( _, _, _) -> fail + "Found multiple keys 'any', 'all' and/or 'some' at the same level" + String{} -> + parseKey v + _ -> + Json.typeMismatch "Object or String" v + +fromScriptJson + :: FromJSON (Script elem) + => (Value -> Parser (Script elem)) + -> (Value -> Parser (Script elem)) + -> Value + -> Parser (Script elem) +fromScriptJson parseElem backtrack v = + asum + [ parseElem v + , parseAnyOf v + , parseAllOf v + , parseAtLeast v + , parseActiveFrom v + , parseActiveUntil v + ] <|> backtrack v + +parseAnyOf + :: FromJSON (Script elem) + => Value + -> Parser (Script elem) +parseAnyOf = withObject "Script AnyOf" $ \o -> + RequireAnyOf <$> o .: "any" + +parseAllOf + :: FromJSON (Script elem) + => Value + -> Parser (Script elem) +parseAllOf = withObject "Script AllOf" $ \o -> + RequireAllOf <$> o .: "all" + +parseAtLeast + :: FromJSON (Script elem) + => Value + -> Parser (Script elem) +parseAtLeast = withObject "Script SomeOf" $ \o -> do + some <- o .: "some" + RequireSomeOf <$> some .: "at_least" <*> some .: "from" + +parseActiveFrom + :: Value + -> Parser (Script elem) +parseActiveFrom = withObject "Script ActiveFrom" $ \o -> + ActiveFromSlot <$> o .: "active_from" + +parseActiveUntil + :: Value + -> Parser (Script elem) +parseActiveUntil = withObject "Script ActiveUntil" $ \o -> + ActiveUntilSlot <$> o .: "active_until" + +cosignerToText :: Cosigner -> Text +cosignerToText (Cosigner ix) = "cosigner#"<> T.pack (show ix) + +instance ToJSON Cosigner where + toJSON = String . cosignerToText + +instance FromJSON Cosigner where + parseJSON = withText "Cosigner" $ \txt -> case T.splitOn "cosigner#" txt of + ["",numTxt] -> case T.decimal numTxt of + Right (num,"") -> do + when (num < minBound @Word8 || num > maxBound @Word8) $ + fail "Cosigner number should be between '0' and '255'" + pure $ Cosigner num + _ -> fail "Cosigner should be enumerated with number" + _ -> fail "Cosigner should be of the form: cosigner#num" + +encodeXPub :: XPub -> Value +encodeXPub = String . T.decodeUtf8 . encode EBase16 . xpubToBytes + +parseXPub :: Value -> Parser XPub +parseXPub = withText "XPub" $ \txt -> + case fromBase16 (T.encodeUtf8 txt) of + Left err -> fail err + Right hex -> case xpubFromBytes hex of + Nothing -> fail "Extended public key cannot be retrieved from a given hex bytestring" + Just validXPub -> pure validXPub + +instance ToJSON ScriptTemplate where + toJSON (ScriptTemplate cosigners' template') = + object [ "cosigners" .= object (fmap (first fromText . toPair) (Map.toList cosigners')) + , "template" .= toJSON template'] + where + toPair (cosigner', xpub) = + ( cosignerToText cosigner' + , encodeXPub xpub ) + +instance FromJSON (Script Cosigner) where + parseJSON v = fromScriptJson parserCosigner backtrack v + where + parserCosigner o = do + cosigner <- parseJSON @Cosigner o + pure $ RequireSignatureOf cosigner + backtrack = \case + Object o -> do + mAny <- o .:? "any" :: Parser (Maybe Value) + mAll <- o .:? "all" :: Parser (Maybe Value) + mSome <- o .:? "some" :: Parser (Maybe Value) + mCos <- o .:? "cosigner" :: Parser (Maybe Value) + case (mAny, mAll, mSome, mCos) of + (Just{}, Nothing, Nothing, Nothing) -> parseAnyOf v + (Nothing, Just{}, Nothing, Nothing) -> parseAllOf v + (Nothing, Nothing, Just{}, Nothing) -> parseAtLeast v + (Nothing, Nothing, Nothing, Just{}) -> parserCosigner v + (Nothing, Nothing, Nothing, Nothing) -> fail + "Found object with unknown key. Expecting 'any', 'all', 'some' or 'cosigner'" + ( _, _, _, _) -> fail + "Found multiple keys 'any', 'all', 'cosigner' and/or 'some' at the same level" + _ -> + Json.typeMismatch "Object only" v + +instance FromJSON ScriptTemplate where + parseJSON = withObject "ScriptTemplate" $ \o -> do + template' <- parseJSON <$> o .: "template" + cosigners' <- parseCosignerPairs <$> o .: "cosigners" + ScriptTemplate . Map.fromList <$> cosigners' <*> template' + where + parseCosignerPairs = withObject "Cosigner pairs" $ \o -> + case KeyMap.toList o of + [] -> fail "Cosigners object array should not be empty" + cs -> for (reverse cs) $ \(numTxt, str) -> do + cosigner' <- parseJSON @Cosigner (String (toText numTxt)) + xpub <- parseXPub str + pure (cosigner', xpub) diff --git a/lib/Cardano/Address/Script/Parser.hs b/lib/Cardano/Address/Script/Parser.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/Script/Parser.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address.Script.Parser + ( + -- ** Script Parser + scriptFromString + , scriptToText + , scriptParser + + -- Internal + , requireSignatureOfParser + , requireAllOfParser + , requireAnyOfParser + , requireAtLeastOfParser + , requireCosignerOfParser + ) where + +import Prelude + +import Cardano.Address.KeyHash + ( KeyHash, keyHashFromText, prettyErrKeyHashFromText ) +import Cardano.Address.Script + ( Cosigner (..), ErrValidateScript (..), Script (..) ) +import Data.Char + ( isDigit, isLetter ) +import Data.Text + ( Text ) +import Data.Word + ( Word8 ) +import Numeric.Natural + ( Natural ) +import Text.ParserCombinators.ReadP + ( ReadP, readP_to_S, (<++) ) + +import qualified Data.Text as T +import qualified Text.ParserCombinators.ReadP as P + +-- | Run 'scriptParser' on string input. +-- +-- @since 3.0.0 +scriptFromString + :: ReadP (Script a) + -> String + -> Either ErrValidateScript (Script a) +scriptFromString parser str = + case readP_to_S (scriptParser parser) str of + [(script, "")] -> pure script + _ -> Left Malformed + +-- | Defines canonical string output for script that is +-- consistent with 'scriptFromString'. +-- +-- @since 3.10.0 +scriptToText + :: Show a + => Script a + -> Text +scriptToText (RequireSignatureOf object) = T.pack $ show object +scriptToText (RequireAllOf contents) = + "all [" <> T.intercalate "," (map scriptToText contents) <> "]" +scriptToText (RequireAnyOf contents) = + "any [" <> T.intercalate "," (map scriptToText contents) <> "]" +scriptToText (RequireSomeOf m contents) = + "at_least "<> T.pack (show m) <> + " [" <> T.intercalate "," (map scriptToText contents) <> "]" +scriptToText (ActiveFromSlot s) = + "active_from " <> T.pack (show s) +scriptToText (ActiveUntilSlot s) = + "active_until " <> T.pack (show s) + + +-- | The script embodies combination of signing keys that need to be met to make +-- it valid. We assume here that the script could +-- delivered from standard input. The examples below are self-explanatory: +-- +-- 1. requiring signature +-- 3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3fe +-- +-- 2. 'any' for signature required +-- any [3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3fe, 3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3f1] +-- +-- 3. 'all' signatures required +-- all [3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3fe, 3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3f1] +-- +-- 4. 'at_least' 1 signature required +-- at_least 1 [3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3fe, 3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3f1] +-- +-- 5. Nested script are supported +-- at_least 1 [3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3fe, all [3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3f1, 3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3f1]] +-- 6. 1 signature required after slot number 120 +-- all [3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3fe, active_from 120] +-- 7. 1 signature required until slot number 150 +-- all [3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3fe, active_until 150] +-- 8. 1 signature required in slot interval <145, 150) +-- all [3c07030e36bfffe67e2e2ec09e5293d384637cd2f004356ef320f3fe, active_from 145, active_until 150] +-- +-- Parser is insensitive to whitespaces. +-- +-- @since 3.0.0 +scriptParser :: ReadP (Script a) -> ReadP (Script a) +scriptParser parser = + requireAllOfParser parser <++ + requireAnyOfParser parser <++ + requireAtLeastOfParser parser <++ + parser <++ + activeFromSlotParser <++ + activeUntilSlotParser + +requireSignatureOfParser :: ReadP (Script KeyHash) +requireSignatureOfParser = do + P.skipSpaces + verKeyStr <- P.munch1 (\c -> isDigit c || isLetter c || c == '_') + case keyHashFromText (T.pack verKeyStr) of + Left e -> fail (prettyErrKeyHashFromText e) + Right h -> pure (RequireSignatureOf h) + +requireCosignerOfParser :: ReadP (Script Cosigner) +requireCosignerOfParser = do + P.skipSpaces + _identifier <- P.string "cosigner#" + cosignerid <- fromInteger . read <$> P.munch1 isDigit + pure $ RequireSignatureOf $ Cosigner cosignerid + +requireAllOfParser :: ReadP (Script a) -> ReadP (Script a) +requireAllOfParser parser = do + P.skipSpaces + _identifier <- P.string "all" + RequireAllOf <$> commonPart parser + +requireAnyOfParser :: ReadP (Script a) -> ReadP (Script a) +requireAnyOfParser parser = do + P.skipSpaces + _identifier <- P.string "any" + RequireAnyOf <$> commonPart parser + +requireAtLeastOfParser :: ReadP (Script a) -> ReadP (Script a) +requireAtLeastOfParser parser = do + P.skipSpaces + _identifier <- P.string "at_least" + RequireSomeOf <$> naturalParser <*> commonPart parser + +activeFromSlotParser :: ReadP (Script a) +activeFromSlotParser = do + P.skipSpaces + _identifier <- P.string "active_from" + ActiveFromSlot <$> slotParser + +activeUntilSlotParser :: ReadP (Script a) +activeUntilSlotParser = do + P.skipSpaces + _identifier <- P.string "active_until" + ActiveUntilSlot <$> slotParser + +naturalParser :: ReadP Word8 +naturalParser = do + P.skipSpaces + fromInteger . read <$> P.munch1 isDigit + +slotParser :: ReadP Natural +slotParser = do + P.skipSpaces + fromInteger . read <$> P.munch1 isDigit + +commonPart :: ReadP (Script a) -> ReadP [Script a] +commonPart parser = do + P.skipSpaces + _open <- P.string "[" + P.skipSpaces + content <- P.sepBy (scriptParser parser) (P.string ",") + P.skipSpaces + _close <- P.string "]" + P.skipSpaces + return content diff --git a/lib/Cardano/Address/Style/Byron.hs b/lib/Cardano/Address/Style/Byron.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/Style/Byron.hs @@ -0,0 +1,629 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address.Style.Byron + ( -- $overview + + -- * Byron + Byron + , DerivationPath + , payloadPassphrase + , derivationPath + , getKey + + -- * Key Derivation + -- $keyDerivation + , genMasterKeyFromXPrv + , genMasterKeyFromMnemonic + , deriveAccountPrivateKey + , deriveAddressPrivateKey + + -- * Addresses + -- $addresses + , AddressInfo (..) + , eitherInspectAddress + , inspectAddress + , inspectByronAddress + , paymentAddress + , ErrInspectAddress (..) + , prettyErrInspectAddress + + -- * Network Discrimination + , byronMainnet + , byronStaging + , byronTestnet + , byronPreprod + , byronPreview + + -- * Unsafe + , liftXPrv + , liftXPub + + -- Internals + , minSeedLengthBytes + ) where + +import Prelude + +import Cardano.Address + ( Address + , AddressDiscrimination (..) + , HasNetworkDiscriminant (..) + , NetworkTag (..) + , unAddress + , unsafeMkAddress + ) +import Cardano.Address.Derivation + ( Depth (..) + , DerivationScheme (DerivationScheme1) + , DerivationType (..) + , Index (..) + , XPrv + , XPub + , deriveXPrv + , generate + , toXPub + , xpubToBytes + ) +import Cardano.Address.Internal + ( DeserialiseFailure, WithErrorMessage (..) ) +import Cardano.Mnemonic + ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode ) +import Control.DeepSeq + ( NFData ) +import Control.Exception + ( Exception, displayException ) +import Control.Exception.Base + ( assert ) +import Control.Monad.Catch + ( MonadThrow, throwM ) +import Crypto.Hash + ( hash ) +import Crypto.Hash.Algorithms + ( Blake2b_256, SHA512 (..) ) +import Data.Aeson + ( ToJSON (..), (.=) ) +import Data.Bifunctor + ( bimap, first ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Kind + ( Type ) +import Data.List + ( find ) +import Data.Word + ( Word32, Word8 ) +import GHC.Generics + ( Generic ) + +import qualified Cardano.Address as Internal +import qualified Cardano.Address.Derivation as Internal +import qualified Cardano.Codec.Cbor as CBOR +import qualified Codec.CBOR.Decoding as CBOR +import qualified Crypto.KDF.PBKDF2 as PBKDF2 +import qualified Data.Aeson as Json +import qualified Data.ByteArray as BA +import qualified Data.Text.Encoding as T + +-- $overview +-- +-- This module provides an implementation of: +-- +-- - 'Cardano.Address.Derivation.GenMasterKey': for generating Byron master keys from mnemonic sentences +-- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical derivation of parent to child keys +-- - 'Cardano.Address.PaymentAddress': for constructing addresses from a public key +-- +-- We call 'Byron' addresses the old address type used by Daedalus in the early +-- days of Cardano. Using this type of addresses and underlying key scheme is +-- now considered __deprecated__ because of some security implications. +-- +-- The internals of the 'Byron' does not matter for the reader, but basically +-- contains what is necessary to perform key derivation and generate addresses +-- from a 'Byron' type. +-- +-- Byron uses WholeDomain (meaning Soft+Hardened) for account key and payment key derivation. +-- It should use Hardened for account and Soft for payment as design, +-- but due to the error made prior 2019 in cardano-sl +-- implementation WholeDomain was adopted to handle all the keys. Nevertheless, +-- it was recommended and enforced to use Hardened for account derivation and Soft for payment +-- key derivation from 2019 onwards. To sum up both account index and payment index can assume +-- values from 0 to 4294967295 (ie. 0xFFFFFFFF) + +-- == Deprecation Notice +-- +-- Unless you have good reason to do so (like writing backward-compatible code +-- with an existing piece), any new implementation __should use__ the +-- 'Cardano.Address.Style.Icarus.Icarus' style for key and addresses. + + +-- | Material for deriving HD random scheme keys, which can be used for making +-- addresses. +-- +-- @since 1.0.0 +data Byron (depth :: Depth) key = Byron + { getKey :: key + -- ^ The raw private or public key. + -- + -- @since 1.0.0 + , derivationPath :: DerivationPath depth + -- ^ The address derivation indices for the level of this key. + -- + -- @since 1.0.0 + , payloadPassphrase :: ScrubbedBytes + -- ^ Used for encryption of the derivation path payload within an address. + -- + -- @since 1.0.0 + } deriving stock (Generic) +{-# DEPRECATED Byron "see 'Cardano.Address.Style.Icarus.Icarus'" #-} +{-# DEPRECATED getKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-} +{-# DEPRECATED derivationPath "see 'Cardano.Address.Style.Icarus.Icarus'" #-} +{-# DEPRECATED payloadPassphrase "see 'Cardano.Address.Style.Icarus.Icarus'" #-} + +instance (NFData key, NFData (DerivationPath depth)) => NFData (Byron depth key) +deriving instance (Show key, Show (DerivationPath depth)) => Show (Byron depth key) +deriving instance (Eq key, Eq (DerivationPath depth)) => Eq (Byron depth key) +deriving instance (Functor (Byron depth)) + +-- | The hierarchical derivation indices for a given level/depth. +-- +-- @since 1.0.0 +type family DerivationPath (depth :: Depth) :: Type where + -- The root key is generated from the seed. + DerivationPath 'RootK = + () + -- The account key is generated from the root key and account index. + DerivationPath 'AccountK = + Index 'WholeDomain 'AccountK + -- The address key is generated from the account key and address index. + DerivationPath 'PaymentK = + (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'PaymentK) +{-# DEPRECATED DerivationPath "see 'Cardano.Address.Style.Icarus.Icarus'" #-} + +-- +-- Key Derivation +-- +-- === Generating a root key from 'SomeMnemonic' +-- > :set -XOverloadedStrings +-- > :set -XTypeApplications +-- > :set -XDataKinds +-- > :set -XFlexibleContexts +-- > import Cardano.Mnemonic ( mkSomeMnemonic ) +-- > import Cardano.Address ( base58 ) +-- > import Cardano.Address.Derivation ( toXPub ) +-- > import qualified Cardano.Address.Style.Byron as Byron +-- > +-- > let (Right mw) = mkSomeMnemonic @'[12] ["moon","fox","ostrich","quick","cactus","raven","wasp","intact","first","ring","crumble","error"] +-- > let rootK = Byron.genMasterKeyFromMnemonic mw :: Byron 'RootK XPrv +-- +-- === Deriving child keys +-- === Both accIx and addIx assume values from 0 to 4294967295 (ie. 0xFFFFFFFF) +-- === In case of account one can get this bound via +-- === let accIxMin = minBound @(Index 'WholeDomain 'AccountK) +-- === let accIxMax = maxBound @(Index 'WholeDomain 'AccountK) +-- > let Just accIx = wholeDomainIndex 0x80000000 +-- > let acctK = Byron.deriveAccountPrivateKey rootK accIx +-- > +-- > let Just addIx = wholeDomainIndex 0x80000014 +-- > let addrK = Byron.deriveAddressPrivateKey acctK addIx +-- > +-- > base58 $ Byron.paymentAddress Byron.byronMainnet (toXPub <$> addrK) +-- > "DdzFFzCqrhsq3KjLtT51mESbZ4RepiHPzLqEhamexVFTJpGbCXmh7qSxnHvaL88QmtVTD1E1sjx8Z1ZNDhYmcBV38ZjDST9kYVxSkhcw" + +instance Internal.GenMasterKey Byron where + type SecondFactor Byron = () + + genMasterKeyFromXPrv xprv = + liftXPrv (toXPub xprv) () xprv + genMasterKeyFromMnemonic (SomeMnemonic mw) () = + liftXPrv (toXPub xprv) () xprv + where + xprv = generate (hashSeed seedValidated) + seed = entropyToBytes $ mnemonicToEntropy mw + seedValidated = assert + (BA.length seed >= minSeedLengthBytes && BA.length seed <= 255) + seed + +instance Internal.HardDerivation Byron where + type AddressIndexDerivationType Byron = 'WholeDomain + type AccountIndexDerivationType Byron = 'WholeDomain + type WithRole Byron = () + + deriveAccountPrivateKey rootXPrv accIx = Byron + { getKey = deriveXPrv DerivationScheme1 (getKey rootXPrv) accIx + , derivationPath = accIx + , payloadPassphrase = payloadPassphrase rootXPrv + } + + deriveAddressPrivateKey accXPrv () addrIx = Byron + { getKey = deriveXPrv DerivationScheme1 (getKey accXPrv) addrIx + , derivationPath = (derivationPath accXPrv, addrIx) + , payloadPassphrase = payloadPassphrase accXPrv + } + +-- | Generate a root key from a corresponding mnemonic. +-- +-- @since 1.0.0 +genMasterKeyFromMnemonic + :: SomeMnemonic + -- ^ Some valid mnemonic sentence. + -> Byron 'RootK XPrv +genMasterKeyFromMnemonic = + flip Internal.genMasterKeyFromMnemonic () +{-# DEPRECATED genMasterKeyFromMnemonic "see 'Cardano.Address.Style.Icarus.Icarus'" #-} + +-- | Generate a root key from a corresponding root 'XPrv' +-- +-- @since 1.0.0 +genMasterKeyFromXPrv + :: XPrv + -> Byron 'RootK XPrv +genMasterKeyFromXPrv = + Internal.genMasterKeyFromXPrv +{-# DEPRECATED genMasterKeyFromXPrv "see 'Cardano.Address.Style.Icarus.Icarus'" #-} + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives an account private key from the given root private key. +-- +-- @since 1.0.0 +deriveAccountPrivateKey + :: Byron 'RootK XPrv + -> Index 'WholeDomain 'AccountK + -> Byron 'AccountK XPrv +deriveAccountPrivateKey = + Internal.deriveAccountPrivateKey +{-# DEPRECATED deriveAccountPrivateKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-} + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives an address private key from the given account private key. +-- +-- @since 1.0.0 +deriveAddressPrivateKey + :: Byron 'AccountK XPrv + -> Index 'WholeDomain 'PaymentK + -> Byron 'PaymentK XPrv +deriveAddressPrivateKey acctK = + Internal.deriveAddressPrivateKey acctK () +{-# DEPRECATED deriveAddressPrivateKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-} + +-- +-- Addresses +-- +-- $addresses +-- === Generating a 'PaymentAddress' +-- +-- | Possible errors from inspecting a Byron address +-- +-- @since 3.0.0 +data ErrInspectAddress + = MissingExpectedDerivationPath + | DeserialiseError DeserialiseFailure + | FailedToDecryptPath + deriving (Generic, Show, Eq) + deriving ToJSON via WithErrorMessage ErrInspectAddress + +instance Exception ErrInspectAddress where + displayException = prettyErrInspectAddress + +-- | Pretty-print an 'ErrInspectAddress' +-- +-- @since 3.0.0 +prettyErrInspectAddress :: ErrInspectAddress -> String +prettyErrInspectAddress = \case + MissingExpectedDerivationPath -> + "Missing expected derivation path" + DeserialiseError e -> + displayException e + FailedToDecryptPath -> + "Failed to decrypt derivation path" + +-- Determines whether an 'Address' is a Byron address. +-- +-- Returns a JSON object with information about the address, or throws +-- 'ErrInspectAddress' if the address isn't a byron address. +-- +-- @since 2.0.0 +inspectByronAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value +inspectByronAddress = inspectAddress +{-# DEPRECATED inspectByronAddress "use qualified 'inspectAddress' instead." #-} + +-- | Determines whether an 'Address' is a Byron address. +-- +-- Returns a JSON object with information about the address, or throws +-- 'ErrInspectAddress' if the address isn't a byron address. +-- +-- @since 3.0.0 +inspectAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value +inspectAddress mRootPub addr = either throwM (pure . toJSON) $ + eitherInspectAddress mRootPub addr + +-- | Determines whether an 'Address' is a Byron address. +-- +-- Returns either details about the 'Address', or 'ErrInspectAddress' if it's +-- not a valid address. +-- +-- @since 3.4.0 +eitherInspectAddress :: Maybe XPub -> Address -> Either ErrInspectAddress AddressInfo +eitherInspectAddress mRootPub addr = do + payload <- first DeserialiseError $ + CBOR.deserialiseCbor CBOR.decodeAddressPayload bytes + + (root, attrs) <- first DeserialiseError $ + CBOR.deserialiseCbor decodePayload payload + + path <- do + attr <- maybe (Left MissingExpectedDerivationPath) Right $ + find ((== 1) . fst) attrs + case mRootPub of + Nothing -> Right $ EncryptedDerivationPath $ snd attr + Just rootPub -> decryptPath attr rootPub + + ntwrk <- bimap DeserialiseError (fmap NetworkTag) $ + CBOR.deserialiseCbor CBOR.decodeProtocolMagicAttr payload + + pure AddressInfo + { infoAddressRoot = root + , infoPayload = path + , infoNetworkTag = ntwrk + } + where + bytes :: ByteString + bytes = unAddress addr + + decodePayload :: forall s. CBOR.Decoder s (ByteString, [(Word8, ByteString)]) + decodePayload = do + _ <- CBOR.decodeListLenCanonicalOf 3 + root <- CBOR.decodeBytes + (root,) <$> CBOR.decodeAllAttributes + + decryptPath :: (Word8, ByteString) -> XPub -> Either ErrInspectAddress PayloadInfo + decryptPath attr rootPub = do + let pwd = hdPassphrase rootPub + path <- first (const FailedToDecryptPath) $ + CBOR.deserialiseCbor (CBOR.decodeDerivationPathAttr pwd [attr]) mempty + case path of + Nothing -> Left FailedToDecryptPath + Just (accountIndex, addressIndex) -> Right PayloadDerivationPath{..} + +-- | The result of 'eitherInspectAddress' for Byron addresses. +-- +-- @since 3.4.0 +data AddressInfo = AddressInfo + { infoAddressRoot :: !ByteString + , infoPayload :: !PayloadInfo + , infoNetworkTag :: !(Maybe NetworkTag) + } deriving (Generic, Show, Eq) + +-- | The derivation path in a Byron address payload. +-- +-- @since 3.4.0 +data PayloadInfo + = PayloadDerivationPath + { accountIndex :: !Word32 + , addressIndex :: !Word32 + } + | EncryptedDerivationPath + { encryptedDerivationPath :: !ByteString + } + deriving (Generic, Show, Eq) + +instance ToJSON AddressInfo where + toJSON AddressInfo{..} = Json.object + [ "address_root" .= T.decodeUtf8 (encode EBase16 infoAddressRoot) + , "derivation_path" .= infoPayload + , "network_tag" .= maybe Json.Null toJSON infoNetworkTag + , "address_type" .= toJSON @Word8 8 + ] + +instance ToJSON PayloadInfo where + toJSON PayloadDerivationPath{..} = Json.object + [ "account_index" .= prettyIndex accountIndex + , "address_index" .= prettyIndex addressIndex + ] + where + prettyIndex :: Word32 -> String + prettyIndex ix + | ix >= firstHardened = show (ix - firstHardened) <> "H" + | otherwise = show ix + where + firstHardened = 0x80000000 + toJSON EncryptedDerivationPath{..} = Json.String $ + T.decodeUtf8 $ encode EBase16 encryptedDerivationPath + +instance Internal.PaymentAddress Byron where + paymentAddress discrimination k = unsafeMkAddress + $ CBOR.toStrictByteString + $ CBOR.encodeAddress (getKey k) attrs + where + (acctIx, addrIx) = bimap indexToWord32 indexToWord32 $ derivationPath k + pwd = payloadPassphrase k + NetworkTag magic = networkTag @Byron discrimination + attrs = case addressDiscrimination @Byron discrimination of + RequiresNetworkTag -> + [ CBOR.encodeDerivationPathAttr pwd acctIx addrIx + , CBOR.encodeProtocolMagicAttr magic + ] + RequiresNoTag -> + [ CBOR.encodeDerivationPathAttr pwd acctIx addrIx + ] + +-- Re-export from 'Cardano.Address' to have it documented specialized in Haddock. +-- +-- | Convert a public key to a payment 'Address' valid for the given +-- network discrimination. +-- +-- @since 1.0.0 +paymentAddress + :: NetworkDiscriminant Byron + -> Byron 'PaymentK XPub + -> Address +paymentAddress = + Internal.paymentAddress + +-- +-- Network Discrimination +-- + +instance HasNetworkDiscriminant Byron where + type NetworkDiscriminant Byron = (AddressDiscrimination, NetworkTag) + addressDiscrimination = fst + networkTag = snd + +-- | 'NetworkDiscriminant' for Cardano MainNet & Byron +-- +-- @since 2.0.0 +byronMainnet :: NetworkDiscriminant Byron +byronMainnet = (RequiresNoTag, NetworkTag 764824073) + +-- | 'NetworkDiscriminant' for Cardano Staging & Byron +-- +-- @since 2.0.0 +byronStaging :: NetworkDiscriminant Byron +byronStaging = (RequiresNetworkTag, NetworkTag 633343913) + +-- | 'NetworkDiscriminant' for Cardano Testnet & Byron +-- +-- @since 2.0.0 +byronTestnet :: NetworkDiscriminant Byron +byronTestnet = (RequiresNetworkTag, NetworkTag 1097911063) + +-- | 'NetworkDiscriminant' for Cardano Preview & Byron +-- +-- @since 3.13.0 +byronPreview :: NetworkDiscriminant Byron +byronPreview = (RequiresNetworkTag, NetworkTag 2) + +-- | 'NetworkDiscriminant' for Cardano Preprod & Byron +-- +-- @since 3.13.0 +byronPreprod :: NetworkDiscriminant Byron +byronPreprod = (RequiresNetworkTag, NetworkTag 1) + +-- +-- Unsafe +-- + +-- | Backdoor for generating a new key from a raw 'XPrv'. +-- +-- Note that the @depth@ is left open so that the caller gets to decide what type +-- of key this is. This is mostly for testing, in practice, seeds are used to +-- represent root keys, and one should 'genMasterKeyFromXPrv' +-- +-- The first argument is a type-family 'DerivationPath' and its type depends on +-- the 'depth' of the key. +-- +-- __examples:__ +-- +-- >>> liftXPrv rootPrv () prv +-- _ :: Byron RootK XPrv +-- +-- >>> liftXPrv rootPrv minBound prv +-- _ :: Byron AccountK XPrv +-- +-- >>> liftXPrv rootPrv (minBound, minBound) prv +-- _ :: Byron PaymentK XPrv +-- +-- @since 2.0.0 +liftXPrv + :: XPub -- ^ A root public key + -> DerivationPath depth + -> XPrv + -> Byron depth XPrv +liftXPrv rootPub derivationPath getKey = Byron + { getKey + , derivationPath + , payloadPassphrase = hdPassphrase rootPub + } +{-# DEPRECATED liftXPrv "see 'Cardano.Address.Style.Icarus.Icarus'" #-} + +-- | Backdoor for generating a new key from a raw 'XPub'. +-- +-- Note that the @depth@ is left open so that the caller gets to decide what type +-- of key this is. This is mostly for testing, in practice, seeds are used to +-- represent root keys, and one should 'genMasterKeyFromXPrv' +-- +-- see also 'liftXPrv' +-- +-- @since 2.0.0 +liftXPub + :: XPub -- ^ A root public key + -> DerivationPath depth + -> XPub + -> Byron depth XPub +liftXPub rootPub derivationPath getKey = Byron + { getKey + , derivationPath + , payloadPassphrase = hdPassphrase rootPub + } +{-# DEPRECATED liftXPub "see 'Cardano.Address.Style.Icarus.Icarus'" #-} + +-- +-- Internal +-- + +-- The amount of entropy carried by a BIP-39 12-word mnemonic is 16 bytes. +minSeedLengthBytes :: Int +minSeedLengthBytes = 16 + +-- Hash the seed entropy (generated from mnemonic) used to initiate a HD +-- wallet. This increases the key length to 34 bytes, selectKey is greater than the +-- minimum for 'generate' (32 bytes). +-- +-- Note that our current implementation deviates from BIP-39 because we use a +-- hash function (Blake2b) rather than key stretching with PBKDF2. +-- +-- There are two methods of hashing the seed entropy, for different use cases. +-- +-- 1. Normal random derivation wallet seeds. The seed entropy is hashed using +-- Blake2b_256, inside a double CBOR serialization sandwich. +-- +-- 2. Seeds for redeeming paper wallets. The seed entropy is hashed using +-- Blake2b_256, without any serialization. +hashSeed :: ScrubbedBytes -> ScrubbedBytes +hashSeed = serialize . blake2b256 . serialize + where + serialize = BA.convert . cbor . BA.convert + cbor = CBOR.toStrictByteString . CBOR.encodeBytes + +-- Hash a byte string through blake2b 256 +blake2b256 :: ScrubbedBytes -> ScrubbedBytes +blake2b256 = BA.convert . hash @ScrubbedBytes @Blake2b_256 + +-- Derive a symmetric key for encrypting and authenticating the address +-- derivation path. PBKDF2 encryption using HMAC with the hash algorithm SHA512 +-- is employed. +hdPassphrase :: XPub -> ScrubbedBytes +hdPassphrase masterKey = + PBKDF2.generate + (PBKDF2.prfHMAC SHA512) + (PBKDF2.Parameters 500 32) + (xpubToBytes masterKey) + ("address-hashing" :: ByteString) diff --git a/lib/Cardano/Address/Style/Icarus.hs b/lib/Cardano/Address/Style/Icarus.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/Style/Icarus.hs @@ -0,0 +1,709 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_HADDOCK prune #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address.Style.Icarus + ( -- $overview + + -- * Icarus + Icarus + , getKey + , Role (..) + , roleFromIndex + , roleToIndex + + -- * Key Derivation + -- $keyDerivation + , genMasterKeyFromXPrv + , genMasterKeyFromMnemonic + , deriveAccountPrivateKey + , deriveAddressPrivateKey + , deriveAddressPublicKey + + -- * Addresses + -- $addresses + , AddressInfo (..) + , eitherInspectAddress + , inspectAddress + , inspectIcarusAddress + , paymentAddress + , ErrInspectAddress + , prettyErrInspectAddress + + -- * Network Discrimination + , icarusMainnet + , icarusStaging + , icarusTestnet + , icarusPreview + , icarusPreprod + + -- * Unsafe + , liftXPrv + , liftXPub + + -- Internals + , unsafeGenerateKeyFromHardwareLedger + , minSeedLengthBytes + ) where + +import Prelude + +import Cardano.Address + ( Address + , AddressDiscrimination (..) + , HasNetworkDiscriminant (..) + , NetworkDiscriminant (..) + , NetworkTag (..) + , unAddress + , unsafeMkAddress + ) +import Cardano.Address.Derivation + ( Depth (..) + , DerivationScheme (..) + , DerivationType (..) + , Index (..) + , XPrv + , XPub + , deriveXPrv + , deriveXPub + , generateNew + , indexFromWord32 + , unsafeMkIndex + , xprvFromBytes + ) +import Cardano.Address.Internal + ( DeserialiseFailure, WithErrorMessage (..) ) +import Cardano.Address.Style.Byron + ( byronMainnet, byronPreprod, byronPreview, byronStaging, byronTestnet ) +import Cardano.Mnemonic + ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy, mnemonicToText ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode ) +import Control.DeepSeq + ( NFData ) +import Control.Exception + ( Exception, displayException ) +import Control.Exception.Base + ( assert ) +import Control.Monad.Catch + ( MonadThrow, throwM ) +import Crypto.Hash.Algorithms + ( SHA256 (..), SHA512 (..) ) +import Crypto.MAC.HMAC + ( HMAC, hmac ) +import Data.Aeson + ( ToJSON (..), (.=) ) +import Data.Bifunctor + ( bimap, first ) +import Data.Bits + ( clearBit, setBit, testBit ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Function + ( (&) ) +import Data.Maybe + ( fromMaybe ) +import Data.Typeable + ( Typeable ) +import Data.Word + ( Word32, Word8 ) +import Fmt + ( format ) +import GHC.Generics + ( Generic ) + +import qualified Cardano.Address as Internal +import qualified Cardano.Address.Derivation as Internal +import qualified Cardano.Codec.Cbor as CBOR +import qualified Codec.CBOR.Decoding as CBOR +import qualified Crypto.KDF.PBKDF2 as PBKDF2 +import qualified Data.Aeson as Json +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +-- $overview +-- +-- This module provides an implementation of: +-- +-- - 'Cardano.Address.Derivation.GenMasterKey': for generating Icarus master keys from mnemonic sentences +-- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical hard derivation of parent to child keys +-- - 'Cardano.Address.Derivation.SoftDerivation': for hierarchical soft derivation of parent to child keys +-- - 'Cardano.Address.PaymentAddress': for constructing addresses from a public key +-- +-- We call 'Icarus' addresses the new format of Cardano addresses which came +-- after 'Cardano.Address.Style.Byron.Byron'. This is the format initially used in /Yoroi/ +-- and now also used by /Daedalus/. + +-- | A cryptographic key for sequential-scheme address derivation, with +-- phantom-types to disambiguate key types. +-- +-- @ +-- let rootPrivateKey = Icarus 'RootK XPrv +-- let accountPubKey = Icarus 'AccountK XPub +-- let addressPubKey = Icarus 'PaymentK XPub +-- @ +-- +-- @since 1.0.0 +newtype Icarus (depth :: Depth) key = Icarus + { getKey :: key + -- ^ Extract the raw 'XPrv' or 'XPub' wrapped by this type. + -- + -- @since 1.0.0 + } + deriving stock (Generic, Show, Eq) + +deriving instance (Functor (Icarus depth)) +instance (NFData key) => NFData (Icarus depth key) + +data Role + = UTxOExternal + | UTxOInternal + deriving (Generic, Typeable, Show, Eq, Ord, Bounded) + +instance NFData Role + +roleFromIndex :: Index 'Soft depth -> Maybe Role +roleFromIndex ix = case indexToWord32 ix of + 0 -> Just UTxOExternal + 1 -> Just UTxOInternal + _ -> Nothing + +roleToIndex :: Role -> Index 'Soft depth +roleToIndex = unsafeMkIndex . \case + UTxOExternal -> 0 + UTxOInternal -> 1 + +-- +-- Key Derivation +-- +-- $keyDerivation +-- +-- === Generating a root key from 'SomeMnemonic' +-- > :set -XOverloadedStrings +-- > :set -XTypeApplications +-- > :set -XDataKinds +-- > :set -XFlexibleContexts +-- > import Cardano.Mnemonic ( mkSomeMnemonic ) +-- > import Cardano.Address ( base58 ) +-- > import Cardano.Address.Derivation ( toXPub ) +-- > import qualified Cardano.Address.Style.Icarus as Icarus +-- > +-- > let (Right mw) = mkSomeMnemonic @'[15] ["network","empty","cause","mean","expire","private","finger","accident","session","problem","absurd","banner","stage","void","what"] +-- > let sndFactor = mempty -- Or alternatively, a second factor mnemonic transformed to bytes via someMnemonicToBytes +-- > let rootK = Icarus.genMasterKeyFromMnemonic mw sndFactor :: Icarus 'RootK XPrv +-- +-- === Deriving child keys +-- +-- Let's consider the following 3rd, 4th and 5th derivation paths @0'\/0\/14@ +-- === accIx assumes values from 2147483648 (ie. 0x80000000) to 4294967295 (ie. 0xFFFFFFFF) +-- === addIx assume values from 0 to 2147483647 (ie. 7FFFFFFF) +-- > let Just accIx = indexFromWord32 0x80000000 +-- === this is the same as +-- > let accIx = minBound @(Index 'Hardened 'AccountK) +-- > let acctK = Icarus.deriveAccountPrivateKey rootK accIx +-- > +-- > let Just addIx = indexFromWord32 0x00000014 +-- > let addrK = Icarus.deriveAddressPrivateKey acctK Icarus.UTxOExternal addIx +-- > +-- > base58 $ Icarus.paymentAddress Icarus.icarusMainnet (toXPub <$> addrK) +-- >"Ae2tdPwUPEZ8XpsjgQPH2cJdtohkYrxJ3i5y6mVsrkZZkdpdn6mnr4Rt6wG" + +instance Internal.GenMasterKey Icarus where + type SecondFactor Icarus = ScrubbedBytes + + genMasterKeyFromXPrv = liftXPrv + genMasterKeyFromMnemonic (SomeMnemonic mw) sndFactor = + let + seed = entropyToBytes $ mnemonicToEntropy mw + seedValidated = assert + (BA.length seed >= minSeedLengthBytes && BA.length seed <= 255) + seed + in Icarus $ generateNew seedValidated sndFactor + +instance Internal.HardDerivation Icarus where + type AccountIndexDerivationType Icarus = 'Hardened + type AddressIndexDerivationType Icarus = 'Soft + type WithRole Icarus = Role + + deriveAccountPrivateKey (Icarus rootXPrv) accIx = + let + Just purposeIx = + indexFromWord32 @(Index 'Hardened _) purposeIndex + Just coinTypeIx = + indexFromWord32 @(Index 'Hardened _) coinTypeIndex + purposeXPrv = -- lvl1 derivation; hardened derivation of purpose' + deriveXPrv DerivationScheme2 rootXPrv purposeIx + coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type' + deriveXPrv DerivationScheme2 purposeXPrv coinTypeIx + acctXPrv = -- lvl3 derivation; hardened derivation of account' index + deriveXPrv DerivationScheme2 coinTypeXPrv accIx + in + Icarus acctXPrv + + deriveAddressPrivateKey (Icarus accXPrv) role addrIx = + let + changeXPrv = -- lvl4 derivation; soft derivation of change chain + deriveXPrv DerivationScheme2 accXPrv (roleToIndex role) + addrXPrv = -- lvl5 derivation; soft derivation of address index + deriveXPrv DerivationScheme2 changeXPrv addrIx + in + Icarus addrXPrv + +instance Internal.SoftDerivation Icarus where + deriveAddressPublicKey (Icarus accXPub) role addrIx = + fromMaybe errWrongIndex $ do + changeXPub <- -- lvl4 derivation in bip44 is derivation of change chain + deriveXPub DerivationScheme2 accXPub (roleToIndex role) + addrXPub <- -- lvl5 derivation in bip44 is derivation of address chain + deriveXPub DerivationScheme2 changeXPub addrIx + return $ Icarus addrXPub + where + errWrongIndex = error $ + "deriveAddressPublicKey failed: was given an hardened (or too big) \ + \index for soft path derivation ( " ++ show addrIx ++ "). This is \ + \either a programmer error, or, we may have reached the maximum \ + \number of addresses for a given wallet." + +-- | Generate a root key from a corresponding mnemonic. +-- +-- @since 1.0.0 +genMasterKeyFromMnemonic + :: SomeMnemonic + -- ^ Some valid mnemonic sentence. + -> ScrubbedBytes + -- ^ An optional second-factor passphrase (or 'mempty') + -> Icarus 'RootK XPrv +genMasterKeyFromMnemonic = + Internal.genMasterKeyFromMnemonic + +-- | Generate a root key from a corresponding root 'XPrv' +-- +-- @since 1.0.0 +genMasterKeyFromXPrv + :: XPrv + -> Icarus 'RootK XPrv +genMasterKeyFromXPrv = + Internal.genMasterKeyFromXPrv + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives an account private key from the given root private key. +-- +-- @since 1.0.0 +deriveAccountPrivateKey + :: Icarus 'RootK XPrv + -> Index 'Hardened 'AccountK + -> Icarus 'AccountK XPrv +deriveAccountPrivateKey = + Internal.deriveAccountPrivateKey + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives an address private key from the given account private key. +-- +-- @since 1.0.0 +deriveAddressPrivateKey + :: Icarus 'AccountK XPrv + -> Role + -> Index 'Soft 'PaymentK + -> Icarus 'PaymentK XPrv +deriveAddressPrivateKey = + Internal.deriveAddressPrivateKey + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock +-- +-- | Derives an address public key from the given account public key. +-- +-- @since 1.0.0 +deriveAddressPublicKey + :: Icarus 'AccountK XPub + -> Role + -> Index 'Soft 'PaymentK + -> Icarus 'PaymentK XPub +deriveAddressPublicKey = + Internal.deriveAddressPublicKey + +-- +-- Addresses +-- +-- $addresses +-- === Generating a 'PaymentAddress' +-- +-- | Possible errors from inspecting a Shelley address +-- +-- @since 3.0.0 +data ErrInspectAddress + = UnexpectedDerivationPath + | DeserialiseError DeserialiseFailure + deriving (Generic, Show, Eq) + deriving ToJSON via WithErrorMessage ErrInspectAddress + +instance Exception ErrInspectAddress where + displayException = prettyErrInspectAddress + +-- | Pretty-print an 'ErrInspectAddress' +-- +-- @since 3.0.0 +prettyErrInspectAddress :: ErrInspectAddress -> String +prettyErrInspectAddress = \case + UnexpectedDerivationPath -> + "Unexpected derivation path" + DeserialiseError e -> + format "Deserialisation error (was: {})" (show e) + +-- Determines whether an 'Address' is an Icarus address. +-- +-- Returns a JSON object with information about the address, or throws +-- 'ErrInspectAddress' if the address isn't an icarus address. +-- +-- @since 2.0.0 +inspectIcarusAddress :: MonadThrow m => Address -> m Json.Value +inspectIcarusAddress = inspectAddress +{-# DEPRECATED inspectIcarusAddress "use qualified 'inspectAddress' instead." #-} + +-- | Determines whether an 'Address' is an Icarus address. +-- +-- Returns a JSON object with information about the address, or throws +-- 'ErrInspectAddress' if the address isn't an icarus address. +-- λ> :set -XOverloadedStrings +-- λ> :set -XTypeApplications +-- λ> :set -XDataKinds +-- λ> :set -XFlexibleContexts +-- λ> import Cardano.Mnemonic ( mkSomeMnemonic ) +-- λ> import qualified Cardano.Address.Style.Icarus as Icarus +-- λ> import Cardano.Address.Derivation ( toXPub ) +-- λ> import Cardano.Address ( base58 ) +-- λ> let (Right mw) = mkSomeMnemonic @'[12] ["moon","fox","ostrich","quick","cactus","raven","wasp","intact","first","ring","crumble","error"] +-- λ> let sndFactor = mempty +-- λ> let rootK = Icarus.genMasterKeyFromMnemonic mw sndFactor :: Icarus 'RootK XPrv +-- λ> let Just accIx = indexFromWord32 0x80000000 +-- λ> let acctK = Icarus.deriveAccountPrivateKey rootK accIx +-- λ> let Just addIx = indexFromWord32 0x00000014 +-- λ> let addrK = Icarus.deriveAddressPrivateKey acctK Icarus.UTxOExternal addIx +-- λ> (toXPub <$> addrK) +-- Icarus {getKey = XPub {xpubPublicKey = "\223\148\230\206\187\135\253\SO\151\216\183\210]}s:\151\134\174q\173\207\184\202\EM\176\170\220\216\235\&1\243", xpubChaincode = ChainCode "\\\160\196\&8~\208\165\241\138\SOH\222\ETX*\150&\214\185\196 \153\DC2\167\165\243\155\136\228\255\229~d\253"}} +-- λ> base58 $ Icarus.paymentAddress icarusMainnet (toXPub <$> addrK) +-- "Ae2tdPwUPEYyzBcNXkFWKywMiZ9eSd96dQxhBQd371foiH16Y7gFgLBj9G5" +-- +-- λ> import Cardano.Codec.Cbor +-- λ> import Crypto.Hash.Algorithms (Blake2b_224, SHA3_256) +-- λ> import Crypto.Hash (hash) +-- λ> let blake2b224 = hash @_ @Blake2b_224 +-- λ> let sha3256 = hash @_ @SHA3_256 +-- λ> import qualified Codec.CBOR.Encoding as CBOR +-- λ> let encodeXPub = CBOR.encodeBytes (xpubToBytes . Icarus.getKey $ icarusAddrKPub) +-- λ> let encodeSpendingData = CBOR.encodeListLen 2 <> CBOR.encodeWord8 0 <> encodeXPub +-- λ> let encodeAttrs = CBOR.encodeMapLen 0 +-- λ> import qualified Data.ByteArray as BA +-- λ> let rootAddr = BA.convert $ blake2b224 $ sha3256 $ CBOR.toStrictByteString $ mempty <> CBOR.encodeListLen 3 <> CBOR.encodeWord8 0 <> encodeSpendingData <> encodeAttrs +-- λ> encode EBase16 rootAddr +-- "1fdde02c9e087474aa7ab0a46ae2f6d316a92cd0fa2d4e8b1c2eebdf" +-- +-- $ echo Ae2tdPwUPEYyzBcNXkFWKywMiZ9eSd96dQxhBQd371foiH16Y7gFgLBj9G5 | cardano-address address inspect +-- { +-- "stake_reference": "none", +-- "address_style": "Icarus", +-- "address_root": "1fdde02c9e087474aa7ab0a46ae2f6d316a92cd0fa2d4e8b1c2eebdf", +-- "network_tag": null, +-- "address_type": 8 +--} +-- @since 2.0.0 +inspectAddress :: MonadThrow m => Address -> m Json.Value +inspectAddress = either throwM (pure . toJSON) . eitherInspectAddress + +-- | Determines whether an 'Address' is an Icarus address. +-- +-- Returns either details about the 'Address', or 'ErrInspectAddress' if it's +-- not a valid icarus address. +-- +-- @since 3.4.0 +eitherInspectAddress :: Address -> Either ErrInspectAddress AddressInfo +eitherInspectAddress addr = do + payload <- first DeserialiseError $ + CBOR.deserialiseCbor CBOR.decodeAddressPayload $ + unAddress addr + ntwrk <- bimap DeserialiseError (fmap NetworkTag) $ + CBOR.deserialiseCbor CBOR.decodeProtocolMagicAttr payload + (root, attrs) <- first DeserialiseError $ + CBOR.deserialiseCbor decodePayload payload + if (elem 1 $ fst <$> attrs) + then Left UnexpectedDerivationPath + else Right AddressInfo + { infoAddressRoot = root + , infoNetworkTag = ntwrk + } + where + decodePayload :: forall s. CBOR.Decoder s (ByteString, [(Word8, ByteString)]) + decodePayload = do + _ <- CBOR.decodeListLenCanonicalOf 3 + root <- CBOR.decodeBytes + (root,) <$> CBOR.decodeAllAttributes + +-- | The result of 'eitherInspectAddress' for Icarus addresses. +-- +-- @since 3.4.0 +data AddressInfo = AddressInfo + { infoAddressRoot :: !ByteString + , infoNetworkTag :: !(Maybe NetworkTag) + } deriving (Generic, Show, Eq) + +instance ToJSON AddressInfo where + toJSON AddressInfo{..} = Json.object + [ "network_tag" .= maybe Json.Null toJSON infoNetworkTag + , "address_root" .= T.decodeUtf8 (encode EBase16 infoAddressRoot) + , "address_type" .= toJSON @Word8 8 + ] + +instance Internal.PaymentAddress Icarus where + paymentAddress discrimination k = unsafeMkAddress + $ CBOR.toStrictByteString + $ CBOR.encodeAddress (getKey k) attrs + where + NetworkTag magic = networkTag @Icarus discrimination + attrs = case addressDiscrimination @Icarus discrimination of + RequiresNetworkTag -> + [ CBOR.encodeProtocolMagicAttr magic + ] + RequiresNoTag -> + [] + +-- Re-export from 'Cardano.Address' to have it documented specialized in Haddock. +-- +-- | Convert a public key to a payment 'Address' valid for the given +-- network discrimination. +-- +-- @since 1.0.0 +paymentAddress + :: NetworkDiscriminant Icarus + -> Icarus 'PaymentK XPub + -> Address +paymentAddress = + Internal.paymentAddress + +-- +-- Network Discrimination +-- + +instance HasNetworkDiscriminant Icarus where + type NetworkDiscriminant Icarus = (AddressDiscrimination, NetworkTag) + addressDiscrimination = fst + networkTag = snd + +-- | 'NetworkDiscriminant' for Cardano MainNet & 'Icarus' +-- +-- @since 2.0.0 +icarusMainnet :: NetworkDiscriminant Icarus +icarusMainnet = byronMainnet + +-- | 'NetworkDiscriminant' for Cardano Staging & 'Icarus' +-- +-- @since 2.0.0 +icarusStaging :: NetworkDiscriminant Icarus +icarusStaging = byronStaging + +-- | 'NetworkDiscriminant' for Cardano Testnet & 'Icarus' +-- +-- @since 2.0.0 +icarusTestnet :: NetworkDiscriminant Icarus +icarusTestnet = byronTestnet + +-- | 'NetworkDiscriminant' for Cardano Preprod & 'Icarus' +-- +-- @since 3.13.0 +icarusPreprod :: NetworkDiscriminant Icarus +icarusPreprod = byronPreprod + +-- | 'NetworkDiscriminant' for Cardano Preview & 'Icarus' +-- +-- @since 3.13.0 +icarusPreview :: NetworkDiscriminant Icarus +icarusPreview = byronPreview + +-- +-- Unsafe +-- + +-- | Unsafe backdoor for constructing an 'Icarus' key from a raw 'XPrv'. this is +-- unsafe because it lets the caller choose the actually derivation 'depth'. +-- +-- This can be useful however when serializing / deserializing such a type, or to +-- speed up test code (and avoid having to do needless derivations from a master +-- key down to an address key for instance). +-- +-- @since 1.0.0 +liftXPrv :: XPrv -> Icarus depth XPrv +liftXPrv = Icarus + +-- | Unsafe backdoor for constructing an 'Icarus' key from a raw 'XPub'. this is +-- unsafe because it lets the caller choose the actually derivation 'depth'. +-- +-- This can be useful however when serializing / deserializing such a type, or to +-- speed up test code (and avoid having to do needless derivations from a master +-- key down to an address key for instance). +-- +-- @since 2.0.0 +liftXPub :: XPub -> Icarus depth XPub +liftXPub = Icarus + +-- +-- Internal +-- + +-- Purpose is a constant set to 44' (or 0x8000002C) following the original +-- BIP-44 specification. +-- +-- It indicates that the subtree of this node is used according to this +-- specification. +-- +-- Hardened derivation is used at this level. +purposeIndex :: Word32 +purposeIndex = 0x8000002C + +-- One master node (seed) can be used for unlimited number of independent +-- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the +-- same space for various cryptocoins has some disadvantages. +-- +-- This level creates a separate subtree for every cryptocoin, avoiding reusing +-- addresses across cryptocoins and improving privacy issues. +-- +-- Coin type is a constant, set for each cryptocoin. For Cardano this constant +-- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada +-- Lovelace. +-- +-- Hardened derivation is used at this level. +coinTypeIndex :: Word32 +coinTypeIndex = 0x80000717 + +-- The minimum seed length for 'generateKeyFromMnemonic' and 'unsafeGenerateKeyFromMnemonic'. +minSeedLengthBytes :: Int +minSeedLengthBytes = 16 + +-- Hardware Ledger devices generates keys from mnemonic using a different +-- approach (different from the rest of Cardano). +-- +-- It is a combination of: +-- +-- - [SLIP 0010](https://github.com/satoshilabs/slips/blob/master/slip-0010.md) +-- - [BIP 0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki) +-- - [BIP 0039](https://github.com/bitcoin/bips/blob/master/bip-0039.mediawiki) +-- - [RFC 8032](https://tools.ietf.org/html/rfc8032#section-5.1.5) +-- - What seems to be arbitrary changes from Ledger regarding the calculation of +-- the initial chain code and generation of the root private key. +unsafeGenerateKeyFromHardwareLedger + :: SomeMnemonic + -- ^ The root mnemonic + -> Icarus 'RootK XPrv +unsafeGenerateKeyFromHardwareLedger (SomeMnemonic mw) = unsafeFromRight $ do + let seed = pbkdf2HmacSha512 + $ T.encodeUtf8 + $ T.intercalate " " + $ mnemonicToText mw + + -- NOTE + -- SLIP-0010 refers to `iR` as the chain code. Here however, the chain code + -- is obtained as a hash of the initial seed whereas iR is used to make part + -- of the root private key itself. + let cc = hmacSha256 (BS.pack [1] <> seed) + let (iL, iR) = first pruneBuffer $ hashRepeatedly seed + + prv <- maybe (Left "invalid xprv") pure $ xprvFromBytes $ iL <> iR <> cc + pure $ Icarus prv + where + -- Errors yielded in the body of 'unsafeGenerateKeyFromHardwareLedger' are + -- programmer errors (out-of-range byte buffer access or, invalid length for + -- cryptographic operations). Therefore, we throw badly if we encounter any. + unsafeFromRight :: Either String a -> a + unsafeFromRight = either error id + + -- This is the algorithm described in SLIP 0010 for master key generation + -- with an extra step to discard _some_ of the potential private keys. Why + -- this extra step remains a mystery as of today. + -- + -- 1. Generate a seed byte sequence S of 512 bits according to BIP-0039. + -- (done in a previous step, passed as argument). + -- + -- 2. Calculate I = HMAC-SHA512(Key = "ed25519 seed", Data = S) + -- + -- 3. Split I into two 32-byte sequences, IL and IR. + -- + -- extra ******************************************************************* + -- * * + -- * 3.5 If the third highest bit of the last byte of IL is not zero * + -- * S = I and go back to step 2. * + -- * * + -- ************************************************************************* + -- + -- 4. Use parse256(IL) as master secret key, and IR as master chain code. + hashRepeatedly :: ByteString -> (ByteString, ByteString) + hashRepeatedly bytes = case BS.splitAt 32 (hmacSha512 bytes) of + (iL, iR) | isInvalidKey iL -> hashRepeatedly (iL <> iR) + (iL, iR) -> (iL, iR) + where + isInvalidKey k = testBit (k `BS.index` 31) 5 + + -- - Clear the lowest 3 bits of the first byte + -- - Clear the highest bit of the last byte + -- - Set the second highest bit of the last byte + -- + -- As described in [RFC 8032 - 5.1.5](https://tools.ietf.org/html/rfc8032#section-5.1.5) + pruneBuffer :: ByteString -> ByteString + pruneBuffer bytes = + let + (firstByte, rest) = fromMaybe (error "pruneBuffer: no first byte") $ + BS.uncons bytes + + (rest', lastByte) = fromMaybe (error "pruneBuffer: no last byte") $ + BS.unsnoc rest + + firstPruned = firstByte + & (`clearBit` 0) + & (`clearBit` 1) + & (`clearBit` 2) + + lastPruned = lastByte + & (`setBit` 6) + & (`clearBit` 7) + in + (firstPruned `BS.cons` BS.snoc rest' lastPruned) + + -- As described in [BIP 0039 - From Mnemonic to Seed](https://github.com/bitcoin/bips/blob/master/bip-0039.mediawiki#from-mnemonic-to-seed) + pbkdf2HmacSha512 :: ByteString -> ByteString + pbkdf2HmacSha512 bytes = PBKDF2.generate + (PBKDF2.prfHMAC SHA512) + (PBKDF2.Parameters 2048 64) + bytes + ("mnemonic" :: ByteString) + + hmacSha256 :: ByteString -> ByteString + hmacSha256 = + BA.convert @(HMAC SHA256) . hmac salt + + -- As described in [SLIP 0010 - Master Key Generation](https://github.com/satoshilabs/slips/blob/master/slip-0010.md#master-key-generation) + hmacSha512 :: ByteString -> ByteString + hmacSha512 = + BA.convert @(HMAC SHA512) . hmac salt + + salt :: ByteString + salt = "ed25519 seed" diff --git a/lib/Cardano/Address/Style/Shared.hs b/lib/Cardano/Address/Style/Shared.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/Style/Shared.hs @@ -0,0 +1,310 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address.Style.Shared + ( -- $overview + + -- * Shared + Shared + , getKey + , liftXPrv + , liftXPub + , sharedWalletId + + -- * Key Derivation + -- $keyDerivation + , genMasterKeyFromXPrv + , genMasterKeyFromMnemonic + , deriveAccountPrivateKey + , deriveAddressPrivateKey + , deriveAddressPublicKey + , deriveDelegationPrivateKey + , deriveDelegationPublicKey + , hashKey + + ) where + +import Prelude + +import Cardano.Address.Derivation + ( Depth (..) + , DerivationType (..) + , Index (..) + , XPrv + , XPub + , hashCredential + , hashWalletId + , xpubPublicKey + ) +import Cardano.Address.KeyHash + ( KeyHash (..), KeyRole ) +import Cardano.Address.Script + ( Cosigner, Script ) +import Cardano.Address.Script.Parser + ( scriptToText ) +import Cardano.Address.Style.Shelley + ( Role (..) + , deriveAccountPrivateKeyShelley + , deriveAddressPrivateKeyShelley + , deriveAddressPublicKeyShelley + , genMasterKeyFromMnemonicShelley + ) +import Cardano.Mnemonic + ( SomeMnemonic ) +import Control.DeepSeq + ( NFData ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Coerce + ( coerce ) +import Data.Word + ( Word32 ) +import GHC.Generics + ( Generic ) + +import qualified Cardano.Address.Derivation as Internal +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as T + + +-- $overview +-- +-- This module provides an implementation of: +-- +-- - 'Cardano.Address.Derivation.GenMasterKey': for generating Shared master keys from mnemonic sentences +-- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical hard derivation of parent to child keys +-- - 'Cardano.Address.Derivation.SoftDerivation': for hierarchical soft derivation of parent to child keys +-- +-- - 'paymentAddress': for constructing payment addresses from a address public key or a script +-- - 'delegationAddress': for constructing delegation addresses from payment credential (public key or script) and stake credential (public key or script) +-- - 'pointerAddress': for constructing delegation addresses from payment credential (public key or script) and chain pointer +-- - 'stakeAddress': for constructing reward accounts from stake credential (public key or script) + +-- | A cryptographic key for sequential-scheme address derivation, with +-- phantom-types to disambiguate key types. The derivation is mostly like Shelley, except the used purpose index +-- (here 1854H rather than Shelley's 1852H) +-- +-- @ +-- let rootPrivateKey = Shared 'RootK XPrv +-- let accountPubKey = Shared 'AccountK XPub +-- let addressPubKey = Shared 'PaymentK XPub +-- @ +-- +-- @since 3.4.0 +newtype Shared (depth :: Depth) key = Shared + { getKey :: key + -- ^ Extract the raw 'XPrv' or 'XPub' wrapped by this type. + -- + -- @since 3.4.0 + } + deriving stock (Generic, Show, Eq) + +deriving instance (Functor (Shared depth)) +instance (NFData key) => NFData (Shared depth key) + +-- +-- Key Derivation +-- +-- $keyDerivation +-- +-- === Generating a root key from 'SomeMnemonic' +-- > :set -XOverloadedStrings +-- > :set -XTypeApplications +-- > :set -XDataKinds +-- > import Cardano.Mnemonic ( mkSomeMnemonic ) +-- > +-- > let (Right mw) = mkSomeMnemonic @'[15] ["network","empty","cause","mean","expire","private","finger","accident","session","problem","absurd","banner","stage","void","what"] +-- > let sndFactor = mempty -- Or alternatively, a second factor mnemonic transformed to bytes via someMnemonicToBytes +-- > let rootK = genMasterKeyFromMnemonic mw sndFactor :: Shared 'RootK XPrv +-- +-- === Deriving child keys +-- +-- Let's consider the following 3rd, 4th and 5th derivation paths @0'\/0\/14@ +-- +-- > let Just accIx = indexFromWord32 0x80000000 +-- > let acctK = deriveAccountPrivateKey rootK accIx +-- > +-- > let Just addIx = indexFromWord32 0x00000014 +-- > let addrK = deriveAddressPrivateKey acctK UTxOExternal addIx +-- +-- > let stakeK = deriveDelegationPrivateKey acctK + +instance Internal.GenMasterKey Shared where + type SecondFactor Shared = ScrubbedBytes + + genMasterKeyFromXPrv = liftXPrv + genMasterKeyFromMnemonic fstFactor sndFactor = + Shared $ genMasterKeyFromMnemonicShelley fstFactor sndFactor + +instance Internal.HardDerivation Shared where + type AccountIndexDerivationType Shared = 'Hardened + type AddressIndexDerivationType Shared = 'Soft + type WithRole Shared = Role + + deriveAccountPrivateKey (Shared rootXPrv) accIx = + Shared $ deriveAccountPrivateKeyShelley rootXPrv accIx purposeIndex + + deriveAddressPrivateKey (Shared accXPrv) keyRole addrIx = + Shared $ deriveAddressPrivateKeyShelley accXPrv keyRole addrIx + +instance Internal.SoftDerivation Shared where + deriveAddressPublicKey (Shared accXPub) keyRole addrIx = + Shared $ deriveAddressPublicKeyShelley accXPub keyRole addrIx + +-- | Generate a root key from a corresponding mnemonic. +-- +-- @since 3.4.0 +genMasterKeyFromMnemonic + :: SomeMnemonic + -- ^ Some valid mnemonic sentence. + -> ScrubbedBytes + -- ^ An optional second-factor passphrase (or 'mempty') + -> Shared 'RootK XPrv +genMasterKeyFromMnemonic = Internal.genMasterKeyFromMnemonic + +-- | Generate a root key from a corresponding root 'XPrv' +-- +-- @since 3.4.0 +genMasterKeyFromXPrv :: XPrv -> Shared 'RootK XPrv +genMasterKeyFromXPrv = Internal.genMasterKeyFromXPrv + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives an account private key from the given root private key. +-- +-- @since 3.4.0 +deriveAccountPrivateKey + :: Shared 'RootK XPrv + -> Index 'Hardened 'AccountK + -> Shared 'AccountK XPrv +deriveAccountPrivateKey = Internal.deriveAccountPrivateKey + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives a multisig private key from the given account private key for payment credential. +-- +-- @since 3.4.0 +deriveAddressPrivateKey + :: Shared 'AccountK XPrv + -> Role + -> Index 'Soft 'PaymentK + -> Shared 'ScriptK XPrv +deriveAddressPrivateKey = coerce . Internal.deriveAddressPrivateKey + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives a multisig private key from the given account private key for delegation credential. +-- +-- @since 3.4.0 +deriveDelegationPrivateKey + :: Shared 'AccountK XPrv + -> Index 'Soft 'PaymentK + -> Shared 'ScriptK XPrv +deriveDelegationPrivateKey accPrv = coerce . + Internal.deriveAddressPrivateKey accPrv Stake + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock +-- +-- | Derives a multisig public key from the given account public key for payment credential. +-- +-- @since 3.4.0 +deriveAddressPublicKey + :: Shared 'AccountK XPub + -> Role + -> Index 'Soft 'PaymentK + -> Shared 'ScriptK XPub +deriveAddressPublicKey = coerce . Internal.deriveAddressPublicKey + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock +-- +-- | Derives a multisig public key from the given account public key for delegation credential. +-- +-- @since 3.4.0 +deriveDelegationPublicKey + :: Shared 'AccountK XPub + -> Index 'Soft 'PaymentK + -> Shared 'ScriptK XPub +deriveDelegationPublicKey accPub = coerce . + Internal.deriveAddressPublicKey accPub Stake + +-- +-- Unsafe +-- + +-- | Unsafe backdoor for constructing an 'Shared' key from a raw 'XPrv'. this is +-- unsafe because it lets the caller choose the actually derivation 'depth'. +-- +-- This can be useful however when serializing / deserializing such a type, or to +-- speed up test code (and avoid having to do needless derivations from a master +-- key down to an address key for instance). +-- +-- @since 3.4.0 +liftXPrv :: XPrv -> Shared depth XPrv +liftXPrv = Shared + +-- | Unsafe backdoor for constructing an 'Shared' key from a raw 'XPub'. this is +-- unsafe because it lets the caller choose the actually derivation 'depth'. +-- +-- This can be useful however when serializing / deserializing such a type, or to +-- speed up test code (and avoid having to do needless derivations from a master +-- key down to an address key for instance). +-- +-- @since 3.4.0 +liftXPub :: XPub -> Shared depth XPub +liftXPub = Shared + + +-- | Calculates wallet id of shared wallet +-- It takes raw bytes of account public kye (64-bytes), +-- spending script template, and +-- optionally staking script template. +-- +-- @since 3.10.0 +sharedWalletId + :: ByteString + -> Script Cosigner + -> Maybe (Script Cosigner) + -> ByteString +sharedWalletId bytes spending stakingM = + if BS.length bytes == 64 then + hashWalletId $ + bytes <> + serializeScriptTemplate spending <> + maybe mempty serializeScriptTemplate stakingM + else + error "Extended account public key is expected to have 64 bytes." + where + serializeScriptTemplate = T.encodeUtf8 . scriptToText + +-- +-- Internal +-- + +--- | Computes a 28-byte Blake2b224 digest of a Shared 'XPub'. +--- +--- @since 3.4.0 +hashKey :: KeyRole -> Shared key XPub -> KeyHash +hashKey cred = KeyHash cred . hashCredential . xpubPublicKey . getKey + +-- Purpose is a constant set to 1854' (or 0x8000073e) following the +-- CIP-1854 Multi-signatures HD Wallets +-- +-- Hardened derivation is used at this level. +purposeIndex :: Word32 +purposeIndex = 0x8000073e diff --git a/lib/Cardano/Address/Style/Shelley.hs b/lib/Cardano/Address/Style/Shelley.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Address/Style/Shelley.hs @@ -0,0 +1,1311 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_HADDOCK prune #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Address.Style.Shelley + ( -- $overview + + -- * Shelley + Shelley + , getKey + , Role (..) + , roleFromIndex + , roleToIndex + , Credential (..) + , CredentialType (..) + , hashKey + + -- * Key Derivation + -- $keyDerivation + , genMasterKeyFromXPrv + , genMasterKeyFromMnemonic + , deriveAccountPrivateKey + , deriveAddressPrivateKey + , deriveDelegationPrivateKey + , deriveDRepPrivateKey + , deriveCCColdPrivateKey + , deriveCCHotPrivateKey + , deriveAddressPublicKey + , derivePolicyPrivateKey + + -- * Addresses + -- $addresses + , InspectAddress (..) + , AddressInfo (..) + , ReferenceInfo (..) + , eitherInspectAddress + , inspectAddress + , inspectShelleyAddress + , paymentAddress + , delegationAddress + , pointerAddress + , stakeAddress + , extendAddress + , ErrExtendAddress (..) + , ErrInspectAddressOnlyShelley (..) + , ErrInspectAddress (..) + , prettyErrInspectAddressOnlyShelley + , prettyErrInspectAddress + + -- * Network Discrimination + , MkNetworkDiscriminantError (..) + , mkNetworkDiscriminant + , inspectNetworkDiscriminant + , shelleyMainnet + , shelleyTestnet + + -- * Unsafe + , liftXPrv + , liftXPub + , liftPub + , unsafeFromRight + + -- Internals + , minSeedLengthBytes + , genMasterKeyFromMnemonicShelley + , deriveAccountPrivateKeyShelley + , deriveAddressPrivateKeyShelley + , deriveAddressPublicKeyShelley + ) where + +import Prelude + +import Cardano.Address + ( Address (..) + , AddressDiscrimination (..) + , ChainPointer (..) + , HasNetworkDiscriminant (..) + , NetworkDiscriminant (..) + , NetworkTag (..) + , invariantNetworkTag + , invariantSize + , unsafeMkAddress + ) +import Cardano.Address.Derivation + ( Depth (..) + , DerivationScheme (..) + , DerivationType (..) + , Index (..) + , Pub + , XPrv + , XPub + , credentialHashSize + , deriveXPrv + , deriveXPub + , generateNew + , hashCredential + , indexFromWord32 + , pubToBytes + , unsafeMkIndex + , xpubPublicKey + ) +import Cardano.Address.Internal + ( WithErrorMessage (..), orElse ) +import Cardano.Address.KeyHash + ( KeyHash (..), KeyRole (..) ) +import Cardano.Address.Script + ( Script, ScriptHash (..), toScriptHash ) +import Cardano.Mnemonic + ( SomeMnemonic, someMnemonicToBytes ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode ) +import Control.DeepSeq + ( NFData ) +import Control.Exception + ( Exception, displayException ) +import Control.Exception.Base + ( assert ) +import Control.Monad + ( unless, when ) +import Control.Monad.Catch + ( MonadThrow, throwM ) +import Data.Aeson + ( ToJSON (..), (.=) ) +import Data.Bifunctor + ( bimap, first ) +import Data.Binary.Get + ( runGetOrFail ) +import Data.Binary.Put + ( putByteString, putWord8, runPut ) +import Data.Bits + ( shiftR, (.&.) ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Maybe + ( fromMaybe, isNothing ) +import Data.Typeable + ( Typeable ) +import Data.Word + ( Word32, Word8 ) +import Data.Word7 + ( getVariableLengthNat, putVariableLengthNat ) +import Fmt + ( Buildable, build, format, (+|), (|+) ) +import GHC.Generics + ( Generic ) + +import qualified Cardano.Address.Derivation as Internal +import qualified Cardano.Address.Style.Byron as Byron +import qualified Cardano.Address.Style.Icarus as Icarus +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.Aeson as Json +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +-- $overview +-- +-- This module provides an implementation of: +-- +-- - 'Cardano.Address.Derivation.GenMasterKey': for generating Shelley master keys from mnemonic sentences +-- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical hard derivation of parent to child keys +-- - 'Cardano.Address.Derivation.SoftDerivation': for hierarchical soft derivation of parent to child keys +-- +-- - 'paymentAddress': for constructing payment addresses from a address public key or a script +-- - 'delegationAddress': for constructing delegation addresses from payment credential (public key or script) and stake credential (public key or script) +-- - 'pointerAddress': for constructing delegation addresses from payment credential (public key or script) and chain pointer +-- - 'stakeAddress': for constructing reward accounts from stake credential (public key or script) + +-- | A cryptographic key for sequential-scheme address derivation, with +-- phantom-types to disambiguate key types. +-- +-- @ +-- let rootPrivateKey = Shelley 'RootK XPrv +-- let accountPubKey = Shelley 'AccountK XPub +-- let addressPubKey = Shelley 'PaymentK XPub +-- @ +-- +-- @since 2.0.0 +newtype Shelley (depth :: Depth) key = Shelley + { getKey :: key + -- ^ Extract the raw 'XPrv' or 'XPub' wrapped by this type. + -- + -- @since 1.0.0 + } + deriving stock (Generic, Show, Eq) + +deriving instance (Functor (Shelley depth)) +instance (NFData key) => NFData (Shelley depth key) + +-- | Describe what the keys within an account are used for. +-- +-- - UTxOExternal: used for public addresses sent to other parties for receiving money. +-- - UTxOInternal: generated by wallet software to send change back to the wallet. +-- - Stake: used for stake key(s) and delegation. +-- - DRep: used for DRep key derivation +-- - CCCold: used for constitutional committee cold key derivation +-- - CCHot: used for constitutional committee hot key derivation +-- +-- @since 3.0.0 +data Role + = UTxOExternal + | UTxOInternal + | Stake + | DRep + | CCCold + | CCHot + deriving (Generic, Typeable, Show, Eq, Ord, Bounded) + +instance NFData Role + +roleFromIndex :: Index 'Soft depth -> Maybe Role +roleFromIndex ix = case indexToWord32 ix of + 0 -> Just UTxOExternal + 1 -> Just UTxOInternal + 2 -> Just Stake + 3 -> Just DRep + 4 -> Just CCCold + 5 -> Just CCHot + _ -> Nothing + +roleToIndex :: Role -> Index 'Soft depth +roleToIndex = unsafeMkIndex . \case + UTxOExternal -> 0 + UTxOInternal -> 1 + Stake -> 2 + DRep -> 3 + CCCold -> 4 + CCHot -> 5 + +-- +-- Key Derivation +-- +-- $keyDerivation +-- +-- === Generating a root key from 'SomeMnemonic' +-- > :set -XOverloadedStrings +-- > :set -XTypeApplications +-- > :set -XDataKinds +-- > import Cardano.Mnemonic ( mkSomeMnemonic ) +-- > +-- > let (Right mw) = mkSomeMnemonic @'[15] ["network","empty","cause","mean","expire","private","finger","accident","session","problem","absurd","banner","stage","void","what"] +-- > let sndFactor = mempty -- Or alternatively, a second factor mnemonic transformed to bytes via someMnemonicToBytes +-- > let rootK = genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv +-- +-- === Deriving child keys +-- +-- Let's consider the following 3rd, 4th and 5th derivation paths @0'\/0\/14@ +-- +-- > let Just accIx = indexFromWord32 0x80000000 +-- > let acctK = deriveAccountPrivateKey rootK accIx +-- > +-- > let Just addIx = indexFromWord32 0x00000014 +-- > let addrK = deriveAddressPrivateKey acctK UTxOExternal addIx +-- +-- > let stakeK = deriveDelegationPrivateKey acctK + +instance Internal.GenMasterKey Shelley where + type SecondFactor Shelley = ScrubbedBytes + + genMasterKeyFromXPrv = liftXPrv + genMasterKeyFromMnemonic fstFactor sndFactor = + Shelley $ genMasterKeyFromMnemonicShelley fstFactor sndFactor + +instance Internal.HardDerivation Shelley where + type AccountIndexDerivationType Shelley = 'Hardened + type AddressIndexDerivationType Shelley = 'Soft + type WithRole Shelley = Role + + deriveAccountPrivateKey (Shelley rootXPrv) accIx = + Shelley $ deriveAccountPrivateKeyShelley rootXPrv accIx purposeIndex + + deriveAddressPrivateKey (Shelley accXPrv) role addrIx = + Shelley $ deriveAddressPrivateKeyShelley accXPrv role addrIx + +instance Internal.SoftDerivation Shelley where + deriveAddressPublicKey (Shelley accXPub) role addrIx = + Shelley $ deriveAddressPublicKeyShelley accXPub role addrIx + +-- | Generate a root key from a corresponding mnemonic. +-- +-- @since 2.0.0 +genMasterKeyFromMnemonic + :: SomeMnemonic + -- ^ Some valid mnemonic sentence. + -> ScrubbedBytes + -- ^ An optional second-factor passphrase (or 'mempty') + -> Shelley 'RootK XPrv +genMasterKeyFromMnemonic = + Internal.genMasterKeyFromMnemonic + +-- | Generate a root key from a corresponding root 'XPrv' +-- +-- @since 2.0.0 +genMasterKeyFromXPrv + :: XPrv -> Shelley 'RootK XPrv +genMasterKeyFromXPrv = + Internal.genMasterKeyFromXPrv + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives an account private key from the given root private key. +-- +-- @since 2.0.0 +deriveAccountPrivateKey + :: Shelley 'RootK XPrv + -> Index 'Hardened 'AccountK + -> Shelley 'AccountK XPrv +deriveAccountPrivateKey = + Internal.deriveAccountPrivateKey + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives a policy private key from the given root private key. +-- +-- @since 3.9.0 +derivePolicyPrivateKey + :: Shelley 'RootK XPrv + -> Index 'Hardened 'PolicyK + -> Shelley 'PolicyK XPrv +derivePolicyPrivateKey (Shelley rootXPrv) policyIx = + Shelley $ deriveAccountPrivateKeyShelley rootXPrv policyIx policyPurposeIndex + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock. +-- +-- | Derives an address private key from the given account private key. +-- +-- @since 2.0.0 +deriveAddressPrivateKey + :: Shelley 'AccountK XPrv + -> Role + -> Index 'Soft 'PaymentK + -> Shelley 'PaymentK XPrv +deriveAddressPrivateKey = + Internal.deriveAddressPrivateKey + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock +-- +-- | Derives an address public key from the given account public key. +-- +-- @since 2.0.0 +deriveAddressPublicKey + :: Shelley 'AccountK XPub + -> Role + -> Index 'Soft 'PaymentK + -> Shelley 'PaymentK XPub +deriveAddressPublicKey = + Internal.deriveAddressPublicKey + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock +-- +-- | Derive a delegation key for a corresponding 'AccountK'. Note that wallet +-- software are by convention only using one delegation key per account, and always +-- the first account (with index 0'). +-- +-- Deriving delegation keys for something else than the initial account is not +-- recommended and can lead to incompatibility with existing wallet softwares +-- (Daedalus, Yoroi, Adalite...). +-- +-- @since 2.0.0 +deriveDelegationPrivateKey + :: Shelley 'AccountK XPrv + -> Shelley 'DelegationK XPrv +deriveDelegationPrivateKey accXPrv = + let (Shelley stakeXPrv) = + deriveAddressPrivateKey accXPrv Stake (minBound @(Index 'Soft _)) + in Shelley stakeXPrv + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock +-- +-- | Derive a DRep key for a corresponding 'AccountK'. Note that wallet +-- software are by convention only using one delegation key per account, and always +-- the first account (with index 0'). +-- +-- Deriving DRep keys for something else than the initial account is not +-- recommended and can lead to incompatibility with existing wallet softwares +-- (Daedalus, Yoroi, Adalite...). +-- +deriveDRepPrivateKey + :: Shelley 'AccountK XPrv + -> Shelley 'DRepK XPrv +deriveDRepPrivateKey accXPrv = + let (Shelley drepXPrv) = + deriveAddressPrivateKey accXPrv DRep (minBound @(Index 'Soft _)) + in Shelley drepXPrv + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock +-- +-- | Derive a CCCold key for a corresponding 'AccountK'. Note that wallet +-- software are by convention only using one delegation key per account, and always +-- the first account (with index 0'). +-- +-- Deriving CCCold keys for something else than the initial account is not +-- recommended and can lead to incompatibility with existing wallet softwares +-- (Daedalus, Yoroi, Adalite...). +-- +deriveCCColdPrivateKey + :: Shelley 'AccountK XPrv + -> Shelley 'CCColdK XPrv +deriveCCColdPrivateKey accXPrv = + let (Shelley ccColdXPrv) = + deriveAddressPrivateKey accXPrv CCCold (minBound @(Index 'Soft _)) + in Shelley ccColdXPrv + +-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock +-- +-- | Derive a CCHot key for a corresponding 'AccountK'. Note that wallet +-- software are by convention only using one delegation key per account, and always +-- the first account (with index 0'). +-- +-- Deriving CCHot keys for something else than the initial account is not +-- recommended and can lead to incompatibility with existing wallet softwares +-- (Daedalus, Yoroi, Adalite...). +-- +deriveCCHotPrivateKey + :: Shelley 'AccountK XPrv + -> Shelley 'CCHotK XPrv +deriveCCHotPrivateKey accXPrv = + let (Shelley ccHotXPrv) = + deriveAddressPrivateKey accXPrv CCHot (minBound @(Index 'Soft _)) + in Shelley ccHotXPrv + +-- +-- Addresses +-- +-- $addresses +-- === Generating a 'PaymentAddress' from public key credential +-- +-- > import Cardano.Address ( bech32 ) +-- > import Cardano.Address.Derivation ( toXPub ) +-- > +-- > let (Right tag) = mkNetworkDiscriminant 1 +-- > let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK) +-- > bech32 $ paymentAddress tag paymentCredential +-- > "addr1vxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdncxsce5t" +-- +-- === Generating a 'PaymentAddress' from script credential +-- +-- > import Cardano.Address.Script.Parser ( scriptFromString ) +-- > import Cardano.Address.Script ( toScriptHash ) +-- > import Codec.Binary.Encoding ( encode ) +-- > import Data.Text.Encoding ( decodeUtf8 ) +-- > +-- > let (Right tag) = mkNetworkDiscriminant 1 +-- > let verKey1 = "script_vkh18srsxr3khll7vl3w9mqfu55n6wzxxlxj7qzr2mhnyreluzt36ms" +-- > let verKey2 = "script_vkh18srsxr3khll7vl3w9mqfu55n6wzxxlxj7qzr2mhnyrenxv223vj" +-- > let scriptStr = "all [" ++ verKey1 ++ ", " ++ verKey2 ++ "]" +-- > let (Right script) = scriptFromString scriptStr +-- > let infoSpendingScriptHash@(ScriptHash bytes) = toScriptHash script +-- > decodeUtf8 (encode EBase16 bytes) +-- > "a015ae61075e25c3d9250bdcbc35c6557272127927ecf2a2d716e29f" +-- > bech32 $ paymentAddress tag (PaymentFromScriptHash infoSpendingScriptHash) +-- > "addr1wxspttnpqa0zts7ey59ae0p4ce2hyusj0yn7eu4z6utw98c9uxm83" +-- +-- === Generating a 'DelegationAddress' +-- +-- > let (Right tag) = mkNetworkDiscriminant 1 +-- > let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK) +-- > let delegationCredential = DelegationFromExtendedKey $ (toXPub <$> stakeK) +-- > bech32 $ delegationAddress tag paymentCredential delegationCredential +-- > "addr1qxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdn7nudck0fzve4346yytz3wpwv9yhlxt7jwuc7ytwx2vfkyqmkc5xa" +-- +-- === Generating a 'PointerAddress' +-- +-- > import Cardano.Address ( ChainPointer (..) ) +-- > +-- > let (Right tag) = mkNetworkDiscriminant 1 +-- > let ptr = ChainPointer 123 1 2 +-- > let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK) +-- > bech32 $ pointerAddress tag paymentCredential ptr +-- > "addr1gxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdnmmqypqfcp5um" +-- +-- === Generating a 'DelegationAddress' from using the same script credential in both payment and delegation +-- > bech32 $ delegationAddress tag (PaymentFromScriptHash infoSpendingScriptHash) (DelegationFromScript infoSpendingScriptHash) +-- > "addr1xxspttnpqa0zts7ey59ae0p4ce2hyusj0yn7eu4z6utw98aqzkhxzp67yhpajfgtmj7rt3j4wfepy7f8ane294cku20swucnrl" + +-- | Possible errors from inspecting a Shelley, Icarus, or Byron address. +-- +-- @since 3.4.0 +data ErrInspectAddress + = WrongInputSize Int -- ^ Unexpected size + | ErrShelley ErrInspectAddressOnlyShelley + | ErrIcarus Icarus.ErrInspectAddress + | ErrByron Byron.ErrInspectAddress + deriving (Generic, Show, Eq) + deriving ToJSON via WithErrorMessage ErrInspectAddress + +instance Exception ErrInspectAddress where + displayException = prettyErrInspectAddress + +-- | Possible errors from inspecting a Shelley address +-- +-- @since 3.4.0 +data ErrInspectAddressOnlyShelley + = PtrRetrieveError String -- ^ Human readable error of underlying operation + | UnknownType Word8 -- ^ Unknown value in address type field + deriving (Generic, Eq, Show) + deriving ToJSON via WithErrorMessage ErrInspectAddressOnlyShelley + +instance Exception ErrInspectAddressOnlyShelley where + displayException = prettyErrInspectAddressOnlyShelley + +-- | Pretty-print an 'ErrInspectAddressOnlyShelley' +-- +-- @since 3.4.0 +prettyErrInspectAddressOnlyShelley :: ErrInspectAddressOnlyShelley -> String +prettyErrInspectAddressOnlyShelley = \case + PtrRetrieveError s -> + format "Failed to retrieve pointer (underlying errors was: {})" s + UnknownType t -> + format "Unknown address type {}" t + +-- | Pretty-print an 'ErrInspectAddress' +-- +-- @since 3.0.0 +prettyErrInspectAddress :: ErrInspectAddress -> String +prettyErrInspectAddress = \case + WrongInputSize i -> format "Wrong input size of {}" i + ErrShelley e -> "Invalid Shelley address: " + <> prettyErrInspectAddressOnlyShelley e + ErrIcarus e -> "Invalid Icarus address: " + <> Icarus.prettyErrInspectAddress e + ErrByron e -> "Invalid Byron address: " + <> Byron.prettyErrInspectAddress e + +-- Determines whether an 'Address' a Shelley address. +-- +-- Throws 'AddrError' if it's not a valid Shelley address, or a ready-to-print +-- string giving details about the 'Address'. +-- +-- @since 2.0.0 +inspectShelleyAddress + :: MonadThrow m + => Maybe XPub + -> Address + -> m Json.Value +inspectShelleyAddress = inspectAddress +{-# DEPRECATED inspectShelleyAddress "use qualified 'inspectAddress' instead." #-} + +-- | Analyze an 'Address' to know whether it's a valid address for the Cardano +-- Shelley era. Shelley format addresses, as well as old-style Byron and Icarus +-- addresses can be parsed by this function. +-- +-- Returns a JSON value containing details about the 'Address', or throws +-- 'ErrInspectAddress' if it's not a valid address. +-- +-- @since 3.0.0 +inspectAddress + :: MonadThrow m + => Maybe XPub + -> Address + -> m Json.Value +inspectAddress mRootPub addr = either throwM (pure . toJSON) $ + eitherInspectAddress mRootPub addr + +-- | Determines whether an 'Address' is a valid address for the Cardano Shelley +-- era. Shelley format addresses, as well as old-style Byron and Icarus +-- addresses can be parsed by this function. +-- +-- Returns either details about the 'Address', or 'ErrInspectAddress' if it's +-- not a valid address. +-- +-- @since 3.4.0 +eitherInspectAddress + :: Maybe XPub + -> Address + -> Either ErrInspectAddress InspectAddress +eitherInspectAddress mRootPub addr = unpackAddress addr >>= parseInfo + where + parseInfo :: AddressParts -> Either ErrInspectAddress InspectAddress + parseInfo parts = case addrType parts of + -- 1000: byron address + 0b10000000 -> + (bimap ErrIcarus InspectAddressIcarus (Icarus.eitherInspectAddress addr)) + `orElse` + (bimap ErrByron InspectAddressByron (Byron.eitherInspectAddress mRootPub addr)) + -- Anything else: shelley address + _ -> bimap ErrShelley InspectAddressShelley (parseAddressInfoShelley parts) + +-- | Returns either details about the 'Address', or +-- 'ErrInspectAddressOnlyShelley' if it's not a valid Shelley address. +parseAddressInfoShelley :: AddressParts -> Either ErrInspectAddressOnlyShelley AddressInfo +parseAddressInfoShelley AddressParts{..} = case addrType of + -- 0000: base address: keyhash28,keyhash28 + 0b00000000 | addrRestLength == credentialHashSize + credentialHashSize -> + Right addressInfo + { infoStakeReference = Just ByValue + , infoSpendingKeyHash = Just addrHash1 + , infoStakeKeyHash = Just addrHash2 + } + -- 0001: base address: scripthash28,keyhash28 + 0b00010000 | addrRestLength == credentialHashSize + credentialHashSize -> + Right addressInfo + { infoStakeReference = Just ByValue + , infoSpendingScriptHash = Just addrHash1 + , infoStakeKeyHash = Just addrHash2 + } + -- 0010: base address: keyhash28,scripthash28 + 0b00100000 | addrRestLength == credentialHashSize + credentialHashSize -> + Right addressInfo + { infoStakeReference = Just ByValue + , infoSpendingKeyHash = Just addrHash1 + , infoStakeScriptHash = Just addrHash2 + } + -- 0011: base address: scripthash28,scripthash28 + 0b00110000 | addrRestLength == 2 * credentialHashSize -> + Right addressInfo + { infoStakeReference = Just ByValue + , infoSpendingScriptHash = Just addrHash1 + , infoStakeScriptHash = Just addrHash2 + } + -- 0100: pointer address: keyhash28, 3 variable length uint + 0b01000000 | addrRestLength > credentialHashSize -> do + ptr <- getPtr addrHash2 + pure addressInfo + { infoStakeReference = Just $ ByPointer ptr + , infoSpendingKeyHash = Just addrHash1 + } + -- 0101: pointer address: scripthash28, 3 variable length uint + 0b01010000 | addrRestLength > credentialHashSize -> do + ptr <- getPtr addrHash2 + pure addressInfo + { infoStakeReference = Just $ ByPointer ptr + , infoSpendingScriptHash = Just addrHash1 + } + -- 0110: enterprise address: keyhash28 + 0b01100000 | addrRestLength == credentialHashSize -> + Right addressInfo + { infoStakeReference = Nothing + , infoSpendingKeyHash = Just addrHash1 + } + -- 0111: enterprise address: scripthash28 + 0b01110000 | addrRestLength == credentialHashSize -> + Right addressInfo + { infoStakeReference = Nothing + , infoSpendingScriptHash = Just addrHash1 + } + -- 1110: reward account: keyhash28 + 0b11100000 | addrRestLength == credentialHashSize -> + Right addressInfo + { infoStakeReference = Just ByValue + , infoStakeKeyHash = Just addrHash1 + } + -- 1111: reward account: scripthash28 + 0b11110000 | addrRestLength == credentialHashSize -> + Right addressInfo + { infoStakeReference = Just ByValue + , infoStakeScriptHash = Just addrHash1 + } + unknown -> Left (UnknownType unknown) + + where + addressInfo = AddressInfo + { infoNetworkTag = NetworkTag $ fromIntegral addrNetwork + , infoStakeReference = Nothing + , infoSpendingKeyHash = Nothing + , infoStakeKeyHash = Nothing + , infoSpendingScriptHash = Nothing + , infoStakeScriptHash = Nothing + , infoAddressType = shiftR (addrType .&. 0b11110000) 4 + } + + getPtr :: ByteString -> Either ErrInspectAddressOnlyShelley ChainPointer + getPtr source = case runGetOrFail get (BL.fromStrict source) of + Right ("", _, a) -> Right a + Right _ -> err "Unconsumed bytes after pointer" + Left (_, _, e) -> err e + where + get = ChainPointer + <$> getVariableLengthNat + <*> getVariableLengthNat + <*> getVariableLengthNat + err = Left . PtrRetrieveError + +-- | The result of 'eitherInspectAddress'. +-- +-- @since 3.4.0 +data InspectAddress + = InspectAddressShelley AddressInfo + | InspectAddressIcarus Icarus.AddressInfo + | InspectAddressByron Byron.AddressInfo + deriving (Generic, Show, Eq) + +instance ToJSON InspectAddress where + toJSON addr = combine (styleProp <> missingProp) (toJSON addr') + where + addr' = case addr of + InspectAddressShelley s -> toJSON s + InspectAddressIcarus i -> toJSON i + InspectAddressByron b -> toJSON b + + styleProp = "address_style" .= Json.String styleName + styleName = case addr of + InspectAddressShelley _ -> "Shelley" + InspectAddressIcarus _ -> "Icarus" + InspectAddressByron _ -> "Byron" + missingProp = case addr of + InspectAddressShelley _ -> mempty + InspectAddressIcarus _ -> noStakeRef + InspectAddressByron _ -> noStakeRef + noStakeRef = "stake_reference" .= Json.String "none" + + combine extra = \case + Json.Object props -> Json.Object (extra <> props) + otherValue -> otherValue -- not expected to happen + +-- | An inspected Shelley address. +-- +-- @since 3.4.0 +data AddressInfo = AddressInfo + { infoStakeReference :: !(Maybe ReferenceInfo) + , infoSpendingKeyHash :: !(Maybe ByteString) + , infoStakeKeyHash :: !(Maybe ByteString) + , infoSpendingScriptHash :: !(Maybe ByteString) + , infoStakeScriptHash :: !(Maybe ByteString) + , infoNetworkTag :: !NetworkTag + , infoAddressType :: !Word8 + } deriving (Generic, Show, Eq) + +-- | Info from 'Address' about how delegation keys are located. +-- +-- @since 3.6.1 +data ReferenceInfo + = ByValue + | ByPointer ChainPointer + deriving (Generic, Show, Eq) + +instance ToJSON AddressInfo where + toJSON AddressInfo{..} = Json.object $ + [ "network_tag" .= infoNetworkTag + , "stake_reference" .= Json.String (maybe "none" refName infoStakeReference) + , "address_type" .= toJSON @Word8 infoAddressType + ] + ++ maybe [] (\ptr -> ["pointer" .= ptr]) (infoStakeReference >>= getPointer) + ++ jsonHash "spending_key_hash" CIP5.addr_vkh infoSpendingKeyHash + ++ jsonHash "stake_key_hash" CIP5.stake_vkh infoStakeKeyHash + ++ jsonHash "spending_shared_hash" CIP5.addr_shared_vkh infoSpendingScriptHash + ++ jsonHash "stake_shared_hash" CIP5.stake_shared_vkh infoStakeScriptHash + ++ jsonHash "stake_script_hash" CIP5.stake_vkh infoStakeScriptHash + where + getPointer ByValue = Nothing + getPointer (ByPointer ptr) = Just ptr + + jsonHash _ _ Nothing = [] + jsonHash key hrp (Just bs) = + [ key .= base16 bs , (key <> "_bech32") .= bech32With hrp bs ] + + base16 = T.unpack . T.decodeUtf8 . encode EBase16 + bech32With hrp = T.decodeUtf8 . encode (EBech32 hrp) + + refName ByValue = "by value" + refName (ByPointer _) = "by pointer" + +-- | Structure containing the result of 'unpackAddress', the constituent parts +-- of an address. Internal to this module. +data AddressParts = AddressParts + { addrType :: Word8 + , addrNetwork :: Word8 + , addrHash1 :: ByteString + , addrHash2 :: ByteString + , addrRestLength :: Int + } deriving (Show) + +-- | Split fields out of a Shelley encoded address. +unpackAddress :: Address -> Either ErrInspectAddress AddressParts +unpackAddress (unAddress -> bytes) + | BS.length bytes >= 1 + credentialHashSize = Right AddressParts{..} + | otherwise = Left $ WrongInputSize $ BS.length bytes + where + (fstByte, rest) = first BS.head $ BS.splitAt 1 bytes + addrType = fstByte .&. 0b11110000 + addrNetwork = fstByte .&. 0b00001111 + (addrHash1, addrHash2) = BS.splitAt credentialHashSize rest + addrRestLength = BS.length rest + +-- | Shelley offers several ways to identify ownership of entities on chain. +-- +-- This data-family has two instances, depending on whether the key is used for +-- payment or for delegation. +-- +-- @since 3.0.0 +data family Credential (purpose :: Depth) + +data instance Credential 'PaymentK where + PaymentFromKey :: Shelley 'PaymentK Pub -> Credential 'PaymentK + PaymentFromExtendedKey :: Shelley 'PaymentK XPub -> Credential 'PaymentK + PaymentFromKeyHash :: KeyHash -> Credential 'PaymentK + PaymentFromScript :: Script KeyHash -> Credential 'PaymentK + PaymentFromScriptHash :: ScriptHash -> Credential 'PaymentK + deriving Show + +data instance Credential 'DelegationK where + DelegationFromKey :: Shelley 'DelegationK Pub -> Credential 'DelegationK + DelegationFromExtendedKey :: Shelley 'DelegationK XPub -> Credential 'DelegationK + DelegationFromKeyHash :: KeyHash -> Credential 'DelegationK + DelegationFromScript :: Script KeyHash -> Credential 'DelegationK + DelegationFromScriptHash :: ScriptHash -> Credential 'DelegationK + DelegationFromPointer :: ChainPointer -> Credential 'DelegationK + deriving Show + +-- Re-export from 'Cardano.Address' to have it documented specialized in Haddock. +-- +-- | Convert a payment credential (key or script) to a payment 'Address' valid +-- for the given network discrimination. +-- +-- @since 2.0.0 +paymentAddress + :: NetworkDiscriminant Shelley + -> Credential 'PaymentK + -> Address +paymentAddress discrimination = \case + PaymentFromKey keyPub -> + constructPayload + (EnterpriseAddress CredentialFromKey) + discrimination + (hashCredential . pubToBytes . getKey $ keyPub) + PaymentFromExtendedKey keyXPub -> + constructPayload + (EnterpriseAddress CredentialFromKey) + discrimination + (hashCredential . xpubPublicKey . getKey $ keyXPub) + PaymentFromKeyHash (KeyHash Payment verKeyHash) -> + constructPayload + (EnterpriseAddress CredentialFromKey) + discrimination + verKeyHash + PaymentFromKeyHash (KeyHash keyrole _) -> + error $ "Payment credential should be built from key hash having payment" + <> " role. Key hash with " <> show keyrole <> " was used." + PaymentFromScript script -> + let (ScriptHash bytes) = toScriptHash script + in constructPayload + (EnterpriseAddress CredentialFromScript) + discrimination + bytes + PaymentFromScriptHash (ScriptHash bytes) -> + constructPayload + (EnterpriseAddress CredentialFromScript) + discrimination + bytes + +-- | Convert a payment credential (key or script) and a delegation credential (key or script) +-- to a delegation 'Address' valid for the given network discrimination. +-- Funds sent to this address will be delegated according to the delegation settings +-- attached to the delegation key. +-- +-- @since 2.0.0 +delegationAddress + :: NetworkDiscriminant Shelley + -> Credential 'PaymentK + -> Credential 'DelegationK + -> Address +delegationAddress discrimination paymentCredential stakeCredential = + unsafeFromRight $ extendAddress + (paymentAddress discrimination paymentCredential) + stakeCredential + +-- | Convert a payment credential (key or script) and pointer to delegation certificate in blockchain to a +-- pointer 'Address' valid for the given network discrimination. +-- +-- @since 3.0.0 +pointerAddress + :: NetworkDiscriminant Shelley + -> Credential 'PaymentK + -> ChainPointer + -> Address +pointerAddress discrimination credential pointer = + unsafeFromRight $ extendAddress + (paymentAddress discrimination credential) + (DelegationFromPointer pointer) + +-- | Convert a delegation credential (key or script) to a stake Address (aka reward account address) +-- for the given network discrimination. +-- +-- @since 3.0.0 +stakeAddress + :: NetworkDiscriminant Shelley + -> Credential 'DelegationK + -> Either ErrInvalidStakeAddress Address +stakeAddress discrimination = \case + DelegationFromKey keyPub -> + Right $ constructPayload + (RewardAccount CredentialFromKey) + discrimination + (hashCredential . pubToBytes . getKey $ keyPub) + + DelegationFromExtendedKey keyXPub -> + Right $ constructPayload + (RewardAccount CredentialFromKey) + discrimination + (hashCredential . xpubPublicKey . getKey $ keyXPub) + + DelegationFromKeyHash (KeyHash Delegation verKeyHash) -> + Right $ constructPayload + (RewardAccount CredentialFromKey) + discrimination + verKeyHash + + DelegationFromKeyHash (KeyHash keyrole _) -> + Left $ ErrStakeAddressFromKeyHash keyrole + + DelegationFromScript script -> + let (ScriptHash bytes) = toScriptHash script + in Right $ constructPayload + (RewardAccount CredentialFromScript) + discrimination + bytes + + DelegationFromScriptHash (ScriptHash bytes) -> + Right $ constructPayload + (RewardAccount CredentialFromScript) + discrimination + bytes + + DelegationFromPointer{} -> + Left ErrStakeAddressFromPointer + +-- | Stake addresses can only be constructed from key or script hash. Trying to +-- create one from a pointer will result in the following error. +-- +-- @since 3.0.0 +data ErrInvalidStakeAddress + = ErrStakeAddressFromPointer + | ErrStakeAddressFromKeyHash KeyRole + deriving (Generic, Show, Eq) + +-- | Extend an existing payment 'Address' to make it a delegation address. +-- +-- @since 2.0.0 +extendAddress + :: Address + -> Credential 'DelegationK + -> Either ErrExtendAddress Address +extendAddress addr infoStakeReference = do + when (isNothing (inspectAddress Nothing addr)) $ + Left $ ErrInvalidAddressStyle "Given address isn't a Shelley address" + + let bytes = unAddress addr + let (fstByte, rest) = first BS.head $ BS.splitAt 1 bytes + + let paymentFirstByte = fstByte .&. 0b11110000 + let extendableTypes = addressType <$> + [ EnterpriseAddress CredentialFromKey + , EnterpriseAddress CredentialFromScript + ] + unless (paymentFirstByte `elem` extendableTypes) $ do + Left $ ErrInvalidAddressType "Only payment addresses can be extended" + + case infoStakeReference of + -- base address: keyhash28,keyhash28 : 00000000 -> 0 + -- base address: scripthash28,keyhash28 : 00010000 -> 16 + DelegationFromKey delegationKey -> do + pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do + -- 0b01100000 .&. 0b00011111 = 0 + -- 0b01110000 .&. 0b00011111 = 16 + putWord8 $ fstByte .&. 0b00011111 + putByteString rest + putByteString . hashCredential . pubToBytes . getKey $ delegationKey + + -- base address: keyhash28,keyhash28 : 00000000 -> 0 + -- base address: scripthash28,keyhash28 : 00010000 -> 16 + DelegationFromExtendedKey delegationKey -> do + pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do + -- 0b01100000 .&. 0b00011111 = 0 + -- 0b01110000 .&. 0b00011111 = 16 + putWord8 $ fstByte .&. 0b00011111 + putByteString rest + putByteString . hashCredential . xpubPublicKey . getKey $ delegationKey + DelegationFromKeyHash (KeyHash Delegation keyhash) -> do + pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do + -- 0b01100000 .&. 0b00011111 = 0 + -- 0b01110000 .&. 0b00011111 = 16 + putWord8 $ fstByte .&. 0b00011111 + putByteString rest + putByteString keyhash + DelegationFromKeyHash (KeyHash keyrole _) -> do + Left $ ErrInvalidKeyHashType $ + "Delegation part can only be constructed from delegation key hash. " + <> "Key hash of " <> show keyrole <> " was used." + + -- base address: keyhash28,scripthash28 : 00100000 -> 32 + -- base address: scripthash28,scripthash28 : 00110000 -> 48 + DelegationFromScript script -> do + pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do + -- 0b01100000 .&. 0b00111111 = 32 + -- 0b01110000 .&. 0b00111111 = 48 + putWord8 $ fstByte .&. 0b00111111 + putByteString rest + putByteString $ unScriptHash $ toScriptHash script + + -- base address: keyhash28,scripthash28 : 00100000 -> 32 + -- base address: scripthash28,scripthash28 : 00110000 -> 48 + DelegationFromScriptHash (ScriptHash scriptBytes) -> do + pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do + -- 0b01100000 .&. 0b00111111 = 32 + -- 0b01110000 .&. 0b00111111 = 48 + putWord8 $ fstByte .&. 0b00111111 + putByteString rest + putByteString scriptBytes + + -- pointer address: keyhash28, 3 variable length uint : 01000000 -> 64 + -- pointer address: scripthash28, 3 variable length uint : 01010000 -> 80 + DelegationFromPointer pointer -> do + pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do + -- 0b01100000 .&. 0b01011111 = 64 + -- 0b01110000 .&. 0b01011111 = 80 + putWord8 $ fstByte .&. 0b01011111 + putByteString rest + putPointer pointer + where + putPointer (ChainPointer a b c) = do + putVariableLengthNat a + putVariableLengthNat b + putVariableLengthNat c + +-- | Captures error occuring when trying to extend an invalid address. +-- +-- @since 2.0.0 +data ErrExtendAddress + = ErrInvalidAddressStyle String + | ErrInvalidAddressType String + | ErrInvalidKeyHashType String + deriving (Show) + +-- +-- Network Discriminant +-- + +instance HasNetworkDiscriminant Shelley where + type NetworkDiscriminant Shelley = NetworkTag + addressDiscrimination _ = RequiresNetworkTag + networkTag = id + +-- | Error reported from trying to create a network discriminant from number +-- +-- @since 2.0.0 +newtype MkNetworkDiscriminantError + = ErrWrongNetworkTag Integer + -- ^ Wrong network tag. + deriving (Eq, Show) + +instance Buildable MkNetworkDiscriminantError where + build (ErrWrongNetworkTag i) = "Invalid network tag "+|i|+". Must be between [0, 15]" + +-- | Construct 'NetworkDiscriminant' for Cardano 'Shelley' from a number. +-- If the number is invalid, ie., not between 0 and 15, then +-- 'MkNetworkDiscriminantError' is thrown. +-- +-- @since 2.0.0 +mkNetworkDiscriminant + :: Integer + -> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley) +mkNetworkDiscriminant nTag + | nTag < 16 = Right $ NetworkTag $ fromIntegral nTag + | otherwise = Left $ ErrWrongNetworkTag nTag + +-- | Retrieve the network discriminant of a given 'Address'. +-- If the 'Address' is malformed or, not a shelley address, returns Nothing. +-- +-- @since 2.0.0 +inspectNetworkDiscriminant + :: Address + -> Maybe (NetworkDiscriminant Shelley) +inspectNetworkDiscriminant addr = case eitherInspectAddress Nothing addr of + Right (InspectAddressShelley info) -> Just (infoNetworkTag info) + _ -> Nothing + +-- | 'NetworkDicriminant' for Cardano MainNet & Shelley +-- +-- @since 2.0.0 +shelleyMainnet :: NetworkDiscriminant Shelley +shelleyMainnet = NetworkTag 1 + +-- | 'NetworkDicriminant' for Cardano Testnet & Shelley +-- +-- @since 2.0.0 +shelleyTestnet :: NetworkDiscriminant Shelley +shelleyTestnet = NetworkTag 0 + +-- +-- Unsafe +-- + +-- | Unsafe backdoor for constructing an 'Shelley' key from a raw 'XPrv'. this is +-- unsafe because it lets the caller choose the actually derivation 'depth'. +-- +-- This can be useful however when serializing / deserializing such a type, or to +-- speed up test code (and avoid having to do needless derivations from a master +-- key down to an address key for instance). +-- +-- @since 2.0.0 +liftXPrv :: XPrv -> Shelley depth XPrv +liftXPrv = Shelley + +-- | Unsafe backdoor for constructing an 'Shelley' key from a raw 'XPub'. this is +-- unsafe because it lets the caller choose the actually derivation 'depth'. +-- +-- This can be useful however when serializing / deserializing such a type, or to +-- speed up test code (and avoid having to do needless derivations from a master +-- key down to an address key for instance). +-- +-- @since 2.0.0 +liftXPub :: XPub -> Shelley depth XPub +liftXPub = Shelley + +-- | Unsafe backdoor for constructing an 'Shelley' key from a raw 'Pub'. this is +-- unsafe because it lets the caller choose the actually derivation 'depth'. +-- +-- This can be useful however when serializing / deserializing such a type, or to +-- speed up test code (and avoid having to do needless derivations from a master +-- key down to an address key for instance). +-- +-- @since 3.0.0 +liftPub :: Pub -> Shelley depth Pub +liftPub = Shelley + +-- Use with care when it is _safe_. +unsafeFromRight :: Either a c -> c +unsafeFromRight = + either (error "impossible: internally generated invalid address") id + +-- +-- Internal +-- + +-- Purpose is a constant set to 1852' (or 0x8000073c) following the BIP-44 +-- extension for Cardano: +-- +-- https://github.com/input-output-hk/implementation-decisions/blob/e2d1bed5e617f0907bc5e12cf1c3f3302a4a7c42/text/1852-hd-chimeric.md +-- +-- It indicates that the subtree of this node is used according to this +-- specification. +-- +-- Hardened derivation is used at this level. +purposeIndex :: Word32 +purposeIndex = 0x8000073c + +-- Policy purpose is a constant set to 1855' (or 0x8000073c) following the CIP-1855 +-- https://github.com/cardano-foundation/CIPs/tree/master/CIP-1855 +-- +-- It indicates that the subtree of this node is used according to this +-- specification. +-- +-- Hardened derivation is used at this level. +policyPurposeIndex :: Word32 +policyPurposeIndex = 0x8000073f + + +-- One master node (seed) can be used for unlimited number of independent +-- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the +-- same space for various cryptocoins has some disadvantages. +-- +-- This level creates a separate subtree for every cryptocoin, avoiding reusing +-- addresses across cryptocoins and improving privacy issues. +-- +-- Coin type is a constant, set for each cryptocoin. For Cardano this constant +-- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada +-- Lovelace. +-- +-- Hardened derivation is used at this level. +coinTypeIndex :: Word32 +coinTypeIndex = 0x80000717 + +-- The minimum seed length for 'genMasterKeyFromMnemonic'. +minSeedLengthBytes :: Int +minSeedLengthBytes = 16 + +-- A sum-type for constructing addresses payment part. +data CredentialType = CredentialFromKey | CredentialFromScript + deriving (Show, Eq) + +-- Different types of Shelley addresses. +data AddressType + = BaseAddress CredentialType CredentialType + | PointerAddress CredentialType + | EnterpriseAddress CredentialType + | RewardAccount CredentialType + | ByronAddress + deriving (Show, Eq) + +addressType :: AddressType -> Word8 +addressType = \case + ByronAddress -> 0b10000000 + BaseAddress CredentialFromKey CredentialFromKey -> 0b00000000 + BaseAddress CredentialFromScript CredentialFromKey -> 0b00010000 + BaseAddress CredentialFromKey CredentialFromScript -> 0b00100000 + BaseAddress CredentialFromScript CredentialFromScript -> 0b00110000 + PointerAddress CredentialFromKey -> 0b01000000 + PointerAddress CredentialFromScript -> 0b01010000 + EnterpriseAddress CredentialFromKey -> 0b01100000 + EnterpriseAddress CredentialFromScript -> 0b01110000 + RewardAccount CredentialFromKey -> 0b11100000 + RewardAccount CredentialFromScript -> 0b11110000 + +-- Helper to constructs appropriate address headers. Rest of the payload is left +-- to the caller as a raw 'ByteString'. +constructPayload + :: AddressType + -> NetworkDiscriminant Shelley + -> ByteString + -> Address +constructPayload addrType discrimination bytes = unsafeMkAddress $ + invariantSize expectedLength $ BL.toStrict $ runPut $ do + putWord8 firstByte + putByteString bytes + where + firstByte = + let netTagLimit = 16 + in addressType addrType + invariantNetworkTag netTagLimit (networkTag @Shelley discrimination) + expectedLength = + let headerSizeBytes = 1 + in headerSizeBytes + credentialHashSize + +--Shelley specific derivation and generation +genMasterKeyFromMnemonicShelley + :: BA.ByteArrayAccess sndFactor + => SomeMnemonic + -> sndFactor + -> XPrv +genMasterKeyFromMnemonicShelley fstFactor = + generateNew seedValidated + where + seed = someMnemonicToBytes fstFactor + seedValidated = assert + (BA.length seed >= minSeedLengthBytes && BA.length seed <= 255) + seed + +deriveAccountPrivateKeyShelley + :: XPrv + -> Index derivationType depth + -> Word32 + -> XPrv +deriveAccountPrivateKeyShelley rootXPrv accIx purpose = + let + Just purposeIx = + indexFromWord32 @(Index 'Hardened _) purpose + Just coinTypeIx = + indexFromWord32 @(Index 'Hardened _) coinTypeIndex + purposeXPrv = -- lvl1 derivation; hardened derivation of purpose' + deriveXPrv DerivationScheme2 rootXPrv purposeIx + coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type' + deriveXPrv DerivationScheme2 purposeXPrv coinTypeIx + acctXPrv = -- lvl3 derivation; hardened derivation of account' index + deriveXPrv DerivationScheme2 coinTypeXPrv accIx + in + acctXPrv + +deriveAddressPrivateKeyShelley + :: XPrv + -> Role + -> Index derivationType depth + -> XPrv +deriveAddressPrivateKeyShelley accXPrv role addrIx = + let + changeXPrv = -- lvl4 derivation; soft derivation of change chain + deriveXPrv DerivationScheme2 accXPrv (roleToIndex role) + addrXPrv = -- lvl5 derivation; soft derivation of address index + deriveXPrv DerivationScheme2 changeXPrv addrIx + in + addrXPrv + +deriveAddressPublicKeyShelley + :: XPub + -> Role + -> Index derivationType depth + -> XPub +deriveAddressPublicKeyShelley accXPub role addrIx = + fromMaybe errWrongIndex $ do + changeXPub <- -- lvl4 derivation in bip44 is derivation of change chain + deriveXPub DerivationScheme2 accXPub (roleToIndex role) + -- lvl5 derivation in bip44 is derivation of address chain + deriveXPub DerivationScheme2 changeXPub addrIx + where + errWrongIndex = error $ + "deriveAddressPublicKey failed: was given an hardened (or too big) \ + \index for soft path derivation ( " ++ show addrIx ++ "). This is \ + \either a programmer error, or, we may have reached the maximum \ + \number of addresses for a given wallet." + +-- +-- Internal +-- + +--- | Computes a 28-byte Blake2b224 digest of a Shelley 'XPub'. +--- +--- @since 3.13.0 +hashKey :: KeyRole -> Shelley key XPub -> KeyHash +hashKey cred = KeyHash cred . hashCredential . xpubPublicKey . getKey diff --git a/lib/Cardano/Codec/Bech32/Prefixes.hs b/lib/Cardano/Codec/Bech32/Prefixes.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Codec/Bech32/Prefixes.hs @@ -0,0 +1,312 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{- HLINT ignore "Use camelCase" -} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 +-- +-- List common bech32 prefixes used for objects in the Cardano eco-systems. +-- +-- As specified in [CIP-5](https://github.com/cardano-foundation/CIPs/tree/master/CIP5) +-- and in [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105) +module Cardano.Codec.Bech32.Prefixes + ( -- * Addresses + addr + , addr_test + , script + , stake + , stake_test + + -- * Hashes + , addr_vkh + , stake_vkh + , addr_shared_vkh + , stake_shared_vkh + + -- * Keys for 1852H + , addr_vk + , addr_sk + , addr_xvk + , addr_xsk + , acct_vk + , acct_sk + , acct_xvk + , acct_xsk + , root_vk + , root_sk + , root_xvk + , root_xsk + , stake_vk + , stake_sk + , stake_xvk + , stake_xsk + + -- * Keys for 1854H + , addr_shared_vk + , addr_shared_sk + , addr_shared_xvk + , addr_shared_xsk + , acct_shared_vk + , acct_shared_sk + , acct_shared_xvk + , acct_shared_xsk + , root_shared_vk + , root_shared_sk + , root_shared_xvk + , root_shared_xsk + , stake_shared_vk + , stake_shared_sk + , stake_shared_xvk + , stake_shared_xsk + + -- * Keys for 1855H + , policy_vk + , policy_xvk + , policy_vkh + , policy_xsk + , policy_sk + + -- * Keys/hashes for CIP-0105 + , drep_vk + , drep_sk + , drep_xvk + , drep_xsk + , drep_vkh + , drep + , drep_script + + , cc_cold_vk + , cc_cold_sk + , cc_cold_xvk + , cc_cold_xsk + , cc_cold_vkh + , cc_cold + , cc_cold_script + + , cc_hot_vk + , cc_hot_sk + , cc_hot_xvk + , cc_hot_xsk + , cc_hot_vkh + , cc_hot + , cc_hot_script + ) where + +import Codec.Binary.Bech32 + ( HumanReadablePart ) +import Codec.Binary.Bech32.TH + ( humanReadablePart ) + + +-- Addresses + +addr :: HumanReadablePart +addr = [humanReadablePart|addr|] + +addr_test :: HumanReadablePart +addr_test = [humanReadablePart|addr_test|] + +script :: HumanReadablePart +script = [humanReadablePart|script|] + +stake :: HumanReadablePart +stake = [humanReadablePart|stake|] + +stake_test :: HumanReadablePart +stake_test = [humanReadablePart|stake_test|] + + +-- Keys + +addr_vk :: HumanReadablePart +addr_vk = [humanReadablePart|addr_vk|] + +addr_sk :: HumanReadablePart +addr_sk = [humanReadablePart|addr_sk|] + +addr_xvk :: HumanReadablePart +addr_xvk = [humanReadablePart|addr_xvk|] + +addr_xsk :: HumanReadablePart +addr_xsk = [humanReadablePart|addr_xsk|] + +acct_vk :: HumanReadablePart +acct_vk = [humanReadablePart|acct_vk|] + +acct_sk :: HumanReadablePart +acct_sk = [humanReadablePart|acct_sk|] + +acct_xvk :: HumanReadablePart +acct_xvk = [humanReadablePart|acct_xvk|] + +acct_xsk :: HumanReadablePart +acct_xsk = [humanReadablePart|acct_xsk|] + +root_vk :: HumanReadablePart +root_vk = [humanReadablePart|root_vk|] + +root_sk :: HumanReadablePart +root_sk = [humanReadablePart|root_sk|] + +root_xvk :: HumanReadablePart +root_xvk = [humanReadablePart|root_xvk|] + +root_xsk :: HumanReadablePart +root_xsk = [humanReadablePart|root_xsk|] + +stake_vk :: HumanReadablePart +stake_vk = [humanReadablePart|stake_vk|] + +stake_sk :: HumanReadablePart +stake_sk = [humanReadablePart|stake_sk|] + +stake_xvk :: HumanReadablePart +stake_xvk = [humanReadablePart|stake_xvk|] + +stake_xsk :: HumanReadablePart +stake_xsk = [humanReadablePart|stake_xsk|] + +addr_shared_vk :: HumanReadablePart +addr_shared_vk = [humanReadablePart|addr_shared_vk|] + +addr_shared_sk :: HumanReadablePart +addr_shared_sk = [humanReadablePart|addr_shared_sk|] + +addr_shared_xvk :: HumanReadablePart +addr_shared_xvk = [humanReadablePart|addr_shared_xvk|] + +addr_shared_xsk :: HumanReadablePart +addr_shared_xsk = [humanReadablePart|addr_shared_xsk|] + +acct_shared_vk :: HumanReadablePart +acct_shared_vk = [humanReadablePart|acct_shared_vk|] + +acct_shared_sk :: HumanReadablePart +acct_shared_sk = [humanReadablePart|acct_shared_sk|] + +acct_shared_xvk :: HumanReadablePart +acct_shared_xvk = [humanReadablePart|acct_shared_xvk|] + +acct_shared_xsk :: HumanReadablePart +acct_shared_xsk = [humanReadablePart|acct_shared_xsk|] + +root_shared_vk :: HumanReadablePart +root_shared_vk = [humanReadablePart|root_shared_vk|] + +root_shared_sk :: HumanReadablePart +root_shared_sk = [humanReadablePart|root_shared_sk|] + +root_shared_xvk :: HumanReadablePart +root_shared_xvk = [humanReadablePart|root_shared_xvk|] + +root_shared_xsk :: HumanReadablePart +root_shared_xsk = [humanReadablePart|root_shared_xsk|] + +stake_shared_vk :: HumanReadablePart +stake_shared_vk = [humanReadablePart|stake_shared_vk|] + +stake_shared_sk :: HumanReadablePart +stake_shared_sk = [humanReadablePart|stake_shared_sk|] + +stake_shared_xvk :: HumanReadablePart +stake_shared_xvk = [humanReadablePart|stake_shared_xvk|] + +stake_shared_xsk :: HumanReadablePart +stake_shared_xsk = [humanReadablePart|stake_shared_xsk|] + +-- Hashes + +addr_vkh :: HumanReadablePart +addr_vkh = [humanReadablePart|addr_vkh|] + +stake_vkh :: HumanReadablePart +stake_vkh = [humanReadablePart|stake_vkh|] + +addr_shared_vkh :: HumanReadablePart +addr_shared_vkh = [humanReadablePart|addr_shared_vkh|] + +stake_shared_vkh :: HumanReadablePart +stake_shared_vkh = [humanReadablePart|stake_shared_vkh|] + +-- Policy +policy_vk :: HumanReadablePart +policy_vk = [humanReadablePart|policy_vk|] + +policy_xvk :: HumanReadablePart +policy_xvk = [humanReadablePart|policy_xvk|] + +policy_vkh :: HumanReadablePart +policy_vkh = [humanReadablePart|policy_vkh|] + +policy_xsk :: HumanReadablePart +policy_xsk = [humanReadablePart|policy_xsk|] + +policy_sk :: HumanReadablePart +policy_sk = [humanReadablePart|policy_sk|] + +-- Keys/hashes for CIP-0105 +drep_vk :: HumanReadablePart +drep_vk = [humanReadablePart|drep_vk|] + +drep_sk :: HumanReadablePart +drep_sk = [humanReadablePart|drep_sk|] + +drep_xvk :: HumanReadablePart +drep_xvk = [humanReadablePart|drep_xvk|] + +drep_xsk :: HumanReadablePart +drep_xsk = [humanReadablePart|drep_xsk|] + +drep_vkh :: HumanReadablePart +drep_vkh = [humanReadablePart|drep_vkh|] + +drep :: HumanReadablePart +drep = [humanReadablePart|drep|] + +drep_script :: HumanReadablePart +drep_script = [humanReadablePart|drep_script|] + +cc_cold_vk :: HumanReadablePart +cc_cold_vk = [humanReadablePart|cc_cold_vk|] + +cc_cold_sk :: HumanReadablePart +cc_cold_sk = [humanReadablePart|cc_cold_sk|] + +cc_cold_xvk :: HumanReadablePart +cc_cold_xvk = [humanReadablePart|cc_cold_xvk|] + +cc_cold_vkh :: HumanReadablePart +cc_cold_vkh = [humanReadablePart|cc_cold_vkh|] + +cc_cold_xsk :: HumanReadablePart +cc_cold_xsk = [humanReadablePart|cc_cold_xsk|] + +cc_cold :: HumanReadablePart +cc_cold = [humanReadablePart|cc_cold|] + +cc_cold_script :: HumanReadablePart +cc_cold_script = [humanReadablePart|cc_cold_script|] + +cc_hot_vk :: HumanReadablePart +cc_hot_vk = [humanReadablePart|cc_hot_vk|] + +cc_hot_sk :: HumanReadablePart +cc_hot_sk = [humanReadablePart|cc_hot_sk|] + +cc_hot_xvk :: HumanReadablePart +cc_hot_xvk = [humanReadablePart|cc_hot_xvk|] + +cc_hot_xsk :: HumanReadablePart +cc_hot_xsk = [humanReadablePart|cc_hot_xsk|] + +cc_hot_vkh :: HumanReadablePart +cc_hot_vkh = [humanReadablePart|cc_hot_vkh|] + +cc_hot :: HumanReadablePart +cc_hot = [humanReadablePart|cc_hot|] + +cc_hot_script :: HumanReadablePart +cc_hot_script = [humanReadablePart|cc_hot_script|] diff --git a/lib/Cardano/Codec/Cbor.hs b/lib/Cardano/Codec/Cbor.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Codec/Cbor.hs @@ -0,0 +1,413 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 +-- +-- These are (partial) CBOR decoders for Byron binary types. Note that we +-- ignore most of the block's and header's content and only retrieve the pieces +-- of information relevant to us, wallet (we do assume a trusted node and +-- therefore, we needn't to care about verifying signatures and blocks +-- themselves). + +module Cardano.Codec.Cbor + ( -- * Encoders + encodeAddress + , encodeAttributes + , encodeDerivationPathAttr + , encodeProtocolMagicAttr + + -- * Decoders + , decodeAddress + , decodeAddressDerivationPath + , decodeAddressPayload + , decodeAllAttributes + , decodeDerivationPathAttr + , decodeProtocolMagicAttr + , deserialiseCbor + , unsafeDeserialiseCbor + + -- * Reexports from CBOR + , CBOR.encodeBytes + , CBOR.toStrictByteString + , CBOR.toLazyByteString + ) where + +import Prelude + +import Cardano.Crypto.Wallet + ( ChainCode (..), XPub (..) ) +import Control.Monad + ( replicateM, when ) +import Crypto.Error + ( CryptoError (..), CryptoFailable (..) ) +import Crypto.Hash + ( hash ) +import Crypto.Hash.Algorithms + ( Blake2b_224, SHA3_256 ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Digest.CRC32 + ( crc32 ) +import Data.List + ( find ) +import Data.Word + ( Word32, Word8 ) +import GHC.Stack + ( HasCallStack ) + +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Encoding as CBOR +import qualified Codec.CBOR.Read as CBOR +import qualified Codec.CBOR.Write as CBOR +import qualified Crypto.Cipher.ChaChaPoly1305 as Poly +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL + +{------------------------------------------------------------------------------- + Byron Address Binary Format + +In the composition of a Cardano address, the following functions concern the +"Derivation Path" box. + ++-------------------------------------------------------------------------------+ +| | +| CBOR-Serialized Object with CRC¹ | +| | ++-------------------------------------------------------------------------------+ + | + | + v ++-------------------------------------------------------------------------------+ +| Address Root | Address Attributes | AddrType | +| | | | +| Hash (224 bits) | Der. Path² + Stake + NM | PubKey | (Script) | Redeem | +| | (open for extension) | (open for extension) | ++-------------------------------------------------------------------------------+ + | | + | | +----------------------------------+ + v | | Derivation Path | ++---------------------------+ |---->| | +| SHA3-256 | | | ChaChaPoly⁴ AccountIx/AddressIx | +| |> Blake2b 224 | | +----------------------------------+ +| |> CBOR | | +| | | +| -AddrType | | +----------------------------------+ +| -ASD³ (~AddrType+PubKey) | | | Stake Distribution | +| -Address Attributes | | | | ++---------------------------+ |---->| BootstrapEra | (Single | Multi) | + | +----------------------------------+ + | + | + | +----------------------------------+ + | | Network Magic | + |---->| | + | Addr Discr: MainNet vs TestNet | + +----------------------------------+ + +-------------------------------------------------------------------------------} + +-- * Encoding + +-- | Encode a public key to a corresponding Cardano Address. The encoding of the +-- attributes part of an address is left out to the caller; This allows for +-- distinguishing between Sequential and Random addresses (the former doesn't +-- have any attributes to encode). +-- +-- @ +-- -- Old / Random Addresses +-- let encodeAddrAttributes = mempty +-- <> CBOR.encodeMapLen 1 +-- <> CBOR.encodeWord8 1 +-- <> encodeDerivationPath (hdPassphrase rootXPub) accIx addrIx +-- let addr = encodeAddress xpub encodeAddrAttributes +-- +-- -- New / Sequential Addresses +-- let encodeAddrAttributes = mempty <> CBOR.encodeMapLen 0 +-- let addr = encodeAddress xpub encodeAddrAttributes +-- @ +-- +-- Note that we are passing the behavior to encode attributes as a parameter +-- here and do not handle multiple cases in 'encodeAddress' itself for multiple +-- reasons: +-- +-- - Inversion of control gives us a nicer implementation overall +-- +-- - Encoding attributes for Random addresses requires more context than just +-- the public key (like the wallet root id and some extra logic for encoding +-- passphrases). This is just scheme-specific and is better left out of this +-- particular function +encodeAddress :: XPub -> [CBOR.Encoding] -> CBOR.Encoding +encodeAddress (XPub pub (ChainCode cc)) attrs = + encodeAddressPayload payload + where + blake2b224 = hash @_ @Blake2b_224 + sha3256 = hash @_ @SHA3_256 + payload = CBOR.toStrictByteString $ mempty + <> CBOR.encodeListLen 3 + <> CBOR.encodeBytes root + <> encodeAttributes attrs + <> CBOR.encodeWord8 0 -- Address Type, 0 = Public Key + root = BA.convert $ blake2b224 $ sha3256 $ CBOR.toStrictByteString $ mempty + <> CBOR.encodeListLen 3 + <> CBOR.encodeWord8 0 -- Address Type, 0 = Public Key + <> encodeSpendingData + <> encodeAttributes attrs + encodeXPub = + CBOR.encodeBytes (pub <> cc) + encodeSpendingData = CBOR.encodeListLen 2 + <> CBOR.encodeWord8 0 + <> encodeXPub + +encodeAddressPayload :: ByteString -> CBOR.Encoding +encodeAddressPayload payload = mempty + <> CBOR.encodeListLen 2 + <> CBOR.encodeTag 24 -- Hard-Coded Tag value in cardano-sl + <> CBOR.encodeBytes payload + <> CBOR.encodeWord32 (crc32 payload) + +encodeAttributes :: [CBOR.Encoding] -> CBOR.Encoding +encodeAttributes attrs = CBOR.encodeMapLen l <> mconcat attrs + where + l = fromIntegral (length attrs) + +encodeProtocolMagicAttr :: Word32 -> CBOR.Encoding +encodeProtocolMagicAttr pm = mempty + <> CBOR.encodeWord 2 -- Tag for 'ProtocolMagic' attribute + <> CBOR.encodeBytes (CBOR.toStrictByteString $ CBOR.encodeWord32 pm) + +-- This is the opposite of 'decodeDerivationPathAttr'. +-- +-- NOTE: The caller must ensure that the passphrase length is 32 bytes. +encodeDerivationPathAttr + :: ScrubbedBytes + -> Word32 + -> Word32 + -> CBOR.Encoding +encodeDerivationPathAttr pwd acctIx addrIx = mempty + <> CBOR.encodeWord8 1 -- Tag for 'DerivationPath' attribute + <> CBOR.encodeBytes (encryptDerivationPath pwd path) + where + path = encodeDerivationPath acctIx addrIx + +encodeDerivationPath + :: Word32 + -> Word32 + -> CBOR.Encoding +encodeDerivationPath acctIx addrIx = mempty + <> CBOR.encodeListLenIndef + <> CBOR.encodeWord32 acctIx + <> CBOR.encodeWord32 addrIx + <> CBOR.encodeBreak + +-- | ChaCha20/Poly1305 encrypting and signing the HD payload of addresses. +-- +-- NOTE: The caller must ensure that the passphrase length is 32 bytes. +encryptDerivationPath + :: ScrubbedBytes + -- ^ Symmetric key / passphrase, 32-byte long + -> CBOR.Encoding + -- ^ Payload to be encrypted + -> ByteString + -- ^ Ciphertext with a 128-bit crypto-tag appended. +encryptDerivationPath pwd payload = unsafeSerialize $ do + nonce <- Poly.nonce12 cardanoNonce + st1 <- Poly.finalizeAAD <$> Poly.initialize pwd nonce + let (out, st2) = Poly.encrypt (CBOR.toStrictByteString payload) st1 + return $ out <> BA.convert (Poly.finalize st2) + where + unsafeSerialize :: CryptoFailable ByteString -> ByteString + unsafeSerialize = + CBOR.toStrictByteString . CBOR.encodeBytes . useInvariant + + -- Encryption will fail if the key is the wrong size, but that won't happen + -- if the key was created with 'generateKeyFromSeed'. + useInvariant = \case + CryptoPassed res -> res + CryptoFailed err -> error $ "encodeAddressKey: " ++ show err + +-- | Hard-coded nonce from the legacy code-base. +cardanoNonce :: ByteString +cardanoNonce = "serokellfore" + +decodeAddress :: CBOR.Decoder s ByteString +decodeAddress = do + _ <- CBOR.decodeListLenCanonicalOf 2 + -- CRC Protection Wrapper + tag <- CBOR.decodeTag + -- Mysterious hard-coded tag cardano-sl seems to so much like + bytes <- CBOR.decodeBytes + -- Addr Root + Attributes + Type + crc <- CBOR.decodeWord32 -- CRC + + when (crc /= crc32 bytes) $ fail "non-matching crc32." + + -- NOTE 1: + -- Treating addresses as a blob here, so we just re-encode them as such + -- Ultimately for us, addresses are nothing more than a bunch of bytes that + -- we display in a Base58 format when we have to. + return $ CBOR.toStrictByteString $ mempty + <> CBOR.encodeListLen 2 + <> CBOR.encodeTag tag + <> CBOR.encodeBytes bytes + <> CBOR.encodeWord32 crc + +decodeAddressPayload :: CBOR.Decoder s ByteString +decodeAddressPayload = do + _ <- CBOR.decodeListLenCanonicalOf 2 + _ <- CBOR.decodeTag + bytes <- CBOR.decodeBytes + crc <- CBOR.decodeWord32 + when (crc /= crc32 bytes) $ fail "non-matching crc32." + return bytes + +decodeAddressDerivationPath + :: ScrubbedBytes + -> CBOR.Decoder s (Maybe (Word32, Word32)) +decodeAddressDerivationPath pwd = do + _ <- CBOR.decodeListLenCanonicalOf 3 + _ <- CBOR.decodeBytes + path <- decodeAllAttributes >>= decodeDerivationPathAttr pwd + addrType <- CBOR.decodeWord8 -- Type + when (addrType /= 0) $ + fail $ mconcat + [ "decodeAddressDerivationPath: type is not 0 (public key), it is " + , show addrType + ] + pure path + +decodeProtocolMagicAttr + :: CBOR.Decoder s (Maybe Word32) +decodeProtocolMagicAttr = do + _ <- CBOR.decodeListLenCanonicalOf 3 + _ <- CBOR.decodeBytes + attrs <- decodeAllAttributes + case find ((== 2) . fst) attrs of + Nothing -> pure Nothing + Just (_, bytes) -> case deserialiseCbor CBOR.decodeWord32 bytes of + Left _ -> fail "unable to decode attribute into protocol magic" + Right pm -> pure (Just pm) + +-- | The attributes are pairs of numeric tags and bytes, where the bytes will be +-- CBOR-encoded stuff. This decoder does not enforce "canonicity" of entries. +decodeAllAttributes + :: CBOR.Decoder s [(Word8, ByteString)] +decodeAllAttributes = do + n <- CBOR.decodeMapLenCanonical -- Address Attributes length + replicateM n decodeAttr + where + decodeAttr = (,) <$> CBOR.decodeWord8 <*> CBOR.decodeBytes + +decodeDerivationPathAttr + :: ScrubbedBytes + -> [(Word8, ByteString)] + -> CBOR.Decoder s (Maybe (Word32, Word32)) +decodeDerivationPathAttr pwd attrs = do + case lookup derPathTag attrs of + Just payload -> decodeNestedBytes decoder payload + Nothing -> fail $ mconcat + [ "decodeDerivationPathAttr: Missing attribute " + , show derPathTag + ] + where + derPathTag = 1 + decoder :: CBOR.Decoder s (Maybe (Word32, Word32)) + decoder = do + bytes <- CBOR.decodeBytes + case decryptDerivationPath pwd bytes of + CryptoPassed plaintext -> + Just <$> decodeNestedBytes decodeDerivationPath plaintext + CryptoFailed _ -> + pure Nothing + +-- | ChaCha20/Poly1305 decrypting and authenticating the HD payload of +-- addresses. +decryptDerivationPath + :: ScrubbedBytes + -- ^ Symmetric key / passphrase, 32-byte long + -> ByteString + -- ^ Payload to be decrypted + -> CryptoFailable ByteString +decryptDerivationPath pwd bytes = do + let (payload, tag) = BS.splitAt (BS.length bytes - 16) bytes + nonce <- Poly.nonce12 cardanoNonce + st1 <- Poly.finalizeAAD <$> Poly.initialize pwd nonce + let (out, st2) = Poly.decrypt payload st1 + when (BA.convert (Poly.finalize st2) /= tag) $ + CryptoFailed CryptoError_MacKeyInvalid + return out + +-- Opposite of 'encodeDerivationPath'. +decodeDerivationPath + :: CBOR.Decoder s (Word32, Word32) +decodeDerivationPath = do + ixs <- decodeListIndef CBOR.decodeWord32 + case ixs of + [acctIx, addrIx] -> + pure (acctIx, addrIx) + _ -> + fail $ mconcat + [ "decodeDerivationPath: invalid derivation path payload: " + , "expected two indexes but got: " + , show ixs + ] +-- | Decode an arbitrary long list. CBOR introduce a "break" character to +-- mark the end of the list, so we simply decode each item until we encounter +-- a break character. +-- +-- @ +-- myDecoder :: CBOR.Decoder s [MyType] +-- myDecoder = decodeListIndef decodeOne +-- where +-- decodeOne :: CBOR.Decoder s MyType +-- @ +decodeListIndef :: forall s a. CBOR.Decoder s a -> CBOR.Decoder s [a] +decodeListIndef decodeOne = do + _ <- CBOR.decodeListLenIndef + CBOR.decodeSequenceLenIndef (flip (:)) [] reverse decodeOne + +-- | Byron CBOR encodings often have CBOR nested in CBOR. This helps decoding +-- a particular 'ByteString' that represents a CBOR object. +decodeNestedBytes + :: MonadFail m + => (forall s. CBOR.Decoder s r) + -> ByteString + -> m r +decodeNestedBytes dec bytes = + case CBOR.deserialiseFromBytes dec (BL.fromStrict bytes) of + Right ("", res) -> + pure res + Right _ -> + fail "Leftovers when decoding nested bytes" + _ -> + fail "Could not decode nested bytes" + +-- | Shortcut for deserialising a strict 'Bytestring' with the given decoder. +deserialiseCbor + :: (forall s. CBOR.Decoder s a) + -> ByteString + -> Either CBOR.DeserialiseFailure a +deserialiseCbor dec = + fmap snd . CBOR.deserialiseFromBytes dec . BL.fromStrict + +-- | CBOR deserialise without error handling - handy for prototypes or testing. +unsafeDeserialiseCbor + :: HasCallStack + => (forall s. CBOR.Decoder s a) + -> BL.ByteString + -> a +unsafeDeserialiseCbor decoder bytes = either + (\e -> error $ "unsafeSerializeCbor: " <> show e) + snd + (CBOR.deserialiseFromBytes decoder bytes) diff --git a/lib/Cardano/Mnemonic.hs b/lib/Cardano/Mnemonic.hs new file mode 100644 --- /dev/null +++ b/lib/Cardano/Mnemonic.hs @@ -0,0 +1,461 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Cardano.Mnemonic + ( + -- * Introduction + -- $introduction + + -- * @SomeMnemonic@ + SomeMnemonic(..) + , MkSomeMnemonic (..) + , MkSomeMnemonicError(..) + , someMnemonicToBytes + , NatVals (..) + + -- * @Mnemonic@ + , Mnemonic + , mkMnemonic + , MkMnemonicError(..) + , mnemonicToText + , mnemonicToEntropy + + -- * @Entropy@ + , Entropy + , genEntropy + , mkEntropy + , entropyToBytes + , entropyToMnemonic + + -- Internals & Re-export from @Crypto.Encoding.BIP39@ + , EntropyError(..) + , DictionaryError(..) + , MnemonicWordsError(..) + , ValidEntropySize + , ValidChecksumSize + , ValidMnemonicSentence + , ConsistentEntropy + , CheckSumBits + , EntropySize + , MnemonicWords + , MnemonicException(..) + + -- * Troubleshooting + -- $troubleshooting + ) where + +import Prelude + +import Basement.NormalForm + ( NormalForm (..) ) +import Basement.Sized.List + ( unListN ) +import Control.Arrow + ( left ) +import Control.DeepSeq + ( NFData (..) ) +import Control.Monad.Catch + ( throwM ) +import Crypto.Encoding.BIP39 + ( CheckSumBits + , ConsistentEntropy + , DictionaryError (..) + , Entropy + , EntropyError (..) + , EntropySize + , MnemonicSentence + , MnemonicWords + , MnemonicWordsError (..) + , ValidChecksumSize + , ValidEntropySize + , ValidMnemonicSentence + , dictionaryIndexToWord + , entropyRaw + , entropyToWords + , mnemonicPhrase + , mnemonicPhraseToMnemonicSentence + , mnemonicSentenceToListN + , toEntropy + , wordsToEntropy + ) +import Data.Bifunctor + ( bimap ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.List + ( intercalate ) +import Data.Proxy + ( Proxy (..) ) +import Data.Text + ( Text ) +import Data.Type.Equality + ( (:~:) (..), testEquality ) +import Data.Typeable + ( Typeable ) +import GHC.TypeLits + ( KnownNat, Nat, natVal ) +import Type.Reflection + ( typeOf ) + +import qualified Basement.Compat.Base as Basement +import qualified Basement.String as Basement +import qualified Crypto.Encoding.BIP39.English as Dictionary +import qualified Crypto.Random.Entropy as Crypto +import qualified Data.ByteArray as BA +import qualified Data.Text as T + +-- $introduction +-- +-- We call 'Entropy' an arbitrary sequence of bytes that has been generated +-- through __high quality randomness methods__. The allowed size of an +-- 'Entropy' is @96-256@ bits and is __necessarily a multiple of 32 bits__ (4 +-- bytes). +-- +-- We call 'Mnemonic' an 'Entropy' with an appended checksum calculated by +-- taking the first @ent / 32@ bits of the /SHA256/ hash of it, where ent +-- designates the 'Entropy' size in bits. +-- +-- The concatenated result is split into groups of @11@ bits, each encoding a +-- number from 0 to 2047 serving as an index into a known dictionary: +-- +-- https://github.com/cardano-foundation/cardano-wallet/tree/master/specifications/mnemonic/english.txt +-- +-- This makes for a __human-readable sentence__ of English words. +-- +-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+ +-- | Entropy Size | Checksum Size | Sentence Length | Example | +-- +=====================+===============+=================+=================================================================================================================================================+ +-- | 96 bits (12 bytes) | 3 bits | 9 words | test child burst immense armed parrot company walk dog | +-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+ +-- | 128 bits (16 bytes) | 4 bits | 12 words | test walk nut penalty hip pave soap entry language right filter choice | +-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+ +-- | 160 bits (20 bytes) | 5 bits | 15 words | art forum devote street sure rather head chuckle guard poverty release quote oak craft enemy | +-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+ +-- | 192 bits (24 bytes) | 6 bits | 18 words | churn shaft spoon second erode useless thrive burst group seed element sign scrub buffalo jelly grace neck useless | +-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+ +-- | 224 bits (28 bytes) | 7 bits | 21 words | draft ability female child jump maid roof hurt below live topple paper exclude ordinary coach churn sunset emerge blame ketchup much | +-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+ +-- | 256 bits (32 bytes) | 8 bits | 24 words | excess behave track soul table wear ocean cash stay nature item turtle palm soccer lunch horror start stumble month panic right must lock dress | +-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+ + +-- A opaque 'Mnemonic' type. +data Mnemonic (mw :: Nat) = Mnemonic + { mnemonicToEntropy :: Entropy (EntropySize mw) + -- ^ Convert a 'Mnemonic' back to an 'Entropy'. + -- + -- @since 1.0.0 + , mnemonicToSentence :: MnemonicSentence mw + } deriving stock (Eq, Show) + +-- This wraps EntropyError of "Cardano.Encoding.BIP39" +newtype MnemonicException csz = + UnexpectedEntropyError (EntropyError csz) + -- ^ Invalid entropy length or checksum + deriving stock (Show, Typeable) + deriving newtype NFData + +-- | This wraps errors from "Cardano.Encoding.BIP39" +data MkMnemonicError csz + = ErrMnemonicWords MnemonicWordsError + -- ^ Wrong number of words in mnemonic. + | ErrEntropy (EntropyError csz) + -- ^ Invalid entropy length or checksum. + | ErrDictionary DictionaryError + -- ^ Invalid word in mnemonic. + deriving stock (Eq, Show) + +deriving instance Eq (EntropyError czs) +deriving instance Eq MnemonicWordsError +deriving instance Eq DictionaryError + +-- NFData instances +instance NFData (Mnemonic mw) where + rnf (Mnemonic ent ws) = toNormalForm ent `seq` toNormalForm ws +instance NFData (EntropyError csz) where + rnf (ErrInvalidEntropyLength a b) = rnf a `seq` rnf b + rnf (ErrInvalidEntropyChecksum a b) = toNormalForm a `seq` toNormalForm b +instance NFData MnemonicWordsError where + rnf (ErrWrongNumberOfWords a b) = rnf a `seq` rnf b +instance NFData DictionaryError where + rnf (ErrInvalidDictionaryWord s) = toNormalForm s +instance NFData (MkMnemonicError csz) where + rnf (ErrMnemonicWords e) = rnf e + rnf (ErrEntropy e) = rnf e + rnf (ErrDictionary e) = rnf e + +-- | Smart-constructor for the 'Entropy'. Make sure the 'ByteString' comes from a highly random source or use 'genEntropy'. +-- +-- __example__: +-- +-- >>> mkEntropy @160 bytes +-- Entropy {} :: Entropy 160 +-- +-- __property__: +-- +-- prop> mkEntropy (entropyToBytes ent) == Right ent +-- +-- @since 1.0.0 +mkEntropy + :: forall (ent :: Nat) csz. (ValidEntropySize ent, ValidChecksumSize ent csz) + => ScrubbedBytes + -> Either (EntropyError csz) (Entropy ent) +mkEntropy = toEntropy + +-- | Generate Entropy of a given size using a cryptographically secure random seed. +-- +-- __example:__ +-- +-- >>> genEntropy @128 +-- Entropy {} :: Entropy 128 +-- +-- @since 1.0.0 +genEntropy + :: forall (ent :: Nat) csz. (ValidEntropySize ent, ValidChecksumSize ent csz) + => IO (Entropy ent) +genEntropy = + let + size = + fromIntegral $ natVal @ent Proxy + eitherToIO = + either (throwM . UnexpectedEntropyError) return + in + (eitherToIO . mkEntropy) =<< Crypto.getEntropy (size `div` 8) + +-- | Smart-constructor for 'Mnemonic'. Requires a type application to +-- disambiguate the mnemonic size. +-- +-- __example__: +-- +-- >>> mkMnemonic @15 sentence +-- Mnemonic {} :: Mnemonic 15 +-- +-- __property__: +-- +-- prop> mkMnemonic (mnemonicToText mnemonic) == Right mnemonic +-- +-- @since 1.0.0 +mkMnemonic + :: forall (mw :: Nat) (ent :: Nat) csz. + ( ConsistentEntropy ent mw csz + , EntropySize mw ~ ent + ) + => [Text] + -> Either (MkMnemonicError csz) (Mnemonic mw) +mkMnemonic wordsm = do + phrase <- left ErrMnemonicWords + $ mnemonicPhrase @mw (toUtf8String <$> wordsm) + + sentence <- left ErrDictionary + $ mnemonicPhraseToMnemonicSentence Dictionary.english phrase + + entropy <- left ErrEntropy + $ wordsToEntropy sentence + + pure Mnemonic + { mnemonicToEntropy = entropy + , mnemonicToSentence = sentence + } + +-- | Convert an Entropy to a corresponding Mnemonic Sentence. Since 'Entropy' +-- and 'Mnemonic' can only be created through smart-constructors, this function +-- cannot fail and is total. +-- +-- @since 1.0.0 +entropyToMnemonic + :: forall mw ent csz. + ( ValidMnemonicSentence mw + , ValidEntropySize ent + , ValidChecksumSize ent csz + , ent ~ EntropySize mw + , mw ~ MnemonicWords ent + ) + => Entropy ent + -> Mnemonic mw +entropyToMnemonic entropy = Mnemonic + { mnemonicToSentence = entropyToWords entropy + , mnemonicToEntropy = entropy + } + +-- | Convert 'Entropy' to plain bytes. +-- +-- @since 1.0.0 +entropyToBytes + :: Entropy n + -> ScrubbedBytes +entropyToBytes = BA.convert . entropyRaw + +toUtf8String + :: Text + -> Basement.String +toUtf8String = Basement.fromString . T.unpack + +fromUtf8String + :: Basement.String + -> Text +fromUtf8String = T.pack . Basement.toList + +instance (KnownNat csz) => Basement.Exception (MnemonicException csz) + +-- | Convert a 'Mnemonic' to a sentence of English mnemonic words. +-- +-- @since 1.0.0 +mnemonicToText + :: Mnemonic mw + -> [Text] +mnemonicToText = + map (fromUtf8String . dictionaryIndexToWord Dictionary.english) + . unListN + . mnemonicSentenceToListN + . mnemonicToSentence + +-- | Convert a 'SomeMnemonic' to bytes. +-- +-- @since 1.0.1 +someMnemonicToBytes :: SomeMnemonic -> ScrubbedBytes +someMnemonicToBytes (SomeMnemonic mw) = entropyToBytes $ mnemonicToEntropy mw + +-- | Ease the manipulation of 'Mnemonic' by encapsulating the type constraints inside a constructor. +-- This is particularly useful for functions which do not require anything but a valid 'Mnemonic' without any +-- particular pre-condition on the size of the 'Mnemonic' itself. +-- +-- @since 1.0.0 +data SomeMnemonic where + SomeMnemonic :: forall mw. KnownNat mw => Mnemonic mw -> SomeMnemonic + +deriving instance Show SomeMnemonic +instance Eq SomeMnemonic where + (SomeMnemonic mwa) == (SomeMnemonic mwb) = + case typeOf mwa `testEquality` typeOf mwb of + Nothing -> False + Just Refl -> mwa == mwb +instance NFData SomeMnemonic where + rnf (SomeMnemonic mnem) = rnf mnem + +-- | This class enables caller to parse text list of variable length +-- into mnemonic sentences. +-- +-- Note that the given 'Nat's **have** to be valid mnemonic sizes, otherwise the +-- underlying code won't even compile, with not-so-friendly error messages. +class MkSomeMnemonic (sz :: [Nat]) where + -- | Construct a mnemonic from a list of words. This function is particularly useful when the + -- number of words is not necessarily known at runtime. The function is however /ambiguous/ and + -- requires thereby a type application. + -- + -- __examples:__ + -- + -- >>> mkSomeMnemonic @'[ 12 ] [ "test", "child", "burst", "immense", "armed", "parrot", "company", "walk", "dog" ] + -- Left "Invalid number of words: 12 words are expected." + -- + -- >>> mkSomeMnemonic @'[ 9, 12, 15 ] [ "test", "child", "burst", "immense", "armed", "parrot", "company", "walk", "dog" ] + -- Right (SomeMnemonic ...) + -- + -- @since 1.0.0 + mkSomeMnemonic :: [Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic + +-- | Error reported from trying to create a passphrase from a given mnemonic +-- +-- @since 1.0.0 +newtype MkSomeMnemonicError (sz :: [Nat]) = + MkSomeMnemonicError { getMkSomeMnemonicError :: String } + deriving stock (Eq, Show) + +instance {-# OVERLAPS #-} + ( n ~ EntropySize mw + , csz ~ CheckSumBits n + , ConsistentEntropy n mw csz + , MkSomeMnemonic rest + , NatVals rest + ) => + MkSomeMnemonic (mw ': rest) + where + mkSomeMnemonic parts = case parseMW of + Left err -> left (promote err) parseRest + Right mw -> Right mw + where + parseMW = left (MkSomeMnemonicError . getMkSomeMnemonicError) $ -- coerce + mkSomeMnemonic @'[mw] parts + parseRest = left (MkSomeMnemonicError . getMkSomeMnemonicError) $ -- coerce + mkSomeMnemonic @rest parts + promote e e' = + let + sz = fromEnum <$> natVals (Proxy :: Proxy (mw ': rest)) + mw = fromEnum $ natVal (Proxy :: Proxy mw) + in if length parts `notElem` sz + then MkSomeMnemonicError + $ "Invalid number of words: " + <> intercalate ", " (show <$> init sz) + <> (if length sz > 1 then " or " else "") <> show (last sz) + <> " words are expected." + else if length parts == mw then e else e' + +-- | Small helper to collect 'Nat' values from a type-level list +class NatVals (ns :: [Nat]) where + natVals :: Proxy ns -> [Integer] + +instance NatVals '[] where + natVals _ = [] + +instance (KnownNat n, NatVals rest) => NatVals (n ': rest) where + natVals _ = natVal (Proxy :: Proxy n) : natVals (Proxy :: Proxy rest) + +instance + ( n ~ EntropySize mw + , csz ~ CheckSumBits n + , ConsistentEntropy n mw csz + ) => + MkSomeMnemonic (mw ': '[]) + where + mkSomeMnemonic parts = do + bimap (MkSomeMnemonicError . pretty) SomeMnemonic (mkMnemonic @mw parts) + where + pretty = \case + ErrMnemonicWords ErrWrongNumberOfWords{} -> + "Invalid number of words: " + <> show (natVal (Proxy :: Proxy mw)) + <> " words are expected." + ErrDictionary (ErrInvalidDictionaryWord _) -> + "Found an unknown word not present in the pre-defined dictionary. \ + \The full dictionary is available here: \ + \https://github.com/cardano-foundation/cardano-wallet/tree/master/specifications/mnemonic/english.txt" + ErrEntropy ErrInvalidEntropyChecksum{} -> + "Invalid entropy checksum: please double-check the last word of \ + \your mnemonic sentence." + ErrEntropy ErrInvalidEntropyLength{} -> + "Something went wrong when trying to generate the entropy from \ + \the given mnemonic. As a user, there's nothing you can do." + +-- $troubleshooting +-- +-- - /Natural XX is out of bounds for Int/: +-- This usually occurs when ones is trying to specify an invalid size for an +-- 'Entropy' or 'Mnemonic'. For example: +-- +-- >>> genEntropy @42 +-- error: +-- • Natural CheckSumBits 42 is out of bounds for Int +-- +-- - This could be the case as well when forgetting to use an adequate type application: +-- +-- >>> mkEntropy mempty +-- error: +-- • Natural ent is out of bounds for Int diff --git a/lib/Codec/Binary/Encoding.hs b/lib/Codec/Binary/Encoding.hs new file mode 100644 --- /dev/null +++ b/lib/Codec/Binary/Encoding.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Codec.Binary.Encoding + ( -- * Types + AbstractEncoding (..) + , Encoding + + -- * Encode + , encode + + -- * Decode + , detectEncoding + , fromBase16 + , fromBase64 + , fromBase58 + , fromBech32 + ) where + +import Prelude + +import Codec.Binary.Bech32 + ( HumanReadablePart ) +import Control.Applicative + ( (<|>) ) +import Control.Arrow + ( left ) +import Control.Monad + ( guard ) +import Data.ByteArray.Encoding + ( Base (..), convertFromBase, convertToBase ) +import Data.ByteString + ( ByteString ) +import Data.ByteString.Base58 + ( bitcoinAlphabet, decodeBase58, encodeBase58, unAlphabet ) +import Data.Char + ( isLetter, isLower, isUpper, ord, toLower ) + +import qualified Codec.Binary.Bech32 as Bech32 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + + +-- +-- Encoding +-- + +-- | A concrete 'Encoding' algebraic data-type. +type Encoding = AbstractEncoding HumanReadablePart + +-- | An abstract 'Encoding' to make it easy to map over the bech32 component. +-- Typically used as 'AbstractEncoding HumanReadablePart'. +-- +-- > λ> let xpubHRP = [humanReadablePart|xpub|] +-- > λ> let xprvHRP = [humanReadablePart|xprv|] +-- > +-- > λ> fmap (const xpubHRP) (EBech32 xprvHRP) +-- > EBech32 (HumanReadablePart "xpub") +-- +data AbstractEncoding a + = EBase16 + | EBase58 + | EBech32 a + deriving (Eq, Show, Functor) + +-- +-- Encode +-- + + +-- | Encode a 'ByteString' with the given encoding. +-- +-- @since 2.0.0 +encode :: Encoding -> ByteString -> ByteString +encode encoding bytes = case encoding of + EBase16 -> + convertToBase Base16 bytes + EBase58 -> + encodeBase58 bitcoinAlphabet bytes + EBech32 hrp -> + T.encodeUtf8 $ Bech32.encodeLenient hrp $ Bech32.dataPartFromBytes bytes + +-- +-- Decode +-- + +-- | Try detecting the encoding of a given 'String' +-- +-- @since 2.0.0 +detectEncoding :: String -> Maybe (AbstractEncoding ()) +detectEncoding str = isBase16 <|> isBech32 <|> isBase58 + where + isBase16 = do + guard (all ((`elem` "0123456789abcdef") . toLower) str) + guard (even (length str)) + pure EBase16 + + isBech32 = do + guard (not (null humanpart)) + guard (all (\c -> ord c >= 33 && ord c <= 126) humanpart) + guard (length datapart >= 6) + guard (all (`elem` Bech32.dataCharList) datapart) + guard (all isUpper alpha || all isLower alpha) + pure (EBech32 ()) + where + datapart = reverse . takeWhile (/= '1') . reverse $ str + humanpart = takeWhile (/= '1') str + alpha = filter isLetter str + + isBase58 = do + guard (all (`elem` T.unpack (T.decodeUtf8 $ unAlphabet bitcoinAlphabet)) str) + pure EBase58 + +-- | Try decoding a base16-encoded 'ByteString' +-- +-- @since 2.0.0 +fromBase16 :: ByteString -> Either String ByteString +fromBase16 = convertFromBase Base16 + +-- | Try decoding a base64-encoded 'ByteString' +-- +-- @since 3.13.0 +fromBase64 :: ByteString -> Either String ByteString +fromBase64 = convertFromBase Base64 + +-- | Try decoding a bech32-encoded 'ByteString' +-- +-- @since 2.0.0 +fromBech32 + :: ([Int] -> String -> String) + -> ByteString + -> Either String (HumanReadablePart, ByteString) +fromBech32 markCharsRedAtIndices raw = left errToString $ do + (hrp, dp) <- left Just $ Bech32.decodeLenient $ T.decodeUtf8 raw + maybe (Left Nothing) (Right . (hrp,)) $ Bech32.dataPartToBytes dp + where + unCharPos (Bech32.CharPosition x) = x + invalidCharsMsg = "Invalid character(s) in string" + errToString = ("Bech32 error: " <>) . \case + Just Bech32.StringToDecodeTooLong -> + "string is too long" + Just Bech32.StringToDecodeTooShort -> + "string is too short" + Just Bech32.StringToDecodeHasMixedCase -> + "string has mixed case" + Just Bech32.StringToDecodeMissingSeparatorChar -> + "string has no separator char" + Just (Bech32.StringToDecodeContainsInvalidChars []) -> + invalidCharsMsg + Just (Bech32.StringToDecodeContainsInvalidChars ixs) -> + invalidCharsMsg <> ":\n" <> markCharsRedAtIndices + (map unCharPos ixs) + (T.unpack . T.decodeUtf8 $ raw) + Nothing -> + "invalid data-part; these bytes ain't uint8." + +fromBase58 :: ByteString -> Either String ByteString +fromBase58 raw = maybe (Left "Invalid Base58-encoded string.") Right $ do + decodeBase58 bitcoinAlphabet raw diff --git a/lib/Command.hs b/lib/Command.hs new file mode 100644 --- /dev/null +++ b/lib/Command.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command + ( CLI + + -- * I/O interface + , setup + , parse + , run + ) where + +import Prelude + +import Control.Exception + ( handle ) +import Control.Monad + ( void ) +import Options.Applicative + ( ParserInfo + , customExecParser + , footerDoc + , helper + , info + , prefs + , progDesc + , showHelpOnEmpty + , subparser + , (<|>) + ) +import Options.Applicative.Help.Pretty + ( annotate, bold, hsep, pretty, vsep ) +import System.Console.ANSI + ( hSupportsANSI ) +import System.IO + ( BufferMode (..), Handle, hSetBuffering, stderr, stdin, stdout ) +import System.IO.Extra + ( prettyIOException, progName ) + +import qualified Command.Address as Address +import qualified Command.Key as Key +import qualified Command.RecoveryPhrase as RecoveryPhrase +import qualified Command.Script as Script +import qualified Command.Version as Version + +data CLI + = RecoveryPhrase RecoveryPhrase.Cmd + | Key Key.Cmd + | Address Address.Cmd + | Script Script.Cmd + | Version + deriving (Show) + +cli :: ParserInfo CLI +cli = info (helper <*> parser) $ mempty + <> progDesc "Command-line for address and key manipulation in Cardano." + <> footerDoc (Just $ vsep + [ pretty "💡 Need auto-completion?" + , pretty "" + , hsep + [ pretty " ↳" + , annotate bold $ pretty "source <(" + , annotate bold $ pretty progName + , annotate bold $ pretty $ "--bash-completion-script `which "<>progName<>"`)" + ] + , pretty "" + , pretty "Or alternatively --fish-completion-script / --zsh-completion-script." + , pretty "For a long-term solution, you may want to put this script in the relevant place. e.g.:" + , pretty "" + , hsep [pretty " ↳", annotate bold $ pretty "/etc/bash_completion.d"] + ]) + where + parser = Version.opt Version <|> subparser (mconcat + [ RecoveryPhrase.mod RecoveryPhrase + , Key.mod Key + , Address.mod Address + , Script.mod Script + ]) + +-- | Run a given command +run :: CLI -> IO () +run = handle prettyIOException . \case + RecoveryPhrase sub -> RecoveryPhrase.run sub + Key sub -> Key.run sub + Address sub -> Address.run sub + Script sub -> Script.run sub + Version -> Version.run + +-- | Parse command line options and arguments +parse :: IO CLI +parse = customExecParser (prefs showHelpOnEmpty) cli + +-- | Enable ANSI colors on Windows and correct output buffering +setup :: IO () +setup = + mapM_ hSetup [stderr, stdout, stdin] + where + hSetup :: Handle -> IO () + hSetup h = do + void $ hSupportsANSI h + hSetBuffering h NoBuffering diff --git a/lib/Command/Address.hs b/lib/Command/Address.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Address.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Address + ( Cmd + , mod + , run + ) where + +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , helper + , info + , progDesc + , subparser + ) +import Options.Applicative.Help.Pretty + ( annotate, bold, hsep, pretty, vsep ) +import Prelude hiding + ( mod ) + +import qualified Command.Address.Bootstrap as Bootstrap +import qualified Command.Address.Delegation as Delegation +import qualified Command.Address.Inspect as Inspect +import qualified Command.Address.Payment as Payment +import qualified Command.Address.Pointer as Pointer +import qualified Command.Address.Reward as Reward + + +data Cmd + = Bootstrap Bootstrap.Cmd + | Payment Payment.Cmd + | Reward Reward.Cmd + | Delegation Delegation.Cmd + | Pointer Pointer.Cmd + | Inspect Inspect.Cmd + deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "address" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "About addresses" + <> footerDoc (Just $ vsep + [ pretty "Integrating with Byron?" + , hsep [ pretty " ↳ Look at", annotate bold $ pretty "'bootstrap'", pretty "." ] + , pretty "" + , pretty "Integrating with Shelley?" + , hsep [ pretty " ↳ Look at", annotate bold $ pretty "'payment'", pretty "&", annotate bold $ pretty "'delegation'", pretty "." ] + ]) + where + parser = subparser $ mconcat + [ Bootstrap.mod Bootstrap + , Payment.mod Payment + , Reward.mod Reward + , Delegation.mod Delegation + , Pointer.mod Pointer + , Inspect.mod Inspect + ] + +run :: Cmd -> IO () +run = \case + Bootstrap sub -> Bootstrap.run sub + Payment sub -> Payment.run sub + Reward sub -> Reward.run sub + Delegation sub -> Delegation.run sub + Pointer sub -> Pointer.run sub + Inspect sub -> Inspect.run sub diff --git a/lib/Command/Address/Bootstrap.hs b/lib/Command/Address/Bootstrap.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Address/Bootstrap.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Address.Bootstrap + ( Cmd + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address + ( AddressDiscrimination (..), NetworkDiscriminant, base58 ) +import Cardano.Address.Derivation + ( XPub, coerceWholeDomainIndex ) +import Cardano.Address.Style.Byron + ( Byron ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , header + , helper + , info + , optional + , progDesc + ) +import Options.Applicative.Derivation + ( DerivationPath, castDerivationPath, derivationPathArg, xpubOpt ) +import Options.Applicative.Discrimination + ( NetworkTag (..), networkTagOpt ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import Options.Applicative.Style + ( Style (..) ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetXPub, progName ) + +import qualified Cardano.Address.Style.Byron as Byron +import qualified Cardano.Address.Style.Icarus as Icarus +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text.Encoding as T + +data Cmd = Cmd + { rootXPub :: Maybe XPub + , networkTag :: NetworkTag + , derivationPath :: Maybe DerivationPath + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "bootstrap" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Create a bootstrap address" + <> header "Those addresses, now deprecated, were used during the Byron era." + <> footerDoc (Just $ vsep + [ prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate --size 12 \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Byron > root.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 14H/42H | tee addr.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --with-chain-code \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address bootstrap --root $(cat root.prv | "<>progName<>" key public --with-chain-code) \\" + , indent 8 $ annotate bold $ prettyText "--network-tag preview 14H/42H" + , indent 2 $ prettyText "KjgoiXJS2coBYYTM69pafiau6bbGqKrzbFiRzahpWsPvit48YNiHocPpB7VJ..." + ]) + where + parser = Cmd + <$> optional (xpubOpt [CIP5.root_xvk] "root" "A root public key. Needed for Byron addresses only.") + <*> networkTagOpt Byron + <*> optional derivationPathArg + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Cmd{networkTag,rootXPub,derivationPath} = do + (_hrp, xpub) <- hGetXPub stdin [CIP5.addr_xvk] + addr <- case derivationPath of + Nothing -> + pure $ Icarus.paymentAddress discriminant (Icarus.liftXPub xpub) + Just untypedPath -> do + root <- maybe + (fail "A root public key must be provided when --path is provided") pure rootXPub + case castDerivationPath untypedPath of + [acctIx, addrIx] -> do + let path = (acctIx, coerceWholeDomainIndex addrIx) + xkey = Byron.liftXPub root path xpub + pure $ Byron.paymentAddress discriminant xkey + _ -> do + fail "Byron derivation path must describe 2 levels (e.g. 0H/0H)" + B8.hPutStr stdout $ T.encodeUtf8 $ base58 addr + where + discriminant :: NetworkDiscriminant Byron -- Or Icarus, same. + discriminant + | networkTag == snd Byron.byronMainnet = + Byron.byronMainnet + | otherwise = + (RequiresNetworkTag, networkTag) diff --git a/lib/Command/Address/Delegation.hs b/lib/Command/Address/Delegation.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Address/Delegation.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Address.Delegation + ( Cmd + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address + ( bech32, unsafeMkAddress ) +import Cardano.Address.Derivation + ( Depth (..) ) +import Cardano.Address.Style.Shelley + ( Credential (..), ErrExtendAddress (..) ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, helper, info, progDesc ) +import Options.Applicative.Credential + ( delegationCredentialArg ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetBech32, progName ) + +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text.Encoding as T + +newtype Cmd = Cmd + { credential :: Credential 'DelegationK + } deriving Show + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "delegation" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Create a delegation address" + <> footerDoc (Just $ vsep + [ prettyText "The payment address is read from stdin." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate --size 15 \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Shelley > root.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 1852H/1815H/0H/2/0 > stake.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 1852H/1815H/0H/0/0 > addr.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat addr.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --with-chain-code \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address payment --network-tag testnet \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address delegation $(cat stake.prv | "<>progName<>" key public --with-chain-code)" + , indent 2 $ pretty ("addr1qpj2d4dqzds5p3mmlu95v9pex2d72cdvyjh2u3dtj4yqesv27k..." :: String) + ]) + where + msg = "An extended stake public key, a non-extended stake public key, a script or a script hash." + parser = Cmd + <$> delegationCredentialArg msg + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Cmd{credential} = do + (_, bytes) <- hGetBech32 stdin allowedPrefixes + case Shelley.extendAddress (unsafeMkAddress bytes) credential of + Left (ErrInvalidAddressStyle msg) -> + fail msg + Left (ErrInvalidAddressType msg) -> + fail msg + Left (ErrInvalidKeyHashType msg) -> + fail msg + Right addr -> + B8.hPutStr stdout $ T.encodeUtf8 $ bech32 addr + where + allowedPrefixes = + [ CIP5.addr + , CIP5.addr_test + ] diff --git a/lib/Command/Address/Inspect.hs b/lib/Command/Address/Inspect.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Address/Inspect.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Address.Inspect + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address + ( Address, unsafeMkAddress ) +import Cardano.Address.Derivation + ( XPub ) +import Control.Applicative + ( optional ) +import Control.Exception + ( displayException ) +import Data.Text + ( Text ) +import Fmt + ( format ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, helper, info, progDesc ) +import Options.Applicative.Derivation + ( xpubOpt ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import System.Exit + ( die ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetBytes, progName ) + +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.Aeson.Encode.Pretty as Json +import qualified Data.ByteString.Lazy.Char8 as BL8 + +newtype Cmd = Inspect + { rootPublicKey :: Maybe XPub + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "inspect" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Show information about an address" + <> footerDoc (Just $ vsep + [ prettyText "The address is read from stdin." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ prettyText "$ cat addr.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --with-chain-code \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address payment --network-tag testnet \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address delegation $(cat stake.prv | "<>progName<>" key public --with-chain-code) \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address inspect" + , indent 2 $ prettyText "{" + , indent 2 $ prettyText " \"address_style\": \"Shelley\"," + , indent 2 $ prettyText " \"stake_reference\": \"by value\"," + , indent 2 $ prettyText " \"stake_key_hash\": \"6b542d6da35e6c95d95a33c6f66ec482d3f4caf3ad35e2ede09cf827\"," + , indent 2 $ prettyText " \"spending_key_hash\": \"44bc4f524f49a78a9c8a45b882d8710cb9254b3da6a978d50dc9b870\"," + , indent 2 $ prettyText " \"network_tag\": 0," + , indent 2 $ prettyText " \"address_type\": 0" + , indent 2 $ prettyText "}" + ]) + where + parser = Inspect + <$> optional (xpubOpt [CIP5.root_xvk] "root" helpDoc) + helpDoc = + "A root public key. If specified, tries to decrypt the derivation path \ + \of Byron addresses." + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Inspect{rootPublicKey} = do + bytes <- hGetBytes stdin + case inspect (unsafeMkAddress bytes) of + Right json -> BL8.hPutStrLn stdout (Json.encodePretty json) + Left e -> die $ format "Error: {}" (displayException e) + where + inspect :: Address -> Either Shelley.ErrInspectAddress Shelley.InspectAddress + inspect = Shelley.eitherInspectAddress rootPublicKey diff --git a/lib/Command/Address/Payment.hs b/lib/Command/Address/Payment.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Address/Payment.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Address.Payment + ( Cmd + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address + ( unAddress ) +import Cardano.Address.Derivation + ( pubFromBytes, xpubFromBytes ) +import Cardano.Address.KeyHash + ( KeyHash, KeyRole (..), keyHashFromBytes ) +import Cardano.Address.Script + ( Script, scriptHashFromBytes ) +import Cardano.Address.Style.Shelley + ( Credential (..), shelleyTestnet ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , header + , helper + , info + , optional + , progDesc + ) +import Options.Applicative.Discrimination + ( NetworkTag (..), fromNetworkTag, networkTagOpt ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import Options.Applicative.Script + ( scriptArg ) +import Options.Applicative.Style + ( Style (..) ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetBech32, hPutBytes, progName ) + +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 + +data Cmd = Cmd + { networkTag :: NetworkTag + , paymentScript :: Maybe (Script KeyHash) + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "payment" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Create a payment address" + <> header "Payment addresses carry no delegation rights whatsoever." + <> footerDoc (Just $ vsep + [ prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate --size 15 \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Shelley > root.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 1852H/1815H/0H/0/0 > addr.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat addr.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --with-chain-code \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address payment --network-tag testnet" + , indent 2 $ prettyText "addr_test1vqrlltfahghjxl5sy5h5mvfrrlt6me5fqphhwjqvj5jd88cccqcek" + ]) + where + parser = Cmd + <$> networkTagOpt Shelley + <*> optional scriptArg + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Cmd{networkTag,paymentScript} = do + discriminant <- fromNetworkTag networkTag + addr <- case paymentScript of + Just script -> do + let credential = PaymentFromScript script + pure $ Shelley.paymentAddress discriminant credential + Nothing -> do + (hrp, bytes) <- hGetBech32 stdin allowedPrefixes + addressFromBytes discriminant bytes hrp + hPutBytes stdout (unAddress addr) (EBech32 addrHrp) + where + addrHrp + | networkTag == shelleyTestnet = CIP5.addr_test + | otherwise = CIP5.addr + + allowedPrefixes = + [ CIP5.addr_xvk + , CIP5.addr_vk + , CIP5.addr_vkh + , CIP5.script + ] + + addressFromBytes discriminant bytes hrp + | hrp == CIP5.script = do + case scriptHashFromBytes bytes of + Nothing -> + fail "Couldn't convert bytes into script hash." + Just h -> do + let credential = PaymentFromScriptHash h + pure $ Shelley.paymentAddress discriminant credential + + | hrp == CIP5.addr_vkh = do + case keyHashFromBytes (Payment, bytes) of + Nothing -> + fail "Couldn't convert bytes into payment key hash." + Just keyhash -> do + let credential = PaymentFromKeyHash keyhash + pure $ Shelley.paymentAddress discriminant credential + + | hrp == CIP5.addr_vk = do + case pubFromBytes bytes of + Nothing -> + fail "Couldn't convert bytes into non-extended public key." + Just key -> do + let credential = PaymentFromKey $ Shelley.liftPub key + pure $ Shelley.paymentAddress discriminant credential + + | otherwise = do + case xpubFromBytes bytes of + Nothing -> + fail "Couldn't convert bytes into extended public key." + Just key -> do + let credential = PaymentFromExtendedKey $ Shelley.liftXPub key + pure $ Shelley.paymentAddress discriminant credential diff --git a/lib/Command/Address/Pointer.hs b/lib/Command/Address/Pointer.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Address/Pointer.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Address.Pointer + ( Cmd + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address + ( ChainPointer (..), bech32, unsafeMkAddress ) +import Cardano.Address.Style.Shelley + ( Credential (..), ErrExtendAddress (..) ) +import Data.Text + ( Text ) +import Numeric.Natural + ( Natural ) +import Options.Applicative + ( CommandFields + , Mod + , argument + , auto + , command + , footerDoc + , header + , help + , helper + , info + , metavar + , progDesc + ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetBech32, progName ) + +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text.Encoding as T + +data Cmd = Cmd + { slotNum :: Natural + , transactionIndex :: Natural + , outputIndex :: Natural + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "pointer" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Create a pointer address" + <> header "Create addresses with a pointer that indicate the position \ + \of a registered stake address on the chain." + <> footerDoc (Just $ vsep + [ prettyText "The payment address is read from stdin." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate --size 15 \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Shelley > root.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 1852H/1815H/0H/0/0 > addr.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat addr.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --with-chain-code \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address payment --network-tag 0\\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address pointer 42 14 0" + , indent 2 $ prettyText "addr1grq8e0smk44luyl897e24gn6qfkx4ax734r6pzq29zcew032pcqqef7zzu" + ]) + where + parser = Cmd + <$> argument auto (metavar "SLOT" <> help "A slot number") + <*> argument auto (metavar "TX" <> help "A transaction index within that slot") + <*> argument auto (metavar "OUT" <> help "An output index within that transaction") + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Cmd{slotNum,transactionIndex,outputIndex} = do + (_, bytes) <- hGetBech32 stdin allowedPrefixes + case Shelley.extendAddress (unsafeMkAddress bytes) (DelegationFromPointer ptr) of + Left (ErrInvalidAddressStyle msg) -> + fail msg + Left (ErrInvalidAddressType msg) -> + fail msg + Left (ErrInvalidKeyHashType msg) -> + fail msg + Right addr -> + B8.hPutStr stdout $ T.encodeUtf8 $ bech32 addr + where + allowedPrefixes = + [ CIP5.addr + , CIP5.addr_test + ] + + ptr = ChainPointer { slotNum, transactionIndex, outputIndex } diff --git a/lib/Command/Address/Reward.hs b/lib/Command/Address/Reward.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Address/Reward.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Address.Reward + ( Cmd + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address + ( NetworkTag (..), unAddress ) +import Cardano.Address.Derivation + ( pubFromBytes, xpubFromBytes ) +import Cardano.Address.KeyHash + ( KeyHash, KeyRole (..), keyHashFromBytes ) +import Cardano.Address.Script + ( Script, scriptHashFromBytes ) +import Cardano.Address.Style.Shelley + ( Credential (..), shelleyTestnet, unsafeFromRight ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , header + , helper + , info + , optional + , progDesc + ) +import Options.Applicative.Discrimination + ( fromNetworkTag, networkTagOpt ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import Options.Applicative.Script + ( scriptArg ) +import Options.Applicative.Style + ( Style (..) ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetBech32, hPutBytes, progName ) + +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 + +data Cmd = Cmd + { networkTag :: NetworkTag + , delegationScript :: Maybe (Script KeyHash) + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "stake" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Create a stake address" + <> header "Create a stake address \ + \that references a delegation key (1-1)." + <> footerDoc (Just $ vsep + [ prettyText "The public key is read from stdin." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate --size 15 \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Shelley > root.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 1852H/1815H/0H/2/0 > stake.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat stake.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --with-chain-code \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" address stake --network-tag testnet" + , indent 2 $ prettyText "stake_test1uzp7swuxjx7wmpkkvat8kpgrmjl8ze0dj9lytn25qv2tm4g6n5c35" + ]) + where + parser = Cmd + <$> networkTagOpt Shelley + <*> optional scriptArg + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Cmd{networkTag,delegationScript} = do + discriminant <- fromNetworkTag networkTag + addr <- case delegationScript of + Just script -> do + let credential = DelegationFromScript script + pure $ unsafeFromRight $ Shelley.stakeAddress discriminant credential + Nothing -> do + (hrp, bytes) <- hGetBech32 stdin allowedPrefixes + stakeAddressFromBytes discriminant bytes hrp + hPutBytes stdout (unAddress addr) (EBech32 stakeHrp) + where + stakeHrp + | networkTag == shelleyTestnet = CIP5.stake_test + | otherwise = CIP5.stake + + allowedPrefixes = + [ CIP5.stake_xvk + , CIP5.stake_vk + , CIP5.stake_vkh + , CIP5.script + ] + + stakeAddressFromBytes discriminant bytes hrp + | hrp == CIP5.script = do + case scriptHashFromBytes bytes of + Nothing -> + fail "Couldn't convert bytes into script hash." + Just h -> do + let credential = DelegationFromScriptHash h + pure $ unsafeFromRight $ Shelley.stakeAddress discriminant credential + + | hrp == CIP5.stake_vkh = do + case keyHashFromBytes (Delegation, bytes) of + Nothing -> + fail "Couldn't convert bytes into delegation key hash." + Just keyhash -> do + let credential = DelegationFromKeyHash keyhash + pure $ unsafeFromRight $ Shelley.stakeAddress discriminant credential + + | hrp == CIP5.stake_vk = do + case pubFromBytes bytes of + Nothing -> + fail "Couldn't convert bytes into non-extended public key." + Just key -> do + let credential = DelegationFromKey $ Shelley.liftPub key + pure $ unsafeFromRight $ Shelley.stakeAddress discriminant credential + + | otherwise = do + case xpubFromBytes bytes of + Nothing -> + fail "Couldn't convert bytes into extended public key." + Just key -> do + let credential = DelegationFromExtendedKey $ Shelley.liftXPub key + pure $ unsafeFromRight $ Shelley.stakeAddress discriminant credential diff --git a/lib/Command/Key.hs b/lib/Command/Key.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Key.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Key + ( Cmd (..) + , mod + , run + ) where + +import Data.Text + ( Text ) + +import Prelude hiding + ( mod ) + +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , helper + , info + , progDesc + , subparser + ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import System.IO.Extra + ( progName ) + +import qualified Command.Key.Child as Child +import qualified Command.Key.FromRecoveryPhrase as FromRecoveryPhrase +import qualified Command.Key.Hash as Hash +import qualified Command.Key.Inspect as Inspect +import qualified Command.Key.Private as Private +import qualified Command.Key.Public as Public +import qualified Command.Key.WalletId as WalletId + +data Cmd + = FromRecoveryPhrase FromRecoveryPhrase.Cmd + | Child Child.Cmd + | Private Private.Cmd + | Public Public.Cmd + | Inspect Inspect.Cmd + | Hash Hash.Cmd + | WalletId WalletId.Cmd + deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "key" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "About public/private keys" + <> footerDoc (Just $ vsep + [ prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate --size 15 \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Shelley > root.prv" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 1852H/1815H/0H \\" + , indent 4 $ annotate bold $ prettyText "| tee acct.prv \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --with-chain-code > acct.pub" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" key inspect <<< $(cat acct.prv)" + , indent 2 $ prettyText "{" + , indent 2 $ prettyText " \"key_type\": \"private\"," + , indent 2 $ prettyText " \"chain_code\": \"67bef6f80df02c7452e20e76ffb4bb57cae8aac2adf042b21a6b19e4f7b1f511\"," + , indent 2 $ prettyText " \"extended_key\": \"90ead3efad7aacac242705ede323665387f49ed847bed025eb333708ccf6aa54403482a867daeb18f38c57d6cddd7e6fd6aed4a3209f7425a3d1c5d9987a9c5f\"" + , indent 2 $ prettyText "}" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" key inspect <<< $(cat acct.pub)" + , indent 2 $ prettyText "{" + , indent 2 $ prettyText " \"key_type\": \"public\"," + , indent 2 $ prettyText " \"chain_code\": \"67bef6f80df02c7452e20e76ffb4bb57cae8aac2adf042b21a6b19e4f7b1f511\"," + , indent 2 $ prettyText " \"extended_key\": \"d306350ee88f51fb710252e27f0c40006c58e994761b383e02d400e2be59b3cc\"" + , indent 2 $ prettyText "}" + ]) + where + parser = subparser $ mconcat + [ FromRecoveryPhrase.mod FromRecoveryPhrase + , Child.mod Child + , Private.mod Private + , Public.mod Public + , Inspect.mod Inspect + , Hash.mod Hash + , WalletId.mod WalletId + ] + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run = \case + FromRecoveryPhrase sub -> FromRecoveryPhrase.run sub + Child sub -> Child.run sub + Private sub -> Private.run sub + Public sub -> Public.run sub + Inspect sub -> Inspect.run sub + Hash sub -> Hash.run sub + WalletId sub -> WalletId.run sub diff --git a/lib/Command/Key/Child.hs b/lib/Command/Key/Child.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Key/Child.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Key.Child + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.Derivation + ( DerivationScheme (..) + , deriveXPrv + , deriveXPub + , indexToWord32 + , xprvToBytes + , xpubToBytes + ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Control.Monad + ( foldM ) +import Data.Functor.Identity + ( Identity (..) ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, helper, info, progDesc ) +import Options.Applicative.Derivation + ( DerivationPath, castDerivationPath, derivationPathArg ) +import Options.Applicative.Help.Pretty + ( Doc, pretty ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetXP__, hPutBytes ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 + +newtype Cmd = Child + { path :: DerivationPath + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "child" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Derive child keys from a parent public/private key" + <> footerDoc (Just $ prettyText $ mconcat + [ "The parent key is read from stdin." + ]) + where + parser = Child + <$> derivationPathArg + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Child{path} = do + (hrp, child) <- hGetXP__ stdin allowedPrefixes >>= \case + Left (hrp, xpub) -> do + let ixs = castDerivationPath path + case foldM (deriveXPub DerivationScheme2) xpub ixs of + Just child -> + (,xpubToBytes child) <$> childHrpFor (indexToWord32 <$> ixs) hrp + Nothing -> + fail + "Couldn't derive child key. If you're trying to derive \ + \children on a PUBLIC key, you must use soft indexes only." + + Right (hrp, xprv) -> do + let ixs = castDerivationPath path + let scheme = if length ixs == 2 && hrp == CIP5.root_xsk + then DerivationScheme1 + else DerivationScheme2 + let Identity child = foldM (\k -> pure . deriveXPrv scheme k) xprv ixs + (,xprvToBytes child) <$> childHrpFor (indexToWord32 <$> ixs) hrp + + hPutBytes stdout child (EBech32 hrp) + where + allowedPrefixes = + [ CIP5.root_xsk + , CIP5.acct_xsk + , CIP5.acct_xvk + , CIP5.root_shared_xsk + , CIP5.acct_shared_xsk + , CIP5.acct_shared_xvk + ] + + -- As a reminder, we really have two scenarios: + -- + -- Byron Legacy: + -- + -- m / rnd_account' / rnd_address' + -- + -- + -- Icarus & Shelley: + -- + -- m / purpose' / coin_type' / account' / role / index + -- + -- purpose' = 1852H for shelley wallet addresses. + -- + -- We do not allow derivations to anywhere in the path to avoid people + -- shooting themselves in the foot. + -- Hence We only allow the following transformations: + -- + -- root_xsk => addr_xsk: (legacy) + -- m => m / rnd_account' / rnd_address + -- + -- root_xsk => acct_xsk: (hard derivation from root to account) + -- m => m / purpose' / coin_type' / account' + -- + -- root_xsk => acct_xsk: (hard derivation from root to address) + -- m => m / purpose' / coin_type' / account' / role / index + -- + -- acct_xsk => addr_xsk: (hard derivation from account to address) + -- m / purpose' / coin_type' / account' => m / purpose' / coin_type' / account' / role / index + -- + -- acct_xvk => addr_xvk: (soft derivation from account to address) + -- m / purpose' / coin_type' / account' => m / purpose' / coin_type' / account' / role / index + -- + -- + + -- Shared: + -- + -- m / purpose' / coin_type' / account' / role / index + -- + -- purpose' = 1854H for shared wallet addresses. + -- + -- As with Icarus/Shelley sequential wallets, to prevent undiscoverable + -- addresses, we allow only the following transformations: + -- + -- shared_root_xsk => shared_acct_xsk: (hard derivation from root to account) + -- m => m / purpose' / coin_type' / account' + -- + -- shared_root_xsk => shared_acct_xsk: (hard derivation from root to address) + -- m => m / purpose' / coin_type' / account' / role / index + -- + -- shared_acct_xsk => shared_addr_xsk: (hard derivation from account to address) + -- m / purpose' / coin_type' / account' => m / purpose' / coin_type' / account' / role / index + -- + -- shared_acct_xvk => shared_addr_xvk: (soft derivation from account to address) + -- m / purpose' / coin_type' / account' => m / purpose' / coin_type' / account' / role / index + -- + -- + -- There's no use-case at the moment for accessing intermediate paths such + -- as m / purpose' or m / purpose' / coin_type' so we do not expose them. + childHrpFor [_,_,_,2,_] hrp + | hrp == CIP5.root_xsk = pure CIP5.stake_xsk + | hrp == CIP5.root_shared_xsk = pure CIP5.stake_shared_xsk + + childHrpFor [_,_,_,3,0] hrp + | hrp == CIP5.root_xsk = pure CIP5.drep_xsk + + childHrpFor [_,_,_,4,0] hrp + | hrp == CIP5.root_xsk = pure CIP5.cc_cold_xsk + + childHrpFor [_,_,_,5,0] hrp + | hrp == CIP5.root_xsk = pure CIP5.cc_hot_xsk + + childHrpFor [p,_,_,_,_] hrp + | hrp == CIP5.root_xsk = + -- 2147485502 stands for 1854H + if p == 2147485502 then + pure CIP5.addr_shared_xsk + else + pure CIP5.addr_xsk + | hrp == CIP5.root_shared_xsk = pure CIP5.addr_shared_xsk + + childHrpFor [p,_,_] hrp + | hrp == CIP5.root_xsk = + -- 2147485502 stands for 1854H + if p == 2147485502 then + pure CIP5.acct_shared_xsk + -- 2147485503 stands for 1855H + else if p == 2147485503 then + pure CIP5.policy_xsk + else + pure CIP5.acct_xsk + | hrp == CIP5.root_shared_xsk = pure CIP5.acct_shared_xsk + + childHrpFor [2,_] hrp + | hrp == CIP5.acct_xsk = pure CIP5.stake_xsk + | hrp == CIP5.acct_xvk = pure CIP5.stake_xvk + | hrp == CIP5.acct_shared_xsk = pure CIP5.stake_shared_xsk + | hrp == CIP5.acct_shared_xvk = pure CIP5.stake_shared_xvk + + childHrpFor [3,0] hrp + | hrp == CIP5.acct_xsk = pure CIP5.drep_xsk + | hrp == CIP5.acct_xvk = pure CIP5.drep_xvk + + childHrpFor [4,0] hrp + | hrp == CIP5.acct_xsk = pure CIP5.cc_cold_xsk + | hrp == CIP5.acct_xvk = pure CIP5.cc_cold_xvk + + childHrpFor [5,0] hrp + | hrp == CIP5.acct_xsk = pure CIP5.cc_hot_xsk + | hrp == CIP5.acct_xvk = pure CIP5.cc_hot_xvk + + childHrpFor [_,_] hrp + | hrp == CIP5.root_xsk = pure CIP5.addr_xsk + | hrp == CIP5.acct_xsk = pure CIP5.addr_xsk + | hrp == CIP5.acct_xvk = pure CIP5.addr_xvk + | hrp == CIP5.acct_shared_xsk = pure CIP5.addr_shared_xsk + | hrp == CIP5.acct_shared_xvk = pure CIP5.addr_shared_xvk + + childHrpFor _ hrp + | hrp == CIP5.root_xsk = fail + "When deriving child keys from a parent root key, you must \ + \provide either 2, 3 or 5 path segments. Provide 2 (account and \ + \address) if you intend to derive a legacy Byron key. Provide 3 or 5 \ + \(purpose, coin_type, account, role, index) if you're dealing with \ + \anything else." + + | hrp == CIP5.root_shared_xsk = fail + "When deriving child keys from a parent root key, you must \ + \provide either 3 or 5 path segments. Provide 3 \ + \(purpose, coin_type, account) or 5 \ + \(purpose, coin_type, account, role, index)." + + | otherwise = fail + "When deriving child keys from a parent account key, you must \ + \provide exactly two path segments (role & index)." diff --git a/lib/Command/Key/FromRecoveryPhrase.hs b/lib/Command/Key/FromRecoveryPhrase.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Key/FromRecoveryPhrase.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Key.FromRecoveryPhrase + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.Derivation + ( xprvToBytes ) +import Codec.Binary.Bech32 + ( HumanReadablePart ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , helper + , info + , optional + , progDesc + ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import Options.Applicative.Style + ( Passphrase (..) + , PassphraseInfo (..) + , PassphraseInput (..) + , PassphraseInputMode + , Style (..) + , fileOpt + , generateRootKey + , passphraseInfoOpt + , passphraseInputModeOpt + , styleArg + ) +import System.IO + ( stderr, stdin, stdout ) +import System.IO.Extra + ( hGetPassphraseBytes + , hGetPassphraseMnemonic + , hGetSomeMnemonic + , hGetSomeMnemonicInteractively + , hPutBytes + , progName + ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 + + +data Cmd = FromRecoveryPhrase + { style :: Style + , passphraseInfo :: Maybe PassphraseInfo + , passphraseInputMode :: PassphraseInputMode + , passphraseFromFile :: Maybe FilePath + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "from-recovery-phrase" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Convert a recovery phrase to an extended private key" + <> footerDoc (Just $ vsep + [ prettyText "The recovery phrase without passphrase is read from stdin." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate \\" + , indent 2 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Icarus" + , prettyText "" + , prettyText "The recovery phrase with passphrase can be entered interactively or from file." + , prettyText "In both cases passhrase can take form of mnemonic, base16, base64, utf8 or octet array." + , prettyText "In interactive case one can select explicit, sensitive or silent mode." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" key from-recovery-phrase Shelley --passphrase from-mnemonic --sensitive" + , indent 2 $ annotate bold $ prettyText "Please enter a [9, 12, 15, 18, 21, 24] word mnemonic:" + , indent 2 $ annotate bold $ prettyText "**********************************************************************************************************" + , indent 2 $ annotate bold $ prettyText "Please enter a 9–12 word second factor:" + , indent 2 $ annotate bold $ prettyText "*************************************************************" + , prettyText "" + , prettyText "In case of passphrase reading from file the recovery phrase is read from stdin." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ prettyText "$ echo \"Secret Secondary Phrase\" > sndfactor.prv" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate \\" + , indent 2 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Shelley --from-file \"./sndfactor.prv\"" + , prettyText "" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate --size 12 > sndfactor.prv" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate \\" + , indent 2 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Shelley --passphrase from-mnemonic --from-file \"./sndfactor.prv\"" + ]) + where + parser = FromRecoveryPhrase + <$> styleArg + <*> optional passphraseInfoOpt + <*> passphraseInputModeOpt + <*> optional fileOpt + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run FromRecoveryPhrase{style,passphraseInfo, passphraseInputMode,passphraseFromFile} = do + (someMnemonic, passphrase) <- case passphraseInfo of + Nothing -> do + mnemonic <- hGetSomeMnemonic stdin + pure (mnemonic, Nothing) + Just pinfo -> do + mnemonic <- case passphraseFromFile of + Nothing -> do + let prompt = "Please enter a [9, 12, 15, 18, 21, 24] word mnemonic:" + hGetSomeMnemonicInteractively (stdin, stderr) + passphraseInputMode prompt + Just _ -> + hGetSomeMnemonic stdin + let passphraseSrc = + maybe Interactive FromFile passphraseFromFile + passwd <- handlePassphraseInfo passphraseSrc pinfo + pure (mnemonic, Just passwd) + rootK <- generateRootKey someMnemonic passphrase style + hPutBytes stdout (xprvToBytes rootK) (EBech32 $ styleHrp style) + where + handlePassphraseInfo passphraseSrc = \case + Mnemonic -> do + let prompt = "Please enter a 9–12 word second factor:" + p <- hGetPassphraseMnemonic (stdin, stderr) + passphraseInputMode passphraseSrc prompt + pure $ FromMnemonic p + Hex -> do + let prompt = "Please enter hex-encoded passphrase:" + p <- hGetPassphraseBytes (stdin, stderr) + passphraseInputMode passphraseSrc prompt Hex + pure $ FromEncoded p + Base64 -> do + let prompt = "Please enter base64-encoded passphrase:" + p <- hGetPassphraseBytes (stdin, stderr) + passphraseInputMode passphraseSrc prompt Base64 + pure $ FromEncoded p + Utf8 -> do + let prompt = "Please enter utf8-encoded passphrase:" + p <- hGetPassphraseBytes (stdin, stderr) + passphraseInputMode passphraseSrc prompt Utf8 + pure $ FromEncoded p + Octets -> do + let prompt = "Please enter passphrase in the form of octet array:" + p <- hGetPassphraseBytes (stdin, stderr) + passphraseInputMode passphraseSrc prompt Octets + pure $ FromEncoded p + +styleHrp :: Style -> HumanReadablePart +styleHrp Shared = CIP5.root_shared_xsk +styleHrp _ = CIP5.root_xsk diff --git a/lib/Command/Key/Hash.hs b/lib/Command/Key/Hash.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Key/Hash.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Key.Hash + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.Derivation + ( hashCredential ) +import Cardano.Address.KeyHash + ( GovernanceType, KeyHash (..), KeyRole (..), keyHashToText ) +import Control.Monad + ( when ) +import Data.Maybe + ( fromJust ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, helper, info, progDesc ) +import Options.Applicative.Governance + ( governanceOpt ) +import Options.Applicative.Help.Pretty + ( pretty ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetBech32, hPutStringNoNewLn ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.ByteString as BS +import qualified Data.Text as T + +newtype Cmd = Hash + { govType :: GovernanceType + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "hash" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Get the hash of a public key" + <> footerDoc (Just $ pretty $ mconcat + [ "The public key is read from stdin and" :: Text + , "bech32-encoded hash is returned." + , "To get hex-encoded output pass it to stdin of `bech32`." + ]) + where + parser = Hash + <$> governanceOpt + +run :: Cmd -> IO () +run Hash{govType} = do + (hrp, bytes) <- hGetBech32 stdin allowedPrefixes + guardBytes hrp bytes + let keyhash = KeyHash (prefixFor hrp) (hashCredential $ BS.take 32 bytes) + hPutStringNoNewLn stdout $ T.unpack $ + keyHashToText keyhash govType + where + -- Mapping of input HRP to key role + prefixToRole = + [ ( CIP5.addr_vk , Payment ) + , ( CIP5.addr_xvk , Payment ) + , ( CIP5.stake_vk , Delegation ) + , ( CIP5.stake_xvk , Delegation ) + , ( CIP5.addr_shared_vk , PaymentShared ) + , ( CIP5.addr_shared_xvk , PaymentShared ) + , ( CIP5.stake_shared_vk , DelegationShared ) + , ( CIP5.stake_shared_xvk, DelegationShared ) + , ( CIP5.policy_vk , Policy ) + , ( CIP5.policy_xvk , Policy ) + , ( CIP5.drep_vk , Representative ) + , ( CIP5.drep_xvk , Representative ) + , ( CIP5.cc_cold_vk , CommitteeCold ) + , ( CIP5.cc_cold_xvk , CommitteeCold ) + , ( CIP5.cc_hot_vk , CommitteeHot ) + , ( CIP5.cc_hot_xvk , CommitteeHot ) + ] + allowedPrefixes = map fst prefixToRole + prefixFor = fromJust . flip lookup prefixToRole + + extendedPrefixes = + [ CIP5.addr_xvk + , CIP5.stake_xvk + , CIP5.addr_shared_xvk + , CIP5.stake_shared_xvk + , CIP5.policy_xvk + , CIP5.drep_xvk + , CIP5.cc_cold_xvk + , CIP5.cc_hot_xvk + ] + + guardBytes hrp bytes + | hrp `elem` extendedPrefixes = do + when (BS.length bytes /= 64) $ + fail "data should be a 32-byte public key with a 32-byte chain-code appended" + + | otherwise = do + when (BS.length bytes /= 32) $ + fail "data should be a 32-byte public key." diff --git a/lib/Command/Key/Inspect.hs b/lib/Command/Key/Inspect.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Key/Inspect.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Key.Inspect + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.Derivation + ( XPrv, XPub, xprvChainCode, xprvPrivateKey, xpubChainCode, xpubPublicKey ) +import Codec.Binary.Bech32 + ( HumanReadablePart ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode ) +import Data.Aeson + ( (.=) ) +import Data.ByteString + ( ByteString ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, helper, info, progDesc ) +import Options.Applicative.Help.Pretty + ( pretty ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetXP__ ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.Aeson as Json +import qualified Data.Aeson.Encode.Pretty as Json +import qualified Data.ByteString.Lazy.Char8 as BL8 +import qualified Data.Text.Encoding as T + + +data Cmd = Inspect + deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "inspect" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Show information about a key" + <> footerDoc (Just $ pretty $ mconcat + [ "The parent key is read from stdin." :: Text + ]) + where + parser = pure Inspect + +run :: Cmd -> IO () +run Inspect = do + either inspectXPub inspectXPrv =<< hGetXP__ stdin allowedPrefixes + where + allowedPrefixes :: [HumanReadablePart] + allowedPrefixes = + [ CIP5.root_xvk + , CIP5.root_xsk + , CIP5.acct_xvk + , CIP5.acct_xsk + , CIP5.addr_xvk + , CIP5.addr_xsk + , CIP5.stake_xvk + , CIP5.stake_xsk + , CIP5.policy_xvk + , CIP5.policy_xsk + , CIP5.root_shared_xvk + , CIP5.root_shared_xsk + , CIP5.acct_shared_xvk + , CIP5.acct_shared_xsk + , CIP5.addr_shared_xvk + , CIP5.addr_shared_xsk + , CIP5.stake_shared_xvk + , CIP5.stake_shared_xsk + , CIP5.drep_xvk + , CIP5.drep_xsk + , CIP5.cc_cold_xvk + , CIP5.cc_cold_xsk + , CIP5.cc_hot_xvk + , CIP5.cc_hot_xsk + ] + + base16 :: ByteString -> Text + base16 = T.decodeUtf8 . encode EBase16 + + inspectXPub :: (HumanReadablePart, XPub) -> IO () + inspectXPub (_, xpub) = do + BL8.hPutStrLn stdout $ Json.encodePretty $ Json.object + [ "key_type" .= Json.String "public" + , "extended_key" .= Json.String (base16 pub) + , "chain_code" .= Json.String (base16 cc) + ] + where + pub = xpubPublicKey xpub + cc = xpubChainCode xpub + + inspectXPrv :: (HumanReadablePart, XPrv) -> IO () + inspectXPrv (_, xprv) = + BL8.hPutStrLn stdout $ Json.encodePretty $ Json.object + [ "key_type" .= Json.String "private" + , "extended_key" .= Json.String (base16 prv) + , "chain_code" .= Json.String (base16 cc) + ] + where + prv = xprvPrivateKey xprv + cc = xprvChainCode xprv diff --git a/lib/Command/Key/Private.hs b/lib/Command/Key/Private.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Key/Private.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Key.Private + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.Derivation + ( xprvChainCode, xprvPrivateKey ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Data.Maybe + ( fromJust ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, helper, info, progDesc ) +import Options.Applicative.Help.Pretty + ( pretty ) +import Options.Applicative.Private + ( PrivateType (..), privateOpt ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetXPrv, hPutBytes ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 + +newtype Cmd = Private + { keyPart :: PrivateType + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "private" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Get the signing or chain code part of an extended private key" + <> footerDoc (Just $ pretty $ mconcat + [ "The private key is read from stdin." :: Text + , "To get a signing key pass '--signing-key'." + , "To get a chain code pass '--chain-code'." + , "Bech32 encoding will be used." + , "In order to have the signing key hex encoded pass the result to the stdin of bech32 tool." + ]) + where + parser = Private + <$> privateOpt + +run :: Cmd -> IO () +run Private{keyPart} = do + (hrp, xprv) <- hGetXPrv stdin allowedPrefixes + let bytes = case keyPart of + ChainCode -> xprvChainCode xprv + SigningKey -> xprvPrivateKey xprv + hPutBytes stdout bytes (getFormat keyPart hrp) + where + prefixes = + [ (CIP5.root_xsk, CIP5.root_sk ) + , (CIP5.acct_xsk, CIP5.acct_sk ) + , (CIP5.addr_xsk, CIP5.addr_sk ) + , (CIP5.stake_xsk, CIP5.stake_sk ) + , (CIP5.root_shared_xsk, CIP5.root_shared_sk ) + , (CIP5.acct_shared_xsk, CIP5.acct_shared_sk ) + , (CIP5.addr_shared_xsk, CIP5.addr_shared_sk ) + , (CIP5.stake_shared_xsk, CIP5.stake_shared_sk ) + , (CIP5.policy_xsk, CIP5.policy_sk ) + , (CIP5.drep_xsk, CIP5.drep_sk ) + , (CIP5.cc_cold_xsk, CIP5.cc_cold_sk ) + , (CIP5.cc_hot_xsk, CIP5.cc_hot_sk ) + ] + allowedPrefixes = map fst prefixes + getFormat ChainCode _ = EBase16 + getFormat SigningKey hrp = + EBech32 $ fromJust $ lookup hrp prefixes diff --git a/lib/Command/Key/Public.hs b/lib/Command/Key/Public.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Key/Public.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Key.Public + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.Derivation + ( toXPub, xpubPublicKey, xpubToBytes ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Data.Maybe + ( fromJust ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, helper, info, progDesc ) +import Options.Applicative.Help.Pretty + ( pretty ) +import Options.Applicative.Public + ( PublicType (..), publicOpt ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetXPrv, hPutBytes ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 + +newtype Cmd = Public + { chainCode :: PublicType + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "public" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Get the public counterpart of a private key" + <> footerDoc (Just $ pretty $ mconcat + [ "The private key is read from stdin." :: Text + , "To get extended public key pass '--with-chain-code'." + , "To get public key pass '--without-chain-code'." + ]) + where + parser = Public + <$> publicOpt + +run :: Cmd -> IO () +run Public{chainCode} = do + (hrp, xprv) <- hGetXPrv stdin allowedPrefixes + let xpub = toXPub xprv + let bytes = case chainCode of + WithChainCode -> xpubToBytes xpub + WithoutChainCode -> xpubPublicKey xpub + hPutBytes stdout bytes (EBech32 $ prefixFor chainCode hrp) + where + prefixes = + [ (CIP5.root_xsk, (CIP5.root_xvk, CIP5.root_vk) ) + , (CIP5.acct_xsk, (CIP5.acct_xvk, CIP5.acct_vk) ) + , (CIP5.addr_xsk, (CIP5.addr_xvk, CIP5.addr_vk) ) + , (CIP5.stake_xsk, (CIP5.stake_xvk, CIP5.stake_vk) ) + , (CIP5.root_shared_xsk, (CIP5.root_shared_xvk, CIP5.root_shared_vk) ) + , (CIP5.acct_shared_xsk, (CIP5.acct_shared_xvk, CIP5.acct_shared_vk) ) + , (CIP5.addr_shared_xsk, (CIP5.addr_shared_xvk, CIP5.addr_shared_vk) ) + , (CIP5.stake_shared_xsk, (CIP5.stake_shared_xvk, CIP5.stake_shared_vk) ) + , (CIP5.policy_xsk, (CIP5.policy_xvk, CIP5.policy_vk) ) + , (CIP5.drep_xsk, (CIP5.drep_xvk, CIP5.drep_vk) ) + , (CIP5.cc_cold_xsk, (CIP5.cc_cold_xvk, CIP5.cc_cold_vk) ) + , (CIP5.cc_hot_xsk, (CIP5.cc_hot_xvk, CIP5.cc_hot_vk) ) + ] + allowedPrefixes = map fst prefixes + getCC WithChainCode = fst + getCC WithoutChainCode = snd + prefixFor cc = getCC cc . fromJust . flip lookup prefixes diff --git a/lib/Command/Key/WalletId.hs b/lib/Command/Key/WalletId.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Key/WalletId.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Key.WalletId + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.Derivation + ( hashWalletId, toXPub, xprvFromBytes, xpubToBytes ) +import Cardano.Address.Script + ( Cosigner, Script ) +import Cardano.Address.Style.Shared + ( sharedWalletId ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Control.Monad + ( when ) +import Data.Maybe + ( fromJust, isNothing ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , helper + , info + , optional + , progDesc + ) +import Options.Applicative.Help.Pretty + ( pretty ) +import Options.Applicative.Script + ( scriptTemplateSpendingArg, scriptTemplateStakingArg ) +import System.IO + ( stdin, stdout ) +import System.IO.Extra + ( hGetBech32, hPutBytes ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.ByteString as BS + +data Cmd = WalletId + { spending :: Maybe (Script Cosigner) + , staking :: Maybe (Script Cosigner) + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "walletid" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Shows the cardano-wallet wallet ID for a given key" + <> footerDoc (Just $ pretty $ mconcat + [ "A wallet ID is a 40-digit hexadecimal string derived " :: Text + , "from the wallet’s key. It is used by the cardano-wallet " + , "server to refer to specific wallets.\n\n" + , "For shelley wallets the key can be either an extended root key " + , "(full multi-account wallets), or an extended account key " + , "(single-account wallets).\n\n" + , "In the latter case either private or public extended key is accepted " + , "-- they will have the same wallet ID.\n\n" + , "The bech32-encoded key is read from standard input.\n\n" + , "In case of a shared wallet, the wallet id is calculated based on " + , "private extended account key, payment template script and " + , "staking template script - if specified. Each signature in " + , "any template script is denoted by cosigner#number.\n" + ]) + where + parser = WalletId + <$> optional scriptTemplateSpendingArg + <*> optional scriptTemplateStakingArg + +run :: Cmd -> IO () +run WalletId{spending,staking} = do + (hrp, bytes) <- hGetBech32 stdin allowedPrefixes + guardBytes hrp bytes + let bs = payloadToHash hrp bytes + when ( hrp `elem` [CIP5.acct_shared_xvk, CIP5.acct_shared_xsk] && + isNothing spending ) $ + fail "shared wallet needs to have at least spending script specified" + let walletid = + if hrp `elem` [CIP5.acct_shared_xvk, CIP5.acct_shared_xsk] then + sharedWalletId bs (fromJust spending) staking + else + hashWalletId bs + hPutBytes stdout walletid EBase16 + where + allowedPrefixes = + [ CIP5.root_xsk + , CIP5.root_xvk + , CIP5.acct_xvk + , CIP5.acct_xsk + , CIP5.acct_shared_xvk + , CIP5.acct_shared_xsk + ] + + payloadToHash hrp bs + | hrp `elem` [CIP5.root_xsk, CIP5.acct_xsk, CIP5.acct_shared_xsk] = + case xprvFromBytes bs of + Just xprv -> xpubToBytes . toXPub $ xprv + Nothing -> "96-byte extended private key is invalid due to 'scalarDecodeLong' failure from cryptonite" + | otherwise = + bs + + guardBytes hrp bytes + | hrp `elem` [CIP5.root_xsk, CIP5.root_shared_xsk, CIP5.acct_xsk, CIP5.acct_shared_xsk] = do + when (BS.length bytes /= 96) $ + fail "data should be a 96-byte private key." + + | otherwise = do + when (BS.length bytes /= 64) $ + fail "data should be a 32-byte public key with a 32-byte chain-code appended." diff --git a/lib/Command/RecoveryPhrase.hs b/lib/Command/RecoveryPhrase.hs new file mode 100644 --- /dev/null +++ b/lib/Command/RecoveryPhrase.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.RecoveryPhrase + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Options.Applicative + ( CommandFields, Mod, command, helper, info, progDesc, subparser ) + +import qualified Command.RecoveryPhrase.Generate as Generate + + +newtype Cmd + = Generate Generate.Cmd + deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "recovery-phrase" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "About recovery phrases" + where + parser = subparser $ mconcat + [ Generate.mod Generate + ] + +run :: Cmd -> IO () +run = \case + Generate sub -> Generate.run sub diff --git a/lib/Command/RecoveryPhrase/Generate.hs b/lib/Command/RecoveryPhrase/Generate.hs new file mode 100644 --- /dev/null +++ b/lib/Command/RecoveryPhrase/Generate.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.RecoveryPhrase.Generate + ( Cmd (..) + , mod + , run + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Mnemonic + ( entropyToMnemonic, genEntropy, mnemonicToText ) +import Options.Applicative + ( CommandFields, Mod, command, helper, info, progDesc ) +import Options.Applicative.MnemonicSize + ( MnemonicSize (..), mnemonicSizeOpt ) + +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + + +newtype Cmd = Generate + { size :: MnemonicSize + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "generate" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Generate an English recovery phrase" + where + parser = Generate + <$> mnemonicSizeOpt + +run :: Cmd -> IO () +run Generate{size} = do + m <- case size of + MS_9 -> mnemonicToText @9 . entropyToMnemonic <$> genEntropy + MS_12 -> mnemonicToText @12 . entropyToMnemonic <$> genEntropy + MS_15 -> mnemonicToText @15 . entropyToMnemonic <$> genEntropy + MS_18 -> mnemonicToText @18 . entropyToMnemonic <$> genEntropy + MS_21 -> mnemonicToText @21 . entropyToMnemonic <$> genEntropy + MS_24 -> mnemonicToText @24 . entropyToMnemonic <$> genEntropy + B8.putStrLn $ T.encodeUtf8 $ T.unwords m diff --git a/lib/Command/Script.hs b/lib/Command/Script.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Script.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Script + ( Cmd (..) + , mod + , run + ) where + +import Data.Text + ( Text ) + +import Prelude hiding + ( mod ) + +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , helper + , info + , progDesc + , subparser + ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import System.IO.Extra + ( progName ) + +import qualified Command.Script.Hash as Hash +import qualified Command.Script.Preimage as Preimage +import qualified Command.Script.Validation as Validation + +data Cmd + = Hash Hash.Cmd + | Validation Validation.Cmd + | Preimage Preimage.Cmd + deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "script" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "About scripts" + <> footerDoc (Just $ vsep + [ prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" recovery-phrase generate --size 15 \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key from-recovery-phrase Shared > root_shared.xsk" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root_shared.xsk \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 1854H/1815H/0H/0/0 > signingKey1.xsk" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat signingKey1.xsk \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --without-chain-code \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key hash > verKey1.vkh" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat root_shared.xsk \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key child 1854H/1815H/0H/0/1 > signingKey2.xsk" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ prettyText "$ cat signingKey2.xsk \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key public --without-chain-code \\" + , indent 4 $ annotate bold $ pretty $ "| "<>progName<>" key hash > verKey2.vkh" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" script hash \"all [$(cat verKey1.vkh),$(cat verKey2.vkh)]\"" + , indent 2 $ prettyText "" + , indent 2 $ annotate bold $ pretty $ "$ "<>progName<>" script preimage \"all [addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq, active_from 100, active_until 150]\"" + ]) + where + parser = subparser $ mconcat + [ Hash.mod Hash + , Validation.mod Validation + , Preimage.mod Preimage + ] + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run = \case + Hash sub -> Hash.run sub + Validation sub -> Validation.run sub + Preimage sub -> Preimage.run sub diff --git a/lib/Command/Script/Hash.hs b/lib/Command/Script/Hash.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Script/Hash.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Script.Hash + ( Cmd + , mod + , run + + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.KeyHash + ( GovernanceType, KeyHash (..) ) +import Cardano.Address.Script + ( ErrValidateScript (..) + , Script (..) + , foldScript + , prettyErrValidateScript + , scriptHashToText + , toScriptHash + ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, header, helper, info, progDesc ) +import Options.Applicative.Governance + ( governanceOpt ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import Options.Applicative.Script + ( scriptArg ) +import System.IO + ( stderr, stdout ) +import System.IO.Extra + ( hPutString, hPutStringNoNewLn, progName ) + +import qualified Data.List as L +import qualified Data.Text as T + +data Cmd = Cmd + { script :: Script KeyHash + , govType :: GovernanceType + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "hash" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Create a script hash" + <> header "Create a script hash that can be used in stake or payment credential in address and act as a governance credential." + <> footerDoc (Just $ vsep + [ prettyText "The script is taken as argument." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ progName<>" script hash 'all " + , indent 4 $ annotate bold $ prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText ", addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44" + , indent 4 $ annotate bold $ prettyText "]'" + , indent 2 $ prettyText "script1gr69m385thgvkrtspk73zmkwk537wxyxuevs2u9cukglvtlkz4k" + ]) + where + parser = Cmd + <$> scriptArg + <*> governanceOpt + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Cmd{script,govType} = do + let scriptHash = toScriptHash script + case checkRoles of + Just role -> + hPutStringNoNewLn stdout $ T.unpack $ + scriptHashToText scriptHash role (Just govType) + Nothing -> + hPutString stderr (prettyErrValidateScript NotUniformKeyType) + where + allKeyHashes = foldScript (:) [] script + getRole (KeyHash r _) = r + allRoles = map getRole allKeyHashes + checkRoles = + if length (L.nub allRoles) == 1 then + Just $ head allRoles + else + Nothing diff --git a/lib/Command/Script/Preimage.hs b/lib/Command/Script/Preimage.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Script/Preimage.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Script.Preimage + ( Cmd + , mod + , run + + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.KeyHash + ( KeyHash ) +import Cardano.Address.Script + ( Script (..), serializeScript ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields, Mod, command, footerDoc, header, helper, info, progDesc ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import Options.Applicative.Script + ( scriptArg ) +import System.IO + ( stdout ) +import System.IO.Extra + ( hPutBytes, progName ) + +newtype Cmd = Cmd + { script :: Script KeyHash + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "preimage" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Create a script preimage" + <> header "Create a script preimage that is CBOR-encoded script." + <> footerDoc (Just $ vsep + [ prettyText "The script is taken as argument." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ progName<>" script preimage 'all " + , indent 4 $ annotate bold $ prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText ", addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44" + , indent 4 $ annotate bold $ prettyText "]'" + , indent 2 $ prettyText "008201828200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f01135380" + , prettyText "" + , indent 2 $ annotate bold $ pretty $ progName<>" script preimage 'all " + , indent 4 $ annotate bold $ prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText ", active_from 100, active_until 150" + , indent 4 $ annotate bold $ prettyText "]'" + , indent 2 $ prettyText "008201838200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d8204186482051896" + ]) + where + parser = Cmd + <$> scriptArg + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Cmd{script} = do + hPutBytes stdout (serializeScript script) EBase16 diff --git a/lib/Command/Script/Validation.hs b/lib/Command/Script/Validation.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Script/Validation.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Script.Validation + ( Cmd + , mod + , run + + ) where + +import Prelude hiding + ( mod ) + +import Cardano.Address.KeyHash + ( KeyHash ) +import Cardano.Address.Script + ( Script (..) + , ValidationLevel (..) + , prettyErrValidateScript + , validateScript + ) +import Data.Maybe + ( fromMaybe ) +import Data.Text + ( Text ) +import Options.Applicative + ( CommandFields + , Mod + , command + , footerDoc + , header + , helper + , info + , optional + , progDesc + ) +import Options.Applicative.Help.Pretty + ( Doc, annotate, bold, indent, pretty, vsep ) +import Options.Applicative.Script + ( levelOpt, scriptArg ) +import System.IO + ( stderr, stdout ) +import System.IO.Extra + ( hPutString, progName ) + +data Cmd = Cmd + { script :: Script KeyHash + , validationLevel :: Maybe ValidationLevel + } deriving (Show) + +mod :: (Cmd -> parent) -> Mod CommandFields parent +mod liftCmd = command "validate" $ + info (helper <*> fmap liftCmd parser) $ mempty + <> progDesc "Validate a script" + <> header "Choose a required (default) or recommended validation of a script." + <> footerDoc (Just $ vsep + [ prettyText "The script is taken as argument. To have required validation pass '--required' or nothing." + , prettyText "To have recommended validation pass '--recommended'. Recommended validation adds more validations" + , prettyText "on top of the required one, in particular:" + , prettyText " - check if 'all' is non-empty" + , prettyText " - check if there are redundant timelocks in a given level" + , prettyText " - check if there are no duplicated verification keys in a given level" + , prettyText " - check if 'at_least' coeffcient is positive" + , prettyText " - check if 'all', 'any' are non-empty and `'at_least' has no less elements in the list than the coeffcient after timelocks are filtered out. " + , prettyText "The validation of the script does not take into account transaction validity. We assume that the user will take care of this." + , prettyText "" + , prettyText "Example:" + , indent 2 $ annotate bold $ pretty $ progName<>" script validate 'all" + , indent 4 $ annotate bold $ prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText ", addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44" + , indent 4 $ annotate bold $ prettyText "]'" + , indent 2 $ prettyText "Validated." + , prettyText "" + , indent 2 $ annotate bold $ pretty $ progName<>" script validate --required 'all" + , indent 4 $ annotate bold $ prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText ", addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44" + , indent 4 $ annotate bold $ prettyText "]'" + , indent 2 $ prettyText "Validated." + , prettyText "" + , indent 2 $ annotate bold $ pretty $ progName<>" script validate --recommended 'all []'" + , indent 2 $ prettyText "Not validated: The list inside a script is empty or only contains timelocks (which is not recommended)." + , prettyText "" + , indent 2 $ annotate bold $ pretty $ progName<>" script validate 'at_least 1 [active_from 11, active_until 16]'" + , indent 2 $ prettyText "Validated." + , prettyText "" + , indent 2 $ annotate bold $ pretty $ progName<>" script validate 'all" + , indent 4 $ annotate bold $ prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText ", addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText "]'" + , indent 2 $ prettyText "Validated." + , prettyText "" + , indent 2 $ annotate bold $ pretty $ progName<>" script validate --recommended 'all" + , indent 4 $ annotate bold $ prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText ", addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3" + , indent 4 $ annotate bold $ prettyText "]'" + , indent 2 $ prettyText "Not validated: The list inside a script has duplicate keys (which is not recommended)." + ]) + where + parser = Cmd + <$> scriptArg + <*> optional levelOpt + + prettyText :: Text -> Doc + prettyText = pretty + +run :: Cmd -> IO () +run Cmd{script,validationLevel} = + case validateScript (fromMaybe RequiredValidation validationLevel) script of + Left err -> hPutString stderr $ "Not validated: " <> prettyErrValidateScript err + Right _ -> hPutString stdout "Validated." diff --git a/lib/Command/Version.hs b/lib/Command/Version.hs new file mode 100644 --- /dev/null +++ b/lib/Command/Version.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Command.Version + ( opt + , run + ) where + +import Prelude + +import Data.Version + ( showVersion ) +import Options.Applicative + ( Parser + , command + , flag' + , help + , hidden + , info + , long + , progDesc + , short + , subparser + , (<|>) + ) +import Paths_cardano_addresses + ( version ) +import System.Git.TH + ( gitRevParseHEAD ) + +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +opt :: a -> Parser a +opt a = + flag' a (mconcat + [ long "version" + , short 'v' + , help helpText + ]) + <|> + subparser (mconcat + [ hidden + , command "version" $ info (pure a) (progDesc helpText) + ]) + where + helpText = "Show the software current version and build revision." + +run :: IO () +run = do + B8.putStrLn $ T.encodeUtf8 $ T.pack $ + showVersion version <> " @ " <> $(gitRevParseHEAD) diff --git a/lib/Data/Word7.hs b/lib/Data/Word7.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Word7.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Data.Word7 + ( + -- * Types + Word7 + + -- * Conversions + , toWord7 + , toWord8 + , toWord7s + , toNatural + + -- * Encode / Decode + , putVariableLengthNat + , getVariableLengthNat + ) where + +import Prelude + +import Data.Binary.Get + ( Get, getWord8 ) +import Data.Binary.Put + ( Put, putWord8 ) +import Data.Bits + ( shiftL, shiftR, (.&.), (.|.) ) +import Data.List + ( foldl' ) +import Data.Word + ( Word8 ) +import Numeric.Natural + ( Natural ) + + +-- | A 'Word7' algebraic data-type. +-- @since 2.0.0 +newtype Word7 = Word7 Word8 + deriving (Eq, Show) + + +-- +-- Conversions +-- +-- > toWord7 1 +-- > Word7 1 +-- > toWord7 127 +-- > Word7 127 +-- > toWord7 128 +-- > Word7 0 +toWord7 :: Word8 -> Word7 +toWord7 x = Word7 (x .&. 0x7F) + +toWord8 :: Word7 -> Word8 +toWord8 (Word7 x) = x + +-- > toWord7s 1 +-- > [Word7 1] +-- > toWord7s 128 +-- > [Word7 1,Word7 0] +-- > toWord7s 19099 +-- > [Word7 1,Word7 21,Word7 27] +toWord7s :: Natural -> [Word7] +toWord7s = reverse . go + where + go n + | n <= 0x7F = [Word7 . fromIntegral $ n] + | otherwise = (toWord7 . fromIntegral) n : go (shiftR n 7) + +word7sToNat :: [Word7] -> Natural +word7sToNat = foldl' f 0 + where + f n (Word7 r) = shiftL n 7 .|. (fromIntegral r) + +toNatural :: [Word7] -> Natural +toNatural = + fst . + foldr (\(Word7 x) (res, pow) -> + (res + (fromIntegral x)*(limit pow + 1), pow + 7) + ) + (0,0) + where + limit :: Int -> Natural + limit pow = 2 ^ pow - 1 + +-- +-- Decoding +-- +putVariableLengthNat :: Natural -> Put +putVariableLengthNat = putWord7s . toWord7s + where + putWord7s :: [Word7] -> Put + putWord7s [] = pure () + putWord7s [Word7 x] = putWord8 x + putWord7s (Word7 x : xs) = putWord8 (x .|. 0x80) >> putWord7s xs + +getVariableLengthNat :: Get Natural +getVariableLengthNat = word7sToNat <$> getWord7s + where + getWord7s :: Get [Word7] + getWord7s = do + next <- getWord8 + case next .&. 0x80 of + 0x80 -> (:) (toWord7 next) <$> getWord7s + _ -> pure [Word7 next] diff --git a/lib/Options/Applicative/Credential.hs b/lib/Options/Applicative/Credential.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/Credential.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.Credential + ( delegationCredentialArg + ) where + +import Prelude + +import Cardano.Address.Derivation + ( Depth (..) ) +import Cardano.Address.Internal + ( orElse ) +import Cardano.Address.KeyHash + ( KeyRole (..) ) +import Cardano.Address.Style.Shelley + ( Credential (..), liftPub, liftXPub ) +import Options.Applicative + ( Parser, argument, eitherReader, help, metavar ) +import Options.Applicative.Derivation + ( keyhashReader, pubReader, xpubReader ) +import Options.Applicative.Script + ( scriptHashReader, scriptReader ) + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 + +-- +-- Applicative Parser +-- + +delegationCredentialArg :: String -> Parser (Credential 'DelegationK) +delegationCredentialArg helpDoc = argument (eitherReader reader) $ mempty + <> metavar "EXTENDED KEY || NON-EXTENDED KEY || KEY HASH || SCRIPT || SCRIPT HASH" + <> help helpDoc + where + reader :: String -> Either String (Credential 'DelegationK) + reader str = + (DelegationFromKey . liftPub <$> pubReader allowedPrefixesForPub str) + `orElse` + (DelegationFromExtendedKey . liftXPub <$> xpubReader allowedPrefixesForXPub str) + `orElse` + (DelegationFromKeyHash <$> keyhashReader (Delegation, allowedPrefixesForKeyHash) str) + `orElse` + (DelegationFromScriptHash <$> scriptHashReader str) + `orElse` + (DelegationFromScript <$> scriptReader str) + `orElse` + Left errMsg + + errMsg = mconcat + [ "Couldn't parse delegation credentials. Neither an extended public key, " + , "a non-extended public key, a public key hash, a script nor a script hash." + ] + + allowedPrefixesForPub = + [ CIP5.stake_vk + ] + allowedPrefixesForXPub = + [ CIP5.stake_xvk + ] + allowedPrefixesForKeyHash = + [ CIP5.stake_vkh + ] diff --git a/lib/Options/Applicative/Derivation.hs b/lib/Options/Applicative/Derivation.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/Derivation.hs @@ -0,0 +1,263 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.Derivation + ( + -- * Derivation Path + -- ** Type + DerivationPath + , castDerivationPath + , derivationPathToString + , derivationPathFromString + -- ** Applicative Parser + , derivationPathArg + + -- * Derivation Index + , DerivationIndex + , mkDerivationIndex + , firstHardened + , indexToInteger + , derivationIndexToString + , derivationIndexFromString + + -- * XPub / Pub / XPrv / KeyHash + , xpubReader + , xpubOpt + , xpubArg + , keyhashReader + , pubReader + + -- * Internal + , bech32Reader + ) where + +import Prelude + +import Cardano.Address.Derivation + ( DerivationType (..) + , Index + , Pub + , XPub + , pubFromBytes + , wholeDomainIndex + , xpubFromBytes + ) +import Cardano.Address.KeyHash + ( KeyHash (..), KeyRole (..), keyHashFromBytes ) +import Codec.Binary.Bech32 + ( HumanReadablePart, humanReadablePartToText ) +import Codec.Binary.Encoding + ( fromBech32 ) +import Control.Arrow + ( left ) +import Control.Monad + ( unless ) +import Data.ByteString + ( ByteString ) +import Data.List + ( intercalate, isSuffixOf ) +import Data.Word + ( Word32 ) +import Options.Applicative + ( Parser + , argument + , completer + , eitherReader + , help + , listCompleter + , long + , metavar + , option + ) +import Safe + ( readEitherSafe ) +import System.IO.Extra + ( markCharsRedAtIndices ) + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + + +-- +-- Derivation Path +-- + +-- | Represent a user-provided 'DerivationPath'. +newtype DerivationPath = DerivationPath [DerivationIndex] + deriving (Show, Eq) + +derivationPathFromString :: String -> Either String DerivationPath +derivationPathFromString str = + DerivationPath + <$> mapM (derivationIndexFromString . T.unpack) (T.splitOn "/" txt) + where + txt = T.pack str + +derivationPathToString :: DerivationPath -> String +derivationPathToString (DerivationPath xs) = + intercalate "/" $ map derivationIndexToString xs + +castDerivationPath :: DerivationPath -> [Index 'WholeDomain depth] +castDerivationPath (DerivationPath xs) = map (wholeDomainIndex . getDerivationIndex) xs + +derivationPathArg :: Parser DerivationPath +derivationPathArg = argument (eitherReader derivationPathFromString) $ mempty + <> metavar "DERIVATION-PATH" + <> help + "Slash-separated derivation path. Hardened indexes are marked with a \ + \'H' (e.g. 1852H/1815H/0H/0)." + <> completer (listCompleter ["1852H/1815H/0H/", "44H/1815H/0H/"]) + +-- +-- Derivation Index +-- + +newtype DerivationIndex = DerivationIndex { getDerivationIndex :: Word32 } + deriving stock (Show, Eq) + deriving newtype (Bounded, Ord) + +-- | Safely cast a 'DerivationIndex' to an 'Integer'. +indexToInteger :: DerivationIndex -> Integer +indexToInteger (DerivationIndex ix) = fromIntegral ix + +-- | Get the first 'DerivationIndex' considered /hardened/. +firstHardened :: DerivationIndex +firstHardened = DerivationIndex 0x80000000 + +-- | Smart-constructor for a 'DerivationIndex' +mkDerivationIndex :: Integer -> Either String DerivationIndex +mkDerivationIndex ix + | ix > fromIntegral (maxBound @Word32) = + Left $ show ix <> " is too high to be a derivation index." + | otherwise = + pure $ DerivationIndex $ fromIntegral ix + +-- | Convert a string to a derivation index. String must be followed by a +-- capital /H/ to mark hardened index. For example @0@ refers to the first soft +-- index, whereas @0H@ refers to the first hardened index. +derivationIndexFromString :: String -> Either String DerivationIndex +derivationIndexFromString "" = Left "An empty string is not a derivation index!" +derivationIndexFromString str + | "H" `isSuffixOf` str = do + parseHardenedIndex (init str) + | otherwise = do + parseSoftIndex str + where + parseHardenedIndex txt = do + ix <- left (const msg) $ readEitherSafe txt + mkDerivationIndex $ ix + indexToInteger firstHardened + where + msg = mconcat + [ "Unable to parse hardened index. Hardened indexes are integer " + , "values, between " + , show (indexToInteger (minBound @DerivationIndex)) + , " and " + , show (indexToInteger firstHardened) + , " ending with a capital 'H'. For example: \"42H\"," + ] + + parseSoftIndex txt = do + ix <- left (const msg) $ readEitherSafe txt + guardSoftIndex ix + mkDerivationIndex ix + where + guardSoftIndex ix + | ix >= indexToInteger firstHardened = + Left $ mconcat + [ show ix + , " is too high to be a soft derivation index. " + , "Did you mean \"" + , show (ix - indexToInteger firstHardened) + , "H\"?" + ] + | otherwise = + pure () + + msg = mconcat + [ "Unable to parse soft index. Soft indexes are integer " + , "values, between " + , show (indexToInteger (minBound @DerivationIndex)) + , " and " + , show (indexToInteger firstHardened) + , ". For example: \"14\"." + ] + +-- | Convert a 'DerivationIndex' back to string. +derivationIndexToString :: DerivationIndex -> String +derivationIndexToString ix_@(DerivationIndex ix) + | ix_ >= firstHardened = show ix' ++ "H" + | otherwise = show ix + where + ix' = fromIntegral ix - indexToInteger firstHardened + +-- +-- XPub / Pub / XPrv +-- + +xpubReader :: [HumanReadablePart] -> String -> Either String XPub +xpubReader allowedPrefixes str = do + (_hrp, bytes) <- bech32Reader allowedPrefixes str + case xpubFromBytes bytes of + Just xpub -> pure xpub + Nothing -> Left + "Failed to convert bytes into a valid extended public key." + +pubReader :: [HumanReadablePart] -> String -> Either String Pub +pubReader allowedPrefixes str = do + (_hrp, bytes) <- bech32Reader allowedPrefixes str + case pubFromBytes bytes of + Just pub -> pure pub + Nothing -> Left + "Failed to convert bytes into a valid non-extended public key." + +xpubOpt :: [HumanReadablePart] -> String -> String -> Parser XPub +xpubOpt allowedPrefixes name helpDoc = + option (eitherReader (xpubReader allowedPrefixes)) $ mempty + <> long name + <> metavar "XPUB" + <> help helpDoc + +xpubArg :: [HumanReadablePart] -> String -> Parser XPub +xpubArg allowedPrefixes helpDoc = + argument (eitherReader (xpubReader allowedPrefixes)) $ mempty + <> metavar "XPUB" + <> help helpDoc + +keyhashReader :: (KeyRole, [HumanReadablePart]) -> String -> Either String KeyHash +keyhashReader (keyrole, allowedPrefixes) str = do + (_hrp, bytes) <- bech32Reader allowedPrefixes str + case keyHashFromBytes (keyrole, bytes) of + Just keyhash -> pure keyhash + Nothing -> Left + "Failed to convert bytes into a valid public key hash." + +-- +-- Internal +-- + +bech32Reader + :: [HumanReadablePart] + -> String + -> Either String (HumanReadablePart, ByteString) +bech32Reader allowedPrefixes str = do + (hrp, bytes) <- fromBech32 markCharsRedAtIndices (toBytes str) + unless (hrp `elem` allowedPrefixes) $ Left + $ "Invalid human-readable prefix. Prefix ought to be one of: " + <> show (showHrp <$> allowedPrefixes) + pure (hrp, bytes) + where + showHrp :: HumanReadablePart -> String + showHrp = T.unpack . humanReadablePartToText + + toBytes :: String -> ByteString + toBytes = T.encodeUtf8 . T.pack diff --git a/lib/Options/Applicative/Discrimination.hs b/lib/Options/Applicative/Discrimination.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/Discrimination.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE LambdaCase #-} + +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.Discrimination + ( + -- * Type (re-export from Cardano.Address) + NetworkTag(..) + , fromNetworkTag + + -- * Applicative Parser + , networkTagOpt + ) where + +import Prelude + +import Cardano.Address + ( NetworkDiscriminant (..), NetworkTag (..) ) +import Cardano.Address.Style.Shelley + ( Shelley ) +import Data.List + ( intercalate ) +import Options.Applicative + ( Parser + , completer + , eitherReader + , helpDoc + , listCompleter + , long + , metavar + , option + , (<|>) + ) +import Options.Applicative.Help.Pretty + ( pretty, vsep ) +import Options.Applicative.Style + ( Style (..) ) +import Text.Read + ( readMaybe ) + +import qualified Cardano.Address.Style.Byron as Byron +import qualified Cardano.Address.Style.Shelley as Shelley + +-- | Construct a Shelley 'NetworkDiscriminant' from a network tag. Fails loudly +-- if not possible. +fromNetworkTag :: MonadFail m => NetworkTag -> m (NetworkDiscriminant Shelley) +fromNetworkTag tag = + case (Shelley.mkNetworkDiscriminant . fromIntegral . unNetworkTag) tag of + Left Shelley.ErrWrongNetworkTag{} -> do + fail "Invalid network tag. Must be between [0, 15]" + Right discriminant -> + pure discriminant + +-- +-- Applicative Parser +-- + +-- | Parse a 'NetworkTag' from the command-line, as an option +networkTagOpt :: Style -> Parser NetworkTag +networkTagOpt style = option (eitherReader reader) $ mempty + <> metavar "NETWORK-TAG" + <> long "network-tag" + <> helpDoc (Just (vsep (pretty <$> doc style))) + <> completer (listCompleter $ show <$> tagsFor style) + where + doc style' = + [ "A tag which identifies a Cardano network." + , "" + , header + ] + ++ (fmtAllowedKeyword <$> ("" : allowedKeywords style')) + ++ + [ "" + , "...or alternatively, an explicit network tag as an integer." + ] + where + header = case style' of + Byron -> + "┌ Byron / Icarus ──────────" + Icarus -> + "┌ Byron / Icarus ──────────" + Shelley -> + "┌ Shelley ─────────────────" + Shared -> + "┌ Shared ──────────────────" + fmtAllowedKeyword network = + "│ " <> network + + tagsFor = \case + Byron -> + [ unNetworkTag (snd Byron.byronMainnet) + , unNetworkTag (snd Byron.byronStaging) + , unNetworkTag (snd Byron.byronTestnet) + , unNetworkTag (snd Byron.byronPreprod) + , unNetworkTag (snd Byron.byronPreview) + ] + Icarus -> + tagsFor Byron + Shelley -> + [ unNetworkTag Shelley.shelleyMainnet + , unNetworkTag Shelley.shelleyTestnet + ] + Shared -> + [ unNetworkTag Shelley.shelleyMainnet + , unNetworkTag Shelley.shelleyTestnet + ] + + reader str = maybe (Left err) Right + ((NetworkTag <$> readMaybe str) <|> (readKeywordMaybe str style)) + where + err = + "Invalid network tag. Must be an integer value or one of the \ + \allowed keywords: " <> intercalate ", " (allowedKeywords style) + + readKeywordMaybe str = \case + Byron | str == "mainnet" -> pure (snd Byron.byronMainnet) + Byron | str == "staging" -> pure (snd Byron.byronStaging) + Byron | str == "testnet" -> pure (snd Byron.byronTestnet) + Byron | str == "preview" -> pure (snd Byron.byronPreview) + Byron | str == "preprod" -> pure (snd Byron.byronPreprod) + Icarus -> readKeywordMaybe str Byron + Shelley | str == "mainnet" -> pure Shelley.shelleyMainnet + Shelley | str == "testnet" -> pure Shelley.shelleyTestnet + Shelley | str == "preview" -> pure Shelley.shelleyTestnet + Shelley | str == "preprod" -> pure Shelley.shelleyTestnet + Shared | str == "mainnet" -> pure Shelley.shelleyMainnet + Shared | str == "testnet" -> pure Shelley.shelleyTestnet + Shared | str == "preview" -> pure Shelley.shelleyTestnet + Shared | str == "preprod" -> pure Shelley.shelleyTestnet + _ -> Nothing + + allowedKeywords = \case + Byron -> ["mainnet", "staging", "testnet", "preview", "preprod"] + Icarus -> allowedKeywords Byron + Shelley -> ["mainnet", "testnet", "preview", "preprod"] + Shared -> allowedKeywords Shelley diff --git a/lib/Options/Applicative/Governance.hs b/lib/Options/Applicative/Governance.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/Governance.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE FlexibleContexts #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.Governance + ( + -- * Applicative Parser + governanceOpt + ) where + +import Prelude + +import Cardano.Address.KeyHash + ( GovernanceType (..) ) +import Control.Applicative + ( (<|>) ) +import Options.Applicative + ( Parser, flag', long ) + +-- +-- Applicative Parser +-- + +-- | Parse an 'GovernanceType' from the command-line, if there is proper flag then 'cip-0105' is set. +governanceOpt :: Parser GovernanceType +governanceOpt = deprecated <|> pure CIP0129 + where + deprecated = flag' CIP0105 (long "cip-0105") diff --git a/lib/Options/Applicative/MnemonicSize.hs b/lib/Options/Applicative/MnemonicSize.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/MnemonicSize.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.MnemonicSize + ( + -- * Type + MnemonicSize(..) + , mnemonicSizeToString + , mnemonicSizeFromString + + -- * Applicative Parser + , mnemonicSizeOpt + ) where + +import Prelude + +import Data.List + ( intercalate ) +import Data.List.Extra + ( enumerate ) +import GHC.Generics + ( Generic ) +import Options.Applicative + ( Parser + , completer + , eitherReader + , help + , listCompleter + , long + , metavar + , option + , showDefaultWith + , value + ) + + +-- +-- Type +-- + +data MnemonicSize + = MS_9 | MS_12 | MS_15 | MS_18 | MS_21 | MS_24 + deriving (Generic, Show, Bounded, Enum, Eq) + +mnemonicSizeToString :: MnemonicSize -> String +mnemonicSizeToString = drop 3 . show + +mnemonicSizeFromString :: String -> Either String MnemonicSize +mnemonicSizeFromString str = + case lookup str sizeMap of + Just ms -> Right ms + Nothing -> Left $ mempty + <> "Invalid mnemonic size. Expected one of: " + <> intercalate ", " sizeStrs + <> "." + where + sizeMap = sizeStrs `zip` enumerate + +sizeStrs :: [String] +sizeStrs = mnemonicSizeToString <$> enumerate + +-- +-- Applicative Parser +-- + +mnemonicSizeOpt :: Parser MnemonicSize +mnemonicSizeOpt = option (eitherReader mnemonicSizeFromString) $ mempty + <> long "size" + <> metavar "INT" + <> help "Number of mnemonic words to generate. Must be a multiple of 3." + <> value MS_24 + <> showDefaultWith mnemonicSizeToString + <> completer (listCompleter sizeStrs) diff --git a/lib/Options/Applicative/Private.hs b/lib/Options/Applicative/Private.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/Private.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE FlexibleContexts #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.Private + ( + -- * Types + PrivateType (..) + + -- * Applicative Parser + , privateOpt + ) where + +import Prelude + +import Control.Applicative + ( (<|>) ) +import Options.Applicative + ( Parser, flag', long ) + + +data PrivateType = ChainCode | SigningKey + deriving (Eq, Show) + +-- +-- Applicative Parser +-- + +-- | Parse an 'PrivateType' from the command-line, as set of non-overlapping flags. +privateOpt :: Parser PrivateType +privateOpt = cc <|> signing + where + cc = flag' ChainCode (long "chain-code") + signing = flag' SigningKey (long "signing-key") diff --git a/lib/Options/Applicative/Public.hs b/lib/Options/Applicative/Public.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/Public.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE FlexibleContexts #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.Public + ( + -- * Types + PublicType (..) + + -- * Applicative Parser + , publicOpt + ) where + +import Prelude + +import Control.Applicative + ( (<|>) ) +import Options.Applicative + ( Parser, flag', long ) + + +data PublicType = WithChainCode | WithoutChainCode + deriving (Eq, Show) + +-- +-- Applicative Parser +-- + +-- | Parse an 'PublicType' from the command-line, as set of non-overlapping flags. +publicOpt :: Parser PublicType +publicOpt = withoutCC <|> withCC + where + withoutCC = flag' WithoutChainCode (long "without-chain-code") + withCC = flag' WithChainCode (long "with-chain-code") diff --git a/lib/Options/Applicative/Script.hs b/lib/Options/Applicative/Script.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/Script.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE FlexibleContexts #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.Script + ( + -- ** Applicative Parser + scriptArg + , scriptReader + , scriptHashArg + , scriptHashReader + , levelOpt + , scriptTemplateReader + , scriptTemplateSpendingArg + , scriptTemplateStakingArg + ) where + +import Prelude + +import Cardano.Address.KeyHash + ( KeyHash ) +import Cardano.Address.Script + ( Cosigner (..) + , Script (..) + , ScriptHash + , ValidationLevel (..) + , prettyErrScriptHashFromText + , prettyErrValidateScript + , scriptHashFromText + ) +import Cardano.Address.Script.Parser + ( requireCosignerOfParser, requireSignatureOfParser, scriptFromString ) +import Control.Applicative + ( (<|>) ) +import Control.Arrow + ( left ) +import Data.Bifunctor + ( first ) +import Options.Applicative + ( Parser, argument, eitherReader, flag', help, long, metavar, option ) + +import qualified Data.Text as T + +-- +-- Applicative Parsers +-- + +scriptArg :: Parser (Script KeyHash) +scriptArg = argument (eitherReader scriptReader) $ mempty + <> metavar "SCRIPT" + -- TODO: Provides a bigger help text explaining how to construct a script + -- address. + <> help "Script string." + +scriptReader :: String -> Either String (Script KeyHash) +scriptReader = + left prettyErrValidateScript . (scriptFromString requireSignatureOfParser) + +scriptHashArg :: String -> Parser ScriptHash +scriptHashArg helpDoc = + argument (eitherReader scriptHashReader) $ mempty + <> metavar "SCRIPT HASH" + <> help helpDoc + +scriptHashReader :: String -> Either String ScriptHash +scriptHashReader str = + first prettyErrScriptHashFromText (scriptHashFromText . T.pack $ str) + +levelOpt :: Parser ValidationLevel +levelOpt = required <|> recommended + where + required = flag' RequiredValidation (long "required") + recommended = flag' RecommendedValidation (long "recommended") + +scriptTemplateReader :: String -> Either String (Script Cosigner) +scriptTemplateReader = + left prettyErrValidateScript . (scriptFromString requireCosignerOfParser) + +scriptTemplateSpendingArg :: Parser (Script Cosigner) +scriptTemplateSpendingArg = option (eitherReader scriptTemplateReader) $ mempty + <> long "spending" + <> metavar "SPENDING SCRIPT TEMPLATE" + <> help "Spending script template string." + +scriptTemplateStakingArg :: Parser (Script Cosigner) +scriptTemplateStakingArg = option (eitherReader scriptTemplateReader) $ mempty + <> long "staking" + <> metavar "STAKING SCRIPT TEMPLATE" + <> help "Staking script template string." diff --git a/lib/Options/Applicative/Style.hs b/lib/Options/Applicative/Style.hs new file mode 100644 --- /dev/null +++ b/lib/Options/Applicative/Style.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module Options.Applicative.Style + ( + -- * Type + Style(..) + , Passphrase (..) + , PassphraseInfo (..) + , PassphraseInputMode (..) + , PassphraseInput (..) + , generateRootKey + + -- * Applicative Parser + , styleArg + , passphraseInfoOpt + , passphraseInputModeOpt + , fileOpt + ) where + +import Prelude + +import Cardano.Address.Derivation + ( XPrv ) +import Cardano.Mnemonic + ( SomeMnemonic, someMnemonicToBytes ) +import Control.Applicative + ( (<|>) ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Char + ( toLower ) +import Data.List + ( intercalate ) +import Options.Applicative + ( Parser + , argument + , completer + , eitherReader + , flag' + , help + , listCompleter + , long + , metavar + , option + ) + +import qualified Cardano.Address.Style.Byron as Byron +import qualified Cardano.Address.Style.Icarus as Icarus +import qualified Cardano.Address.Style.Shared as Shared +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Data.ByteArray as BA + +-- +-- Type +-- + +-- | Represent a style of wallet. +data Style + = Byron + | Icarus + | Shelley + | Shared + deriving (Eq, Show, Enum, Bounded) + +-- | User chosen passphrase for the generation phase +-- +-- @since 3.13.0 +data Passphrase = + FromMnemonic SomeMnemonic | FromEncoded ByteString + deriving (Eq, Show) + +data PassphraseInfo = + Mnemonic | Hex | Base64 | Utf8 | Octets + deriving (Eq, Show) + +data PassphraseInputMode = + Sensitive | Silent | Explicit + deriving (Eq, Show) + +data PassphraseInput = + Interactive | FromFile FilePath + deriving (Eq, Show) + +toSndFactor :: Maybe Passphrase -> ScrubbedBytes +toSndFactor = \case + Nothing -> mempty + Just (FromMnemonic mnemonic) -> someMnemonicToBytes mnemonic + Just (FromEncoded bs) -> BA.convert bs + +-- | Generate an extended root private key from a mnemonic sentence, in the +-- given style. +generateRootKey :: SomeMnemonic -> Maybe Passphrase -> Style -> IO XPrv +generateRootKey mw passwd = \case + Byron -> do + let rootK = Byron.genMasterKeyFromMnemonic mw + pure $ Byron.getKey rootK + Icarus -> do + let sndFactor = toSndFactor passwd + let rootK = Icarus.genMasterKeyFromMnemonic mw sndFactor + pure $ Icarus.getKey rootK + Shelley -> do + let sndFactor = toSndFactor passwd + let rootK = Shelley.genMasterKeyFromMnemonic mw sndFactor + pure $ Shelley.getKey rootK + Shared -> do + let sndFactor = toSndFactor passwd + let rootK = Shared.genMasterKeyFromMnemonic mw sndFactor + pure $ Shared.getKey rootK + +-- +-- Applicative Parser +-- + +-- | Parse a 'Style' from the command-line, as an argument. +styleArg :: Parser Style +styleArg = argument (eitherReader reader) $ mempty + <> metavar "STYLE" + <> help styles' + <> completer (listCompleter styles) + where + styles :: [String] + styles = show @Style <$> [minBound .. maxBound] + + styles' = intercalate " | " styles + + reader :: String -> Either String Style + reader str = case toLower <$> str of + "byron" -> Right Byron + "icarus" -> Right Icarus + "shelley" -> Right Shelley + "shared" -> Right Shared + _ -> Left $ "Unknown style; expecting one of " <> styles' + +passphraseInfoReader :: String -> Either String PassphraseInfo +passphraseInfoReader s = maybe (Left err) Right (readPassphraseInfoMaybe s) + where + err = "Invalid passphrase input type. Must be one of the \ + \allowed keywords: from-mnemonic, from-hex, from-base64, from-octets or from-utf8." + readPassphraseInfoMaybe str + | str == mempty = pure Utf8 + | str == "from-mnemonic" = pure Mnemonic + | str == "from-hex" = pure Hex + | str == "from-base64" = pure Base64 + | str == "from-utf8" = pure Utf8 + | str == "from-octets" = pure Octets + | otherwise = Nothing + +passphraseInfoOpt :: Parser PassphraseInfo +passphraseInfoOpt = option (eitherReader passphraseInfoReader) $ mempty + <> long "passphrase" + <> metavar "FORMAT" + <> help helpDoc + where + helpDoc = + "(from-mnemonic | from-hex | from-base64 | from-utf8 | from-octets) " ++ + "User chosen passphrase to be read from stdin for the generation phase. " ++ + "Valid for Icarus, Shelley and Shared styles. Accepting mnemonic " ++ + "(9- or 12 words) or arbitrary passphrase encoded as base16, base64, plain utf8 " ++ + "or raw bytes in the form of octet array." + +-- | Parse an 'PassphraseInputMode' from the command-line, if there is proper flag then sensitive is set. +passphraseInputModeOpt :: Parser PassphraseInputMode +passphraseInputModeOpt = sensitive <|> silent <|> pure Explicit + where + sensitive = flag' Sensitive (long "sensitive" <> help ("Input is shown as * in interactive mode.")) + silent = flag' Silent (long "silent" <> help ("Input is not shown in interactive mode.")) + +fileOpt :: Parser FilePath +fileOpt = option (eitherReader Right) $ mempty + <> long "from-file" + <> metavar "FILE" + <> help ("Passphrase from specified filepath.") diff --git a/lib/System/Git/TH.hs b/lib/System/Git/TH.hs new file mode 100644 --- /dev/null +++ b/lib/System/Git/TH.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module System.Git.TH + ( gitRevParseHEAD + ) where + +import Prelude + +import Control.Exception + ( SomeException, try ) +import Language.Haskell.TH + ( Exp (..), Lit (..), Q, runIO ) +import System.Environment + ( lookupEnv ) +import System.Exit + ( ExitCode (..) ) +import System.Process + ( readProcessWithExitCode ) + +gitRevParseHEAD :: Q Exp +gitRevParseHEAD = + LitE . StringL <$> runIO findGitRev + where + findGitRev :: IO String + findGitRev = do + envRev <- lookupEnv "GITREV" + maybe runGitRevParse pure envRev + + runGitRevParse :: IO String + runGitRevParse = do + result <- try @SomeException $ + readProcessWithExitCode "git" ["rev-parse", "--verify", "HEAD"] "" + case result of + Right (ExitSuccess, revision, _) -> pure revision + _ -> pure "unknown revision" diff --git a/lib/System/IO/Extra.hs b/lib/System/IO/Extra.hs new file mode 100644 --- /dev/null +++ b/lib/System/IO/Extra.hs @@ -0,0 +1,399 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect +-- License: Apache-2.0 + +module System.IO.Extra + ( + -- * I/O application-specific helpers + -- ** Read + hGetBytes + , hGetBech32 + , hGetXPrv + , hGetXPub + , hGetXP__ + , hGetScriptHash + , hGetSomeMnemonic + , hGetSomeMnemonicInteractively + , hGetPassphraseMnemonic + , hGetPassphraseBytes + + -- ** Write + , hPutBytes + , hPutString + , hPutStringNoNewLn + + -- * I/O Helpers + , prettyIOException + , progName + , markCharsRedAtIndices + , noNewline + ) where + +import Prelude + +import Cardano.Address.Derivation + ( XPrv, XPub, xprvFromBytes, xpubFromBytes ) +import Cardano.Address.Script + ( ScriptHash, scriptHashFromBytes ) +import Cardano.Mnemonic + ( MkSomeMnemonicError (..), SomeMnemonic, mkSomeMnemonic ) +import Codec.Binary.Bech32 + ( HumanReadablePart, humanReadablePartToText ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) + , Encoding + , detectEncoding + , encode + , fromBase16 + , fromBase58 + , fromBase64 + , fromBech32 + ) +import Control.Exception + ( IOException, bracket ) +import Control.Monad + ( unless ) +import Data.ByteString + ( ByteString ) +import Data.List + ( nub, sort ) +import Data.Text + ( Text ) +import Data.Word + ( Word8 ) +import Options.Applicative.Style + ( PassphraseInfo (..), PassphraseInput (..), PassphraseInputMode (..) ) +import System.Console.ANSI + ( Color (..) + , ColorIntensity (..) + , ConsoleLayer (..) + , SGR (..) + , hCursorBackward + , setSGRCode + ) +import System.Environment + ( getProgName ) +import System.Exit + ( exitFailure ) +import System.IO + ( BufferMode (..) + , Handle + , hGetBuffering + , hGetChar + , hGetEcho + , hPutChar + , hSetBuffering + , hSetEcho + , stderr + ) +import System.IO.Unsafe + ( unsafePerformIO ) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.IO as TIO +-- +-- I/O Read +-- + +-- | Read some bytes from the console, and decode them if the encoding is recognized. +hGetBytes :: Handle -> IO ByteString +hGetBytes h = do + raw <- B8.filter noNewline <$> B8.hGetContents h + case detectEncoding (T.unpack $ T.decodeUtf8 raw) of + Just (EBase16 ) -> decodeBytes fromBase16 raw + Just (EBech32{}) -> decodeBytes (fmap snd . fromBech32 markCharsRedAtIndices) raw + Just (EBase58 ) -> decodeBytes fromBase58 raw + Nothing -> fail + "Couldn't detect input encoding? Data on stdin must be encoded as \ + \bech16, bech32 or base58." + +decodeBytes + :: (bin -> Either String result) + -> bin + -> IO result +decodeBytes from = either fail pure . from + +-- | Read some bytes encoded in Bech32, only allowing the given prefixes. +hGetBech32 :: Handle -> [HumanReadablePart] -> IO (HumanReadablePart, ByteString) +hGetBech32 h allowedPrefixes = do + raw <- B8.filter noNewline <$> B8.hGetContents h + (hrp, bytes) <- decodeBytes (fromBech32 markCharsRedAtIndices) raw + unless (hrp `elem` allowedPrefixes) $ fail + $ "Invalid human-readable prefix. Prefix ought to be one of: " + <> show (showHrp <$> allowedPrefixes) + pure (hrp, bytes) + where + showHrp :: HumanReadablePart -> String + showHrp = T.unpack . humanReadablePartToText + +-- | Read some English mnemonic words from the console, or fail. +hGetSomeMnemonic :: Handle -> IO SomeMnemonic +hGetSomeMnemonic h = do + wrds <- T.words . T.filter noNewline . T.decodeUtf8 <$> B8.hGetContents h + case mkSomeMnemonic @'[ 9, 12, 15, 18, 21, 24 ] wrds of + Left (MkSomeMnemonicError e) -> fail e + Right mw -> pure mw + +-- | Read an encoded private key from the console, or fail. +hGetXPrv :: Handle -> [HumanReadablePart] -> IO (HumanReadablePart, XPrv) +hGetXPrv h allowedPrefixes = do + (hrp, bytes) <- hGetBech32 h allowedPrefixes + case xprvFromBytes bytes of + Nothing -> fail "Couldn't convert bytes into extended private key." + Just key -> pure (hrp, key) + +-- | Read an encoded public key from the console, or fail. +hGetXPub :: Handle -> [HumanReadablePart] -> IO (HumanReadablePart, XPub) +hGetXPub h allowedPrefixes = do + (hrp, bytes) <- hGetBech32 h allowedPrefixes + case xpubFromBytes bytes of + Nothing -> fail "Couldn't convert bytes into extended public key." + Just key -> pure (hrp, key) + +-- | Read a script hash from the console, or fail. +hGetScriptHash :: Handle -> IO ScriptHash +hGetScriptHash h = do + bytes <- hGetBytes h + case scriptHashFromBytes bytes of + Nothing -> fail "Couldn't convert bytes into script hash." + Just scriptHash -> pure scriptHash + +-- | Read either an encoded public or private key from the console, or fail. +hGetXP__ + :: Handle + -> [HumanReadablePart] + -> IO (Either (HumanReadablePart, XPub) (HumanReadablePart, XPrv)) +hGetXP__ h allowedPrefixes = do + (hrp, bytes) <- hGetBech32 h allowedPrefixes + case (xpubFromBytes bytes, xprvFromBytes bytes) of + (Just xpub, _) -> pure (Left (hrp, xpub)) + (_ , Just xprv) -> pure (Right (hrp, xprv)) + _ -> fail + "Couldn't convert bytes into neither extended public or private keys." + +withBuffering :: Handle -> BufferMode -> IO a -> IO a +withBuffering h buffering action = bracket aFirst aLast aBetween + where + aFirst = (hGetBuffering h <* hSetBuffering h buffering) + aLast = hSetBuffering h + aBetween = const action + +withEcho :: Handle -> Bool -> IO a -> IO a +withEcho h echo action = bracket aFirst aLast aBetween + where + aFirst = (hGetEcho h <* hSetEcho h echo) + aLast = hSetEcho h + aBetween = const action + +-- | Gather user inputs until a newline is met, hiding what's typed with a +-- placeholder character. +hGetSensitiveLine + :: (Handle, Handle) + -> PassphraseInputMode + -> String + -> IO Text +hGetSensitiveLine (hstdin, hstderr) mode prompt = + withBuffering hstderr NoBuffering $ + withBuffering hstdin NoBuffering $ + withEcho hstdin False $ do + hPutString hstderr prompt + getLineSensitive '*' + where + backspace = toEnum 127 + + getLineSensitive :: Char -> IO Text + getLineSensitive placeholder = + getLineSensitive' mempty + where + getLineSensitive' line = do + hGetChar hstdin >>= \case + '\n' -> do + hPutChar hstderr '\n' + return line + c | c == backspace -> + if T.null line + then getLineSensitive' line + else do + hCursorBackward hstderr 1 + hPutChar hstderr ' ' + hCursorBackward hstderr 1 + getLineSensitive' (T.init line) + c -> do + case mode of + Sensitive -> + hPutChar hstderr placeholder + Explicit -> + hPutChar hstderr c + Silent -> + pure () + getLineSensitive' (line <> T.singleton c) + +-- | Prompt user and read some English mnemonic words from stdin. +hGetSomeMnemonicInteractively + :: (Handle, Handle) + -> PassphraseInputMode + -> String + -> IO SomeMnemonic +hGetSomeMnemonicInteractively (hstdin, hstderr) mode prompt = do + wrds <- T.words . T.filter noNewline <$> + hGetSensitiveLine (hstdin, hstderr) mode prompt + case mkSomeMnemonic @'[ 9, 12, 15, 18, 21, 24 ] wrds of + Left (MkSomeMnemonicError e) -> fail e + Right mw -> pure mw + +-- | Read mnemonic passphrase from either file or interactively. +hGetPassphraseMnemonic + :: (Handle, Handle) + -> PassphraseInputMode + -> PassphraseInput + -> String + -> IO SomeMnemonic +hGetPassphraseMnemonic (hstdin, hstderr) mode input prompt = + case input of + Interactive -> + hGetPassphraseMnemonicInteractively (hstdin, hstderr) mode prompt + FromFile path -> + hGetPassphraseMnemonicFromFile path + +-- | Read the mnemonic passphrase (second factor) from file. +hGetPassphraseMnemonicFromFile + :: FilePath + -> IO SomeMnemonic +hGetPassphraseMnemonicFromFile path = do + wrds <- T.words . T.filter noNewline . T.decodeUtf8 <$> BS.readFile path + case mkSomeMnemonic @'[ 9, 12 ] wrds of + Left (MkSomeMnemonicError e) -> fail e + Right mw -> pure mw + +-- | Prompt user and read the mnemonic passphrase (second factor) interactively. +hGetPassphraseMnemonicInteractively + :: (Handle, Handle) + -> PassphraseInputMode + -> String + -> IO SomeMnemonic +hGetPassphraseMnemonicInteractively (hstdin, hstderr) mode prompt = do + wrds <- T.words . T.filter noNewline <$> + hGetSensitiveLine (hstdin, hstderr) mode prompt + case mkSomeMnemonic @'[ 9, 12 ] wrds of + Left (MkSomeMnemonicError e) -> fail e + Right mw -> pure mw + +-- | Read passphrase from either file or interactively, and decode them accoring to passphrase info. +hGetPassphraseBytes + :: (Handle, Handle) + -> PassphraseInputMode + -> PassphraseInput + -> String + -> PassphraseInfo + -> IO ByteString +hGetPassphraseBytes (hstdin, hstderr) mode input prompt info = + case input of + Interactive -> + hGetPassphraseBytesInteractively (hstdin, hstderr) mode prompt info + FromFile path -> + hGetPassphraseBytesFromFile path info + +-- | Read some bytes from the file, and decode them accoring to passphrase info. +hGetPassphraseBytesFromFile + :: FilePath + -> PassphraseInfo + -> IO ByteString +hGetPassphraseBytesFromFile path = \case + Hex -> do + raw <- B8.filter noNewline . T.encodeUtf8 <$> TIO.readFile path + decodeBytes fromBase16 raw + Base64 -> do + raw <- B8.filter noNewline . T.encodeUtf8 <$> TIO.readFile path + decodeBytes fromBase64 raw + Utf8 -> do + B8.filter noNewline . T.encodeUtf8 <$> TIO.readFile path + Octets -> do + txt <- TIO.readFile path + let bytes = read @[Word8] (T.unpack txt) + pure $ BS.pack bytes + _ -> fail + "Data in file must be encoded as hex, base64, utf8 or octet array." + +-- | Read some bytes from the console, and decode them accoring to passphrase info. +hGetPassphraseBytesInteractively + :: (Handle, Handle) + -> PassphraseInputMode + -> String + -> PassphraseInfo + -> IO ByteString +hGetPassphraseBytesInteractively (hstdin, hstderr) mode prompt = \case + Hex -> do + raw <- B8.filter noNewline . T.encodeUtf8 <$> hGetSensitiveLine (hstdin, hstderr) mode prompt + decodeBytes fromBase16 raw + Base64 -> do + raw <- B8.filter noNewline . T.encodeUtf8 <$> hGetSensitiveLine (hstdin, hstderr) mode prompt + decodeBytes fromBase64 raw + Utf8 -> do + txt <- hGetSensitiveLine (hstdin, hstderr) mode prompt + pure $ T.encodeUtf8 txt + Octets -> do + txt <- hGetSensitiveLine (hstdin, hstderr) mode prompt + let bytes = read @[Word8] (T.unpack txt) + pure $ BS.pack bytes + _ -> fail + "Data on stdin must be encoded as hex, base64, utf8 or octet array." + +-- +-- I/O Write +-- + +-- | Print bytes to the console with the given encoding. +hPutBytes :: Handle -> ByteString -> Encoding -> IO () +hPutBytes h bytes = + B8.hPutStr h . flip encode bytes + +-- | Print string to the console with newline appended. +hPutString :: Handle -> String -> IO () +hPutString h = + B8.hPutStrLn h . T.encodeUtf8 . T.pack + +-- | Print string to the console without newline appended. +hPutStringNoNewLn :: Handle -> String -> IO () +hPutStringNoNewLn h = + B8.hPutStr h . T.encodeUtf8 . T.pack + +-- +-- Helpers +-- + +noNewline :: Char -> Bool +noNewline = (`notElem` ['\n', '\r']) + +-- | Fail with a colored red error message. +prettyIOException :: IOException -> IO a +prettyIOException e = do + B8.hPutStrLn stderr $ T.encodeUtf8 $ T.pack $ show e + exitFailure + +-- | Mark all characters from a given string as red (in a console). +markCharsRedAtIndices :: Integral i => [i] -> String -> String +markCharsRedAtIndices ixs = go 0 (sort $ nub ixs) + where + go _c [] [] = mempty + go c (i:is) (s:ss) + | c == i = red ++ s:def ++ go (c + 1) is ss + | otherwise = s : go (c + 1) (i:is) ss + go _ [] ss = ss + go _ _ [] = [] -- NOTE: Really an error case. + + red = setSGRCode [SetColor Foreground Vivid Red] + def = setSGRCode [Reset] + +-- | Get program name to avoid hard-coding it in documentation excerpt. +progName :: String +progName = unsafePerformIO getProgName +{-# NOINLINE progName #-} diff --git a/schemas/address-inspect.json b/schemas/address-inspect.json new file mode 100644 --- /dev/null +++ b/schemas/address-inspect.json @@ -0,0 +1,111 @@ +{ + "$schema": "http://json-schema.org/draft-04/schema#", + "$id": "https://raw.githubusercontent.com/IntersectMBO/cardano-addresses/master/command-line/schemas/address-inspect.json", + "description": "JSON specification for address inspection.", + "type": "object", + "required": [ + "address_style", + "stake_reference", + "network_tag" + ], + "properties": { + "address_style": { + "type": "string", + "enum": ["Shelley", "Icarus", "Byron"] + }, + "stake_reference": { + "type": "string", + "enum": ["none", "by value", "by pointer"] + }, + "network_tag": { + "description": "Can only be null for 'Icarus' and 'Byron' styles.", + "oneOf": [ + { + "type": "integer", + "minimum": 0 + }, + { + "type": "null" + } + ] + }, + "spending_key_hash": { + "type": "string", + "format": "base16", + "minimum_length": "56", + "maximum_length": "56" + }, + "spending_key_hash_bech32": { + "type": "string", + "format": "bech32" + }, + "stake_key_hash": { + "type": "string", + "format": "base16", + "minimum_length": "56", + "maximum_length": "56" + }, + "stake_key_hash_bech32": { + "type": "string", + "format": "bech32" + }, + "script_hash": { + "type": "string", + "format": "base16", + "minimum_length": "56", + "maximum_length": "56" + }, + "script_key_hash_bech32": { + "type": "string", + "format": "bech32" + }, + "pointer": { + "type": "object", + "additionalProperties": false, + "required": [ "slot_num", "transaction_index", "output_index" ], + "properties": { + "slot_num": { + "type": "integer", + "minimum": 0 + }, + "transaction_index": { + "type": "integer", + "minimum": 0 + }, + "output_index": { + "type": "integer", + "minimum": 0 + } + } + }, + "address_root": { + "description": "Only for 'Icarus' and 'Byron' styles.", + "type": "string", + "format": "base16" + }, + "derivation_path": { + "description": "Only for 'Byron' style.", + "oneOf": [ + { + "type": "string", + "format": "base16" + }, + { + "type": "object", + "additionalProperties": false, + "required": ["account_index", "address_index"], + "properties": { + "account_index": { + "type": "string", + "pattern": "^[0-9]+H?$" + }, + "address_index": { + "type": "string", + "pattern": "^[0-9]+H?$" + } + } + } + ] + } + } +} diff --git a/test/AutoDiscover.hs b/test/AutoDiscover.hs new file mode 100644 --- /dev/null +++ b/test/AutoDiscover.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=AutoDiscover #-} diff --git a/test/Cardano/Address/DerivationSpec.hs b/test/Cardano/Address/DerivationSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/Address/DerivationSpec.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Address.DerivationSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Derivation + ( Depth (..) + , DerivationType (..) + , Index (..) + , XPrv + , indexFromWord32 + , nextIndex + , sign + , toXPub + , verify + , xprvChainCode + , xprvFromBytes + , xprvToBytes + , xpubChainCode + , xpubFromBytes + , xpubToBytes + ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.String + ( IsString (..) ) +import Test.Hspec + ( Spec, describe, it, shouldBe ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Arbitrary (..), Property, property, (===) ) + +import Test.Arbitrary + () + +spec :: Spec +spec = describe "Checking auxiliary address derivations types" $ do + describe "Bounded / Indexed relationship" $ do + it "nextIndex maxBound for Hardened indices should result in failure" $ + nextIndex (maxBound @(Index 'Hardened _)) `shouldBe` Nothing + it "nextIndex maxBound for Soft indices should result in failure" $ + nextIndex (maxBound @(Index 'Soft _)) `shouldBe` Nothing + + describe "Indexed Roundtrip" $ do + it "Index @'Hardened _" (property prop_roundtripIndexedHard) + it "Index @'Soft _" (property prop_roundtripIndexedSoft) + + describe "XPub / XPrv properties" $ do + prop "roundtripping: xpubToBytes . xpubFromBytes" $ + prop_roundtripBytes xpubToBytes xpubFromBytes + prop "roundtripping: xprvToBytes . xprvFromBytes" $ + prop_roundtripBytes xprvToBytes xprvFromBytes + prop "forall xprv. xprvChainCode xprv == xpubChainCode (toXPub xprv)" + prop_chainCodeInvariance + prop "forall xprv msg. 'verify' ('toXPub' xprv) msg ('sign' xprv msg) == 'True'" + prop_publicKeySignature + +{------------------------------------------------------------------------------- + Properties +-------------------------------------------------------------------------------} + +prop_publicKeySignature + :: XPrv + -> ScrubbedBytes + -> Property +prop_publicKeySignature xprv msg = + verify (toXPub xprv) msg (sign xprv msg) === True + +prop_chainCodeInvariance + :: XPrv + -> Property +prop_chainCodeInvariance xprv = + xprvChainCode xprv === xpubChainCode (toXPub xprv) + +prop_roundtripBytes + :: (Eq a, Show a) + => (a -> ByteString) + -> (ByteString -> Maybe a) + -> a + -> Property +prop_roundtripBytes encode decode a = + decode (encode a) === pure a + +prop_roundtripIndexedHard :: Index 'WholeDomain 'AccountK -> Property +prop_roundtripIndexedHard ix = (indexFromWord32 . indexToWord32) ix === Just ix + +prop_roundtripIndexedSoft :: Index 'Soft 'PaymentK -> Property +prop_roundtripIndexedSoft ix = (indexFromWord32 . indexToWord32) ix === Just ix + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +instance Arbitrary ScrubbedBytes where + arbitrary = fromString <$> arbitrary diff --git a/test/Cardano/Address/Script/ParserSpec.hs b/test/Cardano/Address/Script/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/Address/Script/ParserSpec.hs @@ -0,0 +1,260 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Cardano.Address.Script.ParserSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.KeyHash + ( KeyHash (..), KeyRole (..) ) +import Cardano.Address.Script + ( Cosigner (..), Script (..) ) +import Cardano.Address.Script.Parser + ( requireAllOfParser + , requireAnyOfParser + , requireAtLeastOfParser + , requireCosignerOfParser + , requireCosignerOfParser + , requireSignatureOfParser + , scriptParser + ) +import Data.ByteString + ( ByteString ) +import Data.Text + ( Text ) +import Test.Hspec + ( Spec, SpecWith, describe, it, shouldBe ) +import Text.ParserCombinators.ReadP + ( ReadP, readP_to_S ) + +import qualified Codec.Binary.Encoding as E +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +spec :: Spec +spec = do + requireOfParserTests @KeyHash requireSignatureOfParser + (kh1,verKeyH1) "requireSignatureOfParser" + requireOfParserTests @Cosigner requireCosignerOfParser + (cosigner0,cosigner0Txt) "requireCosignerOfParser" + + requireAllOfParserTests @KeyHash requireSignatureOfParser + [(kh1,verKeyH1), (kh2,verKeyH2), (kh3,verKeyH3)] + requireAllOfParserTests @Cosigner requireCosignerOfParser + [(cosigner0,cosigner0Txt), (cosigner1,cosigner1Txt), (cosigner2,cosigner2Txt)] + + requireAnyOfParserTests @KeyHash requireSignatureOfParser + [(kh1,verKeyH1), (kh2,verKeyH2), (kh3,verKeyH3)] + requireAnyOfParserTests @Cosigner requireCosignerOfParser + [(cosigner0,cosigner0Txt), (cosigner1,cosigner1Txt), (cosigner2,cosigner2Txt)] + + requireAtLeastOfParserTests @KeyHash requireSignatureOfParser + [(kh1,verKeyH1), (kh2,verKeyH2), (kh3,verKeyH3)] + requireAtLeastOfParserTests @Cosigner requireCosignerOfParser + [(cosigner0,cosigner0Txt), (cosigner1,cosigner1Txt), (cosigner2,cosigner2Txt)] + + timelockParserTests @KeyHash requireSignatureOfParser + (kh1,verKeyH1) + timelockParserTests @Cosigner requireCosignerOfParser + (cosigner0,cosigner0Txt) + where + verKeyH1 = "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" :: Text + kh1 = KeyHash Payment (unBech32 verKeyH1) + verKeyH2 = "addr_shared_vkh1y3zl4nqgm96ankt96dsdhc86vd5geny0wr7hu8cpzdfcqskq2cp" :: Text + kh2 = KeyHash Payment (unBech32 verKeyH2) + verKeyH3 = "addr_shared_vkh175wsm9ckhm3snwcsn72543yguxeuqm7v9r6kl6gx57h8gdydcd9" :: Text + kh3 = KeyHash Payment (unBech32 verKeyH3) + + script1 txt = "all ["<>txt<>"]" + script2 txt = " all [ "<>txt<>" ] " + script3 txt1 txt2 = "all ["<>txt1<>", "<>txt2<>"]" + script4 txt1 txt2 txt3 = "all ["<>txt1<>", "<>txt2<>","<>txt3<>"]" + script5 txt = "any ["<>txt<>"]" + script6 txt = " any [ "<>txt<>" ] " + script7 txt1 txt2 = "any ["<>txt1<>", "<>txt2<>"]" + script8 txt1 txt2 txt3 = "any ["<>txt1<>", "<>txt2<>","<>txt3<>"]" + script9 txt1 txt2 txt3 = "any ["<>txt1<>", all ["<>txt2<>","<>txt3<>"]]" + script10 txt1 txt2 txt3 = "at_least 1 ["<>txt1<>", "<>txt2<>","<>txt3<>"]" + script11 txt1 txt2 txt3 = "at_least 1 ["<>txt1<>", all ["<>txt2<>","<>txt3<>"]]" + script12 = "all []" + script13 txt = "any ["<>txt<>", all [ ]]" + script14 txt = "all ["<>txt<>", active_from 120]" + script15 txt = "all ["<>txt<>", active_until 150]" + script16 txt = "all ["<>txt<>", active_from 120, active_until 125]" + + cosigner0Txt = "cosigner#0" :: Text + cosigner0 = Cosigner 0 + cosigner1Txt = "cosigner#1" :: Text + cosigner1 = Cosigner 1 + cosigner2Txt = "cosigner#2" :: Text + cosigner2 = Cosigner 2 + + requireOfParserTests + :: (Eq a, Show a) + => ReadP (Script a) + -> (a, Text) + -> String + -> SpecWith () + requireOfParserTests parser (obj, txt) descr = + describe (descr <> " : unit tests") $ do + valuesParserUnitTest parser txt + (RequireSignatureOf obj) + valuesParserUnitTest parser (txt <> " ") + (RequireSignatureOf obj) + valuesParserUnitTest parser (txt <>", ") + (RequireSignatureOf obj) + valuesParserUnitTest parser (" " <> txt <>", ") + (RequireSignatureOf obj) + + requireAllOfParserTests + :: (Eq a, Show a) + => ReadP (Script a) + -> [(a, Text)] + -> SpecWith () + requireAllOfParserTests parser objTxts = do + let [(obj1, txt1),(obj2, txt2),(obj3, txt3)] = objTxts + describe "requireAllOfParser : unit tests" $ do + let expected1 = RequireAllOf + [ RequireSignatureOf obj1 ] + valuesParserUnitTest (requireAllOfParser parser) (script1 txt1) expected1 + valuesParserUnitTest (scriptParser parser) (script1 txt1) expected1 + + valuesParserUnitTest (requireAllOfParser parser) (script2 txt1) expected1 + valuesParserUnitTest (scriptParser parser) (script2 txt1) expected1 + + let expected2 = RequireAllOf + [ RequireSignatureOf obj1 + , RequireSignatureOf obj2 ] + valuesParserUnitTest (requireAllOfParser parser) (script3 txt1 txt2) expected2 + valuesParserUnitTest (scriptParser parser) (script3 txt1 txt2) expected2 + + let expected3 = RequireAllOf + [ RequireSignatureOf obj1 + , RequireSignatureOf obj2 + , RequireSignatureOf obj3 ] + valuesParserUnitTest (requireAllOfParser parser) (script4 txt1 txt2 txt3) expected3 + valuesParserUnitTest (scriptParser parser) (script4 txt1 txt2 txt3) expected3 + + let expected4 = RequireAllOf [] + valuesParserUnitTest (requireAllOfParser parser) script12 expected4 + valuesParserUnitTest (scriptParser parser) script12 expected4 + + requireAnyOfParserTests + :: (Eq a, Show a) + => ReadP (Script a) + -> [(a, Text)] + -> SpecWith () + requireAnyOfParserTests parser objTxts = do + let [(obj1, txt1),(obj2, txt2),(obj3, txt3)] = objTxts + describe "requireAnyOfParser : unit tests" $ do + let expected1 = RequireAnyOf + [ RequireSignatureOf obj1 ] + valuesParserUnitTest (requireAnyOfParser parser) (script5 txt1) expected1 + valuesParserUnitTest (scriptParser parser) (script5 txt1) expected1 + + valuesParserUnitTest (requireAnyOfParser parser) (script6 txt1) expected1 + valuesParserUnitTest (scriptParser parser) (script6 txt1) expected1 + + let expected2 = RequireAnyOf + [ RequireSignatureOf obj1 + , RequireSignatureOf obj2 ] + valuesParserUnitTest (requireAnyOfParser parser) (script7 txt1 txt2) expected2 + valuesParserUnitTest (scriptParser parser) (script7 txt1 txt2) expected2 + + let expected3 = RequireAnyOf + [ RequireSignatureOf obj1 + , RequireSignatureOf obj2 + , RequireSignatureOf obj3 ] + valuesParserUnitTest (requireAnyOfParser parser) (script8 txt1 txt2 txt3) expected3 + valuesParserUnitTest (scriptParser parser) (script8 txt1 txt2 txt3) expected3 + + let expected4 = RequireAnyOf + [ RequireSignatureOf obj1 + , RequireAllOf + [ RequireSignatureOf obj2 + , RequireSignatureOf obj3 ] + ] + valuesParserUnitTest (requireAnyOfParser parser) (script9 txt1 txt2 txt3) expected4 + valuesParserUnitTest (scriptParser parser) (script9 txt1 txt2 txt3) expected4 + + let expected5 = RequireAnyOf + [ RequireSignatureOf obj1 + , RequireAllOf [] + ] + valuesParserUnitTest (requireAnyOfParser parser) (script13 txt1) expected5 + valuesParserUnitTest (scriptParser parser) (script13 txt1) expected5 + + requireAtLeastOfParserTests + :: (Eq a, Show a) + => ReadP (Script a) + -> [(a, Text)] + -> SpecWith () + requireAtLeastOfParserTests parser objTxts = do + let [(obj1, txt1),(obj2, txt2),(obj3, txt3)] = objTxts + describe "requireAtLeastOfParser : unit tests" $ do + let expected1 = RequireSomeOf 1 + [ RequireSignatureOf obj1 + , RequireSignatureOf obj2 + , RequireSignatureOf obj3 ] + valuesParserUnitTest (requireAtLeastOfParser parser) (script10 txt1 txt2 txt3) expected1 + valuesParserUnitTest (scriptParser parser) (script10 txt1 txt2 txt3) expected1 + + let expected2 = RequireSomeOf 1 + [ RequireSignatureOf obj1 + , RequireAllOf + [ RequireSignatureOf obj2 + , RequireSignatureOf obj3 ] + ] + valuesParserUnitTest (requireAtLeastOfParser parser) (script11 txt1 txt2 txt3) expected2 + valuesParserUnitTest (scriptParser parser) (script11 txt1 txt2 txt3) expected2 + + timelockParserTests + :: (Eq a, Show a) + => ReadP (Script a) + -> (a, Text) + -> SpecWith () + timelockParserTests parser (obj,txt) = do + describe "validFromSlot unit test" $ do + let expected = RequireAllOf + [ RequireSignatureOf obj + , ActiveFromSlot 120 ] + valuesParserUnitTest (scriptParser parser) (script14 txt) expected + + describe "validUntilSlot unit test" $ do + let expected = RequireAllOf + [ RequireSignatureOf obj + , ActiveUntilSlot 150 ] + valuesParserUnitTest (scriptParser parser) (script15 txt) expected + + describe "validUntilSlot and validFromSlot unit test" $ do + let expected = RequireAllOf + [ RequireSignatureOf obj + , ActiveFromSlot 120 + , ActiveUntilSlot 125 ] + valuesParserUnitTest (scriptParser parser) (script16 txt) expected + +valuesParserUnitTest + :: (Eq s, Show s) + => ReadP s + -> Text + -> s + -> SpecWith() +valuesParserUnitTest parser inp expected = it title $ do + res <- case take 1 $ reverse $ readP_to_S parser (T.unpack inp) of + [(res,_rest)] -> pure res + err -> error $ "valuesParserUnitTest : "<>show err + res `shouldBe` expected + where + title :: String + title = mempty <> " input=" <> show inp + +-- | Unsafe function to get bech32 data part from test data. +unBech32 :: Text -> ByteString +unBech32 = either (error "Incorrect bech32 in test data") snd + . E.fromBech32 (const id) + . T.encodeUtf8 diff --git a/test/Cardano/Address/ScriptSpec.hs b/test/Cardano/Address/ScriptSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/Address/ScriptSpec.hs @@ -0,0 +1,856 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Cardano.Address.ScriptSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Derivation + ( Depth (..) + , DerivationType (..) + , Index + , XPrv + , XPub + , indexFromWord32 + , toXPub + , xpubFromBytes + ) +import Cardano.Address.KeyHash + ( KeyHash (..), KeyRole (..) ) +import Cardano.Address.Script + ( Cosigner (..) + , ErrRecommendedValidateScript (..) + , ErrValidateScript (..) + , ErrValidateScriptTemplate (..) + , Script (..) + , ScriptHash (..) + , ScriptTemplate (..) + , ValidationLevel (..) + , serializeScript + , toScriptHash + , validateScript + , validateScriptOfTemplate + , validateScriptTemplate + ) +import Cardano.Address.Script.Parser + ( requireCosignerOfParser, scriptFromString, scriptToText ) +import Cardano.Address.Style.Shared + ( Shared (..) ) +import Cardano.Address.Style.Shelley + ( Role (..), Shelley (..) ) +import Cardano.Mnemonic + ( mkSomeMnemonic ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode, fromBase16 ) +import Data.Aeson + ( FromJSON, ToJSON ) +import Data.Either + ( isLeft ) +import Data.Maybe + ( fromJust ) +import Data.Text + ( Text ) +import Test.Arbitrary + () +import Test.Hspec + ( Spec, describe, expectationFailure, it, shouldBe, shouldContain ) +import Test.QuickCheck + ( Arbitrary (..) + , Gen + , Positive (..) + , Property + , choose + , classify + , elements + , genericShrink + , oneof + , property + , scale + , sized + , vectorOf + , (===) + ) + +import qualified Cardano.Address.Style.Shared as Shared +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Data.Aeson as Json +import qualified Data.ByteString as BS +import qualified Data.List as L +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +spec :: Spec +spec = do + let mnemonic = ["network","empty","cause","mean","expire","private","finger" + ,"accident","session","problem","absurd","banner","stage","void","what"] + let (Right mw) = mkSomeMnemonic @'[9,15,18,21,24] mnemonic + let sndFactor = mempty + let rootK = Shared.genMasterKeyFromMnemonic mw sndFactor :: Shared 'RootK XPrv + let accXPrv = Shared.deriveAccountPrivateKey rootK minBound + + let roleExt = UTxOExternal + + let index1 = minBound + let multisigXPub1 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv roleExt index1 + let verKeyHash1 = RequireSignatureOf $ Shared.hashKey Payment multisigXPub1 + + let Just index2 = indexFromWord32 @(Index 'Soft _) 0x00000001 + let multisigXPub2 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv roleExt index2 + let verKeyHash2 = RequireSignatureOf $ Shared.hashKey Payment multisigXPub2 + + let Just index3 = indexFromWord32 @(Index 'Soft _) 0x00000002 + let multisigXPub3 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv roleExt index3 + let verKeyHash3 = RequireSignatureOf $ Shared.hashKey Payment multisigXPub3 + + let Just index4 = indexFromWord32 @(Index 'Soft _) 0x00000003 + let multisigXPub4 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv roleExt index4 + let verKeyHash4 = RequireSignatureOf $ Shared.hashKey Payment multisigXPub4 + + let multisigXPub5 = toXPub <$> Shared.deriveDelegationPrivateKey accXPrv index4 + let verKeyHash5 = RequireSignatureOf $ Shared.hashKey Delegation multisigXPub5 + + let rootK' = Shelley.genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv + let accXPrv' = Shelley.deriveAccountPrivateKey rootK' minBound + + let roleRep = Representative + let repXPub5 = toXPub <$> Shelley.deriveDRepPrivateKey accXPrv' + let verKeyHash6 = RequireSignatureOf $ Shelley.hashKey roleRep repXPub5 + + let roleCCCold = CommitteeCold + let cccoldXPub5 = toXPub <$> Shelley.deriveCCColdPrivateKey accXPrv' + let verKeyHash7 = RequireSignatureOf $ Shelley.hashKey roleCCCold cccoldXPub5 + + let roleCCHot = CommitteeHot + let cchotXPub5 = toXPub <$> Shelley.deriveCCHotPrivateKey accXPrv' + let verKeyHash8 = RequireSignatureOf $ Shelley.hashKey roleCCHot cchotXPub5 + + describe "Multisig CBOR and hashes - golden tests" $ do + let checkCBORandScriptHash script cbor hash = do + (toHexText (serializeScript script)) `shouldBe` cbor + (toHexText' (toScriptHash script)) `shouldBe` hash + + it "RequireSignatureOf index=0" $ + checkCBORandScriptHash verKeyHash1 + "008200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab0986ce33d2" + "2e768befb6e18e302a5d89fc4d4bcbd5d63ac256682f87246c06b1bb" + it "RequireSignatureOf index=1" $ + checkCBORandScriptHash verKeyHash2 + "008200581c91e3548bc14b2947014d2060fe17eaf172b85efb02323752400976cf" + "7b244224d7e6517ceb99bd2f83ccc4587285f276acb9caa484c9c306" + it "RequireSignatureOf index=2" $ + checkCBORandScriptHash verKeyHash3 + "008200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa5157479101" + "98530ec66e36061feabcf6b3ef730b75cf8bf13b9948506382272dc7" + it "RequireSignatureOf index=3" $ + checkCBORandScriptHash verKeyHash4 + "008200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b" + "547794e90ad105ea6dc75d0bac54c1473c663b7396dfc82fc34c5a9d" + + it "RequireSignatureOf drep" $ + checkCBORandScriptHash verKeyHash6 + "008200581cb247280d6a0308ee718b19ff5f46046821d7b70c7222484e828f1134" + "c8f06e7f7392b361908aa245fbef6445f038387ac92783bf1c6b951d" + it "RequireSignatureOf cc cold" $ + checkCBORandScriptHash verKeyHash7 + "008200581c18bea75ea27fd18ff6172f73a5e9308f7058dc6bf0c7a9c86529097a" + "27428f9b61dbf6b01247af8df78fa3521e33a806667f5868cf5444cf" + it "RequireSignatureOf cc hot" $ + checkCBORandScriptHash verKeyHash8 + "008200581c052f7b12e4009db952a49f39e6661ba10c95687787c146a4306b7f02" + "a383a4d73664501059f8ac8862829ab65b8ae0bb76eac86cc76ab4c8" + + it "RequireAllOf for index=0 and index=1 keys" $ do + let script = RequireAllOf [verKeyHash1, verKeyHash2] + checkCBORandScriptHash script + "008201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb02323752400976cf" + "0334c66ba3bada99c0bda26f88b8a1aea8c0aba87956d24e938a0f48" + it "RequireAllOf for index=0, index=1 and index=2 keys" $ do + let script = RequireAllOf [verKeyHash1, verKeyHash2, verKeyHash3] + checkCBORandScriptHash script + "008201838200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb0232375240\ + \0976cf8200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa5157479101" + "d5913dca5953a9bba712fde99b4ebc59ac83f5734f73d0c3c528450d" + + it "RequireAnyOf for index=0 and index=1 keys" $ do + let script = RequireAnyOf [verKeyHash1, verKeyHash2] + checkCBORandScriptHash script + "008202828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb02323752400976cf" + "b17721daca904785d6f610df2d22dd949f0698561cd0463962bbcfa7" + it "RequireAllOf for index=0, index=1 and index=2 keys" $ do + let script = RequireAnyOf [verKeyHash1, verKeyHash2, verKeyHash3] + checkCBORandScriptHash script + "008202838200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb0232375240\ + \0976cf8200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa5157479101" + "2149c366b64f75cf17dc25c77576e906b92d780bef9a985f9ecc9193" + + it "RequireSomeOf 1 out of index=0 and index=1 keys" $ do + let script = RequireSomeOf 1 [verKeyHash1, verKeyHash2] + checkCBORandScriptHash script + "00830301828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb02323752400976cf" + "8f81fd46f3fabb58dc2d72a31e239740dd5e09d268e752f11deeb460" + it "RequireAllOf 2 out of index=0, index=1, index=2 and index=3 keys" $ do + let script = RequireSomeOf 2 [verKeyHash1, verKeyHash2, verKeyHash3, verKeyHash4] + checkCBORandScriptHash script + "00830302848200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb023237524009\ + \76cf8200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa515747910\ + \18200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b" + "ded625e186392b3dd432824a51bf4aedad188236ae3d475ee634c560" + + it "nested 1" $ do + let nested = RequireAllOf [verKeyHash3, verKeyHash4] + let script = RequireSomeOf 2 [verKeyHash1, verKeyHash2, nested] + checkCBORandScriptHash script + "00830302838200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28200581c91e3548bc14b2947014d2060fe17eaf172b85efb023237524009\ + \76cf8201828200581c92d19fcb8f67c609f43aef8c53a2226dd141866820ebaa515\ + \74791018200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b" + "3e4bdfb98e8e83a77350dbb546222dc9dec59a31fa413207270e60ea" + + it "nested 2" $ do + let nested = RequireAnyOf [verKeyHash2, verKeyHash3, verKeyHash4] + let script = RequireAllOf [verKeyHash1, nested] + checkCBORandScriptHash script + "008201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28202838200581c91e3548bc14b2947014d2060fe17eaf172b85efb0232\ + \3752400976cf8200581c92d19fcb8f67c609f43aef8c53a2226dd141866820eba\ + \a51574791018200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b" + "f21e0e095cee196d45796e9108bc2a9ebc0f81082850ad4b82ae92ff" + + it "nested 3" $ do + let nested' = RequireAnyOf [verKeyHash3, verKeyHash4] + let nested = RequireAllOf [verKeyHash1, nested'] + let script = RequireSomeOf 1 [verKeyHash1, nested] + checkCBORandScriptHash script + "00830301828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab098\ + \6ce33d28201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab\ + \0986ce33d28202828200581c92d19fcb8f67c609f43aef8c53a2226dd141866820e\ + \baa51574791018200581c1eb1bcd2ebea2641d31e2be9b3db5fd9bd2c54a5d11c2a5f1d08c85b" + "5cf0520d67e4ac52a47fdbf9efbb1a5b95a0df4595287bafdb099d5b" + + it "ActivateFromSlot" $ do + let script = RequireAllOf [verKeyHash1, ActiveFromSlot 120] + checkCBORandScriptHash script + "008201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab0986ce33d282041878" + "068bc5b5efb96ff9831d75a132de4b700f8b605ebce43b2f8e340305" + + it "ActivateUntilSlot" $ do + let script = RequireAllOf [verKeyHash1, ActiveUntilSlot 150] + checkCBORandScriptHash script + "008201828200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab0986ce33d282051896" + "83dee9daf83dd2dcff0b8e5aec72d256e05c283a1824e84485a0c726" + + it "ActivateUntilSlot and ActivateUntilSlot" $ do + let script = RequireAllOf [verKeyHash1, ActiveFromSlot 120, ActiveUntilSlot 150] + checkCBORandScriptHash script + "008201838200581c87ae348a59e3559f84984cc9f85ede71b9f2227825ecab0986ce33d28204187882051896" + "37a5c4fe748ae7f01b9f029c875cbb2b407c559fd497786022a57019" + + it "ActivateFromSlot drep" $ do + let script = RequireAllOf [verKeyHash6, ActiveFromSlot 5001] + checkCBORandScriptHash script + "008201828200581cb247280d6a0308ee718b19ff5f46046821d7b70c7222484e828f11348204191389" + "0cedcaa5d50d7987c7fb2ace9c15d28a779fbd1b1d5b9a0625f20534" + it "ActivateFromSlot cc cold" $ do + let script = RequireAllOf [verKeyHash7, ActiveFromSlot 5001] + checkCBORandScriptHash script + "008201828200581c18bea75ea27fd18ff6172f73a5e9308f7058dc6bf0c7a9c86529097a8204191389" + "4e3dcb55be145c1138bf231ca55c512be30b94e307b4b06d19bc9305" + it "ActivateFromSlot cc hot" $ do + let script = RequireAllOf [verKeyHash8, ActiveFromSlot 5001] + checkCBORandScriptHash script + "008201828200581c052f7b12e4009db952a49f39e6661ba10c95687787c146a4306b7f028204191389" + "e65f9c606223071ab07b08ca0733bdc8a69671737b05c04c481e082a" + + it "ActivateFromSlot drep complex" $ do + let script = RequireAnyOf [verKeyHash6, RequireAllOf [ActiveFromSlot 5001, ActiveUntilSlot 6001] ] + checkCBORandScriptHash script + "008202828200581cb247280d6a0308ee718b19ff5f46046821d7b70c7222484e828f113482018282041913898205191771" + "7a94e934c1bed5fbf82579b59eac33c687a09ed4b5947f62365cdf65" + it "ActivateFromSlot cc cold complex" $ do + let script = RequireAnyOf [verKeyHash7, RequireAllOf [ActiveFromSlot 5001, ActiveUntilSlot 6001] ] + checkCBORandScriptHash script + "008202828200581c18bea75ea27fd18ff6172f73a5e9308f7058dc6bf0c7a9c86529097a82018282041913898205191771" + "89d52b7b0dc5ff707721ad926a296c30eb553d7009e9b2a1fd78e11a" + it "ActivateFromSlot cc hot complex" $ do + let script = RequireAnyOf [verKeyHash8, RequireAllOf [ActiveFromSlot 5001, ActiveUntilSlot 6001] ] + checkCBORandScriptHash script + "008202828200581c052f7b12e4009db952a49f39e6661ba10c95687787c146a4306b7f0282018282041913898205191771" + "8b3cafc36a32bffd3d3c62c502957d69609a8c4a2f42ba68034253a2" + + describe "validateScript - expectations for RequiredValidation" $ do + it "incorrect RequireSignatureOf" $ do + let script = RequireSignatureOf (KeyHash Payment "") + validateScript RequiredValidation script `shouldBe` (Left WrongKeyHash) + + it "incorrect RequireSignatureOf nested" $ do + let script = RequireAllOf [RequireAnyOf [ RequireSignatureOf (KeyHash Payment "")]] + validateScript RequiredValidation script `shouldBe` (Left WrongKeyHash) + + it "correct RequireAllOf []" $ do + let script = RequireAllOf [] + validateScript RequiredValidation script `shouldBe` (Right ()) + + it "incorrect RequireAnyOf []" $ do + let script = RequireAnyOf [] + validateScript RequiredValidation script `shouldBe` (Left LedgerIncompatible) + + it "incorrect RequireSomeOf 1" $ do + let script = RequireSomeOf 2 [verKeyHash1] + validateScript RequiredValidation script `shouldBe` (Left LedgerIncompatible) + + it "incorrect RequireSomeOf 2" $ do + let script = RequireSomeOf 2 [verKeyHash1, verKeyHash1, RequireAnyOf [], RequireSignatureOf (KeyHash Payment "")] + validateScript RequiredValidation script `shouldBe` (Left WrongKeyHash) + + it "correct RequireSomeOf" $ do + let script = RequireSomeOf 2 [verKeyHash1, verKeyHash1, RequireAnyOf []] + validateScript RequiredValidation script `shouldBe` Right () + + it "m=0 in RequireSomeOf is correct" $ do + let script = RequireSomeOf 0 [verKeyHash3, verKeyHash4] + validateScript RequiredValidation script `shouldBe` Right () + + it "timelocks are correct if timelocks are disjoint" $ do + let script = RequireSomeOf 2 [ActiveFromSlot 9, ActiveUntilSlot 8 ] + validateScript RequiredValidation script `shouldBe` Right () + + describe "validateScript - expectations for RecomendedValidation" $ do + it "incorrect RequireAllOf []" $ do + let script = RequireAllOf [] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList) + + it "incorrect in nested 1" $ do + let script = RequireSomeOf 1 [verKeyHash1, RequireAllOf [] ] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList) + + it "incorrect in nested 2" $ do + let script = RequireSomeOf 1 + [ verKeyHash1 + , RequireAnyOf [verKeyHash2, RequireAllOf [] ] + ] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList) + + it "m=0 in RequireSomeOf" $ do + let script = RequireSomeOf 0 [verKeyHash3, verKeyHash4] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended MZero) + + it "duplicate content in RequireAllOf" $ do + let script = RequireAllOf [verKeyHash1, verKeyHash2, verKeyHash1] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures) + + it "duplicate content in RequireAnyOf" $ do + let script = RequireAnyOf [verKeyHash1, verKeyHash2, verKeyHash1] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures) + + it "duplicate content in RequireSomeOf" $ do + let script = RequireSomeOf 1 [verKeyHash1, verKeyHash2, verKeyHash1] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures) + + it "duplicate in nested" $ do + let script = RequireSomeOf 1 + [ verKeyHash1 + , RequireAnyOf [ verKeyHash2 + , RequireSomeOf 2 [verKeyHash3, verKeyHash3, verKeyHash4] + ] + ] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures) + + it "redundant timelocks - too many" $ do + let script = RequireSomeOf 1 [verKeyHash1, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 120] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended RedundantTimelocks) + + it "redundant timelocks - nested" $ do + let script = RequireSomeOf 1 + [ verKeyHash1 + , RequireAnyOf [ verKeyHash2 + , RequireSomeOf 2 [verKeyHash3, verKeyHash4, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 120, ActiveUntilSlot 125, verKeyHash1] + ] + ] + validateScript RecommendedValidation script `shouldBe` Left (NotRecommended RedundantTimelocks) + + it "content in RequireAllOf - 1" $ do + let script = RequireAllOf [verKeyHash1] + validateScript RecommendedValidation script `shouldBe` Right () + + it "content in RequireAllOf - 2" $ do + let script = RequireAllOf [verKeyHash1, verKeyHash2] + validateScript RecommendedValidation script `shouldBe` Right () + + it "nested 1" $ do + let script = RequireSomeOf 1 + [ verKeyHash1 + , RequireAnyOf + [ verKeyHash2 + , RequireSomeOf 1 [verKeyHash3, verKeyHash4] + ] + ] + validateScript RecommendedValidation script `shouldBe` Right () + + it "nested 2" $ do + let script = RequireSomeOf 1 + [ RequireAnyOf + [ verKeyHash1 + , verKeyHash2 + ] + , RequireAnyOf + [ verKeyHash1 + , verKeyHash3 + ] + ] + validateScript RecommendedValidation script `shouldBe` Right () + + it "not uniform prefixes in script" $ do + let script = RequireAllOf + [ RequireAnyOf + [ verKeyHash1, verKeyHash5 ] + ] + validateScript RequiredValidation script `shouldBe` (Left NotUniformKeyType) + + describe "validateScriptTemplate - errors" $ do + let accXpub0 = + "7eebe6dfa9a1530248400eb6a1adaca166ab1d723e9618d989d22a9219a364\ + \cb4c745e128fdc98a5039893f704cf67f58c59cea97241a5c7ec7b4606253e5523" + let accXpub1 = + "417236c94b3ad73557a4df690527f77bebd203de7a208fb3be9c5efa675aaa\ + \967ca13a50a2f2e95364d0b7fdc75a82e8cc97b499ecd6b9ba12529dd63a2ca7d5" + let accXpub2 = + "ebf69a16263b741240d3a3d67b44be3a70516adc1a7422b214d0e379314692\ + \9eb053c9d5500fdcc4088b6a2c3b20b145d84ca77d5ad59343ddf4ba6c9b482d7c" + let accXpub3 = + "30a71e7919e9c409811efe8d818b831096ac44678397e8911c921a19f2e9b7\ + \f45b45a93ec2432ed0d314e356a69409c21823f152ae898a97b9b6f72ecd9c2400" + let cosigners' = Map.fromList $ + zipWith (\ix accXpub -> (Cosigner ix, encodeXPubFromTxtUnsafe accXpub)) + [0, 1, 2, 3] [accXpub0, accXpub1, accXpub2, accXpub3] + let cosignersWrong = Map.fromList $ + zipWith (\ix accXpub -> (Cosigner ix, encodeXPubFromTxtUnsafe accXpub)) + [0, 1, 2, 3] [accXpub0, accXpub1, accXpub2, accXpub0] + let cosigner0 = RequireSignatureOf (Cosigner 0) + let cosigner1 = RequireSignatureOf (Cosigner 1) + let cosigner2 = RequireSignatureOf (Cosigner 2) + let cosigner3 = RequireSignatureOf (Cosigner 3) + let cosigner4 = RequireSignatureOf (Cosigner 4) + + it "no cosigners in script of script template" $ do + let scriptTemplate = ScriptTemplate Map.empty (RequireAnyOf [ActiveFromSlot 21, ActiveUntilSlot 10]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left NoCosignerInScript) + + it "no cosigners xpub in script template" $ do + let scriptTemplate = ScriptTemplate Map.empty (RequireAllOf [cosigner0, cosigner1]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left NoCosignerXPub) + + it "unknown cosigner xpub in script template - 1" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSignatureOf (Cosigner 4)) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left UnknownCosigner) + + it "unknown cosigner xpub in script template - 2" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireAnyOf [cosigner0, cosigner1, cosigner2] ) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left UnknownCosigner) + + it "duplicated xpub in cosigners in script template" $ do + let scriptTemplate = ScriptTemplate cosignersWrong (RequireAnyOf [cosigner0, cosigner1, cosigner2, cosigner3]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left DuplicateXPubs) + + it "missing cosigner's xpub in script template" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireAnyOf [cosigner0, cosigner1, cosigner2, cosigner3, cosigner4] ) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` (Left MissingCosignerXPub) + + it "no content in RequireAnyOf" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner0, cosigner1, cosigner2, cosigner3, RequireAnyOf []]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript LedgerIncompatible) + + it "no content in RequireSomeOf" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner0, cosigner1, cosigner2, cosigner3, RequireSomeOf 1 []]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript LedgerIncompatible) + + it "too high m in RequireSomeOf" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 5 [cosigner0, cosigner1, cosigner2, cosigner3]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript LedgerIncompatible) + + it "m=0 in RequireSomeOf" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 0 [cosigner0, cosigner1, cosigner2, cosigner3]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe`Left (WrongScript $ NotRecommended MZero) + + it "wrong in nested 1" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 [cosigner0, cosigner1, cosigner2, cosigner3, RequireAllOf [] ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended EmptyList) + + it "wrong in nested 2" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner0, cosigner1, cosigner2, cosigner3 + , RequireAnyOf [cosigner2, RequireAllOf [] ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended EmptyList) + + it "wrong in nested 3" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner0, cosigner1, cosigner2, cosigner3 + , RequireAnyOf [ cosigner2 + , RequireSomeOf 3 [cosigner0, cosigner3] + ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended ListTooSmall) + + it "duplicate content in RequireAllOf" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner1, cosigner2, cosigner1,cosigner0, cosigner3 ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended DuplicateSignatures) + + it "duplicate content in RequireAnyOf" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireAnyOf [cosigner1, cosigner2, cosigner1,cosigner0, cosigner3 ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended DuplicateSignatures) + + it "duplicate content in RequireSomeOf" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 [cosigner1, cosigner2, cosigner1,cosigner0, cosigner3 ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended DuplicateSignatures) + + it "duplicate in nested" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireSomeOf 2 [cosigner0, cosigner0, cosigner3] + ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended DuplicateSignatures) + + it "invalid timelocks - too many" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 25]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended RedundantTimelocks) + + it "valid timelocks" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 11, ActiveUntilSlot 11]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Right () + + it "valid timelocks when using all 1" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 21, ActiveUntilSlot 25] + ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Right () + + it "valid timelocks when using all 2" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 21, ActiveUntilSlot 21] + ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Right () + + it "invalid timelocks when using all" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireAllOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 25, ActiveUntilSlot 21] + ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended TimelockTrap) + + it "valid timelocks when using any" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireAnyOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 25, ActiveUntilSlot 21] + ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Right () + + it "invalid timelocks when using any 1" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireAnyOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 21, ActiveUntilSlot 25] + ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended RedundantTimelocks) + + it "invalid timelocks when using any 2" $ do + let scriptTemplate = ScriptTemplate cosigners' (RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireAnyOf [cosigner0, cosigner1, cosigner2 ,cosigner3, ActiveFromSlot 21, ActiveUntilSlot 21] + ] + ]) + validateScriptTemplate RecommendedValidation scriptTemplate `shouldBe` Left (WrongScript $ NotRecommended RedundantTimelocks) + + describe "validateScriptOfTemplate - errors" $ do + let cosigner0 = RequireSignatureOf (Cosigner 0) + let cosigner1 = RequireSignatureOf (Cosigner 1) + let cosigner2 = RequireSignatureOf (Cosigner 2) + let cosigner3 = RequireSignatureOf (Cosigner 3) + + it "correct RequireAllOf []" $ do + let script = RequireAllOf [] + validateScriptOfTemplate RequiredValidation script `shouldBe` (Right ()) + + it "incorrect RequireAnyOf []" $ do + let script = RequireAnyOf [] + validateScriptOfTemplate RequiredValidation script `shouldBe` (Left LedgerIncompatible) + + it "incorrect RequireSomeOf 1" $ do + let script = RequireSomeOf 2 [cosigner0] + validateScriptOfTemplate RequiredValidation script `shouldBe` (Left LedgerIncompatible) + + it "incorrect RequireSomeOf 2" $ do + let script = RequireSomeOf 2 [cosigner0, cosigner0, RequireAnyOf []] + validateScriptOfTemplate RequiredValidation script `shouldBe` Right () + + it "correct RequireSomeOf" $ do + let script = RequireSomeOf 2 [cosigner0, cosigner1, RequireAnyOf []] + validateScriptOfTemplate RequiredValidation script `shouldBe` Right () + + it "m=0 in RequireSomeOf is correct" $ do + let script = RequireSomeOf 0 [cosigner2, cosigner3] + validateScriptOfTemplate RequiredValidation script `shouldBe` Right () + + it "timelocks are correct if timelocks are disjoint" $ do + let script = RequireSomeOf 2 [ActiveFromSlot 9, ActiveUntilSlot 8 ] + validateScriptOfTemplate RequiredValidation script `shouldBe` Right () + + it "incorrect RequireAllOf []" $ do + let script = RequireAllOf [] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList) + + it "incorrect in nested 1" $ do + let script = RequireSomeOf 1 [cosigner1, RequireAllOf [] ] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList) + + it "incorrect in nested 2" $ do + let script = RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [cosigner2, RequireAllOf [] ] + ] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended EmptyList) + + it "m=0 in RequireSomeOf" $ do + let script = RequireSomeOf 0 [cosigner2, cosigner3] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended MZero) + + it "duplicate content in RequireAllOf" $ do + let script = RequireAllOf [cosigner1, cosigner2, cosigner1] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures) + + it "duplicate content in RequireAnyOf" $ do + let script = RequireAnyOf [cosigner1, cosigner2, cosigner1] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures) + + it "duplicate content in RequireSomeOf" $ do + let script = RequireSomeOf 1 [cosigner1, cosigner2, cosigner1] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures) + + it "duplicate in nested" $ do + let script = RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireSomeOf 2 [cosigner3, cosigner3, cosigner0] + ] + ] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended DuplicateSignatures) + + it "redundant timelocks - too many" $ do + let script = RequireSomeOf 1 [cosigner1, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 120] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended RedundantTimelocks) + + it "redundant timelocks - nested" $ do + let script = RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf [ cosigner2 + , RequireSomeOf 2 [cosigner2, cosigner3, ActiveFromSlot 1, ActiveFromSlot 2, ActiveUntilSlot 120, ActiveUntilSlot 125, cosigner1] + ] + ] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Left (NotRecommended RedundantTimelocks) + + it "content in RequireAllOf - 1" $ do + let script = RequireAllOf [cosigner0] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Right () + + it "content in RequireAllOf - 2" $ do + let script = RequireAllOf [cosigner1, cosigner2] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Right () + + it "nested 1" $ do + let script = RequireSomeOf 1 + [ cosigner1 + , RequireAnyOf + [ cosigner2 + , RequireSomeOf 1 [cosigner2, cosigner3] + ] + ] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Right () + + it "nested 2" $ do + let script = RequireSomeOf 1 + [ RequireAnyOf + [ cosigner1 + , cosigner2 + ] + , RequireAnyOf + [ cosigner1 + , cosigner3 + ] + ] + validateScriptOfTemplate RecommendedValidation script `shouldBe` Right () + + describe "can perform roundtrip JSON serialization & deserialization - Script KeyHash" $ + it "fromJSON . toJSON === pure" $ + property (prop_jsonRoundtrip @(Script KeyHash)) + describe "can perform roundtrip JSON serialization & deserialization - Script KeyHash validated" $ + it "fromJSON . toJSON === pure" $ + property (prop_jsonRoundtripWithValidation (validateScript RequiredValidation)) + describe "can perform roundtrip JSON serialization & deserialization - Script Cosigner" $ + it "fromJSON . toJSON === pure" $ + property (prop_jsonRoundtrip @(Script Cosigner)) + describe "can perform roundtrip JSON serialization & deserialization - ScriptTemplate" $ + it "fromJSON . toJSON === pure" $ + property (prop_jsonRoundtrip @ScriptTemplate) + describe "can perform roundtrip JSON serialization & deserialization - ScriptTemplate validated" $ + it "fromJSON . toJSON === pure" $ + property (prop_jsonRoundtripWithValidation (validateScriptTemplate RequiredValidation)) + + describe "can perform text roundtrip - Script Cosigner" $ + it "scriptFromString . T.unpack . scriptToText === pure" $ property prop_scriptTextRoundtrip + + + describe "some JSON parsing error" $ do + it "Invalid type" $ do + let err = "Error in $.all[0].any[0]: expected Object or String, but encountered Number" + Json.eitherDecode @(Script KeyHash) "{ \"all\": [ { \"any\": [1,2,3] } ] }" + `shouldBe` Left err + + it "Multiple 'any', 'all'" $ do + let err = "Error in $.all[0].any[0]: expected Object or String, but encountered Number" + Json.eitherDecode @(Script KeyHash) "{ \"all\": [ { \"any\": [1,2,3] } ] }" + `shouldBe` Left err + + it "Multiple keys" $ do + let err = "Error in $: Found multiple keys 'any', 'all' and/or 'some' at the same level" + Json.eitherDecode @(Script KeyHash) "{ \"all\": [null], \"some\": {} }" + `shouldBe` Left err + + it "Unknown keys" $ do + let err = "Error in $: Found object with unknown key. Expecting 'any', 'all' or 'some'" + Json.eitherDecode @(Script KeyHash) "{ \"patate\": {} }" + `shouldBe` Left err + + it "Invalid JSON" $ do + let err = "'';[][" + case Json.eitherDecode @(Script KeyHash) "'';[][" of + Right _ -> expectationFailure "Parsed invalid json?" + Left msg -> msg `shouldContain` err + + where + toHexText = T.decodeUtf8 . encode EBase16 + toHexText' (ScriptHash bytes) = toHexText bytes + +prop_jsonRoundtripWithValidation + :: (Eq a, Show a, ToJSON a, FromJSON a) + => (a -> Either err ()) + -> a + -> Property +prop_jsonRoundtripWithValidation validate script = + classify (isLeft $ validate script) "invalid" $ + Json.decode (Json.encode script) === Just script + +prop_jsonRoundtrip :: (Eq a, Show a, FromJSON a, ToJSON a) => a -> Property +prop_jsonRoundtrip val = + Json.decode (Json.encode val) === Just val + +prop_scriptTextRoundtrip + :: Script Cosigner + -> Property +prop_scriptTextRoundtrip script = + scriptFromString requireCosignerOfParser (T.unpack $ scriptToText script) + === Right script + +instance Arbitrary (Script KeyHash) where + arbitrary = genScript (RequireSignatureOf <$> arbitrary) + shrink = genericShrink + +instance Arbitrary (Script Cosigner) where + arbitrary = genScript (RequireSignatureOf <$> arbitrary) + shrink = genericShrink + +genScript :: Gen (Script elem) -> Gen (Script elem) +genScript elemGen = scale (`div` 3) $ sized scriptTree + where + scriptTree 0 = oneof + [ elemGen + , ActiveFromSlot <$> arbitrary + , ActiveUntilSlot <$> arbitrary + ] + scriptTree n = do + Positive m <- arbitrary + let n' = n `div` (m + 1) + scripts <- vectorOf m (scriptTree n') + let hasTimelocks = \case + ActiveFromSlot _ -> True + ActiveUntilSlot _ -> True + _ -> False + let scriptsWithValidTimelocks = case L.partition hasTimelocks scripts of + ([], rest) -> rest + ([ActiveFromSlot s1, ActiveUntilSlot s2], rest) -> + if s2 <= s1 then + rest ++ [ActiveFromSlot s2, ActiveUntilSlot s1] + else + scripts + ([ActiveUntilSlot s2, ActiveFromSlot s1], rest) -> + if s2 <= s1 then + rest ++ [ActiveFromSlot s2, ActiveUntilSlot s1] + else + scripts + ([ActiveFromSlot _], _) -> scripts + ([ActiveUntilSlot _], _) -> scripts + (_,rest) -> rest + case fromIntegral (L.length (filter (not . hasTimelocks) scriptsWithValidTimelocks)) of + 0 -> scriptTree 0 + num -> do + atLeast <- choose (1, num) + elements + [ RequireAllOf scriptsWithValidTimelocks + , RequireAnyOf scriptsWithValidTimelocks + , RequireSomeOf atLeast scriptsWithValidTimelocks + ] + +instance Arbitrary KeyHash where + -- always generate valid hashes, because json decoding will immediately fail + -- on these. + arbitrary = do + payload' <- BS.pack <$> vectorOf 28 arbitrary + flip KeyHash payload' <$> + oneof [ pure Payment, pure Delegation, pure Policy + , pure Representative, pure CommitteeCold + , pure CommitteeHot, pure Unknown] + +instance Arbitrary Cosigner where + arbitrary = Cosigner <$> arbitrary + +instance Arbitrary ScriptTemplate where + arbitrary = do + n <- choose (1,5) + cosignerPairs <- vectorOf n arbitrary + ScriptTemplate (Map.fromList cosignerPairs) <$> arbitrary + +encodeXPubFromTxtUnsafe :: Text -> XPub +encodeXPubFromTxtUnsafe txt = + case fromBase16 (T.encodeUtf8 txt) of + Left _ -> error "encodeXPubFromTxtUnsafe: expecting hex-encoded text" + Right hex -> fromJust $ xpubFromBytes hex diff --git a/test/Cardano/Address/Style/ByronSpec.hs b/test/Cardano/Address/Style/ByronSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/Address/Style/ByronSpec.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Cardano.Address.Style.ByronSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Derivation + ( Depth (..) + , DerivationType (..) + , GenMasterKey (..) + , HardDerivation (..) + , Index + , XPrv + , xprvFromBytes + ) +import Cardano.Address.Style.Byron + ( Byron (..), minSeedLengthBytes ) +import Cardano.Mnemonic + ( SomeMnemonic (..) ) +import Control.Monad + ( (<=<) ) +import Data.ByteArray + ( ByteArrayAccess, ScrubbedBytes ) +import Data.ByteArray.Encoding + ( Base (Base16), convertFromBase ) +import Data.ByteString + ( ByteString ) +import Data.Text + ( Text ) +import Test.Arbitrary + ( unsafeMkMnemonic ) +import Test.Hspec + ( Expectation, Spec, describe, it, shouldBe ) +import Test.QuickCheck + ( Arbitrary (..), Property, choose, property, vector ) + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS + +spec :: Spec +spec = do + goldenSpec + describe "Random Address Derivation Properties" $ do + it "Key derivation from seed works for various indexes" $ + property prop_keyDerivationFromSeed + it "Key derivation from master key works for various indexes" $ + property prop_keyDerivationFromXPrv + +{------------------------------------------------------------------------------- + Properties +-------------------------------------------------------------------------------} + +prop_keyDerivationFromSeed + :: SomeMnemonic + -> Index 'WholeDomain 'AccountK + -> Index 'WholeDomain 'PaymentK + -> Property +prop_keyDerivationFromSeed mw accIx addrIx = + addrXPrv `seq` property () + where + rootXPrv = genMasterKeyFromMnemonic mw () :: Byron 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv accIx + addrXPrv = deriveAddressPrivateKey accXPrv () addrIx + +prop_keyDerivationFromXPrv + :: XPrv + -> Index 'WholeDomain 'AccountK + -> Index 'WholeDomain 'PaymentK + -> Property +prop_keyDerivationFromXPrv xprv accIx addrIx = + addrXPrv `seq` property () + where + rootXPrv = genMasterKeyFromXPrv xprv :: Byron 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv accIx + addrXPrv = deriveAddressPrivateKey accXPrv () addrIx + +{------------------------------------------------------------------------------- + Golden tests +-------------------------------------------------------------------------------} + +goldenSpec :: Spec +goldenSpec = describe "Golden tests" $ do + it "unsafeGenerateKeyFromSeed - no passphrase" $ + generateTest generateTest1 + +{------------------------------------------------------------------------------- + Golden tests for generateKeyFromSeed +-------------------------------------------------------------------------------} + +data GenerateKeyFromSeed = GenerateKeyFromSeed + { mnem :: [Text] + , rootKey :: Byron 'RootK XPrv + } + +generateTest :: GenerateKeyFromSeed -> Expectation +generateTest (GenerateKeyFromSeed mnemonic rootXPrv) = + getKey masterKey `shouldBe` getKey rootXPrv + where + mw = SomeMnemonic $ unsafeMkMnemonic @12 mnemonic + masterKey = genMasterKeyFromMnemonic mw () :: Byron 'RootK XPrv + +generateTest1 :: GenerateKeyFromSeed +generateTest1 = GenerateKeyFromSeed + { mnem = defMnemonic + , rootKey = xprv16 + "b84d0b6db447911a98a3ade98145c0e8323e106f07bc17a99c2104c2688bb752\ + \8310902a3cec7e262ded6a4369ec1f48966a6b48b1ee90aa00e61b95417949f8\ + \a4762129a6c83acfda5b257eaeb73ec5fee1518b6674fdc7891fe23f06174421" + } + +-- | This is the mnemonic that provides the 'Default' instance in cardano-sl +defMnemonic :: [Text] +defMnemonic = + [ "squirrel", "material", "silly", "twice", "direct", "slush" + , "pistol", "razor", "become", "junk", "kingdom", "flee" ] + +{------------------------------------------------------------------------------- + Utils +-------------------------------------------------------------------------------} + +-- | Get a private key from a hex string, without error checking. +xprv16 :: ByteString -> Byron 'RootK XPrv +xprv16 hex = genMasterKeyFromXPrv prv + where + Just prv = (xprvFromBytes <=< fromHexText) hex + fromHexText :: ByteString -> Maybe ByteString + fromHexText = either (const Nothing) Just . convertFromBase Base16 + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +newtype Passphrase = Passphrase ScrubbedBytes + deriving stock (Eq, Show) + deriving newtype (ByteArrayAccess) + +-- This generator will only produce valid (@>= minSeedLengthBytes@) passphrases +-- because 'generateKeyFromSeed' is a partial function. +instance {-# OVERLAPS #-} Arbitrary Passphrase where + arbitrary = do + n <- choose (minSeedLengthBytes, 64) + bytes <- BS.pack <$> vector n + return $ Passphrase $ BA.convert bytes diff --git a/test/Cardano/Address/Style/IcarusSpec.hs b/test/Cardano/Address/Style/IcarusSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/Address/Style/IcarusSpec.hs @@ -0,0 +1,279 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Cardano.Address.Style.IcarusSpec + ( spec + ) where + +import Prelude + +import Cardano.Address + ( PaymentAddress (..), base58 ) +import Cardano.Address.Derivation + ( Depth (..) + , DerivationType (..) + , GenMasterKey (..) + , HardDerivation (..) + , Index (..) + , SoftDerivation (..) + , XPrv + , indexFromWord32 + , toXPub + , unsafeMkIndex + ) +import Cardano.Address.Style.Icarus + ( Icarus (..) + , Role (..) + , icarusMainnet + , roleToIndex + , unsafeGenerateKeyFromHardwareLedger + ) +import Cardano.Mnemonic + ( ConsistentEntropy + , EntropySize + , SomeMnemonic (..) + , mkMnemonic + , mkSomeMnemonic + ) +import Control.Monad + ( forM_ ) +import Data.Proxy + ( Proxy (..) ) +import Data.Text + ( Text ) +import Data.Word + ( Word32 ) +import Test.Arbitrary + ( unsafeMkSomeMnemonicFromEntropy ) +import Test.Hspec + ( Spec, describe, it, shouldBe ) +import Test.QuickCheck + ( Property, property, (===) ) + +import qualified Data.Text as T + +spec :: Spec +spec = do + describe "BIP-0044 Derivation Properties" $ do + it "deriveAccountPrivateKey works for various indexes" $ + property prop_accountKeyDerivation + it "N(CKDpriv((kpar, cpar), i)) === CKDpub(N(kpar, cpar), i)" $ + property prop_publicChildKeyDerivation + + describe "Golden Tests - Icarus' style addresses" $ do + let seed0 = unsafeMkSomeMnemonicFromEntropy (Proxy @15) + "4\175\242L\184\243\191 \169]\171 \207\r\v\233\NUL~&\ETB" + mkSoftIx = unsafeMkIndex :: Word32 -> Index 'Soft depth + mkHardIx = unsafeMkIndex :: Word32 -> Index 'Hardened depth + + goldenAddressGeneration $ GoldenAddressGeneration + seed0 (mkHardIx 0x80000000) UTxOExternal (mkSoftIx 0x00000000) + "Ae2tdPwUPEZGQVrA6qKreDzdtYxcWMMrpTFYCpFcuJfhJBEfoeiuW4MtaXZ" + + goldenAddressGeneration $ GoldenAddressGeneration + seed0 (mkHardIx 0x80000000) UTxOExternal (mkSoftIx 0x0000000E) + "Ae2tdPwUPEZDLWQQEBR1UW7HeXJVaqUnuw8DUFu52TDWCJbxbkCyQYyxckP" + + goldenAddressGeneration $ GoldenAddressGeneration + seed0 (mkHardIx 0x8000000E) UTxOInternal (mkSoftIx 0x0000002A) + "Ae2tdPwUPEZFRbyhz3cpfC2CumGzNkFBN2L42rcUc2yjQpEkxDbkPodpMAi" + + let (Right seed1) = mkSomeMnemonic @'[12] + [ "ghost", "buddy", "neutral", "broccoli", "face", "rack" + , "relief", "odor", "swallow", "real", "once", "ecology" + ] + + goldenAddressGeneration $ GoldenAddressGeneration + seed1 (mkHardIx 0x80000000) UTxOExternal (mkSoftIx 0x00000000) + "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + + goldenAddressGeneration $ GoldenAddressGeneration + seed1 (mkHardIx 0x80000000) UTxOExternal (mkSoftIx 0x00000001) + "Ae2tdPwUPEZCJUCuVgnysar8ZJeyKuhjXU35VNgKMMTcXWmS9zzYycmwKa4" + + goldenAddressGeneration $ GoldenAddressGeneration + seed1 (mkHardIx 0x80000000) UTxOExternal (mkSoftIx 0x00000002) + "Ae2tdPwUPEZFJtMH1m5HvsaQZrmgLcVcyuk5TxYtdRHZFo8yV7yEnnJyqTs" + + describe "Hardware Ledger" $ do + goldenHardwareLedger @12 + [ "struggle", "section", "scissors", "siren", "garbage", "yellow" + , "maximum", "finger", "duty", "require", "mule", "earn" + ] + [ "Ae2tdPwUPEZ4Gs4s2recjNjQHBKfuBTkeuqbHJJrC6CuyjGyUD44cCTq4sJ" + , "Ae2tdPwUPEZ8ozZuJWsLVb7aEb5p9ntcja47B9i68GV3y9by1eY5C2y6WUT" + , "Ae2tdPwUPEZJoUCoyoCxUAKAbn2vFo6nu6B7aTWL1Pv9MRKm8unG9ixLurg" + , "Ae2tdPwUPEYwFNKLxqF8s31nbaNt5MZisVqsQ5qsiY763HY5wsBN3mSzPRa" + , "Ae2tdPwUPEZ4ZXzzehKoWWC9QYVqJfEL9x63zjH6wyEJbNRsZ9eccR6nSpv" + , "Ae2tdPwUPEYyX7ug8zm6K7nLWhgEEBo7Ewf1qALxkvqyHHSC5jMFzH418Q1" + , "Ae2tdPwUPEZ95eCwDjNQjReRkeLZFv6kBs3vwaKPHJsw2cxXc3HaCD2jzqw" + , "Ae2tdPwUPEZDHGbQ9sbLZuw3cfhcSzqqdK8Xj3dhAzmWZGeVgJhncu5LR9N" + , "Ae2tdPwUPEYyDca1eVbeEea6CjihoMAgt6mPiNuC1hEpy5U2qQ1Tzt6E8q8" + , "Ae2tdPwUPEZHRMjjXMT2icJXp5h2k2j3Ph6dB5iGRashA2QxHLgFZbHzdms" + ] + + goldenHardwareLedger @18 + [ "vague" , "wrist" , "poet" , "crazy" , "danger" , "dinner" + , "grace" , "home" , "naive" , "unfold" , "april" , "exile" + , "relief" , "rifle" , "ranch" , "tone" , "betray" , "wrong" + ] + [ "Ae2tdPwUPEZMCGyPAK85FrcserPvzVZZUcbFk5TvDmL9LrUyq2KPYubPcru" + , "Ae2tdPwUPEZ6drrnNd1KW3UoiU3U1ZK3mxSpQpFAdXzJHuwvDcYB7Wzxkp1" + , "Ae2tdPwUPEZ7Jaw9qt1q2CjCcds6zpHMyzmPGDh9tBeyQG28AdRGHcaWYx7" + , "Ae2tdPwUPEZ9SW4qxWkFoozTux5i7F9jVpHQFQUycQuNanSUScyMTYrnQXK" + , "Ae2tdPwUPEZ6YegpN8XurGfWyKqkNHLgdbHpdohumKt5QpkNVJhw4FCSRdo" + , "Ae2tdPwUPEZLgrXt3zJeHgFWM2stxRjdm6wWATSoUzJ1CmUxKqgbYQXR8cC" + , "Ae2tdPwUPEZ6axGCfo5nCLn5hEoRo4yNmQKBzn12B2quPncgQRFP6JBZ2ex" + , "Ae2tdPwUPEYzdHGmJDL9tEWXfzyshohvzyS3K9wmLc5qMrwRNFPQA611uzB" + , "Ae2tdPwUPEYxLNQJXcT3XUh54BXn5w53pPe5EHMXo6qo47gpNM9QyJsaXz4" + , "Ae2tdPwUPEYvq2fnzqs9EWxFF2j87nZzBAZZ7y3qoj5oTce1ZGvsc4potp3" + ] + + goldenHardwareLedger @24 + [ "recall" , "grace" , "sport" , "punch" , "exhibit" , "mad" + , "harbor" , "stand" , "obey" , "short" , "width" , "stem" + , "awkward" , "used" , "stairs" , "wool" , "ugly" , "trap" + , "season" , "stove" , "worth" , "toward" , "congress" , "jaguar" + ] + [ "Ae2tdPwUPEZFvG914wGXtCsb9hCr9aKjJC2ZciLKSNRqAKtjnduH7XtPn78" + , "Ae2tdPwUPEZ8rVsdBE6EMZpac32MLzciY75MrwrPs8ikjf6MWYFJUHkGaw5" + , "Ae2tdPwUPEZADQdQy2cbHDwwFRYUcrfreiu82Ngm9Bxdw1pJqJFUnFoQmNL" + , "Ae2tdPwUPEZ3NULtb3fK6qtJYwJbVnmhDeWzoMbjzPbCsEC9MyB4foBABhz" + , "Ae2tdPwUPEZ3rGvPCdzCPrVRvzEfpUp8XnZ861nss3XfLun5wA3c3YMA41v" + , "Ae2tdPwUPEZ575pMY9TBJyPdrwGkq2kr49V9fuqRWpF6wM9JbuZLmxHDo2N" + , "Ae2tdPwUPEZFaVKwy9bcN81ZPVL8uHRfsrCj7ZZhbm2uqiwLrzsy9Bs1rBN" + , "Ae2tdPwUPEZ4K16qFm6qVRWTEGpq5TJiyt8ZojmRANTSpPDAWZuH2Ge85uB" + , "Ae2tdPwUPEZMMYd8JP9F16HJgCsDsPjUoERWoFzZugN4mNjhR9ZnFwPonCs" + , "Ae2tdPwUPEZ3anXo172NFuumSGjrvbk1pHK9LiF82nGmPKC52NMYR77V2dM" + ] + +{------------------------------------------------------------------------------- + Properties +-------------------------------------------------------------------------------} + +-- | Deriving address public key should be equal to deriving address +-- private key and extracting public key from it (works only for non-hardened +-- child keys). +-- +-- To compute the public child key of a parent private key: +-- * N(CKDpriv((kpar, cpar), i)) (works always). +-- * CKDpub(N(kpar, cpar), i) (works only for non-hardened child keys). +-- +-- Thus: +-- +-- N(CKDpriv((kpar, cpar), i)) === CKDpub(N(kpar, cpar), i) +-- +-- if (kpar, cpar) is a non-hardened key. +-- +-- For details see +prop_publicChildKeyDerivation + :: SomeMnemonic + -> Role + -> Index 'Soft 'PaymentK + -> Property +prop_publicChildKeyDerivation mw role ix = + addrXPub1 === addrXPub2 + where + rootXPrv = genMasterKeyFromMnemonic mw mempty :: Icarus 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv minBound + -- N(CKDpriv((kpar, cpar), i)) + addrXPub1 = toXPub <$> deriveAddressPrivateKey accXPrv role ix + -- CKDpub(N(kpar, cpar), i) + addrXPub2 = deriveAddressPublicKey (toXPub <$> accXPrv) role ix + +prop_accountKeyDerivation + :: SomeMnemonic + -> Index 'Hardened 'AccountK + -> Property +prop_accountKeyDerivation mw ix = + accXPrv `seq` property () -- NOTE Making sure this doesn't throw + where + rootXPrv = genMasterKeyFromMnemonic mw mempty :: Icarus 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv ix + +{------------------------------------------------------------------------------- + Golden Tests +-------------------------------------------------------------------------------} + +data GoldenAddressGeneration = GoldenAddressGeneration + { goldSeed :: SomeMnemonic + , goldAcctIx :: Index 'Hardened 'AccountK + , goldAcctStyle :: Role + , goldAddrIx :: Index 'Soft 'PaymentK + , goldAddr :: Text + } + +-- | Compare addresses obtained from a given derivation path and a root seed to +-- their known equivalent in base58. +goldenAddressGeneration + :: GoldenAddressGeneration + -> Spec +goldenAddressGeneration test = it title $ do + let rootXPrv = genMasterKeyFromMnemonic goldSeed mempty :: Icarus 'RootK XPrv + let acctXPrv = deriveAccountPrivateKey rootXPrv goldAcctIx + let addrXPrv = deriveAddressPrivateKey acctXPrv goldAcctStyle goldAddrIx + base58 (paymentAddress icarusMainnet $ toXPub <$> addrXPrv) + `shouldBe` goldAddr + where + GoldenAddressGeneration + { goldSeed + , goldAddr + , goldAcctIx + , goldAddrIx + , goldAcctStyle + } = test + + title = unwords + [ fmtPath goldAcctIx goldAcctStyle goldAddrIx + , "-->" + , T.unpack goldAddr + ] + + -- e.g. m/.../0'/0/0 + fmtPath p3 p4 p5 = mconcat + [ "m/.../" + , show (indexToWord32 p3 - indexToWord32 (minBound @(Index 'Hardened _))) + , "'/" + , show (indexToWord32 (roleToIndex p4)) + , "/" + , show (indexToWord32 p5) + ] + +goldenHardwareLedger + :: forall mw ent csz. + ( ConsistentEntropy ent mw csz + , EntropySize mw ~ ent + ) + => [Text] + -- ^ 24-word mnemonic + -> [Text] + -- ^ Some addresses, starting at index 0 + -> Spec +goldenHardwareLedger sentence addrs = + it title $ do + let Right mnemonic = SomeMnemonic <$> mkMnemonic @mw sentence + let rootXPrv = unsafeGenerateKeyFromHardwareLedger mnemonic + let acctXPrv = deriveAccountPrivateKey rootXPrv minBound + let deriveAddr = deriveAddressPrivateKey acctXPrv UTxOExternal + + forM_ (zip [0..] addrs) $ \(ix, addr) -> do + let Just softIx = indexFromWord32 @(Index 'Soft _) ix + addrXPrv = deriveAddr softIx + base58 (paymentAddress icarusMainnet $ toXPub <$> addrXPrv) + `shouldBe` addr + where + title = T.unpack + $ T.unwords + $ take 3 sentence ++ [ "..." ] ++ drop (length sentence - 3) sentence diff --git a/test/Cardano/Address/Style/SharedSpec.hs b/test/Cardano/Address/Style/SharedSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/Address/Style/SharedSpec.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Address.Style.SharedSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Derivation + ( Depth (..) + , DerivationType (..) + , GenMasterKey (..) + , HardDerivation (..) + , Index (..) + , XPrv + , toXPub + ) +import Cardano.Address.Style.Shared + ( Shared (..) ) +import Cardano.Address.Style.Shelley + ( Role (..) ) +import Cardano.Mnemonic + ( SomeMnemonic ) +import Data.ByteArray + ( ByteArrayAccess, ScrubbedBytes ) +import Test.Arbitrary + () +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..), Property, choose, elements, property, vector, (===) ) + +import qualified Cardano.Address.Style.Shared as Shared +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS + +spec :: Spec +spec = do + describe "BIP-0044 Derivation Properties" $ do + it "deriveAccountPrivateKey works for various indexes" $ + property prop_accountKeyDerivation + it "N(CKDpriv((kpar, cpar), i)) === CKDpub(N(kpar, cpar), i) for multisig for payment credential" $ + property prop_publicMultisigForPaymentDerivation + it "N(CKDpriv((kpar, cpar), i)) === CKDpub(N(kpar, cpar), i) for multisig for delegation credential" $ + property prop_publicMultisigForDelegationDerivation + +{------------------------------------------------------------------------------- + Properties +-------------------------------------------------------------------------------} + +prop_publicMultisigForPaymentDerivation + :: (SomeMnemonic, SndFactor, PaymentRole) + -> Index 'Soft 'PaymentK + -> Property +prop_publicMultisigForPaymentDerivation (mw, (SndFactor sndFactor), PaymentRole role) ix = + multisigXPub1 === multisigXPub2 + where + rootXPrv = Shared.genMasterKeyFromMnemonic mw sndFactor :: Shared 'RootK XPrv + accXPrv = Shared.deriveAccountPrivateKey rootXPrv minBound + multisigXPub1 = toXPub <$> Shared.deriveAddressPrivateKey accXPrv role ix + multisigXPub2 = Shared.deriveAddressPublicKey (toXPub <$> accXPrv) role ix + +prop_publicMultisigForDelegationDerivation + :: (SomeMnemonic, SndFactor) + -> Index 'Soft 'PaymentK + -> Property +prop_publicMultisigForDelegationDerivation (mw, (SndFactor sndFactor)) ix = + multisigXPub1 === multisigXPub2 + where + rootXPrv = genMasterKeyFromMnemonic mw sndFactor :: Shared 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv minBound + multisigXPub1 = toXPub <$> Shared.deriveDelegationPrivateKey accXPrv ix + multisigXPub2 = Shared.deriveDelegationPublicKey (toXPub <$> accXPrv) ix + +prop_accountKeyDerivation + :: (SomeMnemonic, SndFactor) + -> Index 'Hardened 'AccountK + -> Property +prop_accountKeyDerivation (mw, (SndFactor sndFactor)) ix = + accXPrv `seq` property () + where + rootXPrv = genMasterKeyFromMnemonic mw sndFactor :: Shared 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv ix + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +newtype SndFactor = SndFactor ScrubbedBytes + deriving stock (Eq, Show) + deriving newtype (ByteArrayAccess) + +instance Arbitrary SndFactor where + arbitrary = do + n <- choose (0, 64) + bytes <- BS.pack <$> vector n + return $ SndFactor $ BA.convert bytes + +newtype PaymentRole = PaymentRole Role + deriving stock (Eq, Show) + +instance Arbitrary PaymentRole where + arbitrary = elements [PaymentRole UTxOExternal, PaymentRole UTxOInternal] diff --git a/test/Cardano/Address/Style/ShelleySpec.hs b/test/Cardano/Address/Style/ShelleySpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/Address/Style/ShelleySpec.hs @@ -0,0 +1,1397 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Cardano.Address.Style.ShelleySpec + ( spec + ) where + +import Prelude + +import Cardano.Address + ( Address + , ChainPointer (..) + , HasNetworkDiscriminant (..) + , bech32 + , bech32With + , fromBech32 + , unAddress + , unsafeMkAddress + ) +import Cardano.Address.Derivation + ( Depth (..) + , DerivationType (..) + , GenMasterKey (..) + , HardDerivation (..) + , Index (..) + , Pub + , SoftDerivation (..) + , XPrv + , XPub + , hashCredential + , indexFromWord32 + , pubFromBytes + , pubToBytes + , toXPub + , unsafeMkIndex + , xprvPrivateKey + , xprvToBytes + , xpubFromBytes + , xpubToBytes + , xpubToPub + ) +import Cardano.Address.KeyHash + ( GovernanceType (..), KeyHash (..), KeyRole (..), keyHashToText ) +import Cardano.Address.Script + ( Script (..), ScriptHash (..), toScriptHash ) +import Cardano.Address.Style.Shelley + ( Credential (..) + , Role (..) + , Shelley (..) + , delegationAddress + , deriveCCColdPrivateKey + , deriveCCHotPrivateKey + , deriveDRepPrivateKey + , deriveDelegationPrivateKey + , liftPub + , liftXPub + , mkNetworkDiscriminant + , paymentAddress + , pointerAddress + , roleFromIndex + , roleToIndex + ) +import Cardano.Mnemonic + ( SomeMnemonic, mkSomeMnemonic ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode, fromBase16 ) +import Control.Monad + ( (<=<) ) +import Crypto.Hash + ( hashWith ) +import Crypto.Hash.Algorithms + ( SHA3_256 (SHA3_256) ) +import Data.Aeson + ( ToJSON, Value (..) ) +import Data.ByteArray + ( ByteArrayAccess, ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Either + ( rights ) +import Data.Function + ( (&) ) +import Data.Maybe + ( fromMaybe, isNothing ) +import Data.Text + ( Text ) +import Data.Word + ( Word32 ) +import GHC.Generics + ( Generic ) +import Test.Arbitrary + () +import Test.Hspec + ( Spec, SpecWith, describe, it, shouldBe ) +import Test.Hspec.Golden + ( Golden (..) ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Arbitrary (..) + , Property + , choose + , counterexample + , label + , property + , vector + , (===) + ) +import Text.Pretty.Simple + ( defaultOutputOptionsNoColor, pShowOpt ) + +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.Aeson.Encode.Pretty as Aeson +import qualified Data.ByteArray as BA +import qualified Data.ByteArray.Encoding as BAE +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Char as Char +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE +import qualified Data.Text.Lazy.IO as TL + +spec :: Spec +spec = do + describe "BIP-0044 Derivation Properties" $ do + it "deriveAccountPrivateKey works for various indexes" $ + property prop_accountKeyDerivation + it "N(CKDpriv((kpar, cpar), i)) === CKDpub(N(kpar, cpar), i) for any key" $ + property prop_publicChildKeyDerivation + + describe "Role indices" $ do + it "Calling indexFromWord32 for invalid value fails)" $ + property prop_fromWord32Role + it "Roundtrip index" $ property prop_roundtripIndexRole + + describe "Proper pointer addresses construction" $ do + it "Using different numbers in DelegationPointerAddress does not fail" + (property prop_pointerAddressConstruction) + + describe "Text Encoding Roundtrips" $ do + prop "bech32 . fromBech32 - Shelley - payment address" $ + prop_roundtripTextEncoding bech32 fromBech32 + + prop "bech32 . fromBech32 - Shelley - delegation address" $ + prop_roundtripTextEncodingDelegation bech32 fromBech32 + + prop "bech32 . fromBech32 - Shelley - pointer address" $ + prop_roundtripTextEncodingPointer bech32 fromBech32 + + describe "Golden tests" $ do + goldenTestPointerAddress GoldenTestPointerAddress + { verKey = "1a2a3a4a5a6a7a8a" + , stakePtr = ChainPointer 128 2 3 + , netTag = 0 + , expectedAddr = + "408a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d481000203" + } + goldenTestPointerAddress GoldenTestPointerAddress + { verKey = "1a2a3a4a5a6a7a8a" + , stakePtr = ChainPointer 128 2 3 + , netTag = 1 + , expectedAddr = + "418a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d481000203" + } + goldenTestEnterpriseAddress GoldenTestEnterpriseAddress + { verKey = "1a2a3a4a5a6a7a8a" + , netTag = 0 + , expectedAddr = + "608a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d4" + } + goldenTestEnterpriseAddress GoldenTestEnterpriseAddress + { verKey = "1a2a3a4a5a6a7a8a" + , netTag = 1 + , expectedAddr = + "618a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d4" + } + goldenTestEnterpriseAddressKeyHash GoldenTestEnterpriseAddress + { verKey = "1a2a3a4a5a6a7a8a" + , netTag = 0 + , expectedAddr = + "608a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d4" + } + goldenTestEnterpriseAddressKeyHash GoldenTestEnterpriseAddress + { verKey = "1a2a3a4a5a6a7a8a" + , netTag = 1 + , expectedAddr = + "618a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d4" + } + goldenTestBaseAddressPayFromXPub GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 0 + , expectedAddr = + "008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressPayFromXPub GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 1 + , expectedAddr = + "018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressPayFromPub GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 0 + , expectedAddr = + "008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressPayFromPub GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 1 + , expectedAddr = + "018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressPayFromKeyHash GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 0 + , expectedAddr = + "008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressPayFromKeyHash GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 1 + , expectedAddr = + "018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressStakeFromKeyHash GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 0 + , expectedAddr = + "008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressStakeFromKeyHash GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 1 + , expectedAddr = + "018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressStakeFromPub GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 0 + , expectedAddr = + "008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressStakeFromPub GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 1 + , expectedAddr = + "018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressBothFromKeyHash GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 0 + , expectedAddr = + "008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressBothFromKeyHash GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 1 + , expectedAddr = + "018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressBothFromPub GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 0 + , expectedAddr = + "008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestBaseAddressBothFromPub GoldenTestBaseAddress + { verKeyPayment = "1a2a3a4a5a6a7a8a" + , verKeyStake = "1c2c3c4c5c6c7c8c" + , netTag = 1 + , expectedAddr = + "018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4" + } + goldenTestGovernance GoldenTestGovernance + { mnemonic = [ "test", "walk", "nut", "penalty", "hip", "pave", "soap", + "entry", "language", "right", "filter", "choice" ] + , accountIx = 0x80000000 + , expectedKeysHashes = KeysHashes + { drepXsk = "drep_xsk14rjh4rs2dzm6k5xxe5f73cypzuv02pknfl9xwnsjws8a7ulp530xztarpdlyh05csw2cmnekths7dstq0se3wtza84m4fueffezsjfgassgs9xtfzgehrn0fn7c82uc0rkj06s0w0t80hflzz8cwyry3eg9066uj" + , drepXskHex = "a8e57a8e0a68b7ab50c6cd13e8e0811718f506d34fca674e12740fdf73e1a45e612fa30b7e4bbe9883958dcf365de1e6c1607c33172c5d3d7754f3294e4509251d8411029969123371cde99fb075730f1da4fd41ee7acefba7e211f0e20c91ca" + , drepSk = "drep_sk14rjh4rs2dzm6k5xxe5f73cypzuv02pknfl9xwnsjws8a7ulp530xztarpdlyh05csw2cmnekths7dstq0se3wtza84m4fueffezsjfglsqmad" + , drepSkHex = "a8e57a8e0a68b7ab50c6cd13e8e0811718f506d34fca674e12740fdf73e1a45e612fa30b7e4bbe9883958dcf365de1e6c1607c33172c5d3d7754f3294e450925" + , drepXvk = "drep_xvk17axh4sc9zwkpsft3tlgpjemfwc0u5mnld80r85zw7zdqcst6w543mpq3q2vkjy3nw8x7n8asw4es78dyl4q7u7kwlwn7yy0sugxfrjs6z25qe" + , drepXvkHex = "f74d7ac30513ac1825715fd0196769761fca6e7f69de33d04ef09a0c417a752b1d8411029969123371cde99fb075730f1da4fd41ee7acefba7e211f0e20c91ca" + , drepVk = "drep_vk17axh4sc9zwkpsft3tlgpjemfwc0u5mnld80r85zw7zdqcst6w54sdv4a4e" + , drepVkHex = "f74d7ac30513ac1825715fd0196769761fca6e7f69de33d04ef09a0c417a752b" + , drep = "drep1y2jmg4g450lced7q9n34rq6d5vjwkm0ugx6h0894u6ur92s9txn3a" + , drepHex = "a5b45515a3ff8cb7c02ce351834da324eb6dfc41b5779cb5e6b832aa" + , drepScript1 = "drep16pjhzfkm7rqntfezfkgu5p50t0mkntmdruwlp089zu8v22aculf" + , drepScript1Hex = "d0657126dbf0c135a7224d91ca068f5bf769af6d1f1df0bce5170ec5" + , drepScript2 = "drep14edv7pg3y4wkglyykvvy5t2j906ld3dhdwvf7jda8qaa670f745" + , drepScript2Hex = "ae5acf0511255d647c84b3184a2d522bf5f6c5b76b989f49bd383bdd" + , ccColdXsk = "cc_cold_xsk1dp84kjq9qa647wr70e2yedzt8e27kwugh8mfw675re0hgm8p530z3d9230cjjzyyzlq04hn94x9q2m9um2tvp2y8fn7tau9l2wfj5ykxqxtgua0lxpf0lfn44md2afyl7dktyvpkmug9u28p6v452flxeuca0v7w" + , ccColdXskHex = "684f5b480507755f387e7e544cb44b3e55eb3b88b9f6976bd41e5f746ce1a45e28b4aa8bf129088417c0fade65a98a056cbcda96c0a8874cfcbef0bf53932a12c601968e75ff3052ffa675aedaaea49ff36cb23036df105e28e1d32b4527e6cf" + , ccColdSk = "cc_cold_sk1dp84kjq9qa647wr70e2yedzt8e27kwugh8mfw675re0hgm8p530z3d9230cjjzyyzlq04hn94x9q2m9um2tvp2y8fn7tau9l2wfj5yslmdl88" + , ccColdSkHex = "684f5b480507755f387e7e544cb44b3e55eb3b88b9f6976bd41e5f746ce1a45e28b4aa8bf129088417c0fade65a98a056cbcda96c0a8874cfcbef0bf53932a12" + , ccColdXvk = "cc_cold_xvk149up407pvp9p36lldlp4qckqqzn6vm7u5yerwy8d8rqalse3t04vvqvk3e6l7vzjl7n8ttk646jflumvkgcrdhcstc5wr5etg5n7dnc8nqv5d" + , ccColdXvkHex = "a9781abfc1604a18ebff6fc35062c000a7a66fdca1323710ed38c1dfc3315beac601968e75ff3052ffa675aedaaea49ff36cb23036df105e28e1d32b4527e6cf" + , ccColdVk = "cc_cold_vk149up407pvp9p36lldlp4qckqqzn6vm7u5yerwy8d8rqalse3t04q7qsvwl" + , ccColdVkHex = "a9781abfc1604a18ebff6fc35062c000a7a66fdca1323710ed38c1dfc3315bea" + , ccCold = "cc_cold1ztl0h9vka4ns45kfj7xh3ljwkd46yn9m5znzlfxd6rpdeagw6p59q" + , ccColdHex = "fefb9596ed670ad2c9978d78fe4eb36ba24cbba0a62fa4cdd0c2dcf5" + , ccColdScript1 = "cc_cold14ehj5f64f40xju0086fnunctulkh46mq7munm7upe4hpc434cg3" + , ccColdScript1Hex = "ae6f2a27554d5e6971ef3e933e4f0be7ed7aeb60f6f93dfb81cd6e1c" + , ccColdScript2 = "cc_cold1zxwzpnk0ah7m5ptjjtmkhvgs4736k3e0ns66shd0fy33vkd39j0" + , ccColdScript2Hex = "119c20cecfedfdba057292f76bb110afa3ab472f9c35a85daf492316" + , ccHotXsk = "cc_hot_xsk1mpt30ys7v2ykqms4c83wuednh4hvy3lr27yfhgtp0rhdka8p5300j4d2z77sq2t3kp082qzgkanwkm05mp2u2nwja3ad3pgw9l34a0j5sl5yd6d8pze8dqwksd069kkfdqggk0yytcmet96fre45w64qkgyxl0dt" + , ccHotXskHex = "d85717921e6289606e15c1e2ee65b3bd6ec247e357889ba16178eedb74e1a45ef955aa17bd002971b05e750048b766eb6df4d855c54dd2ec7ad8850e2fe35ebe5487e846e9a708b27681d6835fa2dac968108b3c845e379597491e6b476aa0b2" + , ccHotSk = "cc_hot_sk1mpt30ys7v2ykqms4c83wuednh4hvy3lr27yfhgtp0rhdka8p5300j4d2z77sq2t3kp082qzgkanwkm05mp2u2nwja3ad3pgw9l34a0sdh7u7e" + , ccHotSkHex = "d85717921e6289606e15c1e2ee65b3bd6ec247e357889ba16178eedb74e1a45ef955aa17bd002971b05e750048b766eb6df4d855c54dd2ec7ad8850e2fe35ebe" + , ccHotXvk = "cc_hot_xvk10y48lq72hypxraew74lwjjn9e2dscuwphckglh2nrrpkgweqk5h4fplggm56wz9jw6qadq6l5tdvj6qs3v7ggh3hjkt5j8ntga42pvs5rvh0a" + , ccHotXvkHex = "792a7f83cab90261f72ef57ee94a65ca9b0c71c1be2c8fdd5318c3643b20b52f5487e846e9a708b27681d6835fa2dac968108b3c845e379597491e6b476aa0b2" + , ccHotVk = "cc_hot_vk10y48lq72hypxraew74lwjjn9e2dscuwphckglh2nrrpkgweqk5hschnzv5" + , ccHotVkHex = "792a7f83cab90261f72ef57ee94a65ca9b0c71c1be2c8fdd5318c3643b20b52f" + , ccHot = "cc_hot1qtmd98q0w9jdxasse0m8kyn2nya7kf9qwmgx20cl5p543rcdtr4dz" + , ccHotHex = "f6d29c0f7164d37610cbf67b126a993beb24a076d0653f1fa069588f" + , ccHotScript1 = "cc_hot16fayy2wf9myfvxmtl5e2suuqmnhy5zx80vxkezen7xqws04z0n8" + , ccHotScript1Hex = "d27a4229c92ec8961b6bfd32a87380dcee4a08c77b0d6c8b33f180e8" + , ccHotScript2 = "cc_hot1vts8nrrsxmlntp3v7sh5u7k6qmmlkkmyv5uspq4xjxlpgr6svrf" + , ccHotScript2Hex = "62e0798c7036ff35862cf42f4e7ada06f7fb5b6465390082a691be14" + } + } + goldenTestGovernance GoldenTestGovernance + { mnemonic = [ "test", "walk", "nut", "penalty", "hip", "pave", "soap", + "entry", "language", "right", "filter", "choice" ] + , accountIx = 0x80000100 + , expectedKeysHashes = KeysHashes + { drepXsk = "drep_xsk1zracgd4mqt32f5cj0ps0wudf78u6lumz7gprgm3j8zec5ahp530weq4z9ayj6jzj33lpj86jkk2gnt0ns0d5sywteexxehvva7gugz99ydmpemzpsfnj49vjvw88q9a2s2hxc9ggxal5q6xsqz5vaat2xqsha72w" + , drepXskHex = "10fb8436bb02e2a4d3127860f771a9f1f9aff362f202346e3238b38a76e1a45eec82a22f492d48528c7e191f52b59489adf383db4811cbce4c6cdd8cef91c408a523761cec4182672a9592638e7017aa82ae6c1508377f4068d000a8cef56a30" + , drepSk = "drep_sk1zracgd4mqt32f5cj0ps0wudf78u6lumz7gprgm3j8zec5ahp530weq4z9ayj6jzj33lpj86jkk2gnt0ns0d5sywteexxehvva7gugzqjur0zk" + , drepSkHex = "10fb8436bb02e2a4d3127860f771a9f1f9aff362f202346e3238b38a76e1a45eec82a22f492d48528c7e191f52b59489adf383db4811cbce4c6cdd8cef91c408" + , drepXvk = "drep_xvk1wq6ylcpjnwavhveey855tkhdrqdav6yfxvltw0emky9d3erxn9m22gmkrnkyrqn8922eycuwwqt64q4wds2ssdmlgp5dqq9gem6k5vq23ph3c" + , drepXvkHex = "70344fe0329bbacbb33921e945daed181bd66889333eb73f3bb10ad8e4669976a523761cec4182672a9592638e7017aa82ae6c1508377f4068d000a8cef56a30" + , drepVk = "drep_vk1wq6ylcpjnwavhveey855tkhdrqdav6yfxvltw0emky9d3erxn9mqdrlerg" + , drepVkHex = "70344fe0329bbacbb33921e945daed181bd66889333eb73f3bb10ad8e4669976" + , drep = "drep1yg0dx99005ll3lxnyrrnadv9ynthfj3cwvlwqr4u4qdavwshx0yl0" + , drepHex = "1ed314af7d3ff8fcd320c73eb58524d774ca38733ee00ebca81bd63a" + , drepScript1 = "drep18cgl8kdnjculhww4n3h0a3ahc85ahjcsg53u0f93jnz9cqnvdpd" + , drepScript1Hex = "3e11f3d9b39639fbb9d59c6efec7b7c1e9dbcb104523c7a4b194c45c" + , drepScript2 = "drep1hwj9yuvzxc623w5lmwvp44md7qkdywz2fcd583qmyu62jrsw2xy" + , drepScript2Hex = "bba45271823634a8ba9fdb981ad76df02cd2384a4e1b43c41b2734a9" + , ccColdXsk = "cc_cold_xsk1dppxrjspxrjj5e5xrmh6yaw6w30arsl5lqcsp09ynyzwwulp530q4tlvug79xx6ja3u32fu9jyy84p6erjmza6twrackm9kfsdpc3ap7uxpempqjftx74qwxnmn7d6pg8pl9zpnc0rese26pfmzl9cmtgg8xsxvu" + , ccColdXskHex = "684261ca0130e52a66861eefa275da745fd1c3f4f83100bca49904e773e1a45e0aafece23c531b52ec7915278591087a87591cb62ee96e1f716d96c9834388f43ee1839d84124acdea81c69ee7e6e828387e51067878f30cab414ec5f2e36b42" + , ccColdSk = "cc_cold_sk1dppxrjspxrjj5e5xrmh6yaw6w30arsl5lqcsp09ynyzwwulp530q4tlvug79xx6ja3u32fu9jyy84p6erjmza6twrackm9kfsdpc3aqr79jja" + , ccColdSkHex = "684261ca0130e52a66861eefa275da745fd1c3f4f83100bca49904e773e1a45e0aafece23c531b52ec7915278591087a87591cb62ee96e1f716d96c9834388f4" + , ccColdXvk = "cc_cold_xvk1e2mquwugpwnykfftjs4mv3w4uk80f4hjgd2zls5vusz3zuqhr7gnacvrnkzpyjkda2qud8h8um5zswr72yr8s78npj45znk97t3kkssryhkyv" + , ccColdXvkHex = "cab60e3b880ba64b252b942bb645d5e58ef4d6f243542fc28ce4051170171f913ee1839d84124acdea81c69ee7e6e828387e51067878f30cab414ec5f2e36b42" + , ccColdVk = "cc_cold_vk1e2mquwugpwnykfftjs4mv3w4uk80f4hjgd2zls5vusz3zuqhr7gs3qg4hr" + , ccColdVkHex = "cab60e3b880ba64b252b942bb645d5e58ef4d6f243542fc28ce4051170171f91" + , ccCold = "cc_cold1zt5nwd86uuvwjxalghyxlrxcreledplxellyeygd6xjvxcqy66a7t" + , ccColdHex = "e93734fae718e91bbf45c86f8cd81e7f9687e6cffe4c910dd1a4c360" + , ccColdScript1 = "cc_cold1prtcxdlu75dz48lf8hh86gt8ng7z39yvmyqcg92sgze7gpt2gga" + , ccColdScript1Hex = "08d78337fcf51a2a9fe93dee7d21679a3c28948cd90184155040b3e4" + , ccColdScript2 = "cc_cold1969h0m92nuqrj7x74pj3tnhxh97lfhl4y2vwvqvc6kecwkq6xe5" + , ccColdScript2Hex = "2e8b77ecaa9f003978dea86515cee6b97df4dff52298e60198d5b387" + , ccHotXsk = "cc_hot_xsk15pt89wppyhr9eqgm5nnu7tna3dfmqxa2u45e4g7krzp9u78p530pez36k8k9n0gw08hn6drxlwxxsgc4jsejv6hvcnkd7gd3zxhstpe3vzde6e98zql6n2cmekklm63dydnt80szdr0h768dexeklrfspc5lznuz" + , ccHotXskHex = "a05672b82125c65c811ba4e7cf2e7d8b53b01baae5699aa3d618825e78e1a45e1c8a3ab1ec59bd0e79ef3d3466fb8c6823159433266aecc4ecdf21b111af058731609b9d64a7103fa9ab1bcdadfdea2d2366b3be0268df7f68edc9b36f8d300e" + , ccHotSk = "cc_hot_sk15pt89wppyhr9eqgm5nnu7tna3dfmqxa2u45e4g7krzp9u78p530pez36k8k9n0gw08hn6drxlwxxsgc4jsejv6hvcnkd7gd3zxhstpc7gujxf" + , ccHotSkHex = "a05672b82125c65c811ba4e7cf2e7d8b53b01baae5699aa3d618825e78e1a45e1c8a3ab1ec59bd0e79ef3d3466fb8c6823159433266aecc4ecdf21b111af0587" + , ccHotXvk = "cc_hot_xvk10qawpxlz7eytt9yr4xlwtjkw345v0ehzsxdlkks6qralyp975phrzcymn4j2wypl4x43hnddlh4z6gmxkwlqy6xl0a5wmjdnd7xnqrsvak8ry" + , ccHotXvkHex = "783ae09be2f648b59483a9bee5cace8d68c7e6e2819bfb5a1a00fbf204bea06e31609b9d64a7103fa9ab1bcdadfdea2d2366b3be0268df7f68edc9b36f8d300e" + , ccHotVk = "cc_hot_vk10qawpxlz7eytt9yr4xlwtjkw345v0ehzsxdlkks6qralyp975phqx538xn" + , ccHotVkHex = "783ae09be2f648b59483a9bee5cace8d68c7e6e2819bfb5a1a00fbf204bea06e" + , ccHot = "cc_hot1qtgaf67mr95fa90qj7gehkr3y3q73x6pasmdu3algq6ylpgfamj02" + , ccHotHex = "d1d4ebdb19689e95e097919bd8712441e89b41ec36de47bf40344f85" + , ccHotScript1 = "cc_hot1hheftszv4jw83f5megrvhrevl7lwwmtnjav7srkqngr92348jvr" + , ccHotScript1Hex = "bdf295c04cac9c78a69bca06cb8f2cffbee76d739759e80ec09a0655" + , ccHotScript2 = "cc_hot1dg9jdwlsxzakctywv2cw7a7ggj2dwu0gz5tueu2rf40zv05atgs" + , ccHotScript2Hex = "6a0b26bbf030bb6c2c8e62b0ef77c84494d771e81517ccf1434d5e26" + } + } + goldenTestGovernance GoldenTestGovernance + { mnemonic = [ "excess", "behave", "track", "soul", "table", "wear", + "ocean", "cash", "stay", "nature", "item", "turtle", + "palm", "soccer", "lunch", "horror", "start", "stumble", + "month", "panic", "right", "must", "lock", "dress" ] + , accountIx = 0x80000000 + , expectedKeysHashes = KeysHashes + { drepXsk = "drep_xsk17pwn6d7pu0d6sfzysyk5taux99f5tdqsct7zzthgljyd5zs33azej0tm5ny7ksunthqu84tqg832md6vs3hm392agwx3auhvyjtzxr2l6c0dj47k6zedl4kgugneu04j64fc5uueayydmufdrdaled9k4qllaka6" + , drepXskHex = "f05d3d37c1e3dba82444812d45f786295345b410c2fc212ee8fc88da0a118f45993d7ba4c9eb43935dc1c3d56041e2adb74c846fb8955d438d1ef2ec2496230d5fd61ed957d6d0b2dfd6c8e2279e3eb2d5538a7399e908ddf12d1b7bfcb4b6a8" + , drepSk = "drep_sk17pwn6d7pu0d6sfzysyk5taux99f5tdqsct7zzthgljyd5zs33azej0tm5ny7ksunthqu84tqg832md6vs3hm392agwx3auhvyjtzxrgwyexuy" + , drepSkHex = "f05d3d37c1e3dba82444812d45f786295345b410c2fc212ee8fc88da0a118f45993d7ba4c9eb43935dc1c3d56041e2adb74c846fb8955d438d1ef2ec2496230d" + , drepXvk = "drep_xvk15j30gk0uex88lc9vh6sfda93lv6zede65mzp7ck56m9pgeqhnht9l4s7m9tad59jmltv3c38nclt942n3feen6ggmhcj6xmmlj6td2qu4ce82" + , drepXvkHex = "a4a2f459fcc98e7fe0acbea096f4b1fb342cb73aa6c41f62d4d6ca1464179dd65fd61ed957d6d0b2dfd6c8e2279e3eb2d5538a7399e908ddf12d1b7bfcb4b6a8" + , drepVk = "drep_vk15j30gk0uex88lc9vh6sfda93lv6zede65mzp7ck56m9pgeqhnhtqvs6j8t" + , drepVkHex = "a4a2f459fcc98e7fe0acbea096f4b1fb342cb73aa6c41f62d4d6ca1464179dd6" + , drep = "drep1yge7tpltrazw286rqlhw6lk7vxgq30zdrsevrqye6cm8x2gf38vlv" + , drepHex = "33e587eb1f44e51f4307eeed7ede619008bc4d1c32c18099d6367329" + , drepScript1 = "drep17fql6ztxyk63taryk2e4mh47jw3wdchv9e7u4jxg4edrxg8enef" + , drepScript1Hex = "f241fd096625b515f464b2b35ddebe93a2e6e2ec2e7dcac8c8ae5a33" + , drepScript2 = "drep10qp23w0gppuvc7chc3g7saudlmhj9jmm9ssrrzzm3qwksrn4cul" + , drepScript2Hex = "7802a8b9e80878cc7b17c451e8778dfeef22cb7b2c2031885b881d68" + , ccColdXsk = "cc_cold_xsk1hqtevrzlhtcglwvt5pmgct8ssqx37vjjf3wuydpd6flyqrg33azacap5w5mclacmuycx3xgrtstxgrpzcncf6l840t0klmywc69ryd9zf95taaaseka98yakuj2048slnuekw22qm58majt8alhs438eecehquu0" + , ccColdXskHex = "b817960c5fbaf08fb98ba0768c2cf0800d1f32524c5dc2342dd27e400d118f45dc743475378ff71be1306899035c16640c22c4f09d7cf57adf6fec8ec68a3234a24968bef7b0cdba5393b6e494fa9e1f9f33672940dd0fbec967efef0ac4f9ce" + , ccColdSk = "cc_cold_sk1hqtevrzlhtcglwvt5pmgct8ssqx37vjjf3wuydpd6flyqrg33azacap5w5mclacmuycx3xgrtstxgrpzcncf6l840t0klmywc69rydqvncuyc" + , ccColdSkHex = "b817960c5fbaf08fb98ba0768c2cf0800d1f32524c5dc2342dd27e400d118f45dc743475378ff71be1306899035c16640c22c4f09d7cf57adf6fec8ec68a3234" + , ccColdXvk = "cc_cold_xvk13wc4cvvr266t4rxm9wyel4deeqxyylvjzjdk5w74lva2xm0dhxt6yjtghmmmpnd62wfmdey5l20pl8envu55phg0hmyk0ml0ptz0nns9cqjlk" + , ccColdXvkHex = "8bb15c318356b4ba8cdb2b899fd5b9c80c427d92149b6a3bd5fb3aa36dedb997a24968bef7b0cdba5393b6e494fa9e1f9f33672940dd0fbec967efef0ac4f9ce" + , ccColdVk = "cc_cold_vk13wc4cvvr266t4rxm9wyel4deeqxyylvjzjdk5w74lva2xm0dhxtsfpa2qu" + , ccColdVkHex = "8bb15c318356b4ba8cdb2b899fd5b9c80c427d92149b6a3bd5fb3aa36dedb997" + , ccCold = "cc_cold1ztc2kq7xa0vdrdz3tg7umg724srnw6yac0zschqdl0rerushdm3cm" + , ccColdHex = "f0ab03c6ebd8d1b4515a3dcda3caac0737689dc3c50c5c0dfbc791f2" + , ccColdScript1 = "cc_cold15z7ynn7fuqu55hh850962vrrg7tcdncl8spnjtrxjjm06lpsfgc" + , ccColdScript1Hex = "a0bc49cfc9e0394a5ee7a3cba53063479786cf1f3c03392c6694b6fd" + , ccColdScript2 = "cc_cold1ahw3qh3ledhxp0frga9aawfkxpu0qstte9nmem0phqqegzf9lp3" + , ccColdScript2Hex = "eddd105e3fcb6e60bd23474bdeb9363078f0416bc967bcede1b80194" + , ccHotXsk = "cc_hot_xsk1wzamzchtj7m79mjfpg3c02m534ugej5ac0p3s2sresr7vys33azktmjva6flctprqu6m4k4w459x9qkfsz2ahgy5ganjn23djhhkg5e5eyhu7fjxl6tpxtmzh7e2ftuj4qgmawsmcl7sqesn8e0pmh97zs3c3fqj" + , ccHotXskHex = "70bbb162eb97b7e2ee490a2387ab748d788cca9dc3c3182a03cc07e612118f4565ee4cee93fc2c230735badaaead0a6282c98095dba094476729aa2d95ef645334c92fcf2646fe96132f62bfb2a4af92a811beba1bc7fd0066133e5e1ddcbe14" + , ccHotSk = "cc_hot_sk1wzamzchtj7m79mjfpg3c02m534ugej5ac0p3s2sresr7vys33azktmjva6flctprqu6m4k4w459x9qkfsz2ahgy5ganjn23djhhkg5cmwegml" + , ccHotSkHex = "70bbb162eb97b7e2ee490a2387ab748d788cca9dc3c3182a03cc07e612118f4565ee4cee93fc2c230735badaaead0a6282c98095dba094476729aa2d95ef6453" + , ccHotXvk = "cc_hot_xvk1tazd6lvnf2c9j8m58h6xy56uuyhkee526jgxj2ylaextl0xamd4nfjf0eunydl5kzvhk90aj5jhe92q3h6aph3laqpnpx0j7rhwtu9qe7dhsc" + , ccHotXvkHex = "5f44dd7d934ab0591f743df462535ce12f6ce68ad49069289fee4cbfbcdddb6b34c92fcf2646fe96132f62bfb2a4af92a811beba1bc7fd0066133e5e1ddcbe14" + , ccHotVk = "cc_hot_vk1tazd6lvnf2c9j8m58h6xy56uuyhkee526jgxj2ylaextl0xamd4swmuygc" + , ccHotVkHex = "5f44dd7d934ab0591f743df462535ce12f6ce68ad49069289fee4cbfbcdddb6b" + , ccHot = "cc_hot1qtp2wn5mef3ypk2872d7kl0djczfwsqkmgk53ca8cdjye3qehdsy0" + , ccHotHex = "c2a74e9bca6240d947f29beb7ded9604974016da2d48e3a7c3644cc4" + , ccHotScript1 = "cc_hot1tmwlec0twwvl29h6pgvew5mf4recsxtktev9g07xm37fvvupdmd" + , ccHotScript1Hex = "5eddfce1eb7399f516fa0a19975369a8f38819765e58543fc6dc7c96" + , ccHotScript2 = "cc_hot1c77thg5lrahy0he4q6glsk8vgsp45gt75k3pq09d02u8gvktfzw" + , ccHotScript2Hex = "c7bcbba29f1f6e47df350691f858ec44035a217ea5a2103cad7ab874" + } + } + goldenTestGovernance GoldenTestGovernance + { mnemonic = [ "excess", "behave", "track", "soul", "table", "wear", + "ocean", "cash", "stay", "nature", "item", "turtle", + "palm", "soccer", "lunch", "horror", "start", "stumble", + "month", "panic", "right", "must", "lock", "dress" ] + , accountIx = 0x80000100 + , expectedKeysHashes = KeysHashes + { drepXsk = "drep_xsk14z6a7nd2q5r03s4gxsrujc59sg757vqqcwxeuc5s874c2rq33az37lwkxpxvh5s4a94sncxp6y7m73pxsuknt7gvethhue5jk5vc5n2hrg95mynhw7mtrshxr5mpku4v8x6lpm05nznrqej70u0fllgfkusexdkv" + , drepXskHex = "a8b5df4daa0506f8c2a83407c96285823d4f3000c38d9e62903fab850c118f451f7dd6304ccbd215e96b09e0c1d13dbf4426872d35f90ccaef7e6692b5198a4d571a0b4d927777b6b1c2e61d361b72ac39b5f0edf498a630665e7f1e9ffd09b7" + , drepSk = "drep_sk14z6a7nd2q5r03s4gxsrujc59sg757vqqcwxeuc5s874c2rq33az37lwkxpxvh5s4a94sncxp6y7m73pxsuknt7gvethhue5jk5vc5ngl9zhrx" + , drepSkHex = "a8b5df4daa0506f8c2a83407c96285823d4f3000c38d9e62903fab850c118f451f7dd6304ccbd215e96b09e0c1d13dbf4426872d35f90ccaef7e6692b5198a4d" + , drepXvk = "drep_xvk14dwjrplj73qeggdsg4lh4j9tp495asyq9t6augwaue8kqvjg5wq4wxstfkf8waakk8pwv8fkrde2cwd47rklfx9xxpn9ulc7nl7sndcvdjh2m" + , drepXvkHex = "ab5d2187f2f4419421b0457f7ac8ab0d4b4ec0802af5de21dde64f603248a381571a0b4d927777b6b1c2e61d361b72ac39b5f0edf498a630665e7f1e9ffd09b7" + , drepVk = "drep_vk14dwjrplj73qeggdsg4lh4j9tp495asyq9t6augwaue8kqvjg5wqskrq5yn" + , drepVkHex = "ab5d2187f2f4419421b0457f7ac8ab0d4b4ec0802af5de21dde64f603248a381" + , drep = "drep1ytq6xshsm7uzhy729e45q6avkpyq9a74d2va3726sz5td3gqrgcll" + , drepHex = "c1a342f0dfb82b93ca2e6b406bacb04802f7d56a99d8f95a80a8b6c5" + , drepScript1 = "drep1ckr4x9293myuyz5379wndh4ag00c787htnzwzxxmpfnfzaqtayp" + , drepScript1Hex = "c5875315458ec9c20a91f15d36debd43df8f1fd75cc4e118db0a6691" + , drepScript2 = "drep1wgly5zd539aam7yxr7trxy48dhupswmwusutm4q40dwkc07n3y8" + , drepScript2Hex = "723e4a09b4897bddf8861f963312a76df8183b6ee438bdd4157b5d6c" + , ccColdXsk = "cc_cold_xsk1hqe5kcsq59mx4t9nxrctmth0ppz9gda0gnppyll3h9rxcyq33az4uy3u6qhzuhjsstzca9awgsx27j07hxhrkrk6487nvywp0ag669m4v6lj3knq7e6pxaujy98akn5exhgk44ftruepkte0hdm74dd8zceqnk2h" + , ccColdXskHex = "b8334b6200a1766aacb330f0bdaeef08445437af44c2127ff1b9466c10118f455e123cd02e2e5e5082c58e97ae440caf49feb9ae3b0edaa9fd3611c17f51ad177566bf28da60f674137792214fdb4e9935d16ad52b1f321b2f2fbb77eab5a716" + , ccColdSk = "cc_cold_sk1hqe5kcsq59mx4t9nxrctmth0ppz9gda0gnppyll3h9rxcyq33az4uy3u6qhzuhjsstzca9awgsx27j07hxhrkrk6487nvywp0ag669c5qtm3p" + , ccColdSkHex = "b8334b6200a1766aacb330f0bdaeef08445437af44c2127ff1b9466c10118f455e123cd02e2e5e5082c58e97ae440caf49feb9ae3b0edaa9fd3611c17f51ad17" + , ccColdXvk = "cc_cold_xvk1lmqejccjpxsd9cl4uavxj0jryjlfk5r8wemr0d8saal49lttp2482e4l9rdxpan5zdmeyg20md8fjdw3dt2jk8ejrvhjlwmha266w9syf55nr" + , ccColdXvkHex = "fec199631209a0d2e3f5e758693e4324be9b5067767637b4f0ef7f52fd6b0aaa7566bf28da60f674137792214fdb4e9935d16ad52b1f321b2f2fbb77eab5a716" + , ccColdVk = "cc_cold_vk1lmqejccjpxsd9cl4uavxj0jryjlfk5r8wemr0d8saal49lttp24q6lw08l" + , ccColdVkHex = "fec199631209a0d2e3f5e758693e4324be9b5067767637b4f0ef7f52fd6b0aaa" + , ccCold = "cc_cold1zfxtx2h8qhanhw3u4jt5ydtgsry39gm2ff7v5ax5j4k87sgmkas3l" + , ccColdHex = "4cb32ae705fb3bba3cac9742356880c912a36a4a7cca74d4956c7f41" + , ccColdScript1 = "cc_cold1qlk7rgkd5n6ga8enwk08vwtmlklhzfnmjtjlzlwed62tulgk75f" + , ccColdScript1Hex = "07ede1a2cda4f48e9f33759e76397bfdbf71267b92e5f17dd96e94be" + , ccColdScript2 = "cc_cold1a4qmd5d3dqppxtq5wcuuaa3xfe868vyn46afvktz5ucxzauy6tg" + , ccColdScript2Hex = "ed41b6d1b16802132c147639cef6264e4fa3b093aeba965962a73061" + , ccHotXsk = "cc_hot_xsk14rzh5lvtdhvum6vjfvkwp73mz9gl426cj04xfavnjgmdxrq33azugz0k9sekf2eg70lr34rg5aclr54v30za77xn945kncdm0le6lutxlr5ar355u5awqt2hkmdurv4qv64cmpg39zq2ahjxqken8vk62qunx4hl" + , ccHotXskHex = "a8c57a7d8b6dd9cde9924b2ce0fa3b1151faab5893ea64f5939236d30c118f45c409f62c3364ab28f3fe38d468a771f1d2ac8bc5df78d32d6969e1bb7ff3aff166f8e9d1c694e53ae02d57b6dbc1b2a066ab8d85112880aede4605b333b2da50" + , ccHotSk = "cc_hot_sk14rzh5lvtdhvum6vjfvkwp73mz9gl426cj04xfavnjgmdxrq33azugz0k9sekf2eg70lr34rg5aclr54v30za77xn945kncdm0le6lugud8v57" + , ccHotSkHex = "a8c57a7d8b6dd9cde9924b2ce0fa3b1151faab5893ea64f5939236d30c118f45c409f62c3364ab28f3fe38d468a771f1d2ac8bc5df78d32d6969e1bb7ff3aff1" + , ccHotXvk = "cc_hot_xvk1g2925ntunmthw66sr8t7v3qe7fls4575wput3936cguzk7m6w4fkd78f68rffef6uqk40dkmcxe2qe4t3kz3z2yq4m0yvpdnxwed55q798msd" + , ccHotXvkHex = "428aaa4d7c9ed7776b5019d7e64419f27f0ad3d47078b8963ac2382b7b7a755366f8e9d1c694e53ae02d57b6dbc1b2a066ab8d85112880aede4605b333b2da50" + , ccHotVk = "cc_hot_vk1g2925ntunmthw66sr8t7v3qe7fls4575wput3936cguzk7m6w4fs0zjxf8" + , ccHotVkHex = "428aaa4d7c9ed7776b5019d7e64419f27f0ad3d47078b8963ac2382b7b7a7553" + , ccHot = "cc_hot1q257k3xs4gww24vm0s3zwzkz850xr0ewz9xa3edyfmf622g5zjp8w" + , ccHotHex = "a9eb44d0aa1ce5559b7c22270ac23d1e61bf2e114dd8e5a44ed3a529" + , ccHotScript1 = "cc_hot1n42mr24e22eyspa7m0y6lq5rk8tesq35xt6gfgkezcxluez2snm" + , ccHotScript1Hex = "9d55b1aab952b24807bedbc9af8283b1d798023432f484a2d9160dfe" + , ccHotScript2 = "cc_hot1gfqmx4g0czk2nz2m2rfawg4me283jl7wz4wfssup03av2aynvs9" + , ccHotScript2Hex = "4241b3550fc0aca9895b50d3d722bbca8f197fce155c9843817c7ac5" + } + } + describe "Test vectors" $ do + testVectors + [ "test", "child", "burst", "immense", "armed", "parrot" + , "company", "walk", "dog" ] + testVectors + [ "test", "walk", "nut", "penalty", "hip", "pave", "soap", + "entry", "language", "right", "filter", "choice" ] + testVectors + [ "art", "forum", "devote", "street", "sure", "rather", + "head", "chuckle", "guard", "poverty", "release", + "quote", "oak", "craft", "enemy"] + testVectors + [ "churn", "shaft", "spoon", "second", "erode", "useless", + "thrive", "burst", "group", "seed", "element", "sign", + "scrub", "buffalo", "jelly", "grace", "neck", "useless" ] + testVectors + [ "draft", "ability", "female", "child", "jump", "maid", + "roof", "hurt", "below", "live", "topple", "paper", + "exclude", "ordinary", "coach", "churn", "sunset", + "emerge", "blame", "ketchup", "much" ] + testVectors + [ "excess", "behave", "track", "soul", "table", "wear", + "ocean", "cash", "stay", "nature", "item", "turtle", + "palm", "soccer", "lunch", "horror", "start", "stumble", + "month", "panic", "right", "must", "lock", "dress" ] + +{------------------------------------------------------------------------------- + Properties +-------------------------------------------------------------------------------} + +prop_publicChildKeyDerivation + :: (SomeMnemonic, SndFactor) + -> Role + -> Index 'Soft 'PaymentK + -> Property +prop_publicChildKeyDerivation (mw, (SndFactor sndFactor)) cc ix = + addrXPub1 === addrXPub2 + where + rootXPrv = genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv minBound + addrXPub1 = toXPub <$> deriveAddressPrivateKey accXPrv cc ix + addrXPub2 = deriveAddressPublicKey (toXPub <$> accXPrv) cc ix + +prop_accountKeyDerivation + :: (SomeMnemonic, SndFactor) + -> Index 'Hardened 'AccountK + -> Property +prop_accountKeyDerivation (mw, (SndFactor sndFactor)) ix = + accXPrv `seq` property () + where + rootXPrv = genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv ix + +prop_fromWord32Role :: Int -> Property +prop_fromWord32Role n = + isNothing (toRole n) + === + (n > fromRole maxBound || n < fromRole minBound) + where + fromRole = fromIntegral . indexToWord32 . roleToIndex + toRole = roleFromIndex . unsafeMkIndex . fromIntegral + +prop_roundtripIndexRole :: Role -> Property +prop_roundtripIndexRole ix = (roleFromIndex . roleToIndex) ix === Just ix + +prop_pointerAddressConstruction + :: (SomeMnemonic, SndFactor) + -> Role + -> Index 'Soft 'PaymentK + -> NetworkDiscriminant Shelley + -> ChainPointer + -> Property +prop_pointerAddressConstruction (mw, (SndFactor sndFactor)) cc ix net ptr = + pointerAddr `seq` property () + where + rootXPrv = genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv + accXPrv = deriveAccountPrivateKey rootXPrv minBound + addrXPub = toXPub <$> deriveAddressPrivateKey accXPrv cc ix + pointerAddr = pointerAddress net (PaymentFromExtendedKey addrXPub) ptr + + +{------------------------------------------------------------------------------- + Golden tests +-------------------------------------------------------------------------------} +-- | Definitions: Let's assume we have private key < xprv | pub | cc > +-- Then, extended private key should be understood as < xprv | | cc > +-- extended public key should be understood as < | pub | cc > +-- verification public key should be understood as < | pub | > + +data GoldenTestPointerAddress = GoldenTestPointerAddress + { + -- | The verification public key as string to be encoded into base16 form + -- After that it should have 32-byte length + verKey :: Text + + -- | Location of stake cerificate in the blockchain + , stakePtr :: ChainPointer + + -- | Network tag + , netTag :: Integer + + -- | Expected address as encoded into base16 form + , expectedAddr :: Text + } + +goldenTestPointerAddress :: GoldenTestPointerAddress -> SpecWith () +goldenTestPointerAddress GoldenTestPointerAddress{..} = + it ("pointer address for networkId " <> show netTag) $ do + let (Just xPub) = xpubFromBytes $ b16encode $ T.append verKey verKey + let addrXPub = liftXPub xPub :: Shelley 'PaymentK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let ptrAddr = pointerAddress tag (PaymentFromExtendedKey addrXPub) stakePtr + let (Right bytes) = b16decode expectedAddr + ptrAddr `shouldBe` unsafeMkAddress bytes + +data GoldenTestEnterpriseAddress = GoldenTestEnterpriseAddress + { + -- | The verification public key as string to be encoded into base16 form + -- After that it should have 32-byte length + verKey :: Text + + -- | Network tag + , netTag :: Integer + + -- | Expected address as encoded into base16 form + , expectedAddr :: Text + } + +goldenTestEnterpriseAddress :: GoldenTestEnterpriseAddress -> SpecWith () +goldenTestEnterpriseAddress GoldenTestEnterpriseAddress{..} = + it ("enterprise address for networkId " <> show netTag) $ do + let (Just xPub) = xpubFromBytes $ b16encode $ T.append verKey verKey + let addrXPub = liftXPub xPub :: Shelley 'PaymentK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let enterpriseAddr = Shelley.paymentAddress tag (PaymentFromExtendedKey addrXPub) + let (Right bytes) = b16decode expectedAddr + enterpriseAddr `shouldBe` unsafeMkAddress bytes + +goldenTestEnterpriseAddressKeyHash :: GoldenTestEnterpriseAddress -> SpecWith () +goldenTestEnterpriseAddressKeyHash GoldenTestEnterpriseAddress{..} = + it ("enterprise address for networkId " <> show netTag) $ do + let bs = b16encode $ T.append verKey verKey + let (Just xPub) = xpubFromBytes bs + let addrXPub = liftXPub xPub :: Shelley 'PaymentK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let enterpriseAddrFromKey = + Shelley.paymentAddress tag (PaymentFromExtendedKey addrXPub) + let keyHashDigest = hashCredential $ BS.take 32 bs + let keyHash = KeyHash Payment keyHashDigest + let enterpriseAddrFromKeyHash = + Shelley.paymentAddress tag (PaymentFromKeyHash keyHash) + enterpriseAddrFromKey `shouldBe` enterpriseAddrFromKeyHash + +data GoldenTestBaseAddress = GoldenTestBaseAddress + { + -- | The verification public key as string to be encoded into base16 form + -- After that it should have 32-byte length + verKeyPayment :: Text + + -- | The verification public key as string to be encoded into base16 form + -- After that it should have 32-byte length + , verKeyStake :: Text + + -- | Network tag + , netTag :: Integer + + -- | Expected address as encoded into base16 form + , expectedAddr :: Text + } + +goldenTestBaseAddressPayFromXPub :: GoldenTestBaseAddress -> SpecWith () +goldenTestBaseAddressPayFromXPub GoldenTestBaseAddress{..} = + it ("base address for networkId " <> show netTag) $ do + let (Just xPub1) = + xpubFromBytes $ b16encode $ T.append verKeyPayment verKeyPayment + let addrXPub = liftXPub xPub1 :: Shelley 'PaymentK XPub + let (Just xPub2) = + xpubFromBytes $ b16encode $ T.append verKeyStake verKeyStake + let stakeXPub = liftXPub xPub2 :: Shelley 'DelegationK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let baseAddr = + delegationAddress tag (PaymentFromExtendedKey addrXPub) + (DelegationFromExtendedKey stakeXPub) + let (Right bytes) = b16decode expectedAddr + baseAddr `shouldBe` unsafeMkAddress bytes + +goldenTestBaseAddressPayFromPub :: GoldenTestBaseAddress -> SpecWith () +goldenTestBaseAddressPayFromPub GoldenTestBaseAddress{..} = + it ("base address for networkId " <> show netTag) $ do + let (Just pub1) = + pubFromBytes $ b16encode verKeyPayment + let addrPub = liftPub pub1 :: Shelley 'PaymentK Pub + let (Just xPub2) = + xpubFromBytes $ b16encode $ T.append verKeyStake verKeyStake + let stakeXPub = liftXPub xPub2 :: Shelley 'DelegationK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let baseAddr = + delegationAddress tag (PaymentFromKey addrPub) + (DelegationFromExtendedKey stakeXPub) + let (Right bytes) = b16decode expectedAddr + baseAddr `shouldBe` unsafeMkAddress bytes + +goldenTestBaseAddressPayFromKeyHash :: GoldenTestBaseAddress -> SpecWith () +goldenTestBaseAddressPayFromKeyHash GoldenTestBaseAddress{..} = + it ("base address for networkId " <> show netTag) $ do + let paymentBs = b16encode $ T.append verKeyPayment verKeyPayment + let (Just xPub1) = xpubFromBytes paymentBs + let addrXPub = liftXPub xPub1 :: Shelley 'PaymentK XPub + let (Just xPub2) = + xpubFromBytes $ b16encode $ T.append verKeyStake verKeyStake + let stakeXPub = liftXPub xPub2 :: Shelley 'DelegationK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let baseAddrPayFromKey = + delegationAddress tag (PaymentFromExtendedKey addrXPub) + (DelegationFromExtendedKey stakeXPub) + let keyHashDigest = hashCredential $ BS.take 32 paymentBs + let keyHash = KeyHash Payment keyHashDigest + let baseAddrPayFromKeyHash = + delegationAddress tag (PaymentFromKeyHash keyHash) + (DelegationFromExtendedKey stakeXPub) + baseAddrPayFromKey `shouldBe` baseAddrPayFromKeyHash + +goldenTestBaseAddressStakeFromKeyHash :: GoldenTestBaseAddress -> SpecWith () +goldenTestBaseAddressStakeFromKeyHash GoldenTestBaseAddress{..} = + it ("base address for networkId " <> show netTag) $ do + let paymentBs = b16encode $ T.append verKeyPayment verKeyPayment + let (Just xPub1) = xpubFromBytes paymentBs + let addrXPub = liftXPub xPub1 :: Shelley 'PaymentK XPub + let stakeBs = b16encode $ T.append verKeyStake verKeyStake + let (Just xPub2) = xpubFromBytes stakeBs + let stakeXPub = liftXPub xPub2 :: Shelley 'DelegationK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let baseAddrStakeFromKey = + delegationAddress tag (PaymentFromExtendedKey addrXPub) + (DelegationFromExtendedKey stakeXPub) + let keyHashDigest = hashCredential $ BS.take 32 stakeBs + let keyHash = KeyHash Delegation keyHashDigest + let baseAddrStakeFromKeyHash = + delegationAddress tag (PaymentFromExtendedKey addrXPub) + (DelegationFromKeyHash keyHash) + baseAddrStakeFromKey `shouldBe` baseAddrStakeFromKeyHash + +goldenTestBaseAddressStakeFromPub :: GoldenTestBaseAddress -> SpecWith () +goldenTestBaseAddressStakeFromPub GoldenTestBaseAddress{..} = + it ("base address for networkId " <> show netTag) $ do + let paymentBs = b16encode $ T.append verKeyPayment verKeyPayment + let (Just xPub1) = xpubFromBytes paymentBs + let addrXPub = liftXPub xPub1 :: Shelley 'PaymentK XPub + let stakeBs = b16encode $ T.append verKeyStake verKeyStake + let (Just xPub2) = xpubFromBytes stakeBs + let stakeXPub = liftXPub xPub2 :: Shelley 'DelegationK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let baseAddrStakeFromExtendedKey = + delegationAddress tag (PaymentFromExtendedKey addrXPub) + (DelegationFromExtendedKey stakeXPub) + let stakeBs1 = b16encode verKeyStake + let (Just pub2) = pubFromBytes stakeBs1 + let stakePub = liftPub pub2 :: Shelley 'DelegationK Pub + let baseAddrStakeFromKey = + delegationAddress tag (PaymentFromExtendedKey addrXPub) + (DelegationFromKey stakePub) + baseAddrStakeFromExtendedKey `shouldBe` baseAddrStakeFromKey + +goldenTestBaseAddressBothFromKeyHash :: GoldenTestBaseAddress -> SpecWith () +goldenTestBaseAddressBothFromKeyHash GoldenTestBaseAddress{..} = + it ("base address for networkId " <> show netTag) $ do + let paymentBs = b16encode $ T.append verKeyPayment verKeyPayment + let (Just xPub1) = xpubFromBytes paymentBs + let addrXPub = liftXPub xPub1 :: Shelley 'PaymentK XPub + let stakeBs = b16encode $ T.append verKeyStake verKeyStake + let (Just xPub2) = xpubFromBytes stakeBs + let stakeXPub = liftXPub xPub2 :: Shelley 'DelegationK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let baseAddrBothFromKey = + delegationAddress tag (PaymentFromExtendedKey addrXPub) + (DelegationFromExtendedKey stakeXPub) + let paymentKeyHashDigest = hashCredential $ BS.take 32 paymentBs + let paymentKeyHash = KeyHash Payment paymentKeyHashDigest + let stakeKeyHashDigest = hashCredential $ BS.take 32 stakeBs + let stakeKeyHash = KeyHash Delegation stakeKeyHashDigest + let baseAddrBothFromKeyHash = + delegationAddress tag (PaymentFromKeyHash paymentKeyHash) + (DelegationFromKeyHash stakeKeyHash) + baseAddrBothFromKey `shouldBe` baseAddrBothFromKeyHash + +goldenTestBaseAddressBothFromPub :: GoldenTestBaseAddress -> SpecWith () +goldenTestBaseAddressBothFromPub GoldenTestBaseAddress{..} = + it ("base address for networkId " <> show netTag) $ do + let paymentBs = b16encode $ T.append verKeyPayment verKeyPayment + let (Just xPub1) = xpubFromBytes paymentBs + let addrXPub = liftXPub xPub1 :: Shelley 'PaymentK XPub + let stakeBs = b16encode $ T.append verKeyStake verKeyStake + let (Just xPub2) = xpubFromBytes stakeBs + let stakeXPub = liftXPub xPub2 :: Shelley 'DelegationK XPub + let (Right tag) = mkNetworkDiscriminant netTag + let baseAddrBothFromKey = + delegationAddress tag (PaymentFromExtendedKey addrXPub) + (DelegationFromExtendedKey stakeXPub) + let paymentBs1 = b16encode verKeyPayment + let (Just pub1) = pubFromBytes paymentBs1 + let addrPub = liftPub pub1 :: Shelley 'PaymentK Pub + let stakeBs1 = b16encode verKeyStake + let (Just pub2) = pubFromBytes stakeBs1 + let stakePub = liftPub pub2 :: Shelley 'DelegationK Pub + let baseAddrBothFromPub = + delegationAddress tag (PaymentFromKey addrPub) + (DelegationFromKey stakePub) + baseAddrBothFromKey `shouldBe` baseAddrBothFromPub + +data KeysHashes = KeysHashes + { -- | CIP-1852’s DRep extended signing key (Ed25519-bip32 extended private key), bech32 encoded prefixed with 'drep_xsk' + drepXsk :: Text + + -- | CIP-1852’s DRep extended signing key (Ed25519-bip32 extended private key), base16 encoded + , drepXskHex :: Text + + -- | CIP-1852’s DRep signing key (Ed25519-bip32 non-extended private key), bech32 encoded prefixed with 'drep_sk' + , drepSk :: Text + + -- | CIP-1852’s DRep signing key (Ed25519-bip32 non-extended private key), base16 encoded + , drepSkHex :: Text + + -- | CIP-1852’s DRep extended verification key (Ed25519 public key with chain code), bech32 encoded prefixed with 'drep_xvk' + , drepXvk :: Text + + -- | CIP-1852’s DRep extended verification key (Ed25519 public key with chain code), base16 encoded + , drepXvkHex :: Text + + -- | CIP-1852’s DRep verification key (Ed25519 public key), bech32 encoded prefixed with 'drep_vk' + , drepVk :: Text + + -- | CIP-1852’s DRep verification key (Ed25519 public key), base16 encoded + , drepVkHex :: Text + + -- | Delegate representative verification key hash (DRep ID) (blake2b_224 digest of a delegate representative verification key), bech32 encoded prefixed with 'drep' + , drep :: Text + + -- | Delegate representative verification key hash (DRep ID) (blake2b_224 digest of a delegate representative verification key), base16 encoded + , drepHex :: Text + + -- | Delegate representative script hash (DRep ID) (blake2b_224 digest of a serialized delegate representative script prepended with 00100011 byte), bech32 encoded prefixed with 'drep' + -- script: all [drep, active_from 5001] + , drepScript1 :: Text + + -- | Delegate representative script hash (DRep ID) (blake2b_224 digest of a serialized delegate representative script), base16 encoded + -- script: all [drep, active_from 5001] + , drepScript1Hex :: Text + + -- | Delegate representative script hash (DRep ID) (blake2b_224 digest of a serialized delegate representative script prepended with 00100011 byte), bech32 encoded prefixed with 'drep' + -- script: any [drep, all [active_from 5001, active_until 6001]] + , drepScript2 :: Text + + -- | Delegate representative script hash (DRep ID) (blake2b_224 digest of a serialized delegate representative script), base16 encoded + -- script: any [drep, all [active_from 5001, active_until 6001]] + , drepScript2Hex :: Text + + -- | CIP-1852’s constitutional committee cold extended signing key (Ed25519-bip32 extended private key), bech32 encoded prefixed with 'cc_cold_xsk' + , ccColdXsk :: Text + + -- | CIP-1852’s constitutional committee cold extended signing key (Ed25519-bip32 extended private key), base16 encoded + , ccColdXskHex :: Text + + -- | CIP-1852’s constitutional committee cold signing key (Ed25519-bip32 non-extended private key), bech32 encoded prefixed with 'cc_cold_sk' + , ccColdSk :: Text + + -- | CIP-1852’s constitutional committee cold signing key (Ed25519-bip32 non-extended private key), base16 encoded + , ccColdSkHex :: Text + + -- | CIP-1852’s constitutional committee extended cold verification signing key (Ed25519 public key with chain code), bech32 encoded prefixed with 'cc_cold_xvk' + , ccColdXvk :: Text + + -- | CIP-1852’s constitutional committee extended cold verification signing key (Ed25519 public key with chain code), base16 encoded + , ccColdXvkHex :: Text + + -- | CIP-1852’s constitutional committee cold verification signing key (Ed25519 private key), bech32 encoded prefixed with 'cc_cold_vk' + , ccColdVk :: Text + + -- | CIP-1852’s constitutional committee cold verification signing key (Ed25519 private key), base16 encoded + , ccColdVkHex :: Text + + -- | Constitutional committee cold verification key hash (cold credential) (blake2b_224 digest of a consitutional committee cold verification key), bech32 encoded prefixed with 'cc_cold' + , ccCold :: Text + + -- | Constitutional committee cold verification key hash (cold credential) (blake2b_224 digest of a consitutional committee cold verification key), base16 encoded + , ccColdHex :: Text + + -- | Constitutional committee cold script hash (cold credential) (blake2b_224 digest of a serialized constitutional committee cold script prepended with 00010011 byte), bech32 encoded prefixed with 'cc_cold' + -- script: all [ccCold, active_from 5001] + , ccColdScript1 :: Text + + -- | Constitutional committee cold script hash (cold credential) (blake2b_224 digest of a serialized constitutional committee cold script), base16 encoded + -- script: all [ccCold, active_from 5001] + , ccColdScript1Hex :: Text + + -- | Constitutional committee cold script hash (cold credential) (blake2b_224 digest of a serialized constitutional committee cold script prepended with 00010011 byte), bech32 encoded prefixed with 'cc_cold' + -- script: any [ccCold, all [active_from 5001, active_until 6001]] + , ccColdScript2 :: Text + + -- | Constitutional committee cold script hash (cold credential) (blake2b_224 digest of a serialized constitutional committee cold script), base16 encoded + -- script: any [ccCold, all [active_from 5001, active_until 6001]] + , ccColdScript2Hex :: Text + + -- | CIP-1852’s constitutional committee hot extended signing key (Ed25519-bip32 extended private key), bech32 encoded prefixed with 'cc_hot_xsk' + , ccHotXsk :: Text + + -- | CIP-1852’s constitutional committee hot extended signing key (Ed25519-bip32 extended private key), base16 encoded + , ccHotXskHex :: Text + + -- | CIP-1852’s constitutional committee hot signing key (Ed25519-bip32 non-extended private key), bech32 encoded prefixed with 'cc_hot_sk' + , ccHotSk :: Text + + -- | CIP-1852’s constitutional committee hot signing key (Ed25519-bip32 non-extended private key), base16 encoded + , ccHotSkHex :: Text + + -- | CIP-1852’s constitutional committee extended hot verification signing key (Ed25519 public key with chain code), bech32 encoded prefixed with 'cc_hot_xvk' + , ccHotXvk :: Text + + -- | CIP-1852’s constitutional committee extended hot verification signing key (Ed25519 public key with chain code), base16 encoded + , ccHotXvkHex :: Text + + -- | CIP-1852’s constitutional committee hot verification signing key (Ed25519 private key), bech32 encoded prefixed with 'cc_hot_vk' + , ccHotVk :: Text + + -- | CIP-1852’s constitutional committee hot verification signing key (Ed25519 private key), base16 encoded + , ccHotVkHex :: Text + + -- | Constitutional committee hot verification key hash (hot credential) (blake2b_224 digest of a consitutional committee hot verification key), bech32 encoded prefixed with 'cc_hot' + , ccHot :: Text + + -- | Constitutional committee hot verification key hash (hot credential) (blake2b_224 digest of a consitutional committee hot verification key), base16 encoded + , ccHotHex :: Text + + -- | Constitutional committee hot script hash (hot credential) (blake2b_224 digest of a serialized constitutional committee hot script prepended with 00000011 byte), bech32 encoded prefixed with 'cc_hot' + -- script: all [ccHot, active_from 5001] + , ccHotScript1 :: Text + + -- | Constitutional committee hot script hash (hot credential) (blake2b_224 digest of a serialized constitutional committee hot script), base16 encoded + -- script: all [ccHot, active_from 5001] + , ccHotScript1Hex :: Text + + -- | Constitutional committee hot script hash (hot credential) (blake2b_224 digest of a serialized constitutional committee hot script prepended with 00000011 byte), bech32 encoded prefixed with 'cc_hot' + -- script: any [ccHot, all [active_from 5001, active_until 6001]] + , ccHotScript2 :: Text + + -- | Constitutional committee hot script hash (hot credential) (blake2b_224 digest of a serialized constitutional committee hot script), base16 encoded + -- script: any [ccHot, all [active_from 5001, active_until 6001]] + , ccHotScript2Hex :: Text + + } deriving (Eq, Show) + +data GoldenTestGovernance = GoldenTestGovernance + { + -- | Mnemonic + mnemonic :: [Text] + + -- | Account ix + , accountIx :: Word32 + + -- | Expected Keys and Hashes + , expectedKeysHashes :: KeysHashes + } + +goldenTestGovernance :: GoldenTestGovernance -> SpecWith () +goldenTestGovernance GoldenTestGovernance{..} = + it ("governance keys/hashes for " <> show mnemonic <> " and accIx="<>show accountIx) $ do + let (Right mw) = mkSomeMnemonic @'[9,12,15,18,21,24] mnemonic + let sndFactor = mempty + let rootXPrv = genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv + + let Just accIx = indexFromWord32 @(Index 'Hardened _) accountIx + let acctXPrv = deriveAccountPrivateKey rootXPrv accIx + + let drepXPrv = deriveDRepPrivateKey acctXPrv + let drepXPrvTxt = bech32With CIP5.drep_xsk $ getExtendedKeyAddr drepXPrv + let drepXPrvTxtHex = tob16text . unAddress $ getExtendedKeyAddr drepXPrv + let drepPrvTxt = bech32With CIP5.drep_sk $ getPrivateKeyAddr drepXPrv + let drepPrvTxtHex = T.decodeUtf8 $ encode EBase16 $ unAddress $ getPrivateKeyAddr drepXPrv + let drepXPubTxt = bech32With CIP5.drep_xvk $ getPublicKeyAddr $ toXPub <$> drepXPrv + let drepXPubTxtHex = tob16text . unAddress $ getPublicKeyAddr $ toXPub <$> drepXPrv + let drepPubTxt = bech32With CIP5.drep_vk $ getVerKey $ toXPub <$> drepXPrv + let drepPubTxtHex = tob16text . unAddress $ getVerKey $ toXPub <$> drepXPrv + let drepKeyHash = toKeyHash Representative $ toXPub <$> drepXPrv + let drepTxt = keyHashToText drepKeyHash CIP0129 + let drepTxtHex = tob16text . digest $ drepKeyHash + let drepScriptHash1 = toScriptHash (script1 drepKeyHash) + let drepScript1Txt = toScriptTxt drepScriptHash1 CIP5.drep + let drepScript1TxtHex = tob16text . unScriptHash $ drepScriptHash1 + let drepScriptHash2 = toScriptHash (script2 drepKeyHash) + let drepScript2Txt = toScriptTxt drepScriptHash2 CIP5.drep + let drepScript2TxtHex = tob16text . unScriptHash $ drepScriptHash2 + + let coldXPrv = deriveCCColdPrivateKey acctXPrv + let coldXPrvTxt = bech32With CIP5.cc_cold_xsk $ getExtendedKeyAddr coldXPrv + let coldXPrvTxtHex = tob16text . unAddress $ getExtendedKeyAddr coldXPrv + let coldPrvTxt = bech32With CIP5.cc_cold_sk $ getPrivateKeyAddr coldXPrv + let coldPrvTxtHex = T.decodeUtf8 $ encode EBase16 $ unAddress $ getPrivateKeyAddr coldXPrv + let coldXPubTxt = bech32With CIP5.cc_cold_xvk $ getPublicKeyAddr $ toXPub <$> coldXPrv + let coldXPubTxtHex = tob16text . unAddress $ getPublicKeyAddr $ toXPub <$> coldXPrv + let coldPubTxt = bech32With CIP5.cc_cold_vk $ getVerKey $ toXPub <$> coldXPrv + let coldPubTxtHex = tob16text . unAddress $ getVerKey $ toXPub <$> coldXPrv + let coldKeyHash = toKeyHash CommitteeCold $ toXPub <$> coldXPrv + let coldTxt = keyHashToText coldKeyHash CIP0129 + let coldTxtHex = tob16text . digest $ coldKeyHash + let coldScriptHash1 = toScriptHash (script1 coldKeyHash) + let coldScript1Txt = toScriptTxt coldScriptHash1 CIP5.cc_cold + let coldScript1TxtHex = tob16text . unScriptHash $ coldScriptHash1 + let coldScriptHash2 = toScriptHash (script2 coldKeyHash) + let coldScript2Txt = toScriptTxt coldScriptHash2 CIP5.cc_cold + let coldScript2TxtHex = tob16text . unScriptHash $ coldScriptHash2 + + let hotXPrv = deriveCCHotPrivateKey acctXPrv + let hotXPrvTxt = bech32With CIP5.cc_hot_xsk $ getExtendedKeyAddr hotXPrv + let hotXPrvTxtHex = tob16text . unAddress $ getExtendedKeyAddr hotXPrv + let hotPrvTxt = bech32With CIP5.cc_hot_sk $ getPrivateKeyAddr hotXPrv + let hotPrvTxtHex = T.decodeUtf8 $ encode EBase16 $ unAddress $ getPrivateKeyAddr hotXPrv + let hotXPubTxt = bech32With CIP5.cc_hot_xvk $ getPublicKeyAddr $ toXPub <$> hotXPrv + let hotXPubTxtHex = tob16text . unAddress $ getPublicKeyAddr $ toXPub <$> hotXPrv + let hotPubTxt = bech32With CIP5.cc_hot_vk $ getVerKey $ toXPub <$> hotXPrv + let hotPubTxtHex = tob16text . unAddress $ getVerKey $ toXPub <$> hotXPrv + let hotKeyHash = toKeyHash CommitteeHot $ toXPub <$> hotXPrv + let hotTxt = keyHashToText hotKeyHash CIP0129 + let hotTxtHex = tob16text . digest $ hotKeyHash + let hotScriptHash1 = toScriptHash (script1 hotKeyHash) + let hotScript1Txt = toScriptTxt hotScriptHash1 CIP5.cc_hot + let hotScript1TxtHex = tob16text . unScriptHash $ hotScriptHash1 + let hotScriptHash2 = toScriptHash (script2 hotKeyHash) + let hotScript2Txt = toScriptTxt hotScriptHash2 CIP5.cc_hot + let hotScript2TxtHex = tob16text . unScriptHash $ hotScriptHash2 + + let derivedKeysHashes = KeysHashes + { drepXsk = drepXPrvTxt + , drepXskHex = drepXPrvTxtHex + , drepSk = drepPrvTxt + , drepSkHex = drepPrvTxtHex + , drepXvk = drepXPubTxt + , drepXvkHex = drepXPubTxtHex + , drepVk = drepPubTxt + , drepVkHex = drepPubTxtHex + , drep = drepTxt + , drepHex = drepTxtHex + , drepScript1 = drepScript1Txt + , drepScript1Hex = drepScript1TxtHex + , drepScript2 = drepScript2Txt + , drepScript2Hex = drepScript2TxtHex + , ccColdXsk = coldXPrvTxt + , ccColdXskHex = coldXPrvTxtHex + , ccColdSk = coldPrvTxt + , ccColdSkHex = coldPrvTxtHex + , ccColdXvk = coldXPubTxt + , ccColdXvkHex = coldXPubTxtHex + , ccColdVk = coldPubTxt + , ccColdVkHex = coldPubTxtHex + , ccCold = coldTxt + , ccColdHex = coldTxtHex + , ccColdScript1 = coldScript1Txt + , ccColdScript1Hex = coldScript1TxtHex + , ccColdScript2 = coldScript2Txt + , ccColdScript2Hex = coldScript2TxtHex + , ccHotXsk = hotXPrvTxt + , ccHotXskHex = hotXPrvTxtHex + , ccHotSk = hotPrvTxt + , ccHotSkHex = hotPrvTxtHex + , ccHotXvk = hotXPubTxt + , ccHotXvkHex = hotXPubTxtHex + , ccHotVk = hotPubTxt + , ccHotVkHex = hotPubTxtHex + , ccHot = hotTxt + , ccHotHex = hotTxtHex + , ccHotScript1 = hotScript1Txt + , ccHotScript1Hex = hotScript1TxtHex + , ccHotScript2 = hotScript2Txt + , ccHotScript2Hex = hotScript2TxtHex + } + derivedKeysHashes `shouldBe` expectedKeysHashes + where + getVerKey = unsafeMkAddress . pubToBytes . xpubToPub . getKey + toKeyHash role = + KeyHash role + . hashCredential + . pubToBytes + . xpubToPub + . getKey + script1 keyhash = + RequireAllOf [RequireSignatureOf keyhash, ActiveFromSlot 5001] + script2 keyhash = + RequireAnyOf [ RequireSignatureOf keyhash + , RequireAllOf [ ActiveFromSlot 5001, ActiveUntilSlot 6001] + ] + toScriptTxt (ScriptHash bytes) hrp = + bech32With hrp $ + unsafeMkAddress bytes + +data TestVector = TestVector + { + -- | The extended root private key, bech32 encoded prefixed with 'root_xsk' + rootXPrv :: Text + + -- | The extended 0th account private key, bech32 encoded prefixed with 'acct_xsk' + , accXPrv0 :: Text + + -- | The extended 1st account private key, bech32 encoded prefixed with 'acct_xsk' + , accXPrv1 :: Text + + -- | The extended 0th address private key, bech32 encoded prefixed with 'addr_xsk' + , addrXPrv0 :: Text + + -- | The extended 0th address public key, bech32 encoded prefixed with 'addr_xvk' + , addrXPub0 :: Text + + -- | The extended 1st address private key, bech32 encoded prefixed with 'addr_xsk' + , addrXPrv1 :: Text + + -- | The extended 1st address public key, bech32 encoded prefixed with 'addr_xvk' + , addrXPub1 :: Text + + -- | The extended 1442nd address private key, bech32 encoded prefixed with 'addr_xsk' + , addrXPrv1442 :: Text + + -- | The extended 1442nd address public key, bech32 encoded prefixed with 'addr_xvk' + , addrXPub1442 :: Text + + -- | The payment address for 0th address key, with a networking tag 0, 3 and 6, respectively. + -- Each bech32 encoded prefixed with 'addr' + , paymentAddr0 :: [Text] + + -- | The payment address for 1st address key, with a networking tag 0, 3 and 6, respectively. + -- Each bech32 encoded prefixed with 'addr' + , paymentAddr1 :: [Text] + + -- | The payment address for 1442nd address key, with a networking tag 0, 3 and 6, respectively. + -- Each bech32 encoded prefixed with 'addr' + , paymentAddr1442 :: [Text] + + -- | Delegation addresses for the 0th address key and the 0th account delegation key, + -- with a networking tag 0, 3 and 6, respectively. Each bech32 encoded prefixed with 'addr' + , delegationAddr0Stake0 :: [Text] + + -- | Delegation addresses for the 1st address key and the 0th account delegation key, + -- with a networking tag 0, 3 and 6, respectively. Each bech32 encoded prefixed with 'addr' + , delegationAddr1Stake0 :: [Text] + + -- | Delegation addresses for the 1442nd address key and the 0th account delegation key, + -- with a networking tag 0, 3 and 6, respectively. Each bech32 encoded prefixed with 'addr' + , delegationAddr1442Stake0 :: [Text] + + -- | Delegation addresses for the 0th address key and the 1st account delegation key, + -- with a networking tag 0, 3 and 6, respectively. Each bech32 encoded prefixed with 'addr' + , delegationAddr0Stake1 :: [Text] + + -- | Delegation addresses for the 1st address key and the 1st account delegation key, + -- with a networking tag 0, 3 and 6, respectively. Each bech32 encoded prefixed with 'addr' + , delegationAddr1Stake1 :: [Text] + + -- | Delegation addresses for the 1442nd address key and the 1st account delegation key, + -- with a networking tag 0, 3 and 6, respectively. Each bech32 encoded prefixed with 'addr' + , delegationAddr1442Stake1 :: [Text] + + -- | Pointer addresses for the 0th address key and the delegation certificate located in slot 1, + -- transaction index 2, certificte list index 3, with a networking tag 0, 3 and 6, respectively. + -- Each bech32 encoded prefixed with 'addr' + , pointerAddr0Slot1 :: [Text] + + -- | Pointer addresses for the 0th address key and the delegation certificate located in slot 24157, + -- transaction index 177, certificte list index 42, with a networking tag 0, 3 and 6, respectively. + -- Each bech32 encoded prefixed with 'addr' + , pointerAddr0Slot2 :: [Text] + + -- | Corresponding Mnemonic + , mnemonic :: [Text] + + } deriving Show + +data InspectVector a = InspectVector + { addrXPub0 :: a + , addrXPub1 :: a + , addrXPub1442 :: a + , paymentAddr0 :: [a] + , paymentAddr1 :: [a] + , paymentAddr1442 :: [a] + , delegationAddr0Stake0 :: [a] + , delegationAddr1Stake0 :: [a] + , delegationAddr1442Stake0 :: [a] + , delegationAddr0Stake1 :: [a] + , delegationAddr1Stake1 :: [a] + , delegationAddr1442Stake1 :: [a] + , pointerAddr0Slot1 :: [a] + , pointerAddr0Slot2 :: [a] + } deriving (Generic, Show, Functor) + deriving anyclass ToJSON + +testVectors :: [Text] -> SpecWith () +testVectors mnemonic = describe (show $ T.unpack <$> mnemonic) $ do + let (Right mw) = mkSomeMnemonic @'[9,12,15,18,21,24] mnemonic + let sndFactor = mempty + let rootK = genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv + let rootXPrv = bech32With CIP5.root_xsk $ getExtendedKeyAddr rootK + + let Just accIx0 = indexFromWord32 @(Index 'Hardened _) 0x80000000 + let acctK0 = deriveAccountPrivateKey rootK accIx0 + let accXPrv0 = bech32With CIP5.acct_xsk $ getExtendedKeyAddr acctK0 + let Just accIx1 = indexFromWord32 @(Index 'Hardened _) 0x80000001 + let acctK1 = deriveAccountPrivateKey rootK accIx1 + let accXPrv1 = bech32With CIP5.acct_xsk $ getExtendedKeyAddr acctK1 + + let Just addIx0 = indexFromWord32 @(Index 'Soft _) 0x00000000 + let addrK0prv = deriveAddressPrivateKey acctK0 UTxOExternal addIx0 + let addrXPrv0 = bech32With CIP5.addr_xsk $ getExtendedKeyAddr addrK0prv + let addrXPub0 = bech32With CIP5.addr_xvk $ getPublicKeyAddr $ toXPub <$> addrK0prv + + let Just addIx1 = indexFromWord32 @(Index 'Soft _) 0x00000001 + let addrK1prv = deriveAddressPrivateKey acctK0 UTxOExternal addIx1 + let addrXPrv1 = bech32With CIP5.addr_xsk $ getExtendedKeyAddr addrK1prv + let addrXPub1 = bech32With CIP5.addr_xvk $ getPublicKeyAddr $ toXPub <$> addrK1prv + let Just addIx1442 = indexFromWord32 @(Index 'Soft _) 0x000005a2 + let addrK1442prv = deriveAddressPrivateKey acctK0 UTxOExternal addIx1442 + let addrXPrv1442 = bech32With CIP5.addr_xsk $ getExtendedKeyAddr addrK1442prv + let addrXPub1442 = bech32With CIP5.addr_xvk $ getPublicKeyAddr $ toXPub <$> addrK1442prv + + let networkTags = rights $ mkNetworkDiscriminant <$> [0,3,6] + let paymentAddr0 = getPaymentAddr addrK0prv <$> networkTags + let paymentAddr1 = getPaymentAddr addrK1prv <$> networkTags + let paymentAddr1442 = getPaymentAddr addrK1442prv <$> networkTags + + let slot1 = ChainPointer 1 2 3 + let pointerAddr0Slot1 = getPointerAddr addrK0prv slot1 <$> networkTags + let slot2 = ChainPointer 24157 177 42 + let pointerAddr0Slot2 = getPointerAddr addrK0prv slot2 <$> networkTags + + let stakeKPub0 = toXPub <$> deriveDelegationPrivateKey acctK0 + let delegationAddr0Stake0 = getDelegationAddr addrK0prv (DelegationFromExtendedKey stakeKPub0) <$> networkTags + let delegationAddr1Stake0 = getDelegationAddr addrK1prv (DelegationFromExtendedKey stakeKPub0) <$> networkTags + let delegationAddr1442Stake0 = getDelegationAddr addrK1442prv (DelegationFromExtendedKey stakeKPub0) <$> networkTags + let stakeKPub1 = toXPub <$> deriveDelegationPrivateKey acctK1 + let delegationAddr0Stake1 = getDelegationAddr addrK0prv (DelegationFromExtendedKey stakeKPub1) <$> networkTags + let delegationAddr1Stake1 = getDelegationAddr addrK1prv (DelegationFromExtendedKey stakeKPub1) <$> networkTags + let delegationAddr1442Stake1 = getDelegationAddr addrK1442prv (DelegationFromExtendedKey stakeKPub1) <$> networkTags + let vec = TestVector {..} + let inspectVec = InspectVector {..} + it "should generate correct addresses" $ do + goldenTextLazy ("addresses_" <> shortHex (T.intercalate "_" mnemonic)) + (pShowOpt defaultOutputOptionsNoColor vec) + it "should inspect correctly" $ do + goldenByteStringLazy ("inspects_" <> shortHex (T.intercalate "_" mnemonic)) $ + goldenEncodeJSON $ toInspect <$> inspectVec + where + getPaymentAddr addrKPrv net = bech32 $ paymentAddress net (PaymentFromExtendedKey (toXPub <$> addrKPrv)) + getPointerAddr addrKPrv ptr net = bech32 $ pointerAddress net (PaymentFromExtendedKey (toXPub <$> addrKPrv)) ptr + getDelegationAddr addrKPrv stakeKPub net = + bech32 $ delegationAddress net (PaymentFromExtendedKey (toXPub <$> addrKPrv)) stakeKPub + toInspect :: Text -> Value + toInspect = fromMaybe (String "couldn't inspect") . + (Shelley.inspectAddress Nothing <=< fromBech32) + +-- | Make a short name for a mnemonic by hashing it and taking the first 8 characters +shortHex :: Text -> Text +shortHex = T.take 8 . T.decodeUtf8 . BAE.convertToBase BAE.Base16 . hashByteString . T.encodeUtf8 + where + hashByteString :: ByteString -> ByteString + hashByteString = BA.convert . hashWith SHA3_256 + +getExtendedKeyAddr :: Shelley depth XPrv -> Address +getExtendedKeyAddr = unsafeMkAddress . xprvToBytes . getKey + +getPrivateKeyAddr :: Shelley depth XPrv -> Address +getPrivateKeyAddr = unsafeMkAddress . xprvPrivateKey . getKey + +getPublicKeyAddr :: Shelley depth XPub -> Address +getPublicKeyAddr = unsafeMkAddress . xpubToBytes . getKey + +goldenEncodeJSON :: ToJSON a => a -> BL.ByteString +goldenEncodeJSON = Aeson.encodePretty' cfg + where + cfg = Aeson.defConfig { Aeson.confCompare = compare } + +prop_roundtripTextEncoding + :: (Address -> Text) + -- ^ encode to 'Text' + -> (Text -> Maybe Address) + -- ^ decode from 'Text' + -> Shelley 'PaymentK XPub + -- ^ An arbitrary public key + -> NetworkDiscriminant Shelley + -- ^ An arbitrary network discriminant + -> Property +prop_roundtripTextEncoding encode' decode addXPub discrimination = + (result == pure address) + & counterexample (unlines + [ "Address " <> T.unpack (encode' address) + , "↳ " <> maybe "ø" (T.unpack . encode') result + ]) + & label (show $ addressDiscrimination @Shelley discrimination) + where + address = paymentAddress discrimination (PaymentFromExtendedKey addXPub) + result = decode (encode' address) + +prop_roundtripTextEncodingDelegation + :: (Address -> Text) + -- ^ encode to 'Text' + -> (Text -> Maybe Address) + -- ^ decode from 'Text' + -> Shelley 'PaymentK XPub + -- ^ An arbitrary address public key + -> Shelley 'DelegationK XPub + -- ^ An arbitrary delegation public key + -> NetworkDiscriminant Shelley + -- ^ An arbitrary network discriminant + -> Property +prop_roundtripTextEncodingDelegation encode' decode addXPub delegXPub discrimination = + (result == pure address) + & counterexample (unlines + [ "Address " <> T.unpack (encode' address) + , "↳ " <> maybe "ø" (T.unpack . encode') result + ]) + & label (show $ addressDiscrimination @Shelley discrimination) + where + address = delegationAddress discrimination (PaymentFromExtendedKey addXPub) (DelegationFromExtendedKey delegXPub) + result = decode (encode' address) + +prop_roundtripTextEncodingPointer + :: (Address -> Text) + -- ^ encode to 'Text' + -> (Text -> Maybe Address) + -- ^ decode from 'Text' + -> Shelley 'PaymentK XPub + -- ^ An arbitrary address public key + -> ChainPointer + -- ^ An arbitrary delegation key locator + -> NetworkDiscriminant Shelley + -- ^ An arbitrary network discriminant + -> Property +prop_roundtripTextEncodingPointer encode' decode addXPub ptr discrimination = + (result == pure address) + & counterexample (unlines + [ "Address " <> T.unpack (encode' address) + , "↳ " <> maybe "ø" (T.unpack . encode') result + ]) + & label (show $ addressDiscrimination @Shelley discrimination) + where + address = pointerAddress discrimination (PaymentFromExtendedKey addXPub) ptr + result = decode (encode' address) + +goldenTextLazy :: Text -> TL.Text -> Golden TL.Text +goldenTextLazy name output = + Golden + { output = output + , encodePretty = TL.unpack + , writeToFile = TL.writeFile + , readFromFile = TL.readFile + , testName = T.unpack name + , directory = "test/golden" + , failFirstTime = False + } + +goldenByteStringLazy :: Text -> BL.ByteString -> Golden BL.ByteString +goldenByteStringLazy name output = + Golden + { output = output + , encodePretty = TL.unpack . TLE.decodeUtf8 + , writeToFile = \ fp -> BL.writeFile fp . normalizeLBS + , readFromFile = fmap normalizeLBS . BL.readFile + , testName = T.unpack name + , directory = "test/golden" + , failFirstTime = False + } + +-- This should be sufficent to convert Windows "\r\n" newlines to UNIX "\n" newlines +-- as used by both Mac and Linux. +normalizeLBS :: BL.ByteString -> BL.ByteString +normalizeLBS = BL.filter (/= fromIntegral (Char.ord '\r')) + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +newtype SndFactor = SndFactor ScrubbedBytes + deriving stock (Eq, Show) + deriving newtype (ByteArrayAccess) + +instance Arbitrary SndFactor where + arbitrary = do + n <- choose (0, 64) + bytes <- BS.pack <$> vector n + return $ SndFactor $ BA.convert bytes + +tob16text :: ByteString -> Text +tob16text = T.decodeUtf8 . encode EBase16 + +b16encode :: Text -> ByteString +b16encode = encode EBase16 . T.encodeUtf8 + +b16decode :: Text -> Either String ByteString +b16decode = fromBase16 . T.encodeUtf8 diff --git a/test/Cardano/AddressSpec.hs b/test/Cardano/AddressSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/AddressSpec.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +module Cardano.AddressSpec + ( spec + ) where + +import Prelude + +import Cardano.Address + ( Address + , HasNetworkDiscriminant (..) + , PaymentAddress (..) + , base58 + , bech32 + , fromBase58 + , fromBech32 + ) +import Cardano.Address.Derivation + ( Depth (..), XPub ) +import Cardano.Address.Style.Byron + ( Byron ) +import Cardano.Address.Style.Icarus + ( Icarus ) +import Data.Function + ( (&) ) +import Data.Text + ( Text ) +import Test.Arbitrary + () +import Test.Hspec + ( Spec, describe ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Property, counterexample, label ) + +import qualified Data.Text as T + +spec :: Spec +spec = describe "Text Encoding Roundtrips" $ do + prop "base58 . fromBase58 - Byron" $ + prop_roundtripTextEncoding @Byron base58 fromBase58 + + prop "base58 . fromBase58 - Icarus" $ + prop_roundtripTextEncoding @Icarus base58 fromBase58 + + prop "bech32 . fromBech32 - Byron" $ + prop_roundtripTextEncoding @Byron bech32 fromBech32 + + prop "bech32 . fromBech32 - Icarus" $ + prop_roundtripTextEncoding @Icarus bech32 fromBech32 + +-- Ensure that any address public key can be encoded to an address and that the +-- address can be encoded and decoded without issues. +prop_roundtripTextEncoding + :: forall k. (PaymentAddress k) + => (Address -> Text) + -- ^ encode to 'Text' + -> (Text -> Maybe Address) + -- ^ decode from 'Text' + -> k 'PaymentK XPub + -- ^ An arbitrary public key + -> NetworkDiscriminant k + -- ^ An arbitrary network discriminant + -> Property +prop_roundtripTextEncoding encode decode addXPub discrimination = + (result == pure address) + & counterexample (unlines + [ "Address " <> T.unpack (encode address) + , "↳ " <> maybe "ø" (T.unpack . encode) result + ]) + & label (show $ addressDiscrimination @k discrimination) + where + address = paymentAddress discrimination addXPub + result = decode (encode address) diff --git a/test/Cardano/Codec/CborSpec.hs b/test/Cardano/Codec/CborSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/Codec/CborSpec.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Cardano.Codec.CborSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Derivation + ( Depth (..), GenMasterKey (..), XPrv ) +import Cardano.Address.Style.Byron + ( Byron (..) ) +import Cardano.Codec.Cbor + ( decodeAddressDerivationPath + , decodeAddressPayload + , decodeAllAttributes + , decodeDerivationPathAttr + , deserialiseCbor + , encodeAttributes + , encodeDerivationPathAttr + , toLazyByteString + , unsafeDeserialiseCbor + ) +import Cardano.Mnemonic + ( mkSomeMnemonic ) +import Data.ByteArray + ( ByteArrayAccess, ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Text + ( Text ) +import Data.Word + ( Word32 ) +import Test.Arbitrary + ( unsafeFromHex ) +import Test.Hspec + ( Expectation, Spec, describe, it, shouldBe ) +import Test.QuickCheck + ( Arbitrary (..), Property, conjoin, property, vector, (===), (==>) ) + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL + +{- HLINT ignore "Use head" -} + +spec :: Spec +spec = do + describe "decodeAddress <-> encodeAddress roundtrip" $ do + it "DerivationPath roundtrip" (property prop_derivationPathRoundTrip) + + describe "Golden Tests for Byron Addresses w/ random scheme (Mainnet)" $ do + it "decodeDerivationPath - mainnet - initial account" $ + decodeDerivationPathTest DecodeDerivationPath + { mnem = + arbitraryMnemonic + , addr = + "82d818584283581ca08bcb9e5e8cd30d5aea6d434c46abd8604fe4907d\ + \56b9730ca28ce5a101581e581c22e25f2464ec7295b556d86d0ec33bc1\ + \a681e7656da92dbc0582f5e4001a3abe2aa5" + , accIndex = + 2147483648 + , addrIndex = + 2147483648 + } + + it "decodeDerivationPath - mainnet - another account" $ + decodeDerivationPathTest DecodeDerivationPath + { mnem = + arbitraryMnemonic + , addr = + "82d818584283581cb039e80866203e82fc834b8e6a355b83ec6f8fd199\ + \66078a40e6d6b2a101581e581c22e27fb12d08728073cd416dfbfcb8dc\ + \0e760335d1d60f65e8740034001a4bce4d1a" + , accIndex = + 2694138340 + , addrIndex = + 2512821145 + } + + describe "Golden Tests for Byron Addresses w/ random scheme (Testnet)" $ do + it "decodeDerivationPath - testnet - initial account" $ + decodeDerivationPathTest DecodeDerivationPath + { mnem = + arbitraryMnemonic + , addr = + "82d818584983581ca03d42af673855aabcef3059e21c37235ae706072d\ + \38150dcefae9c6a201581e581c22e25f2464ec7295b556d86d0ec33bc1\ + \a681e7656da92dbc0582f5e402451a4170cb17001a39a0b7b5" + , accIndex = + 2147483648 + , addrIndex = + 2147483648 + } + + it "decodeDerivationPath - testnet - another account" $ + decodeDerivationPathTest DecodeDerivationPath + { mnem = + arbitraryMnemonic + , addr = + "82d818584983581c267b40902921c3afd73926a83a23ca08ae9626a64a\ + \4b5616d14d6709a201581e581c22e219c90fb572d565134f6daeab650d\ + \c871d130430afe594116f1ae02451a4170cb17001aee75f28a" + , accIndex = + 3337448281 + , addrIndex = + 3234874775 + } + +{------------------------------------------------------------------------------- + Golden tests for Address derivation path +-------------------------------------------------------------------------------} + +data DecodeDerivationPath = DecodeDerivationPath + { mnem :: [Text] + , addr :: ByteString + , accIndex :: Word32 + , addrIndex :: Word32 + } deriving (Show, Eq) + +-- An aribtrary mnemonic sentence for the tests +arbitraryMnemonic :: [Text] +arbitraryMnemonic = + [ "price", "whip", "bottom", "execute", "resist", "library" + , "entire", "purse", "assist", "clock", "still", "noble" ] + +decodeDerivationPathTest :: DecodeDerivationPath -> Expectation +decodeDerivationPathTest DecodeDerivationPath{..} = + decoded `shouldBe` Right (Just (accIndex, addrIndex)) + where + payload = unsafeDeserialiseCbor decodeAddressPayload $ + BL.fromStrict (unsafeFromHex addr) + decoded = deserialiseCbor (decodeAddressDerivationPath pwd) payload + Right mw = mkSomeMnemonic @'[12] mnem + key = genMasterKeyFromMnemonic mw () :: Byron 'RootK XPrv + pwd = payloadPassphrase key + +{------------------------------------------------------------------------------- + Derivation Path Roundtrip +-------------------------------------------------------------------------------} + +prop_derivationPathRoundTrip + :: Passphrase + -> Passphrase + -> Word32 + -> Word32 + -> Property +prop_derivationPathRoundTrip (Passphrase pwd) (Passphrase pwd') acctIx addrIx = + let + encoded = toLazyByteString $ encodeAttributes + [ encodeDerivationPathAttr pwd acctIx addrIx ] + decoded = unsafeDeserialiseCbor + (decodeAllAttributes >>= decodeDerivationPathAttr pwd) + encoded + decoded' = unsafeDeserialiseCbor + (decodeAllAttributes >>= decodeDerivationPathAttr pwd') + encoded + in + conjoin + [ decoded === Just (acctIx, addrIx) + , pwd /= pwd' ==> decoded' === Nothing + ] + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +newtype Passphrase = Passphrase ScrubbedBytes + deriving stock (Eq, Show) + deriving newtype (ByteArrayAccess) + +instance Arbitrary Passphrase where + arbitrary = do + bytes <- BS.pack <$> vector 32 + return $ Passphrase $ BA.convert bytes diff --git a/test/Cardano/MnemonicSpec.hs b/test/Cardano/MnemonicSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cardano/MnemonicSpec.hs @@ -0,0 +1,335 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.MnemonicSpec + ( spec + ) where + +import Prelude + +import Cardano.Mnemonic + ( Entropy + , EntropyError + , EntropySize + , MkMnemonicError (..) + , MkSomeMnemonicError (..) + , Mnemonic + , entropyToBytes + , entropyToMnemonic + , genEntropy + , mkEntropy + , mkMnemonic + , mkSomeMnemonic + , mnemonicToEntropy + , mnemonicToText + ) +import Control.Monad + ( forM_ ) +import Crypto.Encoding.BIP39 + ( DictionaryError (..) + , EntropyError (..) + , MnemonicWordsError (..) + , toEntropy + ) +import Data.ByteString + ( ByteString ) +import Data.Either + ( isRight ) +import Data.Text + ( Text ) +import Test.Arbitrary + () +import Test.Hspec + ( Spec, describe, it, shouldBe, shouldReturn, shouldSatisfy ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( (===) ) + +import qualified Data.ByteArray as BA +import qualified Data.Text as T + +data TestVector = TestVector + { + -- | Text + string :: Text + + -- | Corresponding Entropy + , entropy :: Entropy (EntropySize 12) + + -- | Corresponding Mnemonic + , mnemonic :: Mnemonic 12 + } + +spec :: Spec +spec = do + + prop "(9) entropyToMnemonic . mnemonicToEntropy == identity" $ \e -> + (mnemonicToEntropy @9 . entropyToMnemonic @9 @(EntropySize 9)) e == e + + prop "(12) entropyToMnemonic . mnemonicToEntropy == identity" $ \e -> + (mnemonicToEntropy @12 . entropyToMnemonic @12 @(EntropySize 12)) e == e + + prop "(15) entropyToMnemonic . mnemonicToEntropy == identity" $ \e -> + (mnemonicToEntropy @15 . entropyToMnemonic @15 @(EntropySize 15)) e == e + + prop "(18) entropyToMnemonic . mnemonicToEntropy == identity" $ \e -> + (mnemonicToEntropy @18 . entropyToMnemonic @18 @(EntropySize 18)) e == e + + prop "(21) entropyToMnemonic . mnemonicToEntropy == identity" $ \e -> + (mnemonicToEntropy @21 . entropyToMnemonic @21 @(EntropySize 21)) e == e + + prop "(24) entropyToMnemonic . mnemonicToEntropy == identity" $ \e -> + (mnemonicToEntropy @24 . entropyToMnemonic @24 @(EntropySize 24)) e == e + + prop "(9) mkMnemonic . mnemonicToText == pure" $ + \(mw :: Mnemonic 9) -> (mkMnemonic @9 . mnemonicToText) mw === pure mw + + prop "(12) mkMnemonic . mnemonicToText == pure" $ + \(mw :: Mnemonic 12) -> (mkMnemonic @12 . mnemonicToText) mw === pure mw + + prop "(15) mkMnemonic . mnemonicToText == pure" $ + \(mw :: Mnemonic 15) -> (mkMnemonic @15 . mnemonicToText) mw === pure mw + + prop "(18) mkMnemonic . mnemonicToText == pure" $ + \(mw :: Mnemonic 18) -> (mkMnemonic @18 . mnemonicToText) mw === pure mw + + prop "(21) mkMnemonic . mnemonicToText == pure" $ + \(mw :: Mnemonic 21) -> (mkMnemonic @21 . mnemonicToText) mw === pure mw + + prop "(24) mkMnemonic . mnemonicToText == pure" $ + \(mw :: Mnemonic 24) -> (mkMnemonic @24 . mnemonicToText) mw === pure mw + + describe "MkSomeMnemonic" $ do + let noInDictErr = + "Found an unknown word not present in the pre-defined dictionary. \ + \The full dictionary is available here: \ + \https://github.com/cardano-foundation/cardano-wallet/tree/master/specifications/mnemonic/english.txt" + + it "early error reported first (Invalid Entropy)" $ do + let res = mkSomeMnemonic @'[15,18,21] + [ "glimpse", "paper", "toward", "fine", "alert" + , "baby", "pyramid", "alone", "shaft", "force" + , "circle", "fancy", "squeeze", "cannon", "toilet" + ] + res `shouldBe` Left (MkSomeMnemonicError "Invalid entropy checksum: \ + \please double-check the last word of your mnemonic sentence.") + + it "early error reported first (Non-English Word)" $ do + let res = mkSomeMnemonic @'[15,18,21] + [ "baguette", "paper", "toward", "fine", "alert" + , "baby", "pyramid", "alone", "shaft", "force" + , "circle", "fancy", "squeeze", "cannon", "toilet" + ] + res `shouldBe` Left (MkSomeMnemonicError noInDictErr) + + it "early error reported first (Wrong number of words - 1)" $ do + let res = mkSomeMnemonic @'[15,18,21] + ["mom", "unveil", "slim", "abandon" + , "nut", "cash", "laugh", "impact" + , "system", "split", "depth", "sun" + ] + res `shouldBe` Left (MkSomeMnemonicError "Invalid number of words: \ + \15, 18 or 21 words are expected.") + + it "early error reported first (Wrong number of words - 2)" $ do + let res = mkSomeMnemonic @'[15] + ["mom", "unveil", "slim", "abandon" + , "nut", "cash", "laugh", "impact" + , "system", "split", "depth", "sun" + ] + res `shouldBe` Left (MkSomeMnemonicError "Invalid number of words: \ + \15 words are expected.") + + it "early error reported first (Error not in first constructor)" $ do + let res = mkSomeMnemonic @'[15,18,21,24] + ["盗", "精", "序", "郎", "赋", "姿", "委", "善", "酵" + ,"祥", "赛", "矩", "蜡", "注", "韦", "效", "义", "冻" + ] + res `shouldBe` Left (MkSomeMnemonicError noInDictErr) + + it "early error reported first (Error not in first constructor)" $ do + let res = mkSomeMnemonic @'[12,15,18] + ["盗", "精", "序", "郎", "赋", "姿", "委", "善", "酵" + ,"祥", "赛", "矩", "蜡", "注", "韦", "效", "义", "冻" + ] + res `shouldBe` Left (MkSomeMnemonicError noInDictErr) + + it "successfully parse 15 words in [15,18,21]" $ do + let res = mkSomeMnemonic @'[15,18,21] + ["cushion", "anxiety", "oval", "village", "choose" + , "shoot", "over", "behave", "category", "cruise" + , "track", "either", "maid", "organ", "sock" + ] + res `shouldSatisfy` isRight + + it "successfully parse 15 words in [12,15,18]" $ do + let res = mkSomeMnemonic @'[12,15,18] + ["cushion", "anxiety", "oval", "village", "choose" + , "shoot", "over", "behave", "category", "cruise" + , "track", "either", "maid", "organ", "sock" + ] + res `shouldSatisfy` isRight + + it "successfully parse 15 words in [9,12,15]" $ do + let res = mkSomeMnemonic @'[9,12,15] + ["cushion", "anxiety", "oval", "village", "choose" + , "shoot", "over", "behave", "category", "cruise" + , "track", "either", "maid", "organ", "sock" + ] + res `shouldSatisfy` isRight + + describe "golden tests" $ do + it "No empty mnemonic" $ + mkMnemonic @15 [] `shouldBe` + Left (ErrMnemonicWords (ErrWrongNumberOfWords 0 15)) + + it "No 1 word mnemonic" $ + mkMnemonic @15 ["material"] `shouldBe` + Left (ErrMnemonicWords (ErrWrongNumberOfWords 1 15)) + + it "No too long fake mnemonic" $ do + let sentence = + [ "squirrel","material","silly","twice","direct" + , "slush","pistol","razor","become","twice" + ] + mkMnemonic @9 sentence `shouldBe` + Left (ErrMnemonicWords (ErrWrongNumberOfWords 10 9)) + + it "No empty entropy" $ + mkEntropy @(EntropySize 12) "" `shouldBe` + Left (ErrInvalidEntropyLength 0 128) + + it "No too short entropy" $ + mkEntropy @(EntropySize 15) "000000" `shouldBe` + Left (ErrInvalidEntropyLength 48 160) + + it "No too long entropy" $ + mkEntropy @(EntropySize 15) "1234512345123451234512345" `shouldBe` + Left (ErrInvalidEntropyLength 200 160) + + it "Can make entropy" $ + mkEntropy @(EntropySize 15) "12345123451234512345" `shouldSatisfy` + isRight + + it "Can generate 96 bits entropy" $ + (BA.length . entropyToBytes <$> genEntropy @96) `shouldReturn` 12 + + it "Can generate 128 bits entropy" $ + (BA.length . entropyToBytes <$> genEntropy @128) `shouldReturn` 16 + + it "Can generate 160 bits entropy" $ + (BA.length . entropyToBytes <$> genEntropy @160) `shouldReturn` 20 + + it "Can generate 192 bits entropy" $ + (BA.length . entropyToBytes <$> genEntropy @192) `shouldReturn` 24 + + it "Can generate 224 bits entropy" $ + (BA.length . entropyToBytes <$> genEntropy @224) `shouldReturn` 28 + + it "Can generate 256 bits entropy" $ + (BA.length . entropyToBytes <$> genEntropy @256) `shouldReturn` 32 + + it "Mnemonic to Text" $ forM_ testVectors $ \TestVector{..} -> + mnemonicToText mnemonic `shouldBe` extractWords string + + it "Mnemonic from Text" $ forM_ testVectors $ \TestVector{..} -> + (mkMnemonic @12 . extractWords) string `shouldBe` pure mnemonic + + it "Mnemonic to Entropy" $ forM_ testVectors $ \TestVector{..} -> + mnemonicToEntropy mnemonic `shouldBe` entropy + + it "Mnemonic from Api is invalid" $ do + let mnemonicFromApi = + "[squirrel,material,silly,twice,direct,slush,pistol,razor,\ + \become,junk,kingdom,flee,squirrel,silly,twice]" + (mkMnemonic @15 . extractWords) mnemonicFromApi `shouldSatisfy` + isErrInvalidEntropyChecksum + + it "Mnemonic 2nd factor from Api is invalid" $ do + let mnemonicFromApi = + "[squirrel,material,silly,twice,direct,slush,pistol,razor,\ + \become]" + (mkMnemonic @9 . extractWords) mnemonicFromApi `shouldSatisfy` + isErrInvalidEntropyChecksum + + it "15 long mnemonics not valid for mkMnemonic @12" $ do + let mnemonicFromApi = + "[trigger,artwork,lab,raw,confirm,visual,energy,double,\ + \coral,fat,hen,ghost,phone,yellow,bag]" + (mkMnemonic @12 . extractWords) mnemonicFromApi `shouldBe` + Left (ErrMnemonicWords (ErrWrongNumberOfWords 15 12)) + + it "15 long mnemonics not valid for mkMnemonic @24" $ do + let mnemonicFromApi = + "[trigger,artwork,lab,raw,confirm,visual,energy,double,\ + \coral,fat,hen,ghost,phone,yellow,bag]" + (mkMnemonic @24 . extractWords) mnemonicFromApi `shouldBe` + Left (ErrMnemonicWords (ErrWrongNumberOfWords 15 24)) + + it "Non-English mnemonics don't work" $ do + let mnemonicFromApi = + "[むしば,いてん,ぜんりゃく,になう,きあい,よっか,けんま,\ + \げきげん,きおん,こふん,しゅらば,しあさって,てんし,わかめ,\ + \いわば]" + (mkMnemonic @15 . extractWords) mnemonicFromApi `shouldBe` + Left (ErrDictionary (ErrInvalidDictionaryWord "むしば")) + where + testVectors :: [TestVector] + testVectors = + [ TestVector + "[abandon,abandon,abandon,abandon,abandon,abandon,abandon,abandon,\ + \abandon,abandon,abandon,about]" + (orFail $ mkEntropy' + "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ + \\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL") + (orFail $ mkMnemonic + [ "abandon", "abandon", "abandon", "abandon", "abandon", "abandon" + , "abandon", "abandon", "abandon", "abandon", "abandon", "about" + ]) + , TestVector + "[letter,advice,cage,absurd,amount,doctor,acoustic,avoid,letter,\ + \advice,cage,above]" + (orFail $ mkEntropy' + "\128\128\128\128\128\128\128\128\ + \\128\128\128\128\128\128\128\128") + (orFail $ mkMnemonic + [ "letter", "advice", "cage", "absurd", "amount", "doctor" + , "acoustic", "avoid", "letter", "advice", "cage", "above" + ]) + , TestVector + "[zoo,zoo,zoo,zoo,zoo,zoo,zoo,zoo,zoo,zoo,zoo,wrong]" + (orFail $ mkEntropy' + "\255\255\255\255\255\255\255\255\ + \\255\255\255\255\255\255\255\255") + (orFail $ mkMnemonic + [ "zoo", "zoo", "zoo", "zoo", "zoo", "zoo" + , "zoo", "zoo", "zoo", "zoo", "zoo", "wrong" ]) + ] + where + orFail + :: Show e + => Either e a + -> a + orFail = + either (error . (<>) "Failed to create golden Mnemonic: " . show) id + + mkEntropy' + :: ByteString + -> Either (EntropyError 4) (Entropy 128) + mkEntropy' = toEntropy @128 @4 @ByteString + + extractWords :: Text -> [Text] + extractWords = + T.splitOn "," + . T.dropAround (\c -> c == '[' || c == ']') + + isErrInvalidEntropyChecksum :: Either (MkMnemonicError e) b -> Bool + isErrInvalidEntropyChecksum = \case + Left (ErrEntropy ErrInvalidEntropyChecksum{}) -> True + _ -> False diff --git a/test/Codec/Binary/EncodingSpec.hs b/test/Codec/Binary/EncodingSpec.hs new file mode 100644 --- /dev/null +++ b/test/Codec/Binary/EncodingSpec.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Codec.Binary.EncodingSpec + ( spec + ) where + +import Prelude + +import Codec.Binary.Encoding + ( AbstractEncoding (..), detectEncoding ) +import Test.Hspec + ( Spec, SpecWith, describe, it, shouldBe ) + +spec :: Spec +spec = do + describe "detectEncoding" $ do + specDetectEncoding (EBech32 ()) + "ed25519_sk1l25926aaaf7ty55g99r285wptc7nqrzager5jghurqdswklj4pvszzp8qg" + +specDetectEncoding + :: AbstractEncoding () + -> String + -> SpecWith () +specDetectEncoding expected str = + it (str <> " is " <> pretty expected) $ + detectEncoding str `shouldBe` Just expected + where + pretty = \case + EBech32{} -> "bech32" + EBase16{} -> "base16" + EBase58{} -> "base58" diff --git a/test/Command/Address/BootstrapSpec.hs b/test/Command/Address/BootstrapSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Address/BootstrapSpec.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Address.BootstrapSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "address", "bootstrap" ] $ do + specIcarus defaultPhrase "44H/1815H/0H/0/0" "764824073" + "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + specIcarus defaultPhrase "44H/1815H/0H/0/1" "764824073" + "Ae2tdPwUPEZCJUCuVgnysar8ZJeyKuhjXU35VNgKMMTcXWmS9zzYycmwKa4" + specIcarus defaultPhrase "44H/1815H/0H/0/2" "764824073" + "Ae2tdPwUPEZFJtMH1m5HvsaQZrmgLcVcyuk5TxYtdRHZFo8yV7yEnnJyqTs" + + specIcarus defaultPhrase "44H/1815H/0H/0/0" "mainnet" + "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + specIcarus defaultPhrase "44H/1815H/0H/0/1" "mainnet" + "Ae2tdPwUPEZCJUCuVgnysar8ZJeyKuhjXU35VNgKMMTcXWmS9zzYycmwKa4" + specIcarus defaultPhrase "44H/1815H/0H/0/2" "mainnet" + "Ae2tdPwUPEZFJtMH1m5HvsaQZrmgLcVcyuk5TxYtdRHZFo8yV7yEnnJyqTs" + + specByron defaultPhrase "0H/0H" "764824073" + "DdzFFzCqrhsf6hiTYkK5gBAhVDwg3SiaHiEL9wZLYU3WqLUpx6DP\ + \5ZRJr4rtNRXbVNfk89FCHCDR365647os9AEJ8MKZNvG7UKTpythG" + specByron defaultPhrase "0H/1H" "764824073" + "DdzFFzCqrhssdAorKQ7hGGPgNS3akoiuNG6YY7bb11hYrm1x716e\ + \akbz3yUppMS6X4t8WgM3Nx9CwjqZk3oNgm8s9yooJTs5AS7ptFT6" + specByron defaultPhrase "0H/2H" "764824073" + "DdzFFzCqrht4YH5irxboFprowLYgJLddd2iCQt5mrVyQS5CZFMeZ\ + \bQtzJsHf4a6YQhPPNxtqBVP3Drsy1tdjecqq1FK1m2oAR5J8EcVe" + + specByron defaultPhrase "0H/0H" "mainnet" + "DdzFFzCqrhsf6hiTYkK5gBAhVDwg3SiaHiEL9wZLYU3WqLUpx6DP\ + \5ZRJr4rtNRXbVNfk89FCHCDR365647os9AEJ8MKZNvG7UKTpythG" + specByron defaultPhrase "0H/1H" "mainnet" + "DdzFFzCqrhssdAorKQ7hGGPgNS3akoiuNG6YY7bb11hYrm1x716e\ + \akbz3yUppMS6X4t8WgM3Nx9CwjqZk3oNgm8s9yooJTs5AS7ptFT6" + specByron defaultPhrase "0H/2H" "mainnet" + "DdzFFzCqrht4YH5irxboFprowLYgJLddd2iCQt5mrVyQS5CZFMeZ\ + \bQtzJsHf4a6YQhPPNxtqBVP3Drsy1tdjecqq1FK1m2oAR5J8EcVe" + + specInvalidNetwork "💩" + +specIcarus :: [String] -> String -> String -> String -> SpecWith () +specIcarus phrase path networkTag want = it ("golden icarus " <> path <> " (" <> networkTag <> ")") $ do + out <- cli [ "key", "from-recovery-phrase", "icarus" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "address", "bootstrap", "--network-tag", networkTag ] + out `shouldBe` want + +specByron :: [String] -> String -> String -> String -> SpecWith () +specByron phrase path networkTag want = it ("golden byron " <> path <> " (" <> networkTag <> ")") $ do + rootPrv <- cli [ "key", "from-recovery-phrase", "byron" ] (unwords phrase) + rootPub <- cli [ "key", "public", "--with-chain-code" ] rootPrv + out <- cli [ "key", "child", path ] rootPrv + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "address", "bootstrap", "--root", rootPub, "--network-tag", networkTag, path ] + out `shouldBe` want + +specInvalidNetwork :: String -> SpecWith () +specInvalidNetwork networkTag = it ("invalid network " <> networkTag) $ do + (out, err) <- cli [ "address", "bootstrap", "--network-tag", networkTag ] "" + out `shouldBe` "" + err `shouldContain` "Invalid network tag. Must be an integer value or one of the allowed keywords:" + err `shouldContain` "Usage" + +defaultPhrase :: [String] +defaultPhrase = + [ "ghost", "buddy", "neutral", "broccoli", "face", "rack" + , "relief", "odor", "swallow", "real", "once", "ecology" + ] diff --git a/test/Command/Address/DelegationSpec.hs b/test/Command/Address/DelegationSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Address/DelegationSpec.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Address.DelegationSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "address", "delegation" ] $ do + specFromExtendedKey defaultPhrase "1852H/1815H/0H/2/0" + defaultAddrMainnet + "addr1q9therz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qwvxwdrt\ + \70qlcpeeagscasafhffqsxy36t90ldv06wqrk2qdqhgvu" + + specFromExtendedKey defaultPhrase "1852H/1815H/0H/2/0" + defaultAddrTestnet + "addr_test1qptherz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qwv\ + \xwdrt70qlcpeeagscasafhffqsxy36t90ldv06wqrk2qwk2gqr" + + specFromNonextendedKey defaultPhrase "1852H/1815H/0H/2/0" + defaultAddrMainnet + "addr1q9therz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qwvxwdrt\ + \70qlcpeeagscasafhffqsxy36t90ldv06wqrk2qdqhgvu" + + specFromNonextendedKey defaultPhrase "1852H/1815H/0H/2/0" + defaultAddrTestnet + "addr_test1qptherz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qwv\ + \xwdrt70qlcpeeagscasafhffqsxy36t90ldv06wqrk2qwk2gqr" + + specFromKeyHash defaultPhrase "1852H/1815H/0H/2/0" + defaultAddrMainnet + "addr1q9therz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qwvxwdrt\ + \70qlcpeeagscasafhffqsxy36t90ldv06wqrk2qdqhgvu" + + specFromKeyHash defaultPhrase "1852H/1815H/0H/2/0" + defaultAddrTestnet + "addr_test1qptherz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qwv\ + \xwdrt70qlcpeeagscasafhffqsxy36t90ldv06wqrk2qwk2gqr" + + specFromScript + defaultAddrMainnet + "all [stake_shared_vkh1nqc00hvlc6cq0sfhretk0rmzw8dywmusp8retuqnnxzajtzhjg5]" + "addr1y9therz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qfe5nnvf2a5vzmvdfhda0yw08qrj32kn4ytx2l7xpd08l7q0xlqfx" + + specMalformedAddress "💩" + + specMalformedAddress "\NUL" + + specMalformedAddress + "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + + specMalformedAddress + "DdzFFzCqrhsf6hiTYkK5gBAhVDwg3SiaHiEL9wZLYU3WqLUpx6DP\ + \5ZRJr4rtNRXbVNfk89FCHCDR365647os9AEJ8MKZNvG7UKTpythG" + + specInvalidAddress + "addr1qdu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5ewvxwdrt\ + \70qlcpeeagscasafhffqsxy36t90ldv06wqrk2q5ggg4z" + + specMalformedXPub "💩" + + specInvalidXPub + "stake_xvk1qfqcf4tp4ensj5qypqs640rt06pe5x7v2eul00c7rakzzvsakw3caelfuh6cg6nrkdv9y2ctkeu" + +specFromExtendedKey :: [String] -> String -> String -> String -> SpecWith () +specFromExtendedKey phrase path addr want = it ("delegation from key " <> want) $ do + stakeKey <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--with-chain-code" ] + out <- cli [ "address", "delegation", stakeKey ] addr + out `shouldBe` want + +specFromNonextendedKey :: [String] -> String -> String -> String -> SpecWith () +specFromNonextendedKey phrase path addr want = it ("delegation from key " <> want) $ do + stakeKey <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--without-chain-code" ] + out <- cli [ "address", "delegation", stakeKey ] addr + out `shouldBe` want + +specFromKeyHash :: [String] -> String -> String -> String -> SpecWith () +specFromKeyHash phrase path addr want = it ("delegation from key " <> want) $ do + stakeKeyHash <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "key", "hash" ] + out <- cli [ "address", "delegation", stakeKeyHash ] addr + out `shouldBe` want + +specFromScript :: String -> String -> String -> SpecWith () +specFromScript addr script want = it ("delegation from script " <> want) $ do + scriptHash <- cli [ "script", "hash", script ] "" + out <- cli [ "address", "delegation", scriptHash ] addr + out `shouldBe` want + +specMalformedAddress :: String -> SpecWith () +specMalformedAddress addr = it ("malformed address " <> addr) $ do + (out, err) <- cli [ "address", "delegation", defaultXPub ] addr + out `shouldBe` "" + err `shouldContain` "Bech32 error" + +specInvalidAddress :: String -> SpecWith () +specInvalidAddress addr = it ("invalid address " <> addr) $ do + (out, err) <- cli [ "address", "delegation", defaultXPub ] addr + out `shouldBe` "" + err `shouldContain` "Only payment addresses can be extended" + +specMalformedXPub :: String -> SpecWith () +specMalformedXPub xpub = it ("malformed xpub " <> xpub) $ do + (out, err) <- cli [ "address", "delegation", xpub ] defaultAddrMainnet + out `shouldBe` "" + err `shouldContain` "Couldn't parse delegation credentials." + +specInvalidXPub :: String -> SpecWith () +specInvalidXPub xpub = it ("invalid xpub " <> xpub) $ do + (out, err) <- cli [ "address", "delegation", xpub ] defaultAddrMainnet + out `shouldBe` "" + err `shouldContain` "Couldn't parse delegation credentials." + +defaultPhrase :: [String] +defaultPhrase = + [ "art", "forum", "devote", "street", "sure" + , "rather", "head", "chuckle", "guard", "poverty" + , "release", "quote", "oak", "craft", "enemy" + ] + +defaultXPub :: String +defaultXPub = + "stake_xvk1z0lq4d73l4xtk42s3364s2fpn4m5xtuacfkfj4dxxt9uhccvl\ + \g6pamdykgvcna3w4jf6zr3yqenuasug3gp22peqm6vduzrzw8uj6asu49xvf" + +defaultAddrMainnet :: String +defaultAddrMainnet = + "addr1v9therz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qgx2curq" + +defaultAddrTestnet :: String +defaultAddrTestnet = + "addr_test1vptherz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qgazvqv9" diff --git a/test/Command/Address/InspectSpec.hs b/test/Command/Address/InspectSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Address/InspectSpec.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Command.Address.InspectSpec + ( spec + ) where + +import Prelude + +import Control.Monad + ( forM_ ) +import Test.Hspec + ( Spec, SpecWith, expectationFailure, it, shouldBe, shouldContain ) +import Test.Utils + ( SchemaRef, cli, describeCmd, validateJSON ) + +import qualified Data.Aeson as Json +import qualified Data.ByteString.Lazy.Char8 as BL8 + +spec :: Spec +spec = describeCmd [ "address", "inspect" ] $ do + specInspectAddress ["Byron", "none", "\"address_type\": 8"] [] + "37btjrVyb4KEgoGCHJ7XFaJRLBRiVuvcrQWPpp4HeaxdTxhKwQjXHNKL4\ + \3NhXaQNa862BmxSFXZFKqPqbxRc3kCUeTRMwjJevFeCKokBG7A7num5Wh" + + specInspectAddress ["Byron", "address_index", "account_index", "\"address_type\": 8"] + [ "--root" + , "root_xvk18amv7cs8kj0mxpk0l3vk2w6g22vyf7y5texr9huevqg9kd3dav\ + \gv5j52xrfcf90kxx2zdrrl826pzc2kptgwegzzzpfgddwqkrk2gpclvvx76" + ] + "DdzFFzCqrht5csm2GKhnVrjzKpVHHQFNXUDhAFDyLWVY5w8ZsJRP2uhwZ\ + \q2CEAVzDZXYXa4GvggqYEegQsdKAKikFfrrCoHheLH2Jskr" + + specInspectAddress ["Icarus", "none", "\"address_type\": 8"] [] + "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + + specInspectAddress ["Shelley", "none", "\"address_type\": 6"] [] + "addr1vpu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg0yu80w" + + specInspectAddress ["Shelley", "by value", "\"address_type\": 0"] [] + "addr1qdu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5ew\ + \vxwdrt70qlcpeeagscasafhffqsxy36t90ldv06wqrk2q5ggg4z" + + specInspectAddress ["Shelley", "by pointer", "\"address_type\": 4"] [] + "addr1gw2fxv2umyhttkxyxp8x0dlpdt3k6cwng5pxj3jhsydzer5ph3wczvf2x4v58t" + + -- reward account: keyhash28 + specInspectAddress ["Shelley", "by value", "stake_key_hash"] [] + "stake1upshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mqcjv83c" + specInspectAddress ["Shelley", "by value", "stake_key_hash_bech32"] [] + "stake1upshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mqcjv83c" + specInspectAddress ["\"address_type\": 14"] [] + "stake1upshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mqcjv83c" + + -- reward account: scripthash28 + specInspectAddress ["Shelley", "by value", "stake_shared_hash"] [] + "stake17pshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mq36s8xc" + specInspectAddress ["Shelley", "by value", "stake_shared_hash_bech32"] [] + "stake17pshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mq36s8xc" + specInspectAddress ["\"address_type\": 15"] [] + "stake17pshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mq36s8xc" + + -- cardano-cli generated --testnet-magic 42 addresses + specInspectAddress ["Shelley", "by value", "stake_key_hash", "spending_key_hash"] [] + "addr_test1qpwr8l57ceql23ylyprl6qgct239lxph8clwxy5w8r4qdz8ct9uut5a\ + \hmxqkgwy9ecn5carsv39frsgsq09u70wmqwhqjqcjqs" + specInspectAddress ["\"address_type\": 0"] [] + "addr_test1qpwr8l57ceql23ylyprl6qgct239lxph8clwxy5w8r4qdz8ct9uut5a\ + \hmxqkgwy9ecn5carsv39frsgsq09u70wmqwhqjqcjqs" + specInspectAddress ["Shelley", "by value", "stake_key_hash"] [] + "stake_test1uru9j7w96wmanqty8zzuuf6vw3cxgj53cygq8j708hds8tsntl0j7" + specInspectAddress ["Shelley", "by value", "stake_key_hash_bech32"] [] + "stake_test1uru9j7w96wmanqty8zzuuf6vw3cxgj53cygq8j708hds8tsntl0j7" + specInspectAddress ["\"address_type\": 14"] [] + "stake_test1uru9j7w96wmanqty8zzuuf6vw3cxgj53cygq8j708hds8tsntl0j7" + + -- cardano-cli generated --mainnet addresses + specInspectAddress ["Shelley", "by value", "stake_key_hash", "spending_key_hash"] [] + "addr1q9777p2w2hqa3cl0ah97pdwyavjnpf0ex3muvqgttavjxhku2rp98h9drzkdf\ + \va8ea775jszmd799k59aknpvqyn6wwqwll7uw" + specInspectAddress ["\"address_type\": 0"] [] + "addr1q9777p2w2hqa3cl0ah97pdwyavjnpf0ex3muvqgttavjxhku2rp98h9drzkdf\ + \va8ea775jszmd799k59aknpvqyn6wwqwll7uw" + specInspectAddress ["Shelley", "by value", "stake_key_hash"] [] + "stake1u8w9psjnmjk33tx5kwnu7l02fgpdklzjm2z7mfskqzfa88qsjpk8l" + specInspectAddress ["Shelley", "by value", "stake_key_hash_bech32"] [] + "stake1u8w9psjnmjk33tx5kwnu7l02fgpdklzjm2z7mfskqzfa88qsjpk8l" + specInspectAddress ["\"address_type\": 14"] [] + "stake1u8w9psjnmjk33tx5kwnu7l02fgpdklzjm2z7mfskqzfa88qsjpk8l" + + -- Payment address from script hash + -- $ cardano-address recovery-phrase generate --size 15 > phrase.prv + -- $ cardano-address key from-recovery-phrase Shared < phrase.prv > root_shared.xsk + -- $ cardano-address key child 1854H/1815H/0H/0/0 < root_shared.xsk | cardano-address key public --without-chain-code > addr_shared.vk + -- $ cardano-address key child 1854H/1815H/0H/2/0 < root_shared.xsk | cardano-address key public --without-chain-code > stake_shared.vk + -- $ cardano-address script hash "all [$(cat addr_shared.vk), $(cat stake_shared.vk)]" > script.hash + -- $ cardano-address address payment --network-tag testnet < script.hash + specInspectAddress ["Shelley", "none", "\"address_type\": 7"] [] + "addr_test1wpn0f29c6qahheeplasm34dyq6jxm7vt0ptqxet39ylyceqjwaqmt" + + specInspectMalformed + "💩" + + specInspectInvalid "Wrong input size of 28" [] + "79467c69a9ac66280174d09d62575ba955748b21dec3b483a9469a65" + + -- 32-byte long script hash + specInspectInvalid "Unknown address type" [] + "stake17pshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mrgdp5xscfm7jc" + + -- Provided key is not the root key. + specInspectInvalid "Failed to decrypt derivation path" + [ "--root" + , "root_xvk1kvz64d7yggggk5uc8kf8t8jjmh3djlx7ksr2xu25na5ypjzjs5\ + \9j8ym5gqga8un7yg8e6et6sex8kx0cejwjtz8gh8pj0zg7kc53nuqd92dr7" + ] + "DdzFFzCqrht5csm2GKhnVrjzKpVHHQFNXUDhAFDyLWVY5w8ZsJRP2uhwZ\ + \q2CEAVzDZXYXa4GvggqYEegQsdKAKikFfrrCoHheLH2Jskr" + + -- Invalid CRC + specInspectInvalid "non-matching crc32" [] + "Ae2tdPwUPEZ5QJkfzoJgarugsX3rUVbTjg8nqTYmuy2c2msy5augpnm91ZR" + +specInspectAddress :: [String] -> [String] -> String -> SpecWith () +specInspectAddress mustHave args addr = it addr $ do + (out, err) <- cli ([ "address", "inspect" ] <> args) addr + err `shouldBe` ("" :: String) + case Json.eitherDecode (BL8.pack out) of + Left e -> expectationFailure $ "malformed JSON: " <> show e + Right json -> validateJSON schema json >>= \case + [] -> forM_ mustHave (shouldContain out) + es -> expectationFailure $ "invalid JSON: " <> unlines es + where + schema :: SchemaRef + schema = "./schemas/address-inspect.json" + +specInspectMalformed :: String -> SpecWith () +specInspectMalformed str = it ("malformed: " <> str) $ do + (out, err) <- cli [ "address", "inspect" ] str + out `shouldBe` ("" :: String) + err `shouldContain` "Couldn't detect input encoding?" + +specInspectInvalid :: String -> [String] -> String -> SpecWith () +specInspectInvalid errstr args str = it ("invalid: " <> str) $ do + (out, err) <- cli ([ "address", "inspect" ] <> args) str + out `shouldBe` ("" :: String) + err `shouldContain` errstr diff --git a/test/Command/Address/PaymentSpec.hs b/test/Command/Address/PaymentSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Address/PaymentSpec.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Address.PaymentSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "address", "payment" ] $ do + specShelleyFromXPub defaultPhrase "1852H/1815H/0H/0/0" "0" + "addr_test1vpu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg57c2qv" + + specShelleyFromXPub defaultPhrase "1852H/1815H/0H/0/0" "3" + "addr1vdu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg0m9a08" + + specShelleyFromXPub defaultPhrase "1852H/1815H/0H/0/0" "testnet" + "addr_test1vpu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg57c2qv" + + specShelleyFromXPub defaultPhrase "1852H/1815H/0H/0/0" "mainnet" + "addr1v9u5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg0kvk0f" + + specShelleyFromPub defaultPhrase "1852H/1815H/0H/0/0" "0" + "addr_test1vpu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg57c2qv" + + specShelleyFromPub defaultPhrase "1852H/1815H/0H/0/0" "3" + "addr1vdu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg0m9a08" + + specShelleyFromPub defaultPhrase "1852H/1815H/0H/0/0" "testnet" + "addr_test1vpu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg57c2qv" + + specShelleyFromPub defaultPhrase "1852H/1815H/0H/0/0" "mainnet" + "addr1v9u5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg0kvk0f" + + specShelleyFromKeyHash defaultPhrase "1852H/1815H/0H/0/0" "0" + "addr_test1vpu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg57c2qv" + + specShelleyFromKeyHash defaultPhrase "1852H/1815H/0H/0/0" "3" + "addr1vdu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg0m9a08" + + specShelleyFromKeyHash defaultPhrase "1852H/1815H/0H/0/0" "testnet" + "addr_test1vpu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg57c2qv" + + specShelleyFromKeyHash defaultPhrase "1852H/1815H/0H/0/0" "mainnet" + "addr1v9u5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg0kvk0f" + + specMalformedNetwork "💩" + + specInvalidNetwork "42" + specInvalidNetwork "staging" + +specShelleyFromXPub :: [String] -> String -> String -> String -> SpecWith () +specShelleyFromXPub phrase path networkTag want = it ("golden shelley (payment) " <> path) $ do + out <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "address", "payment", "--network-tag", networkTag ] + out `shouldBe` want + +specShelleyFromPub :: [String] -> String -> String -> String -> SpecWith () +specShelleyFromPub phrase path networkTag want = it ("golden shelley (payment) " <> path) $ do + out <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--without-chain-code" ] + >>= cli [ "address", "payment", "--network-tag", networkTag ] + out `shouldBe` want + +specShelleyFromKeyHash :: [String] -> String -> String -> String -> SpecWith () +specShelleyFromKeyHash phrase path networkTag want = it ("golden shelley (payment) " <> path) $ do + out <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "key", "hash" ] + >>= cli [ "address", "payment", "--network-tag", networkTag ] + out `shouldBe` want + +specMalformedNetwork :: String -> SpecWith () +specMalformedNetwork networkTag = it ("malformed network " <> networkTag) $ do + (out, err) <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords defaultPhrase) + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "address", "payment", "--network-tag", networkTag ] + out `shouldBe` "" + err `shouldContain` "Invalid network tag. Must be an integer value or one of the allowed keywords:" + err `shouldContain` "Usage" + +specInvalidNetwork :: String -> SpecWith () +specInvalidNetwork networkTag = it ("invalid network " <> networkTag) $ do + (out, err) <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords defaultPhrase) + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "address", "payment", "--network-tag", networkTag ] + out `shouldBe` "" + err `shouldContain` "Invalid network tag." + +defaultPhrase :: [String] +defaultPhrase = + [ "art", "forum", "devote", "street", "sure" + , "rather", "head", "chuckle", "guard", "poverty" + , "release", "quote", "oak", "craft", "enemy" + ] diff --git a/test/Command/Address/PointerSpec.hs b/test/Command/Address/PointerSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Address/PointerSpec.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Address.PointerSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "address", "pointer" ] $ do + specShelley (1,2,3) defaultAddrMainnet + "addr1g9therz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qgpqgpsyefcgl" + + specShelley (1,2,3) defaultAddrTestnet + "addr_test1gptherz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qgpqgpsa3x7je" + + specShelley (24157,177,42) defaultAddrMainnet + "addr1g9therz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qvph3wczvf2sg4yzx" + + specShelley (24157,177,42) defaultAddrTestnet + "addr_test1gptherz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qvph3wczvf2lxgdw5" + + specMalformed ("💩","💩","💩") defaultAddrMainnet + + specMalformedAddress + "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + + specMalformedAddress + "DdzFFzCqrhsf6hiTYkK5gBAhVDwg3SiaHiEL9wZLYU3WqLUpx6DP\ + \5ZRJr4rtNRXbVNfk89FCHCDR365647os9AEJ8MKZNvG7UKTpythG" + + specInvalidAddress + "addr1qdu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5ewvxwdrt\ + \70qlcpeeagscasafhffqsxy36t90ldv06wqrk2q5ggg4z" + + +specShelley :: (Int, Int, Int) -> String -> String -> SpecWith () +specShelley (a,b,c) addr want = it ("golden shelley (pointer) " <> show (a,b,c)) $ do + out <- cli [ "address", "pointer", show a, show b, show c ] addr + out `shouldBe` want + +specMalformed :: (String, String, String) -> String -> SpecWith () +specMalformed (a,b,c) addr = it ("malformed pointer " <> unwords [a,b,c]) $ do + (out, err) <- cli [ "address", "pointer", a, b, c ] addr + out `shouldBe` "" + err `shouldContain` "cannot parse value" + err `shouldContain` "Usage" + +specMalformedAddress :: String -> SpecWith () +specMalformedAddress addr = it ("invalid address " <> addr) $ do + (out, err) <- cli [ "address", "pointer", "0", "0", "0" ] addr + out `shouldBe` "" + err `shouldContain` "Bech32 error" + +specInvalidAddress :: String -> SpecWith () +specInvalidAddress addr = it ("invalid address " <> addr) $ do + (out, err) <- cli [ "address", "pointer", "0", "0", "0" ] addr + out `shouldBe` "" + err `shouldContain` "Only payment addresses can be extended" + +defaultAddrMainnet :: String +defaultAddrMainnet = + "addr1v9therz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qgx2curq" + +defaultAddrTestnet :: String +defaultAddrTestnet = + "addr_test1vptherz8fgux9ywdysrcpaclznyyvl23l2zfcery3f4m9qgazvqv9" diff --git a/test/Command/Address/RewardSpec.hs b/test/Command/Address/RewardSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Address/RewardSpec.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Address.RewardSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "address", "stake" ] $ do + specShelley defaultPhrase "1852H/1815H/0H/2/0" 0 + "stake_test1ura3dk68y6echdmfmnvm8mej8u5truwv8ufmv830w5a45tcsfhtt2" + + specShelley defaultPhrase "1852H/1815H/0H/2/0" 3 + "stake1u0a3dk68y6echdmfmnvm8mej8u5truwv8ufmv830w5a45tchw5z0e" + + specShelleyFromKeyHash defaultPhrase "1852H/1815H/0H/2/0" 0 + "stake_test1ura3dk68y6echdmfmnvm8mej8u5truwv8ufmv830w5a45tcsfhtt2" + + specShelleyFromKeyHash defaultPhrase "1852H/1815H/0H/2/0" 3 + "stake1u0a3dk68y6echdmfmnvm8mej8u5truwv8ufmv830w5a45tchw5z0e" + + specMalformedNetwork "💩" + + specInvalidNetwork "42" + +specShelley :: [String] -> String -> Int -> String -> SpecWith () +specShelley phrase path networkTag want = it ("golden shelley (payment) " <> path) $ do + out <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "address", "stake", "--network-tag", show networkTag ] + out `shouldBe` want + +specShelleyFromKeyHash :: [String] -> String -> Int -> String -> SpecWith () +specShelleyFromKeyHash phrase path networkTag want = it ("golden shelley (payment) " <> path) $ do + out <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords phrase) + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "key", "hash" ] + >>= cli [ "address", "stake", "--network-tag", show networkTag ] + out `shouldBe` want + +specMalformedNetwork :: String -> SpecWith () +specMalformedNetwork networkTag = it ("malformed network " <> networkTag) $ do + (out, err) <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords defaultPhrase) + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "address", "stake", "--network-tag", networkTag ] + out `shouldBe` "" + err `shouldContain` "Invalid network tag" + err `shouldContain` "Usage" + +specInvalidNetwork :: String -> SpecWith () +specInvalidNetwork networkTag = it ("invalid network " <> networkTag) $ do + (out, err) <- cli [ "key", "from-recovery-phrase", "shelley" ] (unwords defaultPhrase) + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "address", "stake", "--network-tag", networkTag ] + out `shouldBe` "" + err `shouldContain` "Invalid network tag" + +defaultPhrase :: [String] +defaultPhrase = + [ "pole", "pulse", "wolf", "blame", "chronic" + , "ship", "vivid", "tree", "small", "onion" + , "host", "accident", "burden", "lazy", "swarm" + ] diff --git a/test/Command/Key/ChildSpec.hs b/test/Command/Key/ChildSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Key/ChildSpec.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Key.ChildSpec + ( spec + ) where + +import Prelude + +import Control.Monad + ( foldM ) +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain, shouldStartWith ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "key", "child" ] $ do + specChildValidPath "acct_xsk" ["1852H/1815H/0H"] + specChildValidPath "acct_shared_xsk" ["1854H/1815H/0H"] + specChildValidPath "addr_xsk" ["1852H/1815H/0H/0/0"] + specChildValidPath "addr_xsk" ["1852H/1815H/0H", "0/0"] + specChildValidPath "addr_shared_xsk" ["1854H/1815H/0H/0/0"] + specChildValidPath "addr_shared_xsk" ["1854H/1815H/0H", "0/0"] + specChildValidPath "addr_xsk" ["14H/42H"] + specChildValidPath "policy_xsk" ["1855H/1815H/0H"] + specChildValidPath "drep_xsk" ["1852H/1815H/0H/3/0"] + specChildValidPath "drep_xsk" ["1852H/1815H/0H", "3/0"] + specChildValidPath "drep_xsk" ["1852H/1815H/100H/3/0"] + specChildValidPath "cc_cold_xsk" ["1852H/1815H/0H/4/0"] + specChildValidPath "cc_cold_xsk" ["1852H/1815H/0H", "4/0"] + specChildValidPath "cc_cold_xsk" ["1852H/1815H/100H", "4/0"] + specChildValidPath "cc_hot_xsk" ["1852H/1815H/0H/5/0"] + specChildValidPath "cc_hot_xsk" ["1852H/1815H/101H/5/0"] + specChildValidPath "cc_hot_xsk" ["1852H/1815H/0H", "5/0"] + + specChildInvalidPath "from a parent root key" ["0H"] + specChildInvalidPath "from a parent account key" ["1852H/1815H/0H", "0H"] + + specPublicDerivationUsesSoft + + specGovernanceWrongPaths "1852H/1815H/0H/3/1" + specGovernanceWrongPaths "1857H/1815H/0H/3/1" + specGovernanceWrongPaths "1852H/1815H/0H/4/10" + specGovernanceWrongPaths "1858H/1815H/0H/4/10" + specGovernanceWrongPaths "1852H/1815H/1H/5/101" + specGovernanceWrongPaths "1859H/1815H/1H/5/101" + +specChildValidPath :: String -> [String] -> SpecWith () +specChildValidPath hrp paths = it ("Can derive given path(s) from root: " <> show paths) $ do + out <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", "shelley" ] + >>= flip (foldM (\stdin path -> cli ["key", "child", path] stdin)) paths + out `shouldStartWith` hrp + +specChildInvalidPath :: String -> [String] -> SpecWith () +specChildInvalidPath msg paths = it ("Cannot derive given path(s) from root: " <> show paths) $ do + (out, err) <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", "icarus" ] + >>= flip (foldM (\(stdin,_) path -> cli ["key", "child", path] stdin)) paths + out `shouldBe` "" + err `shouldContain` msg + +specPublicDerivationUsesSoft :: SpecWith () +specPublicDerivationUsesSoft = it "Public derivation requires soft indexes" $ do + (out, err) <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", "icarus" ] + >>= cli [ "key", "child", "1852H/1815H/0H" ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "key", "child", "14H/42H" ] + out `shouldBe` "" + err `shouldContain` + "Couldn't derive child key. If you're trying to derive children on a \ + \PUBLIC key, you must use soft indexes only." + +specGovernanceWrongPaths :: String -> SpecWith () +specGovernanceWrongPaths segments = it "Derivation requires addr_ix=0 and 1852H" $ do + out <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", "shelley" ] + >>= cli [ "key", "child", segments ] + out `shouldContain` "addr_xsk1" diff --git a/test/Command/Key/FromRecoveryPhraseSpec.hs b/test/Command/Key/FromRecoveryPhraseSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Key/FromRecoveryPhraseSpec.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Key.FromRecoveryPhraseSpec + ( spec + ) where + +import Prelude + +import System.IO.Temp + ( withSystemTempDirectory, writeTempFile ) +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "key", "from-recovery-phrase" ] $ do + specGolden "byron" defaultPhrase + "root_xsk1vzdkjk8txce80dwm5upjddrawv9l8mq2jyv6qqx2ylzu0yua8age295\ + \s38lj9gune65g07w95ttlt5qq3qh67nx4euvj2cut7z6pente84au2qmjqqy8w9x\ + \58z6f722j5twq860nhhmlq347wf0yp6wdkvq80h42" + + specGolden "icarus" defaultPhrase + "root_xsk1qz497hekfxq0ftrzjh7sl0m9vseep44mrnmk2dkzawczwy7ghfgd3yp\ + \maem5k7lcv782p4haa4kcwmdnks4776rkgrx9zn4h8am82dagca203x7fejp4x04\ + \ty47he9rztj2lp46fwyzz3ad2yszwadjfnv76n80u" + + specGolden "shelley" defaultPhrase + "root_xsk1qz497hekfxq0ftrzjh7sl0m9vseep44mrnmk2dkzawczwy7ghfgd3yp\ + \maem5k7lcv782p4haa4kcwmdnks4776rkgrx9zn4h8am82dagca203x7fejp4x04\ + \ty47he9rztj2lp46fwyzz3ad2yszwadjfnv76n80u" + + specGolden "shared" defaultPhrase + "root_shared_xsk1qz497hekfxq0ftrzjh7sl0m9vseep44mrnmk2dkzawczwy7gh\ + \fgd3ypmaem5k7lcv782p4haa4kcwmdnks4776rkgrx9zn4h8am82dagca203x7fej\ + \p4x04ty47he9rztj2lp46fwyzz3ad2yszwadjfnvuedzh4" + + specGoldenWithMnemonicPassphrase "shelley" defaultPhrase "from-mnemonic" + (unwords sndFactorPhrase) rootXPrvWithPassphrase + + specGoldenWithMnemonicPassphrase "shelley" defaultPhrase "from-hex" + sndFactorPhraseHex rootXPrvWithPassphrase + + specGoldenWithMnemonicPassphrase "shelley" defaultPhrase "from-base64" + sndFactorPhraseBase64 rootXPrvWithPassphrase + + specGoldenWithMnemonicPassphrase "shelley" defaultPhrase "from-octets" + sndFactorPhraseOctets rootXPrvWithPassphrase + + specGoldenWithMnemonicPassphrase "icarus" defaultPhrase "from-mnemonic" + (unwords sndFactorPhrase) rootXPrvWithPassphrase + + specGoldenWithMnemonicPassphrase "icarus" defaultPhrase "from-hex" + sndFactorPhraseHex rootXPrvWithPassphrase + + specGoldenWithMnemonicPassphrase "icarus" defaultPhrase "from-base64" + sndFactorPhraseBase64 rootXPrvWithPassphrase + + specGoldenWithMnemonicPassphrase "icarus" defaultPhrase "from-octets" + sndFactorPhraseOctets rootXPrvWithPassphrase + + specGoldenWithMnemonicPassphrase "shared" defaultPhrase "from-mnemonic" + (unwords sndFactorPhrase) rootXPrvSharedWithPassphrase + + specGoldenWithMnemonicPassphrase "shared" defaultPhrase "from-hex" + sndFactorPhraseHex rootXPrvSharedWithPassphrase + + specGoldenWithMnemonicPassphrase "shared" defaultPhrase "from-base64" + sndFactorPhraseBase64 rootXPrvSharedWithPassphrase + + specGoldenWithMnemonicPassphrase "shared" defaultPhrase "from-octets" + sndFactorPhraseOctets rootXPrvSharedWithPassphrase + + specInvalidStyle "patate" defaultPhrase + specInvalidStyle "💩" defaultPhrase + + specInvalidPhrase "shelley" invalidPhrase + +specGolden :: String -> [String] -> String -> SpecWith () +specGolden style phrase want = it ("golden " <> style) $ do + out <- cli [ "key", "from-recovery-phrase", style ] (unwords phrase) + out `shouldBe` want + +specInvalidStyle :: String -> [String] -> SpecWith () +specInvalidStyle style phrase = it ("invalid style " <> style) $ do + (out, err) <- cli [ "key", "from-recovery-phrase", style ] (unwords phrase) + out `shouldBe` "" + err `shouldContain` "Unknown style; expecting one of" + err `shouldContain` "Usage:" + +specInvalidPhrase :: String -> [String] -> SpecWith () +specInvalidPhrase style phrase = it ("invalid phrase " <> unwords phrase) $ do + (out, err) <- cli [ "key", "from-recovery-phrase", style ] (unwords phrase) + out `shouldBe` "" + err `shouldContain` "Found an unknown word not present in the pre-defined dictionary." + +specGoldenWithMnemonicPassphrase + :: String + -> [String] + -> String + -> String + -> String + -> SpecWith () +specGoldenWithMnemonicPassphrase style phrase method sndfactor want = + it ("golden " <> style <> " from-file "<> method) $ + withSystemTempDirectory "tmpdir" $ \dir -> do + filepath <- writeTempFile dir "passphrase" sndfactor + out <- cli [ "key", "from-recovery-phrase", style, "--passphrase" + , method, "--from-file", filepath] (unwords phrase) + out `shouldBe` want + +defaultPhrase :: [String] +defaultPhrase = + [ "message", "mask", "aunt", "wheel", "ten" + , "maze", "between", "tomato", "slow", "analyst" + , "ladder", "such", "report", "capital", "produce" + ] + +invalidPhrase :: [String] +invalidPhrase = + replicate 9 "¯\\_(ツ)_/¯" + +sndFactorPhrase :: [String] +sndFactorPhrase = + [ "test", "child", "burst", "immense", "armed" + , "parrot", "company", "walk", "dog" + ] + +--λ> let (Right m9) = mkSomeMnemonic @'[ 9, 12, 15 ] [ "test", "child", "burst", "immense", "armed", "parrot", "company", "walk", "dog" ] +--Right (SomeMnemonic (Mnemonic {mnemonicToEntropy = Entropy {entropyRaw = "\223\132\252{8\192\189@\203\167\180@", entropyChecksum = Checksum 4}, mnemonicToSentence = MnemonicSentence {mnemonicSentenceToListN = [WordIndex {unWordIndex = Offset 1788},WordIndex {unWordIndex = Offset 319},WordIndex {unWordIndex = Offset 246},WordIndex {unWordIndex = Offset 908},WordIndex {unWordIndex = Offset 94},WordIndex {unWordIndex = Offset 1283},WordIndex {unWordIndex = Offset 372},WordIndex {unWordIndex = Offset 1972},WordIndex {unWordIndex = Offset 516}]}})) +--λ> import qualified Data.ByteString as BS +--λ> import qualified Data.ByteArray as BA +--λ> let bytes = BA.convert $ someMnemonicToBytes m9 :: BS.ByteString +--λ> bytes +--"\223\132\252{8\192\189@\203\167\180@" +--λ> encode EBase16 bytes +--"df84fc7b38c0bd40cba7b440" +--λ> import qualified Data.Text.Encoding as T +--λ> import qualified Data.ByteArray.Encoding as BA +--λ> T.decodeUtf8 $ BA.convertToBase BA.Base64 bytes +--"34T8ezjAvUDLp7RA" +--λ> BS.unpack bytes +-- [223,132,252,123,56,192,189,64,203,167,180,64] + +sndFactorPhraseHex :: String +sndFactorPhraseHex = "df84fc7b38c0bd40cba7b440" + +sndFactorPhraseBase64 :: String +sndFactorPhraseBase64 = "34T8ezjAvUDLp7RA" + +sndFactorPhraseOctets :: String +sndFactorPhraseOctets = "[223,132,252,123,56,192,189,64,203,167,180,64]" + +rootXPrvWithPassphrase :: String +rootXPrvWithPassphrase = + "root_xsk1xpk2wzz7xsyhfxxvwraxnq2sps45ygfayrmn8kxjep4gl9jxgfg3tffp7z7w7ltd0\ + \gw32wqhyk5c296u7m28l688n8n6v24hrp326kgzz6cgvkvvj2k0t34jkv6ze0d8vxxnavar4tz\ + \gl96th9qhfayllsl4qsqq" + +rootXPrvSharedWithPassphrase :: String +rootXPrvSharedWithPassphrase = + "root_shared_xsk1xpk2wzz7xsyhfxxvwraxnq2sps45ygfayrmn8kxjep4gl9jxgfg3tffp7z\ + \7w7ltd0gw32wqhyk5c296u7m28l688n8n6v24hrp326kgzz6cgvkvvj2k0t34jkv6ze0d8vxxn\ + \avar4tzgl96th9qhfayllsak74cf" diff --git a/test/Command/Key/HashSpec.hs b/test/Command/Key/HashSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Key/HashSpec.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Key.HashSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain, shouldStartWith ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "key", "hash" ] $ do + specKeyNotPublic + specKeyPublic "icarus" "addr_vkh" "1852H/1815H/0H/0/0" "--without-chain-code" + specKeyPublic "icarus" "addr_vkh" "1852H/1815H/0H/1/0" "--without-chain-code" + specKeyPublic "icarus" "stake_vkh" "1852H/1815H/0H/2/0" "--without-chain-code" + specKeyPublic "shared" "addr_shared_vkh" "1854H/1815H/0H/0/0" "--without-chain-code" + specKeyPublic "shared" "stake_shared_vkh" "1854H/1815H/0H/2/0" "--without-chain-code" + + specKeyPublic "icarus" "addr_vkh" "1852H/1815H/0H/0/0" "--with-chain-code" + specKeyPublic "icarus" "addr_vkh" "1852H/1815H/0H/1/0" "--with-chain-code" + specKeyPublic "icarus" "stake_vkh" "1852H/1815H/0H/2/0" "--with-chain-code" + specKeyPublic "shared" "addr_shared_vkh" "1854H/1815H/0H/0/0" "--with-chain-code" + specKeyPublic "shared" "stake_shared_vkh" "1854H/1815H/0H/2/0" "--with-chain-code" + + specKeyPublic "shelley" "policy_vkh" "1855H/1815H/0H" "--with-chain-code" + specKeyPublic "shelley" "policy_vkh" "1855H/1815H/0H" "--without-chain-code" + + specKeyPublic "shelley" "drep_vkh" "1852H/1815H/0H/3/0" "--with-chain-code" + specKeyPublic "shelley" "drep_vkh" "1852H/1815H/0H/3/0" "--without-chain-code" + specKeyPublic "shelley" "cc_cold_vkh" "1852H/1815H/0H/4/0" "--with-chain-code" + specKeyPublic "shelley" "cc_cold_vkh" "1852H/1815H/0H/4/0" "--without-chain-code" + specKeyPublic "shelley" "cc_hot_vkh" "1852H/1815H/0H/5/0" "--with-chain-code" + specKeyPublic "shelley" "cc_hot_vkh" "1852H/1815H/0H/5/0" "--without-chain-code" + + specKeyPublicCred "shelley" "drep1" "1852H/1815H/0H/3/0" "--with-chain-code" + specKeyPublicCred "shelley" "drep1" "1852H/1815H/0H/3/0" "--without-chain-code" + specKeyPublicCred "shelley" "cc_cold1" "1852H/1815H/0H/4/0" "--with-chain-code" + specKeyPublicCred "shelley" "cc_cold1" "1852H/1815H/0H/4/0" "--without-chain-code" + specKeyPublicCred "shelley" "cc_hot1" "1852H/1815H/0H/5/0" "--with-chain-code" + specKeyPublicCred "shelley" "cc_hot1" "1852H/1815H/0H/5/0" "--without-chain-code" + +specKeyNotPublic :: SpecWith () +specKeyNotPublic = it "fail if key isn't public" $ do + (out, err) <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", "icarus" ] + >>= cli [ "key", "hash" ] + + out `shouldBe` "" + err `shouldContain` "Invalid human-readable prefix." + +specKeyPublic :: String -> String -> String -> String -> SpecWith () +specKeyPublic style hrp path cc = it "succeeds if key is public" $ do + out <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", style ] + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", cc ] + >>= cli [ "key", "hash", "--cip-0105" ] + out `shouldStartWith` hrp + +specKeyPublicCred :: String -> String -> String -> String -> SpecWith () +specKeyPublicCred style hrp path cc = it "succeeds if key is public" $ do + out <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", style ] + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", cc ] + >>= cli [ "key", "hash" ] + out `shouldStartWith` hrp diff --git a/test/Command/Key/InspectSpec.hs b/test/Command/Key/InspectSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Key/InspectSpec.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Key.InspectSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Derivation + ( xprvChainCode + , xprvPrivateKey + , xprvToBytes + , xpubChainCode + , xpubPublicKey + , xpubToBytes + ) +import Codec.Binary.Bech32 + ( HumanReadablePart ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode ) +import Data.ByteString + ( ByteString ) +import Test.Hspec + ( Spec, SpecWith, it, shouldContain ) +import Test.QuickCheck + ( arbitrary, generate ) +import Test.Utils + ( cli, describeCmd ) + +import Test.Arbitrary + () + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +spec :: Spec +spec = describeCmd [ "key", "inspect" ] $ do + specInspectPrivate CIP5.root_xsk + specInspectPrivate CIP5.acct_xsk + specInspectPrivate CIP5.addr_xsk + specInspectPrivate CIP5.stake_xsk + specInspectPrivate CIP5.root_shared_xsk + specInspectPrivate CIP5.acct_shared_xsk + specInspectPrivate CIP5.addr_shared_xsk + specInspectPrivate CIP5.stake_shared_xsk + specInspectPrivate CIP5.policy_xsk + specInspectPrivate CIP5.drep_xsk + specInspectPrivate CIP5.cc_cold_xsk + specInspectPrivate CIP5.cc_hot_xsk + + specInspectPublic CIP5.root_xvk + specInspectPublic CIP5.acct_xvk + specInspectPublic CIP5.addr_xvk + specInspectPublic CIP5.stake_xvk + specInspectPublic CIP5.policy_xvk + specInspectPublic CIP5.root_shared_xvk + specInspectPublic CIP5.acct_shared_xvk + specInspectPublic CIP5.addr_shared_xvk + specInspectPublic CIP5.stake_shared_xvk + specInspectPublic CIP5.drep_xvk + specInspectPublic CIP5.cc_cold_xvk + specInspectPublic CIP5.cc_hot_xvk + +specInspectPrivate :: HumanReadablePart -> SpecWith () +specInspectPrivate hrp = it "can inspect private key" $ do + xprv <- generate arbitrary + let cc = base16 $ xprvChainCode xprv + let prv = base16 $ xprvPrivateKey xprv + out <- cli [ "key", "inspect" ] (bech32 hrp $ xprvToBytes xprv) + out `shouldContain` "private" + out `shouldContain` cc + out `shouldContain` prv + +specInspectPublic :: HumanReadablePart -> SpecWith () +specInspectPublic hrp = it "can inspect public key" $ do + xpub <- generate arbitrary + let cc = base16 $ xpubChainCode xpub + let pub = base16 $ xpubPublicKey xpub + out <- cli [ "key", "inspect" ] (bech32 hrp $ xpubToBytes xpub) + out `shouldContain` "public" + out `shouldContain` cc + out `shouldContain` pub + +base16 :: ByteString -> String +base16 = T.unpack . T.decodeUtf8 . encode EBase16 + +bech32 :: HumanReadablePart -> ByteString -> String +bech32 hrp = T.unpack . T.decodeUtf8 . encode (EBech32 hrp) diff --git a/test/Command/Key/PrivateSpec.hs b/test/Command/Key/PrivateSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Key/PrivateSpec.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Key.PrivateSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain, shouldStartWith ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "key", "private" ] $ do + specKeyNotPrivate + + specKeyPrivate "icarus" "acct_sk" "1852H/1815H/0H" "--signing-key" + specKeyPrivate "icarus" "addr_sk" "1852H/1815H/0H/0/0" "--signing-key" + + specKeyPrivate "shelley" "acct_sk" "1852H/1815H/0H" "--signing-key" + specKeyPrivate "shelley" "addr_sk" "1852H/1815H/0H/0/0" "--signing-key" + specKeyPrivate "shelley" "stake_sk" "1852H/1815H/0H/2/0" "--signing-key" + specKeyPrivate "shelley" "policy_sk" "1855H/1815H/0H" "--signing-key" + + specKeyPrivate "shared" "acct_shared_sk" "1854H/1815H/0H" "--signing-key" + specKeyPrivate "shared" "addr_shared_sk" "1854H/1815H/0H/0/0" "--signing-key" + specKeyPrivate "shared" "stake_shared_sk" "1854H/1815H/0H/2/0" "--signing-key" + + specKeyPrivate "shelley" "drep_sk" "1852H/1815H/0H/3/0" "--signing-key" + specKeyPrivate "shelley" "cc_cold_sk" "1852H/1815H/0H/4/0" "--signing-key" + specKeyPrivate "shelley" "cc_hot_sk" "1852H/1815H/0H/5/0" "--signing-key" + +specKeyNotPrivate :: SpecWith () +specKeyNotPrivate = it "fail if key isn't private" $ do + (out, err) <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", "icarus" ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "key", "private", "--chain-code" ] + + out `shouldBe` "" + err `shouldContain` "Invalid human-readable prefix." + +specKeyPrivate :: String -> String -> String -> String -> SpecWith () +specKeyPrivate style hrp path cc = it "succeeds if key is private" $ do + out <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", style ] + >>= cli [ "key", "child", path ] + >>= cli [ "key", "private", cc ] + out `shouldStartWith` hrp diff --git a/test/Command/Key/PublicSpec.hs b/test/Command/Key/PublicSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Key/PublicSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.Key.PublicSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "key", "public" ] $ do + specKeyNotPrivate + +specKeyNotPrivate :: SpecWith () +specKeyNotPrivate = it "fail if key isn't private" $ do + (out, err) <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", "icarus" ] + >>= cli [ "key", "public", "--with-chain-code" ] + >>= cli [ "key", "public", "--with-chain-code" ] + + out `shouldBe` "" + err `shouldContain` "Invalid human-readable prefix." diff --git a/test/Command/Key/WalletIdSpec.hs b/test/Command/Key/WalletIdSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Key/WalletIdSpec.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} + +module Command.Key.WalletIdSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [ "key", "walletid" ] $ do + specKeyNeitherRootNorAcct "shelley" "1852H/1815H/0H/0/0" "--without-chain-code" + specKeyNeitherRootNorAcct "shelley" "1852H/1815H/0H/0/0" "--with-chain-code" + specKeyNeitherRootNorAcct "shelley" "1852H/1815H/0H/1/0" "--without-chain-code" + specKeyNeitherRootNorAcct "shelley" "1852H/1815H/0H/1/0" "--with-chain-code" + specKeyNeitherRootNorAcct "shelley" "1852H/1815H/0H/2/0" "--without-chain-code" + specKeyNeitherRootNorAcct "shelley" "1852H/1815H/0H/2/0" "--with-chain-code" + + specKeyNeitherRootNorAcct "icarus" "1852H/1815H/0H/0/0" "--without-chain-code" + specKeyNeitherRootNorAcct "icarus" "1852H/1815H/0H/0/0" "--with-chain-code" + specKeyNeitherRootNorAcct "icarus" "1852H/1815H/0H/1/0" "--without-chain-code" + specKeyNeitherRootNorAcct "icarus" "1852H/1815H/0H/1/0" "--with-chain-code" + specKeyNeitherRootNorAcct "icarus" "1852H/1815H/0H/2/0" "--without-chain-code" + specKeyNeitherRootNorAcct "icarus" "1852H/1815H/0H/2/0" "--with-chain-code" + + specKeyNeitherRootNorAcct "shared" "1854H/1815H/0H/0/0" "--without-chain-code" + specKeyNeitherRootNorAcct "shared" "1854H/1815H/0H/0/0" "--with-chain-code" + specKeyNeitherRootNorAcct "shared" "1854H/1815H/0H/1/0" "--without-chain-code" + specKeyNeitherRootNorAcct "shared" "1854H/1815H/0H/1/0" "--with-chain-code" + specKeyNeitherRootNorAcct "shared" "1854H/1815H/0H/2/0" "--without-chain-code" + specKeyNeitherRootNorAcct "shared" "1854H/1815H/0H/2/0" "--with-chain-code" + + specAcctKeyNotExtended "shelley" "1852H/1815H/0H" + specAcctKeyNotExtended "icarus" "1852H/1815H/0H" + specAcctKeyNotExtended "shared" "1854H/1815H/0H" + + specRootKeyNotExtended "shelley" + specRootKeyNotExtended "icarus" + specRootKeyNotExtended "shared" + + specRootKeyPubPrvHasEqualWalletId "shelley" + specRootKeyPubPrvHasEqualWalletId "icarus" + + specAcctKeyPubPrvHasEqualWalletId "shelley" "1852H/1815H/0H" Nothing Nothing + specAcctKeyPubPrvHasEqualWalletId "icarus" "1852H/1815H/0H" Nothing Nothing + specAcctKeyPubPrvHasEqualWalletId "shared" "1854H/1815H/0H" (Just "cosigner#0") Nothing + specAcctKeyPubPrvHasEqualWalletId "shared" "1854H/1815H/1H" (Just "cosigner#0") Nothing + specAcctKeyPubPrvHasEqualWalletId "shared" "1854H/1815H/10H" (Just "cosigner#0") Nothing + specAcctKeyPubPrvHasEqualWalletId "shared" "1854H/1815H/0H" (Just "cosigner#0") (Just "cosigner#0") + specAcctKeyPubPrvHasEqualWalletId "shared" "1854H/1815H/0H" (Just "cosigner#0") (Just "cosigner#0") + specAcctKeyPubPrvHasEqualWalletId "shared" "1854H/1815H/0H" (Just "all [cosigner#0,cosigner#1]") (Just "cosigner#0") + specAcctKeyPubPrvHasEqualWalletId "shared" "1854H/1815H/0H" (Just "cosigner#0") (Just "any [cosigner#1, active_until 1000]") + + +specKeyNeitherRootNorAcct :: String -> String -> String -> SpecWith () +specKeyNeitherRootNorAcct style path cc = it "fails if key is nether root nor account" $ do + (out, err) <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", style ] + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", cc ] + >>= cli [ "key", "walletid"] + out `shouldBe` "" + err `shouldContain` "Invalid human-readable prefix." + +specAcctKeyNotExtended :: String -> String -> SpecWith () +specAcctKeyNotExtended style path = it "fails if account key is not extended" $ do + (out, err) <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", style ] + >>= cli [ "key", "child", path ] + >>= cli [ "key", "public", "--without-chain-code" ] + >>= cli [ "key", "walletid"] + out `shouldBe` "" + err `shouldContain` "Invalid human-readable prefix." + +specRootKeyNotExtended :: String -> SpecWith () +specRootKeyNotExtended style = it "fails if root key is not extended" $ do + (out, err) <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", style ] + >>= cli [ "key", "public", "--without-chain-code" ] + >>= cli [ "key", "walletid"] + out `shouldBe` "" + err `shouldContain` "Invalid human-readable prefix." + +specRootKeyPubPrvHasEqualWalletId :: String -> SpecWith () +specRootKeyPubPrvHasEqualWalletId style = it "root private key and its public key give the same wallet id" $ do + xprv <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", style ] + + walletidFromXPrv <- cli @String [ "key", "walletid"] xprv + walletidFromXPub <- cli [ "key", "public", "--with-chain-code" ] xprv + >>= cli [ "key", "walletid"] + + walletidFromXPrv `shouldBe` walletidFromXPub + +specAcctKeyPubPrvHasEqualWalletId + :: String + -> String + -> Maybe String + -> Maybe String + -> SpecWith () +specAcctKeyPubPrvHasEqualWalletId style path spendingScriptM stakingScriptM = + it "root private key and its public key give the same wallet id" $ do + xprv <- cli [ "recovery-phrase", "generate" ] "" + >>= cli [ "key", "from-recovery-phrase", style ] + >>= cli [ "key", "child", path ] + + let spendingArg = + case spendingScriptM of + Nothing -> [] + Just spendingScript -> ["--spending", spendingScript] + let stakingArg = + case stakingScriptM of + Nothing -> [] + Just stakingScript -> ["--staking", stakingScript] + + walletidFromXPrv <- cli @String ([ "key", "walletid"] ++ spendingArg ++ stakingArg) xprv + walletidFromXPub <- cli [ "key", "public", "--with-chain-code" ] xprv + >>= cli ([ "key", "walletid"] ++ spendingArg ++ stakingArg) + + walletidFromXPrv `shouldBe` walletidFromXPub diff --git a/test/Command/KeySpec.hs b/test/Command/KeySpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/KeySpec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.KeySpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Derivation + ( XPrv, xprvToBytes ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), encode ) +import Data.List + ( isInfixOf ) +import Options.Applicative.Derivation + ( DerivationIndex, derivationIndexToString, firstHardened ) +import Test.Hspec + ( Spec ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Property, counterexample, label ) +import Test.QuickCheck.Monadic + ( assert, monadicIO, monitor, run ) +import Test.Utils + ( cli, describeCmd ) + +import Test.Arbitrary + () + +import qualified Cardano.Codec.Bech32.Prefixes as CIP5 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +spec :: Spec +spec = describeCmd ["key"] $ do + prop "public/child commute" prop_publicKeyDerivation + +-- | For soft indices, public key derivation should be "equivalent" to private +-- key derivation. +-- +-- I.e. The following diagram should commute: +-- +-- @ +-- key public +-- +-- xprv +-----------------> xpub +-- + + +-- | | +-- | | +-- key child | | key child +-- | | +-- | | +-- v v +-- xprv' +-----------------> xpub' +-- +-- key public +-- @ +prop_publicKeyDerivation + :: DerivationIndex + -> XPrv + -> Property +prop_publicKeyDerivation ix xprv = do + if ix < firstHardened then monadicIO $ do + monitor (label "Soft Index") + out1 <- run (public bytes >>= child) + out2 <- run (child bytes >>= public) + monitor (counterexample ("stdout: " <> out1)) + monitor (counterexample ("stdout: " <> out2)) + assert (out1 == out2) + else monadicIO $ do + monitor (label "Hard Index") + (out, err) <- run (public bytes >>= cli ["key", "child", "0/" <> derivationIndexToString ix ]) + monitor (counterexample ("stdout: " <> out)) + monitor (counterexample ("stderr: " <> err)) + assert (out == "") + assert ("you must use soft indexes only" `isInfixOf` err) + where + bytes = T.unpack $ T.decodeUtf8 $ encode (EBech32 CIP5.acct_xsk) $ xprvToBytes xprv + public = cli [ "key", "public", "--with-chain-code" ] + child = cli [ "key", "child", "0/" <> derivationIndexToString ix ] diff --git a/test/Command/RecoveryPhrase/GenerateSpec.hs b/test/Command/RecoveryPhrase/GenerateSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/RecoveryPhrase/GenerateSpec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.RecoveryPhrase.GenerateSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd ["recovery-phrase", "generate"] $ do + specDefaultSize + mapM_ specSpecificSize [9,12,15,18,21,24] + mapM_ specInvalidSize ["15.5","3","6","14","abc","👌","0","~!@#%","-1000","1000"] + +specDefaultSize :: SpecWith () +specDefaultSize = it "ø; default size" $ do + out <- cli ["recovery-phrase", "generate"] mempty + length (words out) `shouldBe` 24 + +specSpecificSize :: Int -> SpecWith () +specSpecificSize n = it ("--size=" <> show n <> "; valid size") $ do + out <- cli ["recovery-phrase", "generate", "--size", show n] "" + length (words out) `shouldBe` n + +specInvalidSize :: String -> SpecWith () +specInvalidSize x = it ("--size=" <> x <> "; invalid size") $ do + (out, err) <- cli ["recovery-phrase", "generate", "--size", x] "" + out `shouldBe` "" + err `shouldContain` "Invalid mnemonic size. Expected one of: 9, 12, 15, 18, 21, 24." diff --git a/test/Command/RecoveryPhraseSpec.hs b/test/Command/RecoveryPhraseSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/RecoveryPhraseSpec.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Command.RecoveryPhraseSpec + ( spec + ) where + +import Prelude + +import Test.Hspec + ( Spec, it ) +import Test.Utils + ( describeCmd ) + +spec :: Spec +spec = describeCmd ["recovery-phrase"] $ do + it "N/A" (pure () :: IO ()) diff --git a/test/Command/Script/HashSpec.hs b/test/Command/Script/HashSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Script/HashSpec.hs @@ -0,0 +1,489 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} + +module Command.Script.HashSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Script + ( ErrValidateScript (..), prettyErrValidateScript ) +import Data.String.Interpolate + ( iii ) +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = do + describeCmd [ "script", "hash" ] $ do + specScriptHashProper "script1ugvvxx2vrajnx7q4y8a3mtjgrms8a3c85zz5hjvwa2gpqpkhpzq" + [iii|all [ #{verKeyH1} ]|] + + specScriptHashProper "script1ugvvxx2vrajnx7q4y8a3mtjgrms8a3c85zz5hjvwa2gpqpkhpzq" + ("all [ " <>verKeyH1<>" ] ") + + specScriptHashProper "script1s7uwytqrwv63wp8e8cu7jz7j0nmqfcw3lmeh8u8dujmkvafpkpf" + [iii|all [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptHashProper "script1tgp32rg8358hae5senu7degf4cdp3cvul5ylq5sy76nkxvlm48l" + [iii|any [ #{verKeyH1} ]|] + + specScriptHashProper "script1wnsgkncprsznm9smhc6x9h2gms3dn7kyx5g549hjueussc5twaa" + [iii|any [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptHashProper "script1vw9etsd8d52dndc4aqkgpp23pmj2j9u29dayed494dyngpc9rsv" + [iii|at_least 1 [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptHashProper "script1hwv9dxq42uqy34las3gvhxg3s45n8vtzn74wjq6ungpp7xg86mh" + [iii|at_least 1 [ #{verKeyH1}, all [ #{verKeyH2}, #{verKeyH3} ] ]|] + + specScriptHashProper "script1w8469gq5ed7xtyf2tqdng5yn7ykgckkfcl38xre8hk3ejk2lcwt" + [iii|#{verKeyH4}|] + + specScriptHashProper "drep1ywxlnmh29f0jdv0uj2m5gtqgvgf0e5mtyajy0p2jf55tppszrkgvs" + [iii|all [ #{verKeyH5} ]|] + + specScriptHashWithoutByteProper "drep_script13hu7a632tuntrlyjkazzczrzzt7dx6e8v3rc25jd9zcgv68nx9r" + [iii|all [ #{verKeyH5} ]|] + + specScriptHashProper "drep1ywxlnmh29f0jdv0uj2m5gtqgvgf0e5mtyajy0p2jf55tppszrkgvs" + [iii|all [ #{verKey5} ]|] + + specScriptHashWithoutByteProper "drep_script13hu7a632tuntrlyjkazzczrzzt7dx6e8v3rc25jd9zcgv68nx9r" + [iii|all [ #{verKey5} ]|] + + specScriptHashProper "drep1ywxlnmh29f0jdv0uj2m5gtqgvgf0e5mtyajy0p2jf55tppszrkgvs" + [iii|all [ #{xVerKey5} ]|] + + specScriptHashWithoutByteProper "drep_script13hu7a632tuntrlyjkazzczrzzt7dx6e8v3rc25jd9zcgv68nx9r" + [iii|all [ #{xVerKey5} ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-1-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1y0gx2ufxm0cvzdd8yfxerjsx3adlw6d0d503mu9uu5tsa3gtkvwpe" + [iii|all [ #{verKeyH5}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-1-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1y0gx2ufxm0cvzdd8yfxerjsx3adlw6d0d503mu9uu5tsa3gtkvwpe" + [iii|all [ #{verKeyH5Depr}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-1-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1y0gx2ufxm0cvzdd8yfxerjsx3adlw6d0d503mu9uu5tsa3gtkvwpe" + [iii|all [ #{verKeyH5Cred}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-1-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script16pjhzfkm7rqntfezfkgu5p50t0mkntmdruwlp089zu8v29l95rg" + [iii|all [ #{verKeyH5}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-1-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script16pjhzfkm7rqntfezfkgu5p50t0mkntmdruwlp089zu8v29l95rg" + [iii|all [ #{verKeyH5Depr}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-1-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script16pjhzfkm7rqntfezfkgu5p50t0mkntmdruwlp089zu8v29l95rg" + [iii|all [ #{verKeyH5Cred}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-1-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1y0gx2ufxm0cvzdd8yfxerjsx3adlw6d0d503mu9uu5tsa3gtkvwpe" + [iii|all [ #{verKey5}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-1-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script16pjhzfkm7rqntfezfkgu5p50t0mkntmdruwlp089zu8v29l95rg" + [iii|all [ #{verKey5}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-1-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1y0gx2ufxm0cvzdd8yfxerjsx3adlw6d0d503mu9uu5tsa3gtkvwpe" + [iii|all [ #{xVerKey5}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-1-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script16pjhzfkm7rqntfezfkgu5p50t0mkntmdruwlp089zu8v29l95rg" + [iii|all [ #{xVerKey5}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-2-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1ywh94nc9zyj46erusje3sj3d2g4ltak9ka4e386fh5urhhga37qxs" + [iii|any [ #{verKeyH5}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-2-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1ywh94nc9zyj46erusje3sj3d2g4ltak9ka4e386fh5urhhga37qxs" + [iii|any [ #{verKeyH5Depr}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-2-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1ywh94nc9zyj46erusje3sj3d2g4ltak9ka4e386fh5urhhga37qxs" + [iii|any [ #{verKeyH5Cred}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-2-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script14edv7pg3y4wkglyykvvy5t2j906ld3dhdwvf7jda8qaa63d5kf4" + [iii|any [ #{verKeyH5}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-2-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script14edv7pg3y4wkglyykvvy5t2j906ld3dhdwvf7jda8qaa63d5kf4" + [iii|any [ #{verKeyH5Depr}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-2-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script14edv7pg3y4wkglyykvvy5t2j906ld3dhdwvf7jda8qaa63d5kf4" + [iii|any [ #{verKeyH5Cred}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-2-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1ywh94nc9zyj46erusje3sj3d2g4ltak9ka4e386fh5urhhga37qxs" + [iii|any [ #{verKey5}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-2-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script14edv7pg3y4wkglyykvvy5t2j906ld3dhdwvf7jda8qaa63d5kf4" + [iii|any [ #{verKey5}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-script-2-hash-appended-with-23-hex-encoded-byte-drep-script-hash-credential + specScriptHashProper "drep1ywh94nc9zyj46erusje3sj3d2g4ltak9ka4e386fh5urhhga37qxs" + [iii|any [ #{xVerKey5}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#script-2-hash-drep-script-hash + specScriptHashWithoutByteProper "drep_script14edv7pg3y4wkglyykvvy5t2j906ld3dhdwvf7jda8qaa63d5kf4" + [iii|any [ #{xVerKey5}, all [ active_from 5001, active_until 6001]]|] + + specScriptHashProper "cc_cold1z0ty5s85w82gqy9599yltjnca6nas83xjjaw66nqv3j2j4cxpgzfw" + [iii|all [ #{verKeyH6} ]|] + + specScriptHashWithoutByteProper "cc_cold_script16e9ypar36jqppdpff86u578w5lvpuf55htkk5cryvj54wd8s4jn" + [iii|all [ #{verKeyH6} ]|] + + specScriptHashProper "cc_cold1z0ty5s85w82gqy9599yltjnca6nas83xjjaw66nqv3j2j4cxpgzfw" + [iii|all [ #{verKey6} ]|] + + specScriptHashWithoutByteProper "cc_cold_script16e9ypar36jqppdpff86u578w5lvpuf55htkk5cryvj54wd8s4jn" + [iii|all [ #{verKey6} ]|] + + specScriptHashProper "cc_cold1z0ty5s85w82gqy9599yltjnca6nas83xjjaw66nqv3j2j4cxpgzfw" + [iii|all [ #{xVerKey6} ]|] + + specScriptHashWithoutByteProper "cc_cold_script16e9ypar36jqppdpff86u578w5lvpuf55htkk5cryvj54wd8s4jn" + [iii|all [ #{xVerKey6} ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-1-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zwhx723824x4u6t3aulfx0j0p0n767htvrm0j00ms8xku8q30p2xd" + [iii|all [ #{verKeyH6}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-1-hash + specScriptHashWithoutByteProper "cc_cold_script14ehj5f64f40xju0086fnunctulkh46mq7munm7upe4hpcwpcatv" + [iii|all [ #{verKeyH6}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-1-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zwhx723824x4u6t3aulfx0j0p0n767htvrm0j00ms8xku8q30p2xd" + [iii|all [ #{verKeyH6Depr}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-1-hash + specScriptHashWithoutByteProper "cc_cold_script14ehj5f64f40xju0086fnunctulkh46mq7munm7upe4hpcwpcatv" + [iii|all [ #{verKeyH6Depr}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-1-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zwhx723824x4u6t3aulfx0j0p0n767htvrm0j00ms8xku8q30p2xd" + [iii|all [ #{verKeyH6Cred}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-1-hash + specScriptHashWithoutByteProper "cc_cold_script14ehj5f64f40xju0086fnunctulkh46mq7munm7upe4hpcwpcatv" + [iii|all [ #{verKeyH6Cred}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-1-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zwhx723824x4u6t3aulfx0j0p0n767htvrm0j00ms8xku8q30p2xd" + [iii|all [ #{verKey6}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-1-hash + specScriptHashWithoutByteProper "cc_cold_script14ehj5f64f40xju0086fnunctulkh46mq7munm7upe4hpcwpcatv" + [iii|all [ #{verKey6}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-1-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zwhx723824x4u6t3aulfx0j0p0n767htvrm0j00ms8xku8q30p2xd" + [iii|all [ #{xVerKey6}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-1-hash + specScriptHashWithoutByteProper "cc_cold_script14ehj5f64f40xju0086fnunctulkh46mq7munm7upe4hpcwpcatv" + [iii|all [ #{xVerKey6}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-2-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zvgecgxwelklmws9w2f0w6a3zzh6826897wrt2za4ayjx9swtgkr6" + [iii|any [ #{verKeyH6}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-2-hash + specScriptHashWithoutByteProper "cc_cold_script1zxwzpnk0ah7m5ptjjtmkhvgs4736k3e0ns66shd0fy33vdauq3j" + [iii|any [ #{verKeyH6}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-2-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zvgecgxwelklmws9w2f0w6a3zzh6826897wrt2za4ayjx9swtgkr6" + [iii|any [ #{verKeyH6Depr}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-2-hash + specScriptHashWithoutByteProper "cc_cold_script1zxwzpnk0ah7m5ptjjtmkhvgs4736k3e0ns66shd0fy33vdauq3j" + [iii|any [ #{verKeyH6Depr}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-2-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zvgecgxwelklmws9w2f0w6a3zzh6826897wrt2za4ayjx9swtgkr6" + [iii|any [ #{verKeyH6Cred}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-2-hash + specScriptHashWithoutByteProper "cc_cold_script1zxwzpnk0ah7m5ptjjtmkhvgs4736k3e0ns66shd0fy33vdauq3j" + [iii|any [ #{verKeyH6Cred}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-2-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zvgecgxwelklmws9w2f0w6a3zzh6826897wrt2za4ayjx9swtgkr6" + [iii|any [ #{verKey6}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-2-hash + specScriptHashWithoutByteProper "cc_cold_script1zxwzpnk0ah7m5ptjjtmkhvgs4736k3e0ns66shd0fy33vdauq3j" + [iii|any [ #{verKey6}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-cold-script-2-hash-appended-with-13-hex-encoded-byte-constitutional-committee-cold-script-hash-credential + specScriptHashProper "cc_cold1zvgecgxwelklmws9w2f0w6a3zzh6826897wrt2za4ayjx9swtgkr6" + [iii|any [ #{xVerKey6}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-script-2-hash + specScriptHashWithoutByteProper "cc_cold_script1zxwzpnk0ah7m5ptjjtmkhvgs4736k3e0ns66shd0fy33vdauq3j" + [iii|any [ #{xVerKey6}, all [ active_from 5001, active_until 6001]]|] + + specScriptHashProper "cc_hot1qday89cxvm00rceu70zsny95n485l50rh3pxy8k8m7yrwdgrehyfq" + [iii|all [ #{verKeyH7} ]|] + + specScriptHashWithoutByteProper "cc_hot_script10fpewpnxmmc7x08nc5yepdyafa8arcaugf3pa37l3qmn2xu0u3c" + [iii|all [ #{verKeyH7} ]|] + + specScriptHashProper "cc_hot1qday89cxvm00rceu70zsny95n485l50rh3pxy8k8m7yrwdgrehyfq" + [iii|all [ #{verKeyH7Depr} ]|] + + specScriptHashWithoutByteProper "cc_hot_script10fpewpnxmmc7x08nc5yepdyafa8arcaugf3pa37l3qmn2xu0u3c" + [iii|all [ #{verKeyH7Depr} ]|] + + specScriptHashProper "cc_hot1qday89cxvm00rceu70zsny95n485l50rh3pxy8k8m7yrwdgrehyfq" + [iii|all [ #{verKeyH7Cred} ]|] + + specScriptHashWithoutByteProper "cc_hot_script10fpewpnxmmc7x08nc5yepdyafa8arcaugf3pa37l3qmn2xu0u3c" + [iii|all [ #{verKeyH7Cred} ]|] + + specScriptHashProper "cc_hot1qday89cxvm00rceu70zsny95n485l50rh3pxy8k8m7yrwdgrehyfq" + [iii|all [ #{verKey7} ]|] + + specScriptHashWithoutByteProper "cc_hot_script10fpewpnxmmc7x08nc5yepdyafa8arcaugf3pa37l3qmn2xu0u3c" + [iii|all [ #{verKey7} ]|] + + specScriptHashProper "cc_hot1qday89cxvm00rceu70zsny95n485l50rh3pxy8k8m7yrwdgrehyfq" + [iii|all [ #{xVerKey7} ]|] + + specScriptHashWithoutByteProper "cc_hot_script10fpewpnxmmc7x08nc5yepdyafa8arcaugf3pa37l3qmn2xu0u3c" + [iii|all [ #{xVerKey7} ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-1-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1q0f85s3feyhv39smd07n92rnsrwwujsgcaas6mytx0ccp6q7ak53g" + [iii|all [ #{verKeyH7}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-1-hash + specScriptHashWithoutByteProper "cc_hot_script16fayy2wf9myfvxmtl5e2suuqmnhy5zx80vxkezen7xqwskncf40" + [iii|all [ #{verKeyH7}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-1-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1q0f85s3feyhv39smd07n92rnsrwwujsgcaas6mytx0ccp6q7ak53g" + [iii|all [ #{verKeyH7Depr}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-1-hash + specScriptHashWithoutByteProper "cc_hot_script16fayy2wf9myfvxmtl5e2suuqmnhy5zx80vxkezen7xqwskncf40" + [iii|all [ #{verKeyH7Depr}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-1-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1q0f85s3feyhv39smd07n92rnsrwwujsgcaas6mytx0ccp6q7ak53g" + [iii|all [ #{verKeyH7Cred}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-1-hash + specScriptHashWithoutByteProper "cc_hot_script16fayy2wf9myfvxmtl5e2suuqmnhy5zx80vxkezen7xqwskncf40" + [iii|all [ #{verKeyH7Cred}, active_from 5001]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-1-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1q0f85s3feyhv39smd07n92rnsrwwujsgcaas6mytx0ccp6q7ak53g" + [iii|all [ #{verKey7}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-1-hash + specScriptHashWithoutByteProper "cc_hot_script16fayy2wf9myfvxmtl5e2suuqmnhy5zx80vxkezen7xqwskncf40" + [iii|all [ #{verKey7}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-1-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1q0f85s3feyhv39smd07n92rnsrwwujsgcaas6mytx0ccp6q7ak53g" + [iii|all [ #{xVerKey7}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-1-hash + specScriptHashWithoutByteProper "cc_hot_script16fayy2wf9myfvxmtl5e2suuqmnhy5zx80vxkezen7xqwskncf40" + [iii|all [ #{xVerKey7}, active_from 5001 ]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-2-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1qd3wq7vvwqm07dvx9n6z7nn6mgr0076mv3jnjqyz56gmu9qaj7nrc" + [iii|any [ #{verKeyH7}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-2-hash + specScriptHashWithoutByteProper "cc_hot_script1vts8nrrsxmlntp3v7sh5u7k6qmmlkkmyv5uspq4xjxlpg6u229p" + [iii|any [ #{verKeyH7}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-2-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1qd3wq7vvwqm07dvx9n6z7nn6mgr0076mv3jnjqyz56gmu9qaj7nrc" + [iii|any [ #{verKeyH7Depr}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-2-hash + specScriptHashWithoutByteProper "cc_hot_script1vts8nrrsxmlntp3v7sh5u7k6qmmlkkmyv5uspq4xjxlpg6u229p" + [iii|any [ #{verKeyH7Depr}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-2-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1qd3wq7vvwqm07dvx9n6z7nn6mgr0076mv3jnjqyz56gmu9qaj7nrc" + [iii|any [ #{verKeyH7Cred}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-2-hash + specScriptHashWithoutByteProper "cc_hot_script1vts8nrrsxmlntp3v7sh5u7k6qmmlkkmyv5uspq4xjxlpg6u229p" + [iii|any [ #{verKeyH7Cred}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-2-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1qd3wq7vvwqm07dvx9n6z7nn6mgr0076mv3jnjqyz56gmu9qaj7nrc" + [iii|any [ #{verKey7}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-2-hash + specScriptHashWithoutByteProper "cc_hot_script1vts8nrrsxmlntp3v7sh5u7k6qmmlkkmyv5uspq4xjxlpg6u229p" + [iii|any [ #{verKey7}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-constitutional-committee-hot-script-2-hash-appended-with-03-hex-encoded-byte-constitutional-committee-hot-script-hash-credential + specScriptHashProper "cc_hot1qd3wq7vvwqm07dvx9n6z7nn6mgr0076mv3jnjqyz56gmu9qaj7nrc" + [iii|any [ #{xVerKey7}, all [ active_from 5001, active_until 6001]]|] + + -- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-script-2-hash + specScriptHashWithoutByteProper "cc_hot_script1vts8nrrsxmlntp3v7sh5u7k6qmmlkkmyv5uspq4xjxlpg6u229p" + [iii|any [ #{xVerKey7}, all [ active_from 5001, active_until 6001]]|] + + specScriptInvalid Malformed + [iii|wrong [ #{verKeyH1} ]|] + + specScriptInvalid Malformed + [iii|any [ #{verKeyH1}, ]|] + + specScriptHashProper "script1pcjctr4ltcndy3nljsdrlv3jcawanz4kcj69aj00py62udt0j3g" + [iii|at_least 4 [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptHashProper "script10tx7wh633277e0dgw3mkwvmdawrjvdmcz88ypqjzsgxcjr9nwlj" + [iii|at_least 1 [ #{verKeyH1}, at_least 2 [ #{verKeyH2} ] ]|] + + specScriptInvalid NotUniformKeyType + [iii|all []|] + + specScriptHashProper "script14uj40hnew0uxrwlfz45z5umqwrs54kd0c04ujzyatyxzsk59wr8" + [iii|any [ #{verKeyH1}, all [] ]|] + + specScriptHashProper "script1v9rsc0jdf8l7hm5y45hecm5phjl6lscxmanxm0s93rg3z8q25jj" + [iii|at_least 0 [ #{verKeyH1}, #{verKeyH2} ]|] + + specScriptHashProper "script1ltujlnyeee7j5ujgjjw6taqc9vqlaj63ws75ttpfzxq9557zuzv" + [iii|at_least 1 [ #{verKeyH1}, #{verKeyH2}, active_from 10, active_until 25 ]|] + + specScriptHashProper "script1mt0mww34xff9s6vzt6ehw633njcrd7am406e8vm6c66uggynax4" + [iii|any [ #{verKeyH1}, #{verKeyH2}, #{verKeyH1}]|] + + specScriptInvalid Malformed + [iii|script_vkh18srsxr3khll7vl3w9mqfu55n6wzxxlxjq8egs9|] + + specScriptInvalid Malformed + [iii|any [ #{verKeyH1}, #{verKeyH2}, active_from a]|] + +specScriptHashProper :: String -> String -> SpecWith () +specScriptHashProper expected script = it (script <> " => " <> expected) $ do + out <- cli ["script", "hash", script] "" + out `shouldBe` expected + +specScriptHashWithoutByteProper :: String -> String -> SpecWith () +specScriptHashWithoutByteProper expected script = it (script <> " => " <> expected) $ do + out <- cli ["script", "hash", script, "--cip-0105"] "" + out `shouldBe` expected + +specScriptInvalid :: ErrValidateScript -> String -> SpecWith () +specScriptInvalid errMsg script = it (script <> " => " <> show errMsg) $ do + (out, err) <- cli ["script", "hash", script] "" + out `shouldBe` ("" :: String) + err `shouldContain` (prettyErrValidateScript errMsg) + +verKeyH1 :: String +verKeyH1 = "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" + +verKeyH2 :: String +verKeyH2 = "addr_shared_vkh1y3zl4nqgm96ankt96dsdhc86vd5geny0wr7hu8cpzdfcqskq2cp" + +verKeyH3 :: String +verKeyH3 = "addr_shared_vkh175wsm9ckhm3snwcsn72543yguxeuqm7v9r6kl6gx57h8gdydcd9" + +verKeyH4 :: String +verKeyH4 = "addr_shared_vkh1fee6yrlnczhfp77ftunc6snjrv0hv0s92qj2pe47dt4hz8ajp6a" + +-- Keys in accordance to https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#verification-key-hash-drep-vkh +-- Verification key hash (DRep VKH) +verKeyH5 :: String +verKeyH5 = "drep_vkh15k6929drl7xt0spvudgcxndryn4kmlzpk4meed0xhqe254czjh2" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#deprecated-verification-key-hash-drep-id +-- [DEPRECATED] Verification key hash (DRep ID) +verKeyH5Depr :: String +verKeyH5Depr = "drep15k6929drl7xt0spvudgcxndryn4kmlzpk4meed0xhqe25nle07s" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-compliant-verification-key-hash-appended-with--22-hex-encoded-byte-drep-key-hash-credential +-- [CIP-0129 compliant] Verification key hash appended with '22' hex-encoded byte (DRep key hash credential) +verKeyH5Cred :: String +verKeyH5Cred = "drep1y2jmg4g450lced7q9n34rq6d5vjwkm0ugx6h0894u6ur92s9txn3a" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#drep-verification-key +-- DRep verification key +verKey5 :: String +verKey5 = "drep_vk17axh4sc9zwkpsft3tlgpjemfwc0u5mnld80r85zw7zdqcst6w54sdv4a4e" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#drep-extended-verification-key +-- DRep extended verification key +xVerKey5 :: String +xVerKey5 = "drep_xvk17axh4sc9zwkpsft3tlgpjemfwc0u5mnld80r85zw7zdqcst6w543mpq3q2vkjy3nw8x7n8asw4es78dyl4q7u7kwlwn7yy0sugxfrjs6z25qe" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-verification-key-hash-constitutional-committee-cold-vkh +-- Constitutional Committee Cold Verification key hash (Constitutional Committee Cold VKH) +verKeyH6 :: String +verKeyH6 = "cc_cold_vkh1lmaet9hdvu9d9jvh34u0un4ndw3yewaq5ch6fnwsctw0243cw47" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#deprecated-constitutional-committee-cold-verification-key-hash +-- [DEPRECATED] Constitutional Committee Cold Verification Key Hash +verKeyH6Depr :: String +verKeyH6Depr = "cc_cold1lmaet9hdvu9d9jvh34u0un4ndw3yewaq5ch6fnwsctw02xxwylj" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-compliant-constitutional-committee-cold-verification-key-hash-appended-with--12-hex-encoded-byte-constitutional-committee-cold-key-hash-credential +-- [CIP-0129 compliant] Constitutional Committee Cold Verification key hash appended with '12' hex-encoded byte (Constitutional Committee Cold key hash credential) +verKeyH6Cred :: String +verKeyH6Cred = "cc_cold1ztl0h9vka4ns45kfj7xh3ljwkd46yn9m5znzlfxd6rpdeagw6p59q" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-verification-key +-- Constitutional Committee Cold Verification Key +verKey6 :: String +verKey6 = "cc_cold_vk149up407pvp9p36lldlp4qckqqzn6vm7u5yerwy8d8rqalse3t04q7qsvwl" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-cold-extended-verification-key +-- Constitutional Committee Cold Extended Verification Key +xVerKey6 :: String +xVerKey6 = "cc_cold_xvk149up407pvp9p36lldlp4qckqqzn6vm7u5yerwy8d8rqalse3t04vvqvk3e6l7vzjl7n8ttk646jflumvkgcrdhcstc5wr5etg5n7dnc8nqv5d" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-verification-key-hash-constitutional-committee-hot-vkh +-- Constitutional Committee Hot Verification key hash (Constitutional Committee Hot VKH) +verKeyH7 :: String +verKeyH7 = "cc_hot_vkh17mffcrm3vnfhvyxt7ea3y65e804jfgrk6pjn78aqd9vg7vk5akz" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#deprecated-constitutional-committee-hot-verification-key-hash +-- [DEPRECATED] Constitutional Committee Hot Verification Key Hash +verKeyH7Depr :: String +verKeyH7Depr = "cc_hot17mffcrm3vnfhvyxt7ea3y65e804jfgrk6pjn78aqd9vg7xpq8dv" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#cip-0129-compliant-constitutional-committee-hot-verification-key-hash-appended-with--02-hex-encoded-byte-constitutional-committee-hot-key-hash-credential +-- [CIP-0129 compliant] Constitutional Committee Hot Verification key hash appended with '02' hex-encoded byte (Constitutional Committee Hot key hash credential) +verKeyH7Cred :: String +verKeyH7Cred = "cc_hot1qtmd98q0w9jdxasse0m8kyn2nya7kf9qwmgx20cl5p543rcdtr4dz" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-verification-key +-- Constitutional Committee Hot Verification Key +verKey7 :: String +verKey7 = "cc_hot_vk10y48lq72hypxraew74lwjjn9e2dscuwphckglh2nrrpkgweqk5hschnzv5" + +-- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0105/test-vectors/test-vector-1.md#constitutional-committee-hot-extended-verification-key +-- Constitutional Committee Hot Extended Verification Key +xVerKey7 :: String +xVerKey7 = "cc_hot_xvk10y48lq72hypxraew74lwjjn9e2dscuwphckglh2nrrpkgweqk5h4fplggm56wz9jw6qadq6l5tdvj6qs3v7ggh3hjkt5j8ntga42pvs5rvh0a" diff --git a/test/Command/Script/PreimageSpec.hs b/test/Command/Script/PreimageSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Script/PreimageSpec.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} + +module Command.Script.PreimageSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Script + ( ErrValidateScript (..), prettyErrValidateScript ) +import Data.String.Interpolate + ( iii ) +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = do + describeCmd [ "script", "preimage" ] $ do + specScriptPreimageProper + "008201818200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d" + [iii|all [ #{verKeyH1} ]|] + + specScriptPreimageProper + "008201818200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d" + ("all [ " <>verKeyH1<>" ] ") + + specScriptPreimageProper + "008201838200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10\ + \d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f01135380820058\ + \1cf51d0d9716bee309bb109f954ac488e1b3c06fcc28f56fe906a7ae74" + [iii|all [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptPreimageProper + "008202818200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d" + [iii|any [ #{verKeyH1} ]|] + + specScriptPreimageProper + "008202838200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10\ + \d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f01135380820058\ + \1cf51d0d9716bee309bb109f954ac488e1b3c06fcc28f56fe906a7ae74" + [iii|any [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptPreimageProper + "00830301838200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef\ + \10d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f011353808200\ + \581cf51d0d9716bee309bb109f954ac488e1b3c06fcc28f56fe906a7ae74" + [iii|at_least 1 [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptPreimageProper + "00830301828200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef\ + \10d8201828200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f011353\ + \808200581cf51d0d9716bee309bb109f954ac488e1b3c06fcc28f56fe906a7ae74" + [iii|at_least 1 [ #{verKeyH1}, all [ #{verKeyH2}, #{verKeyH3} ] ]|] + + specScriptPreimageProper + "008200581c4e73a20ff3c0ae90fbc95f278d42721b1f763e055024a0e6be6aeb71" + [iii|#{verKeyH4}|] + + specScriptInvalid Malformed + [iii|wrong [ #{verKeyH1} ]|] + + specScriptInvalid Malformed + [iii|any [ #{verKeyH1}, ]|] + + specScriptPreimageProper + "00830304838200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef\ + \10d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f011353808200\ + \581cf51d0d9716bee309bb109f954ac488e1b3c06fcc28f56fe906a7ae74" + [iii|at_least 4 [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptPreimageProper + "00830301828200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef\ + \10d830302818200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f01135380" + [iii|at_least 1 [ #{verKeyH1}, at_least 2 [ #{verKeyH2} ] ]|] + + specScriptPreimageProper + "00820180" + [iii|all []|] + + specScriptPreimageProper + "008202828200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d820180" + [iii|any [ #{verKeyH1}, all [] ]|] + + specScriptPreimageProper + "00830300828200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10\ + \d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f01135380" + [iii|at_least 0 [ #{verKeyH1}, #{verKeyH2} ]|] + + specScriptPreimageProper + "00830301848200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10\ + \d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f0113538082040a82051819" + [iii|at_least 1 [ #{verKeyH1}, #{verKeyH2}, active_from 10, active_until 25 ]|] + + specScriptPreimageProper + "008202838200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10\ + \d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f01135380820058\ + \1c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d" + [iii|any [ #{verKeyH1}, #{verKeyH2}, #{verKeyH1}]|] + + specScriptInvalid Malformed + [iii|script_vkh18srsxr3khll7vl3w9mqfu55n6wzxxlxjq8egs9|] + + specScriptInvalid Malformed + [iii|any [ #{verKeyH1}, #{verKeyH2}, active_from a]|] + + specScriptPreimageProper + "008201828200581c80686bb3727f602581309117d8e1cc07a410e14376d3882101d299da8204191389" + [iii|all [ #{verKeyH5}, active_from 5001]|] + + specScriptPreimageProper + "008201828200581c80686bb3727f602581309117d8e1cc07a410e14376d3882101d299da8204191389" + [iii|all [ #{verKey5}, active_from 5001]|] + + specScriptPreimageProper + "008201828200581c80686bb3727f602581309117d8e1cc07a410e14376d3882101d299da8204191389" + [iii|all [ #{xVerKey5}, active_from 5001]|] + + specScriptPreimageProper + "008201828200581c6f88e8e9411b27dcd1383bf513373d0ba050ac4d44ac06d5b6881adc8204191389" + [iii|all [ #{verKeyH6}, active_from 5001]|] + + specScriptPreimageProper + "008201828200581c358b52181c48f748492ca4697fcec43e12548914b30311d4022b69918204191389" + [iii|all [ #{verKeyH7}, active_from 5001]|] + + specScriptPreimageProper + "008202828200581c80686bb3727f602581309117d8e1cc07a410e14376d3882101d299da82018282041913898205191771" + [iii|any [ #{verKeyH5}, all [ active_from 5001, active_until 6001]]|] + + specScriptPreimageProper + "008202828200581c6f88e8e9411b27dcd1383bf513373d0ba050ac4d44ac06d5b6881adc82018282041913898205191771" + [iii|any [ #{verKeyH6}, all [ active_from 5001, active_until 6001]]|] + + specScriptPreimageProper + "008202828200581c358b52181c48f748492ca4697fcec43e12548914b30311d4022b699182018282041913898205191771" + [iii|any [ #{verKeyH7}, all [ active_from 5001, active_until 6001]]|] + +specScriptPreimageProper :: String -> String -> SpecWith () +specScriptPreimageProper expected script = it (script <> " => " <> expected) $ do + out <- cli ["script", "preimage", script] "" + out `shouldBe` expected + +specScriptInvalid :: ErrValidateScript -> String -> SpecWith () +specScriptInvalid errMsg script = it (script <> " => " <> show errMsg) $ do + (out, err) <- cli ["script", "preimage", script] "" + out `shouldBe` ("" :: String) + err `shouldContain` (prettyErrValidateScript errMsg) + +verKeyH1 :: String +verKeyH1 = "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" + +verKeyH2 :: String +verKeyH2 = "addr_shared_vkh1y3zl4nqgm96ankt96dsdhc86vd5geny0wr7hu8cpzdfcqskq2cp" + +verKeyH3 :: String +verKeyH3 = "addr_shared_vkh175wsm9ckhm3snwcsn72543yguxeuqm7v9r6kl6gx57h8gdydcd9" + +verKeyH4 :: String +verKeyH4 = "addr_shared_vkh1fee6yrlnczhfp77ftunc6snjrv0hv0s92qj2pe47dt4hz8ajp6a" + +verKeyH5 :: String +verKeyH5 = "drep1y2qxs6anwflkqfvpxzg30k8pesr6gy8pgdmd8zppq8ffnksapjznm" + +verKey5 :: String +verKey5 = "drep_vk1mg7xae48d7z4nntd35tey0jmclxaavwmk3kw2lkkt07p3s3x3yysra6588" + +xVerKey5 :: String +xVerKey5 = "drep_xvk1mg7xae48d7z4nntd35tey0jmclxaavwmk3kw2lkkt07p3s3x3yy45805manx2kj2neg40kfpy9em36vnkjfm4fw09k66837unrvd70qq8ewzf" + +verKeyH6 :: String +verKeyH6 = "cc_cold1zfhc368fgydj0hx38qal2yeh8596q59vf4z2cpk4k6yp4hqy3mpsx" + +verKeyH7 :: String +verKeyH7 = "cc_hot1qg6ck5scr3y0wjzf9jjxjl7wcslpy4yfzjesxyw5qg4knyg9ckh0d" diff --git a/test/Command/Script/ValidationSpec.hs b/test/Command/Script/ValidationSpec.hs new file mode 100644 --- /dev/null +++ b/test/Command/Script/ValidationSpec.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} + +module Command.Script.ValidationSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Script + ( ErrRecommendedValidateScript (..) + , ErrValidateScript (..) + , ValidationLevel (..) + , prettyErrValidateScript + ) +import Data.String.Interpolate + ( iii ) +import Test.Hspec + ( Spec, SpecWith, it, shouldBe, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = do + describeCmd [ "script", "validate"] $ do + specScriptValidated RequiredValidation + [iii|#{verKeyH1}|] + + specScriptValidated RequiredValidation + [iii|at_least 2 [ #{verKeyH1}, #{verKeyH2}, #{verKeyH3} ]|] + + specScriptValidated RequiredValidation + [iii|at_least 2 [ #{verKeyH1}, #{verKeyH2}, active_from 10, active_until 25]|] + + specScriptValidated RequiredValidation + [iii|at_least 2 [ #{verKeyH1}, #{verKeyH2}, active_from 6, active_until 15]|] + + specScriptValidated RequiredValidation + [iii|at_least 2 [ #{verKeyH1}, #{verKeyH2}, active_from 6, active_until 25]|] + + specScriptValidated RequiredValidation + [iii|all []|] + + specScriptNotValidated Malformed RequiredValidation + [iii|any [ #{verKeyH1}, #{verKeyH2}, active_from a]|] + + specScriptNotValidated (NotRecommended EmptyList) RecommendedValidation + [iii|all []|] + + specScriptValidated RequiredValidation + [iii|at_least 2 [ active_from 11, active_until 25]|] + + specScriptValidated RequiredValidation + [iii|at_least 2 [ #{verKeyH1}, active_from 11, active_until 25]|] + + specScriptNotValidated (NotRecommended ListTooSmall) RecommendedValidation + [iii|at_least 2 [ #{verKeyH1}, active_from 11, active_until 25]|] + + specScriptValidated RequiredValidation + [iii|at_least 2 [ #{verKeyH1}, active_from 11, active_until 25, active_until 30]|] + + specScriptNotValidated (NotRecommended RedundantTimelocks) RecommendedValidation + [iii|at_least 1 [ #{verKeyH1}, active_from 11, active_until 25, active_until 30]|] + + specScriptValidated RequiredValidation + [iii|any [ #{verKeyH1}, #{verKeyH2}, #{verKeyH2}]|] + + specScriptNotValidated (NotRecommended DuplicateSignatures) RecommendedValidation + [iii|any [ #{verKeyH1}, #{verKeyH2}, #{verKeyH2}]|] + + specScriptValidated RequiredValidation + [iii|at_least 0 [ #{verKeyH1}, #{verKeyH2} ]|] + + specScriptNotValidated (NotRecommended MZero) RecommendedValidation + [iii|at_least 0 [ #{verKeyH1}, #{verKeyH2} ]|] + + specScriptNotValidated NotUniformKeyType RequiredValidation + [iii|any [ #{verKeyH1}, #{verKeyH4}]|] + + specScriptNotValidated NotUniformKeyType RecommendedValidation + [iii|at_least 1 [ #{verKeyH1}, #{verKeyH4} ]|] + + specScriptValidated RequiredValidation + [iii|all [ #{verKeyH5}, active_from 5001]|] + + specScriptValidated RequiredValidation + [iii|all [ #{verKeyH6}, active_from 5001]|] + + specScriptValidated RequiredValidation + [iii|all [ #{verKeyH7}, active_from 5001]|] + + specScriptValidated RequiredValidation + [iii|any [ #{verKeyH5}, all [ active_from 5001, active_until 6001]]|] + + specScriptValidated RequiredValidation + [iii|any [ #{verKeyH6}, all [ active_from 5001, active_until 6001]]|] + + specScriptValidated RequiredValidation + [iii|any [ #{verKeyH7}, all [ active_from 5001, active_until 6001]]|] + +levelStr :: ValidationLevel -> String +levelStr = \case + RequiredValidation -> "--required" + RecommendedValidation -> "--recommended" + +specScriptValidated :: ValidationLevel -> String -> SpecWith () +specScriptValidated level script = it (script <> " => Validated.") $ do + out <- cli (["script", "validate", levelStr level, script]) "" + out `shouldBe` "Validated.\n" + +specScriptNotValidated :: ErrValidateScript -> ValidationLevel -> String -> SpecWith () +specScriptNotValidated errMsg level script = it (script <> " => " <> show errMsg) $ do + (out, err) <- cli (["script", "validate", levelStr level, script]) "" + out `shouldBe` ("" :: String) + err `shouldContain` prettyErrValidateScript errMsg + +verKeyH1 :: String +verKeyH1 = "addr_shared_vkh1zxt0uvrza94h3hv4jpv0ttddgnwkvdgeyq8jf9w30mcs6y8w3nq" + +verKeyH2 :: String +verKeyH2 = "addr_shared_vkh1y3zl4nqgm96ankt96dsdhc86vd5geny0wr7hu8cpzdfcqskq2cp" + +verKeyH3 :: String +verKeyH3 = "addr_shared_vkh175wsm9ckhm3snwcsn72543yguxeuqm7v9r6kl6gx57h8gdydcd9" + +verKeyH4 :: String +verKeyH4 = "stake_shared_vkh1nqc00hvlc6cq0sfhretk0rmzw8dywmusp8retuqnnxzajtzhjg5" + +verKeyH5 :: String +verKeyH5 = "drep1y2qxs6anwflkqfvpxzg30k8pesr6gy8pgdmd8zppq8ffnksapjznm" + +verKeyH6 :: String +verKeyH6 = "cc_cold1zfhc368fgydj0hx38qal2yeh8596q59vf4z2cpk4k6yp4hqy3mpsx" + +verKeyH7 :: String +verKeyH7 = "cc_hot1qg6ck5scr3y0wjzf9jjxjl7wcslpy4yfzjesxyw5qg4knyg9ckh0d" diff --git a/test/CommandSpec.hs b/test/CommandSpec.hs new file mode 100644 --- /dev/null +++ b/test/CommandSpec.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE FlexibleContexts #-} + +module CommandSpec + ( spec + ) where + +import Prelude + +import Data.Version + ( showVersion ) +import Paths_cardano_addresses + ( version ) +import Test.Hspec + ( Spec, it, shouldContain ) +import Test.Utils + ( cli, describeCmd ) + +spec :: Spec +spec = describeCmd [] $ do + it "Show version when --version is provided" $ do + out <- cli ["--version"] "" + out `shouldContain` showVersion version + + it "Show version when -v is provided" $ do + out <- cli ["-v"] "" + out `shouldContain` showVersion version + + it "Show version when version is provided" $ do + out <- cli ["version"] "" + out `shouldContain` showVersion version diff --git a/test/Data/Word7Spec.hs b/test/Data/Word7Spec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Word7Spec.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +module Data.Word7Spec + ( spec + ) where + +import Prelude + +import Data.Binary.Get + ( runGet ) +import Data.Binary.Put + ( runPut ) +import Data.Word + ( Word8 ) +import Data.Word7 + ( getVariableLengthNat + , putVariableLengthNat + , toNatural + , toWord7 + , toWord7s + , toWord8 + ) +import Numeric.Natural + ( Natural ) +import Test.Hspec + ( Spec, describe ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Property, choose, forAll, (===) ) + +import Test.Arbitrary + () + +spec :: Spec +spec = do + describe "Word7 roundtrips" $ do + prop "toWord7 . toWord8 - Word8" prop_roundtripConversionWord8 + prop "toWord7s . toNatural - Natural" prop_roundtripConversionNatural + + describe "encode / decode roundtrip" $ do + prop "{get,put}VariableLengthNat" prop_roundtripVariableLengthNat + +prop_roundtripConversionWord8 + :: Word8 + -> Property +prop_roundtripConversionWord8 number = + (number `mod` 128 === toWord8 (toWord7 number)) + +prop_roundtripConversionNatural + :: Natural + -> Property +prop_roundtripConversionNatural number = + (number === toNatural (toWord7s number)) + +prop_roundtripVariableLengthNat + :: Property +prop_roundtripVariableLengthNat = + forAll genNatural $ \n -> + runGet getVariableLengthNat (runPut $ putVariableLengthNat n) === n + where + genNatural = fromIntegral @Integer <$> choose (0, 500) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE CPP #-} +module Main where + +import Prelude + +import Main.Utf8 + ( withUtf8 ) +import Test.Hspec.Runner + ( defaultConfig, hspecWith ) + +import qualified AutoDiscover + +-- This is effectively from the now defunct foundation/basement from +-- https://github.com/haskell-foundation/foundation/blob/5e28e3ea1e2fe9a98c157df463bd32d3f92e7f80/basement/Basement/Terminal.hs#L14-L26 +#ifdef mingw32_HOST_OS +import System.IO + ( hPutStrLn, hSetEncoding, stderr, stdin, stdout, utf8 ) +import System.Win32.Console + ( getConsoleCP, getConsoleOutputCP, setConsoleCP, setConsoleOutputCP ) +#endif + +#ifdef mingw32_HOST_OS +initialize :: IO () +initialize = do + query getConsoleOutputCP (\e -> setConsoleOutputCP e >> hSetEncoding stdout utf8 >> hSetEncoding stderr utf8) utf8Code + query getConsoleCP (\e -> setConsoleCP e >> hSetEncoding stdin utf8) utf8Code + where + utf8Code = 65001 + query get set expected = do + v <- get + if v == expected then pure () else set expected +#endif + +main :: IO () +main = do +#ifdef mingw32_HOST_OS + initialize +#endif + withUtf8 $ hspecWith defaultConfig AutoDiscover.spec diff --git a/test/Options/Applicative/DerivationSpec.hs b/test/Options/Applicative/DerivationSpec.hs new file mode 100644 --- /dev/null +++ b/test/Options/Applicative/DerivationSpec.hs @@ -0,0 +1,71 @@ +module Options.Applicative.DerivationSpec + ( spec + ) where + +import Prelude + +import Control.Arrow + ( left ) +import Data.List + ( isInfixOf ) +import Options.Applicative.Derivation + ( DerivationIndex + , DerivationPath + , derivationIndexFromString + , derivationIndexToString + , derivationPathFromString + , derivationPathToString + ) +import Test.Hspec + ( Spec, SpecWith, describe, it, shouldBe ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Property, (===) ) + +import Test.Arbitrary + () + +spec :: Spec +spec = do + describe "DerivationIndex" $ do + specInvalidSoftIndex + specInvalidHardIndex + prop "toString . fromString @ DerivationIndex" + prop_roundtripStringDerivationIndex + + describe "DerivationPath" $ do + specEmptyPath + prop "toString . fromString @ DerivationPath" + prop_roundtripStringDerivationPath + +specInvalidSoftIndex + :: SpecWith () +specInvalidSoftIndex = it "invalid soft derivation index" $ do + left (isInfixOf "Unable to parse soft index") (derivationIndexFromString "💩") + `shouldBe` (Left True) + +specInvalidHardIndex + :: SpecWith () +specInvalidHardIndex = it "invalid hard derivation index" $ do + left (isInfixOf "Unable to parse hardened index") (derivationIndexFromString "💩H") + `shouldBe` (Left True) + + +prop_roundtripStringDerivationIndex + :: DerivationIndex + -> Property +prop_roundtripStringDerivationIndex ix = + derivationIndexFromString (derivationIndexToString ix) === pure ix + +specEmptyPath + :: SpecWith () +specEmptyPath = it "empty derivation path" $ do + derivationPathFromString "" `shouldBe` + (Left "An empty string is not a derivation index!") + +prop_roundtripStringDerivationPath + :: DerivationPath + -> Property +prop_roundtripStringDerivationPath path = + derivationPathFromString (derivationPathToString path) === pure path diff --git a/test/System/IO/ExtraSpec.hs b/test/System/IO/ExtraSpec.hs new file mode 100644 --- /dev/null +++ b/test/System/IO/ExtraSpec.hs @@ -0,0 +1,258 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module System.IO.ExtraSpec + ( spec + ) where + +import Prelude + +import Cardano.Address.Derivation + ( XPrv, XPub, xprvToBytes, xpubToBytes ) +import Codec.Binary.Bech32.TH + ( humanReadablePart ) +import Codec.Binary.Encoding + ( AbstractEncoding (..), Encoding, encode ) +import Control.Exception + ( IOException, SomeException, try ) +import Data.Bifunctor + ( bimap ) +import Data.ByteString + ( ByteString ) +import Data.Function + ( (&) ) +import Data.List + ( nub ) +import System.IO + ( BufferMode (..), Handle, IOMode (..), hClose, hSetBuffering, withFile ) +import System.IO.Extra + ( hGetBytes + , hGetXP__ + , hGetXPrv + , hGetXPub + , hPutBytes + , markCharsRedAtIndices + ) +import System.IO.Temp + ( withSystemTempFile ) +import Test.Hspec + ( Spec + , SpecWith + , describe + , expectationFailure + , it + , shouldBe + , shouldContain + ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Arbitrary (..) + , Property + , choose + , counterexample + , elements + , forAll + , forAllShrink + , property + , vector + , withMaxSuccess + , (===) + , (==>) + ) +import Test.QuickCheck.Monadic + ( assert, monadicIO, monitor, run ) + +import Test.Arbitrary + () + +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +spec :: Spec +spec = do + describe "hGetBytes" $ do + specRoundtrip "MyString" bech32 + specRoundtrip "MyString" base16 + specRoundtrip "MyString" base58 + + specInvalidEncodedString "bech321aaaaaaaaaaaaaaaa" + (`shouldContain` "Bech32 error: Invalid character(s) in string") + specInvalidEncodedString "bech321f4u4xarjd9hxwrhö" + (`shouldContain` "Couldn't detect input encoding") + specInvalidEncodedString "\NUL\NUL" + (`shouldContain` "Couldn't detect input encoding") + + describe "markCharsRedAtIndices" $ do + prop "generates strings of expected length" + propMarkedStringsExpectedLength + prop "all red chars correspond to indices" + propRedCharsMatch + + describe "hGetXPrv" $ do + prop "roundtrip: hGetXPrv vs hPutBytes" $ + withMaxSuccess 1000 propGetPrvRoundtrip + + describe "hGetXPub" $ do + prop "roundtrip: hGetXPub vs hPutBytes" $ + withMaxSuccess 1000 propGetPubRoundtrip + + describe "hGetXP__" $ do + prop "roundtrip: hGetXP__ vs hPutBytes" $ + withMaxSuccess 1000 propGetAnyRoundtrip + +specRoundtrip + :: String + -> (String -> ByteString) + -> SpecWith () +specRoundtrip str encoder = it (str <> " => " <> unbytes (encoder str)) $ do + str' <- withHandle + (\h -> B8.hPutStr h (encoder str)) + (fmap unbytes . hGetBytes) + str `shouldBe` str' + +specInvalidEncodedString + :: String + -> (String -> IO ()) + -> SpecWith () +specInvalidEncodedString str assertion = it ("invalid encoding; " <> str) $ do + result <- try $ withHandle (\h -> B8.hPutStr h (bytes str)) hGetBytes + case result of + Left (e :: SomeException) -> + assertion (show e) + Right{} -> + expectationFailure "expected hGetBytes to fail but didn't" + +base16 :: String -> ByteString +base16 = encode EBase16 . bytes + +bech32 :: String -> ByteString +bech32 = encode (EBech32 hrp) . bytes + where + hrp = [humanReadablePart|bech32|] + +base58 :: String -> ByteString +base58 = encode EBase58 . bytes + +propGetPrvRoundtrip + :: XPrv + -> Property +propGetPrvRoundtrip xprv = monadicIO $ do + result <- run $ try $ withHandle + (\h -> hPutBytes h (xprvToBytes xprv) encoding) + (`hGetXPrv` [hrp]) + monitor (encodingexample encoding (xprvToBytes xprv) (xprvToBytes . snd <$> result)) + assert (result == Right (hrp, xprv)) + where + hrp = [humanReadablePart|xprv|] + encoding = EBech32 hrp + +propGetPubRoundtrip + :: XPub + -> Property +propGetPubRoundtrip xpub = monadicIO $ do + result <- run $ try $ withHandle + (\h -> hPutBytes h (xpubToBytes xpub) encoding) + (`hGetXPub` [hrp]) + monitor (encodingexample encoding (xpubToBytes xpub) (xpubToBytes . snd <$> result)) + assert (result == Right (hrp, xpub)) + where + hrp = [humanReadablePart|xpub|] + encoding = EBech32 hrp + +propGetAnyRoundtrip + :: Either XPub XPrv + -> Property +propGetAnyRoundtrip xany = forAll genEncoding $ \encoding -> monadicIO $ do + result <- run $ try $ withHandle + (\h -> hPutBytes h (either xpubToBytes xprvToBytes xany) encoding) + (`hGetXP__` hrp) + monitor (encodingexample encoding + (either xpubToBytes xprvToBytes xany) + (either (xpubToBytes . snd) (xprvToBytes . snd) <$> result)) + assert ((bimap snd snd <$> result) == Right xany) + assert ((either fst fst <$> result) `elem` (Right <$> hrp)) + where + hrp = [ [humanReadablePart|xpub|], [humanReadablePart|xprv|] ] + genEncoding = elements (EBech32 <$> hrp) + +propMarkedStringsExpectedLength + :: [Word] + -> Property +propMarkedStringsExpectedLength ixs = do + let maxIx = fromIntegral $ foldl max 0 ixs + let genStr = choose (maxIx, maxIx + 5) >>= vector + forAllShrink genStr shrink $ \s -> do + let rendered = markCharsRedAtIndices ixs s + all ((< length s) . fromIntegral) ixs ==> + counterexample rendered $ + length rendered === length s + ((length (nub ixs)) * 9) + +propRedCharsMatch + :: [Word] + -> Property +propRedCharsMatch ixs = do + let maxIx = fromIntegral $ foldl max 0 ixs + let genStr = choose (maxIx, maxIx + 5) >>= vector + forAllShrink genStr shrink $ \(s::String) -> do + let rendered = markCharsRedAtIndices ixs s + let ixs' = indicesOfRedCharacters rendered + if length s > maxIx + then Set.fromList ixs' === Set.fromList ixs + else property $ + Set.fromList ixs' `Set.isSubsetOf` Set.fromList ixs + +-- +-- Helpers +-- + +-- Returns a list of indices of charcters marked red with ANSI. +-- +-- NOTE: Very primitive parser that only works with the current +-- @markCharsRedAtIndices@ which surrounds /every/ red character with ANSI, even +-- for neighboring characters. +indicesOfRedCharacters :: Integral i => String -> [i] +indicesOfRedCharacters s = go s 0 + where + go ('\ESC':'[':'9':'1':'m':_x:'\ESC':'[':'0':'m':xs) n = + n : (go xs (n + 1)) + go (_x:xs) n = + go xs (n + 1) + go [] _ = [] + +encodingexample + :: Encoding + -> ByteString + -> Either IOException ByteString + -> Property + -> Property +encodingexample encoding sent rcvd prop_ = prop_ + & counterexample (unlines + [ "rcvd:" + , show $ encode encoding <$> rcvd + ]) + & counterexample (unlines + [ "sent:" + , show $ encode encoding sent + ]) + +withHandle + :: (Handle -> IO ()) + -- ^ Write operation + -> (Handle -> IO a) + -- ^ Read Operation + -> IO a +withHandle writeOp readOp = withSystemTempFile "System.IO.Extra" $ \file h -> do + hSetBuffering h NoBuffering + writeOp h *> hClose h + withFile file ReadMode readOp + +bytes :: String -> ByteString +bytes = T.encodeUtf8 . T.pack + +unbytes :: ByteString -> String +unbytes = T.unpack . T.decodeUtf8 diff --git a/test/Test/Arbitrary.hs b/test/Test/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/test/Test/Arbitrary.hs @@ -0,0 +1,354 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +module Test.Arbitrary + ( unsafeMkMnemonic + , unsafeMkSomeMnemonicFromEntropy + , unsafeFromHex + , unsafeFromRight + ) where + +import Prelude + +import Cardano.Address + ( AddressDiscrimination (..), ChainPointer (..), NetworkTag (..) ) +import Cardano.Address.Derivation + ( Depth (..) + , GenMasterKey (..) + , HardDerivation (..) + , Index (..) + , XPrv + , XPub + , generate + , generateNew + , indexFromWord32 + , toXPub + , xprvToBytes + ) +import Cardano.Address.Style.Byron + ( Byron + , byronMainnet + , byronPreprod + , byronPreview + , byronStaging + , byronTestnet + ) +import Cardano.Address.Style.Icarus + ( Icarus + , icarusMainnet + , icarusPreprod + , icarusPreview + , icarusStaging + , icarusTestnet + ) +import Cardano.Address.Style.Shelley + ( Shelley ) +import Cardano.Mnemonic + ( ConsistentEntropy + , Entropy + , EntropySize + , Mnemonic + , MnemonicException (..) + , MnemonicWords + , SomeMnemonic (..) + , entropyToMnemonic + , mkEntropy + , mkMnemonic + ) +import Codec.Binary.Bech32 + ( HumanReadablePart ) +import Codec.Binary.Bech32.TH + ( humanReadablePart ) +import Codec.Binary.Encoding + ( AbstractEncoding (..) ) +import Crypto.Encoding.BIP39 + ( ValidChecksumSize, ValidEntropySize, ValidMnemonicSentence ) +import Data.ByteArray.Encoding + ( Base (..), convertFromBase ) +import Data.ByteString + ( ByteString ) +import Data.Function + ( on ) +import Data.List + ( intercalate ) +import Data.Maybe + ( fromMaybe, mapMaybe ) +import Data.Proxy + ( Proxy (..) ) +import Data.Text + ( Text ) +import Data.Word + ( Word64 ) +import GHC.Stack + ( HasCallStack ) +import GHC.TypeLits + ( natVal ) +import Numeric.Natural + ( Natural ) +import Options.Applicative.Derivation + ( DerivationIndex + , DerivationPath + , derivationIndexToString + , derivationPathFromString + , indexToInteger + , mkDerivationIndex + ) +import Test.QuickCheck + ( Arbitrary (..), Gen, choose, elements, genericShrink, oneof, vector ) + +import qualified Cardano.Address.Style.Icarus as Icarus +import qualified Cardano.Address.Style.Shelley as Shelley +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 + +-- +-- Arbitrary Instances +-- + +instance Arbitrary XPrv where + arbitrary = oneof + [ flip generateNew (mempty :: ByteString) . BS.pack <$> vector 16 + , generate . BS.pack <$> vector 32 + ] + +instance Arbitrary XPub where + arbitrary = + toXPub <$> arbitrary + +instance Arbitrary DerivationIndex where + arbitrary = unsafeFromRight . mkDerivationIndex + <$> choose (indexToInteger minBound, indexToInteger maxBound) + +instance Arbitrary DerivationPath where + arbitrary = do + n <- choose (1, 10) + ixs <- vector @DerivationIndex n + pure $ unsafeFromRight $ derivationPathFromString $ + intercalate "/" (derivationIndexToString <$> ixs) + +instance Arbitrary (AbstractEncoding HumanReadablePart) where + arbitrary = elements + [ EBase16 + , EBase58 + , EBech32 [humanReadablePart|bech32|] + ] + +instance Arbitrary Natural where + arbitrary = + fromIntegral <$> choose (1 :: Word64, 10000000000) + +instance Arbitrary ChainPointer where + arbitrary = do + slot <- arbitrary + ix1 <- fromIntegral <$> choose (1 :: Word64, 1000000) + ix2 <- fromIntegral <$> choose (1 :: Word64, 1000000) + pure $ ChainPointer slot ix1 ix2 + +-- | The initial seed has to be vector or length multiple of 4 bytes and shorter +-- than 64 bytes. Note that this is good for testing or examples, but probably +-- not for generating truly random Mnemonic words. +-- +-- See 'Crypto.Random.Entropy (getEntropy)' +instance + ( ValidEntropySize n + , ValidChecksumSize n csz + ) => Arbitrary (Entropy n) where + arbitrary = + let + size = fromIntegral $ natVal @n Proxy + entropy = + mkEntropy @n . BA.convert . B8.pack <$> vector (size `quot` 8) + in + either (error . show . UnexpectedEntropyError) id <$> entropy + +-- | Same remark from 'Arbitrary Entropy' applies here. +instance + ( n ~ EntropySize mw + , mw ~ MnemonicWords n + , ValidChecksumSize n csz + , ValidEntropySize n + , ValidMnemonicSentence mw + , Arbitrary (Entropy n) + ) => Arbitrary (Mnemonic mw) where + arbitrary = + entropyToMnemonic <$> arbitrary @(Entropy n) + +instance (Bounded ix, ix ~ Index ty depth) => Arbitrary (Index ty depth) where + -- Use the Word32 shrink fun. + shrink = mapMaybe indexFromWord32 . shrink . indexToWord32 + -- Use convert Index bounds to Word32 and choose from that range. + arbitrary = fromMaybe err . indexFromWord32 <$> choose bounds + where + bounds = (indexToWord32 (minBound @ix), indexToWord32 (maxBound @ix)) + err = error "Arbitrary Index" + +instance Arbitrary SomeMnemonic where + arbitrary = SomeMnemonic <$> genMnemonic @12 + +instance Arbitrary (Byron 'PaymentK XPub) where + shrink _ = [] + arbitrary = do + mw <- SomeMnemonic <$> genMnemonic @12 + rootK <- genMasterKeyFromMnemonic mw <$> arbitrary + acctK <- deriveAccountPrivateKey rootK <$> arbitrary + addrK <- deriveAddressPrivateKey acctK () <$> arbitrary + pure $ toXPub <$> addrK + +instance Arbitrary (Icarus 'PaymentK XPub) where + shrink _ = [] + arbitrary = do + mw <- SomeMnemonic <$> genMnemonic @15 + bytes <- BA.convert . BS.pack <$> (choose (0, 32) >>= vector) + let rootK = genMasterKeyFromMnemonic mw bytes + acctK <- deriveAccountPrivateKey rootK <$> arbitrary + addrK <- deriveAddressPrivateKey acctK <$> arbitrary <*> arbitrary + pure $ toXPub <$> addrK + +instance Arbitrary (Shelley 'PaymentK XPub) where + shrink _ = [] + arbitrary = do + mw <- SomeMnemonic <$> genMnemonic @15 + bytes <- BA.convert . BS.pack <$> (choose (0, 32) >>= vector) + let rootK = genMasterKeyFromMnemonic mw bytes + acctK <- deriveAccountPrivateKey rootK <$> arbitrary + addrK <- deriveAddressPrivateKey acctK <$> arbitrary <*> arbitrary + pure $ toXPub <$> addrK + +instance Arbitrary (Shelley 'DelegationK XPub) where + shrink _ = [] + arbitrary = do + mw <- SomeMnemonic <$> genMnemonic @15 + bytes <- BA.convert . BS.pack <$> (choose (0, 32) >>= vector) + let rootK = genMasterKeyFromMnemonic mw bytes + acctK <- deriveAccountPrivateKey rootK <$> arbitrary + let delegationK = Shelley.deriveDelegationPrivateKey acctK + pure $ toXPub <$> delegationK + +instance {-# OVERLAPS #-} Arbitrary (AddressDiscrimination, NetworkTag) where + arbitrary = oneof + -- NOTE using explicit smart-constructor as a quick-win for the coverage :) + [ (RequiresNoTag,) <$> arbitrary + , (RequiresNetworkTag,) <$> arbitrary + , pure byronMainnet + , pure byronStaging + , pure byronTestnet + , pure byronPreview + , pure byronPreprod + , pure icarusMainnet + , pure icarusStaging + , pure icarusTestnet + , pure icarusPreview + , pure icarusPreprod + ] + +instance Arbitrary NetworkTag where + shrink (NetworkTag tag) = NetworkTag <$> shrink tag + arbitrary = NetworkTag <$> choose (0, 15) + +instance Arbitrary Shelley.Role where + shrink = genericShrink + arbitrary = elements + [ Shelley.UTxOExternal + , Shelley.UTxOInternal + , Shelley.Stake + , Shelley.DRep + , Shelley.CCCold + , Shelley.CCHot + ] + +instance Arbitrary Icarus.Role where + shrink = genericShrink + arbitrary = elements + [ Icarus.UTxOExternal + , Icarus.UTxOInternal + ] + +-- +-- Extra Instances +-- + +-- Necessary unsound Show instance for QuickCheck failure reporting +instance Show XPrv where + show = show . xprvToBytes + +-- Necessary unsound Eq instance for QuickCheck properties +instance Eq XPrv where + (==) = (==) `on` xprvToBytes +-- +-- Useful functions +-- + +-- | Generates an arbitrary mnemonic of a size according to the type parameter. +-- +-- E.g: +-- >>> arbitrary = SomeMnemonic <$> genMnemonic @12 +genMnemonic + :: forall mw ent csz. + ( ConsistentEntropy ent mw csz + , EntropySize mw ~ ent + ) + => Gen (Mnemonic mw) +genMnemonic = do + let n = fromIntegral (natVal $ Proxy @(EntropySize mw)) `div` 8 + bytes <- BS.pack <$> vector n + let ent = unsafeMkEntropy @(EntropySize mw) bytes + return $ entropyToMnemonic ent + +unsafeMkEntropy + :: forall ent csz. + ( HasCallStack + , ValidEntropySize ent + , ValidChecksumSize ent csz + ) + => ByteString + -> Entropy ent +unsafeMkEntropy = either (error . show) id . mkEntropy . BA.convert + +-- | Build 'Mnemonic' from literals +unsafeMkMnemonic + :: forall mw n csz + . (ConsistentEntropy n mw csz, EntropySize mw ~ n, HasCallStack) + => [Text] + -> Mnemonic mw +unsafeMkMnemonic m = + case mkMnemonic m of + Left e -> error $ "unsafeMnemonic: " <> show e + Right a -> a + +unsafeMkSomeMnemonicFromEntropy + :: forall mw ent csz. + ( HasCallStack + , ValidEntropySize ent + , ValidChecksumSize ent csz + , ValidMnemonicSentence mw + , ent ~ EntropySize mw + , mw ~ MnemonicWords ent + ) + => Proxy mw + -> ByteString + -> SomeMnemonic +unsafeMkSomeMnemonicFromEntropy _ = SomeMnemonic + . entropyToMnemonic + . unsafeMkEntropy @ent + +-- | Decode an hex-encoded 'ByteString' into raw bytes, or fail. +unsafeFromHex :: HasCallStack => ByteString -> ByteString +unsafeFromHex = + either (error . show) id . convertFromBase @ByteString @ByteString Base16 + +-- | Use the 'Right' of an Either +unsafeFromRight :: (HasCallStack, Show left) => Either left right -> right +unsafeFromRight = either (error . show) id diff --git a/test/Test/Utils.hs b/test/Test/Utils.hs new file mode 100644 --- /dev/null +++ b/test/Test/Utils.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Test.Utils + ( cli + , describeCmd + , validateJSON + , SchemaRef + ) where + +import Prelude + +import Data.String + ( IsString ) +import Data.Text + ( Text ) +#ifdef HJSONSCHEMA +import JSONSchema.Draft4 + ( Schema (..) + , SchemaWithURI (..) + , checkSchema + , emptySchema + , referencesViaFilesystem + ) +#endif +import System.Environment + ( lookupEnv ) +import System.Process + ( readProcess, readProcessWithExitCode ) +import Test.Hspec + ( Spec, SpecWith, describe, runIO ) + +import qualified Data.Aeson as Json + + +-- +-- cli +-- + +class CommandLine output where + cli :: [String] + -- ^ arguments + -> String + -- ^ stdin + -> IO output + -- ^ output, either stdout or (stdout, stderr) + +instance CommandLine String where + cli args input = do + (exe', args') <- getWrappedCLI args + readProcess exe' args' input + +instance CommandLine (String, String) where + cli args input = do + (exe', args') <- getWrappedCLI args + dropFirst <$> readProcessWithExitCode exe' args' input + where + dropFirst (_,b,c) = (b, c) + +exe :: String +exe = "cardano-address" + +-- | Return the exe name and args for a CLI invocation. +-- For ghcjs, the cardano-address CLI must be executed under nodejs. +getWrappedCLI :: [String] -> IO (FilePath, [String]) +getWrappedCLI args = maybe (exe, args) wrap <$> lookupJsExe + where + lookupJsExe = fmap allJs <$> lookupEnv "CARDANO_ADDRESSES_CLI" + allJs = (<> ("/" <> exe <> ".jsexe/all.js")) + wrap jsExe = ("node", (jsExe:args)) + +-- +-- describeCmd +-- + +-- | Wrap HSpec 'describe' into a friendly command description. So that, we get +-- a very satisfying result visually from running the tests, and can inspect +-- what each command help text looks like. +describeCmd :: [String] -> SpecWith () -> Spec +describeCmd cmd spec = do + title <- runIO $ cli (cmd ++ ["--help"]) "" + describe title spec + + +-- +-- JSON Schema Validation +-- + +newtype SchemaRef = SchemaRef + { getSchemaRef :: Text + } deriving (Show, IsString) + +validateJSON :: SchemaRef -> Json.Value -> IO [String] +validateJSON _ _ = pure []