├── .buildkite ├── check-stylish.sh └── pipeline.yml ├── .gitignore ├── .stylish-haskell.yaml ├── CHANGELOG.md ├── LICENSE ├── MANUAL.md ├── Makefile ├── README.md ├── RELEASE.md ├── Setup.hs ├── bors.toml ├── cabal-nix.project ├── cabal.project ├── docs └── plant.uml ├── flake.lock ├── flake.nix ├── nix ├── haskell.nix ├── nixos │ └── tests │ │ ├── db-password-auth.nix │ │ ├── db-tests.nix │ │ ├── default.nix │ │ ├── mock-db.nix │ │ └── mock-db │ │ ├── block.csv │ │ ├── out.json │ │ ├── slot_leader.csv │ │ ├── stake_address.csv │ │ ├── tx.csv │ │ ├── tx_in.csv │ │ ├── tx_metadata.csv │ │ └── tx_out.csv ├── pkgs.nix └── tullia.nix ├── registration ├── .gitignore ├── LICENSE ├── app │ └── Main.hs ├── src │ └── Config │ │ └── Registration.hs └── voter-registration.cabal ├── shell.nix ├── src ├── Cardano │ ├── API │ │ ├── Extended.hs │ │ └── Extended │ │ │ └── Raw.hs │ ├── Catalyst │ │ ├── Crypto.hs │ │ ├── Query │ │ │ ├── Esqueleto.hs │ │ │ ├── Sql.hs │ │ │ └── Types.hs │ │ ├── Registration.hs │ │ ├── Registration │ │ │ ├── Types.hs │ │ │ └── Types │ │ │ │ └── Purpose.hs │ │ ├── Test │ │ │ ├── DSL.hs │ │ │ ├── DSL │ │ │ │ ├── Gen.hs │ │ │ │ └── Internal │ │ │ │ │ ├── Db.hs │ │ │ │ │ └── Types.hs │ │ │ └── VotePower │ │ │ │ └── Gen.hs │ │ └── VotePower.hs │ └── Db │ │ └── Extended.hs ├── Config │ ├── Common.hs │ └── Snapshot.hs └── Main.hs ├── supported-systems.nix ├── test ├── Main.hs ├── Test │ └── Cardano │ │ ├── API │ │ └── Extended.hs │ │ └── Catalyst │ │ ├── Crypto.hs │ │ ├── Registration.hs │ │ └── VotePower.hs └── integration │ ├── Main.hs │ └── Test │ └── Cardano │ └── Catalyst │ ├── Db.hs │ ├── Helpers.hs │ └── Query.hs └── voting-tools.cabal /.buildkite/check-stylish.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | stylish-haskell -i `git ls-files -- '*.hs'` 6 | 7 | git diff --exit-code 8 | -------------------------------------------------------------------------------- /.buildkite/pipeline.yml: -------------------------------------------------------------------------------- 1 | steps: 2 | - label: 'Check Stylish Haskell' 3 | command: 'nix develop .#stylish --command .buildkite/check-stylish.sh' 4 | agents: 5 | system: x86_64-linux 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle/ 2 | dist/ 3 | result* 4 | *.local 5 | *.local~ 6 | TAGS 7 | .direnv -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | # Stylish-haskell configuration file. 2 | 3 | # Principles: 4 | # 5 | # 1. Amount of indent should not be dependent on the length of the previous line 6 | # 2. Imports lists should be compact 7 | # 3. All linting rules that delete comments should be disabled 8 | # 4. No inline indenting, for example indent of ->, =, <-, as 9 | # 5. Redunant imports and pragmas should be removed 10 | # 6. Consistent syntax 11 | # 7. No trailing whitespaces 12 | # 8. Slightly generous screen with assumed 13 | # 9. All Haskell files in the project are subject to code formatting style 14 | 15 | steps: 16 | # Principle 4 17 | - simple_align: 18 | cases: false 19 | top_level_patterns: false 20 | # Principle 3 21 | records: false 22 | 23 | # Import cleanup 24 | - imports: 25 | align: global 26 | 27 | # Principle 1,2 28 | list_align: with_module_name 29 | 30 | # Principle 4 31 | pad_module_names: false 32 | 33 | # Principle 2 34 | long_list_align: inline 35 | 36 | empty_list_align: inherit 37 | 38 | list_padding: 2 39 | 40 | separate_lists: true 41 | 42 | space_surround: false 43 | 44 | - language_pragmas: 45 | style: vertical 46 | 47 | align: false 48 | 49 | # Principle 5 50 | remove_redundant: true 51 | 52 | # Principle 6 53 | language_prefix: LANGUAGE 54 | 55 | # Principle 7 56 | - trailing_whitespace: {} 57 | 58 | # Principle 8 59 | columns: 100 60 | 61 | newline: native 62 | 63 | # Principle 9 64 | # 65 | # These syntax-affecting language extensions are enabled so that 66 | # stylish-haskell wouldn't fail with parsing errors when processing files 67 | # in projects that have those extensions enabled in the .cabal file 68 | # rather than locally. 69 | # 70 | # In particular language extensions with British and American spellings 71 | # that we use should be included here until stylish-haskell supports 72 | # the British spelling. 73 | language_extensions: 74 | - BangPatterns 75 | - ConstraintKinds 76 | - DataKinds 77 | - DefaultSignatures 78 | - DeriveDataTypeable 79 | - DeriveGeneric 80 | - ExistentialQuantification 81 | - FlexibleContexts 82 | - FlexibleInstances 83 | - FunctionalDependencies 84 | - GADTs 85 | - GeneralizedNewtypeDeriving 86 | - LambdaCase 87 | - MultiParamTypeClasses 88 | - MultiWayIf 89 | - NoImplicitPrelude 90 | - OverloadedStrings 91 | - PolyKinds 92 | - RecordWildCards 93 | - ScopedTypeVariables 94 | - StandaloneDeriving 95 | - TemplateHaskell 96 | - TupleSections 97 | - TypeApplications 98 | - TypeFamilies 99 | - ViewPatterns 100 | - ExplicitNamespaces 101 | 102 | cabal: true 103 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for voting-tools 2 | 3 | ## 0.3.0.0 -- 2021-12-08 4 | 5 | - The `voter-registration` tool now allows the user to delegate their voting power between voting keys using the `--delegate key,weight` syntax. 6 | - Previous `--vote-public-key-file` syntax still supported. 7 | - The `voting-tools` tool now handles registrations made using the [CIP-36](https://cips.cardano.org/cips/cip36/) transaction metadata format (i.e. `delegations` and `voting purpose`) 8 | - Previous transaction metadata format still supported. 9 | - Re-arranged modules to improve architecture. 10 | 11 | ## 0.2.0.0 -- 2021-12-08 12 | 13 | - Updated voter-registration tool to work in the Alonzo era. 14 | - Improved error messages if there isn't enough funds to meet the registration transaction fee. 15 | - Updated cardano-node and cardano-db-sync dependencies. 16 | - Changed voter-registration to only output transaction metadata, instead of a signed transaction. User must now create and sign transaction. 17 | - Added --version flag to voter-registration and voting-tools executables. 18 | 19 | ## 0.1.0.0 -- YYYY-mm-dd 20 | 21 | * First version. Released on an unsuspecting world. 22 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /MANUAL.md: -------------------------------------------------------------------------------- 1 | # Register to Vote from Scratch 2 | 3 | ## Preamble 4 | 5 | This manual requires: 6 | 7 | - `cardano-cli` executable from the [cardano-node](https://github.com/input-output-hk/cardano-node) project 8 | - `jcli` executable from the [jormungandr](https://github.com/input-output-hk/jormungandr) project 9 | - `voter-registration` executable from this project 10 | - `voting-tools` executable from this project 11 | - A running [cardano-db-sync](https://github.com/input-output-hk/cardano-db-sync) instance, fully synced 12 | 13 | Run this example on testnet (Use "--mainnet" if you want to run this on mainnet): 14 | 15 | ``` shell 16 | export NETWORK_ID="--testnet-magic 1097911063" 17 | ``` 18 | 19 | Let `cardano-cli` know where the node socket is: 20 | 21 | ``` shell 22 | export CARDANO_NODE_SOCKET_PATH="/run/cardano-node/node.socket" 23 | ``` 24 | 25 | ## Generate Stake Address 26 | 27 | TODO: This is outdated since a regular shelley address is now used for the rewards 28 | Generate a stake address from a stake key: 29 | 30 | ``` shell 31 | cardano-cli stake-address key-gen \ 32 | --verification-key-file stake.vkey \ 33 | --signing-key-file stake.skey 34 | cardano-cli stake-address build \ 35 | --stake-verification-key-file stake.vkey \ 36 | $NETWORK_ID \ 37 | --out-file stake.addr 38 | ``` 39 | 40 | ## Generate Base Address 41 | 42 | Generate a [base address](https://docs.cardano.org/core-concepts/cardano-addresses#baseaddresses) from a payment key and a stake key: 43 | 44 | ``` shell 45 | cardano-cli address key-gen \ 46 | --verification-key-file payment.vkey \ 47 | --signing-key-file payment.skey 48 | cardano-cli address build \ 49 | $NETWORK_ID \ 50 | --payment-verification-key-file payment.vkey \ 51 | --stake-verification-key-file stake.vkey \ 52 | --out-file payment.addr 53 | 54 | export PAYMENT_ADDR=$(cat payment.addr) 55 | ``` 56 | 57 | We will use the base address to: 58 | 59 | - Pay transaction fees 60 | - Pay stake address registration fees 61 | - Hold value for the associated stake key (that is later translated into voting power) 62 | 63 | ## Get Funds 64 | 65 | We need to add funds to the base address in order to pay fees and hold value (i.e. voting power): 66 | 67 | - On testnet, add funds using the [faucet](https://testnets.cardano.org/en/testnets/cardano/tools/faucet/), using the base address (`$(cat payment.addr)`) as the address. 68 | - On mainnet, add funds using an exchange or transfer money from elsewhere. 69 | 70 | ## Register Stake Address 71 | 72 | The stake address must be registered on-chain in order for the snapshot tool to find it. 73 | 74 | To do so, first generate a registration certificate: 75 | 76 | ``` shell 77 | cardano-cli stake-address registration-certificate \ 78 | --stake-verification-key-file stake.vkey \ 79 | --out-file stake.cert 80 | ``` 81 | 82 | Then submit the registration certificate in a transaction: 83 | 84 | ``` shell 85 | export UTXO=$(cardano-cli query utxo $NETWORK_ID --address $PAYMENT_ADDR | tail -n1 | awk '{print $1;}') 86 | export UTXO_TXIX=$(cardano-cli query utxo $NETWORK_ID --address $PAYMENT_ADDR | tail -n1 | awk '{print $2;}') 87 | echo "UTxO: $UTXO#$UTXO_TXIX" 88 | 89 | cardano-cli query protocol-parameters \ 90 | $NETWORK_ID \ 91 | --out-file protocol.json 92 | 93 | cardano-cli transaction build \ 94 | $NETWORK_ID \ 95 | --tx-in $UTXO#$UTXO_TXIX \ 96 | --change-address $PAYMENT_ADDR \ 97 | --certificate-file stake.cert \ 98 | --protocol-params-file protocol.json \ 99 | --out-file tx.raw \ 100 | --witness-override 2 101 | 102 | cardano-cli transaction sign \ 103 | --tx-body-file tx.raw \ 104 | --signing-key-file payment.skey \ 105 | --signing-key-file stake.skey \ 106 | $NETWORK_ID \ 107 | --out-file tx.signed 108 | 109 | cardano-cli transaction submit \ 110 | --tx-file tx.signed \ 111 | $NETWORK_ID 112 | ``` 113 | 114 | Note that we pay not only a transaction fee, but a deposit for registering the stake address. 115 | 116 | The deposit amount is listed in the protocol parameters under "stakeAddressDeposit". 117 | 118 | ## Register Voting Key 119 | 120 | We must generate a voting key to use on the Catalyst side-chain: 121 | 122 | ``` shell 123 | jcli key generate \ 124 | --type ed25519extended \ 125 | > vote.skey 126 | jcli key to-public \ 127 | < vote.skey \ 128 | > vote.pub 129 | ``` 130 | 131 | And then generate metadata associating that voting key with our stake address: 132 | 133 | ``` shell 134 | export SLOT_TIP=$(cardano-cli query tip $NETWORK_ID | jq '.slot') 135 | 136 | voter-registration \ 137 | --rewards-address $(cat stake.addr) \ 138 | --vote-public-key-file vote.pub \ 139 | --stake-signing-key-file stake.skey \ 140 | --slot-no $SLOT_TIP \ 141 | --json > metadata.json 142 | ``` 143 | 144 | The voting power on the Catalyst side-chain is derived from the value associated with this stake address (via our [base address](https://docs.cardano.org/core-concepts/cardano-addresses#baseaddresses)). 145 | 146 | It is also possible to delegate your voting power between voting keys. 147 | 148 | For example to split your voting power 1/3 to `vote1.pub` and 2/3 to `vote2.pub`, you could use the following invocation: 149 | 150 | ``` shell 151 | voter-registration \ 152 | --rewards-address $(cat stake.addr) \ 153 | --delegate vote1.pub,1 \ 154 | --delegate vote2.pub,2 \ 155 | --stake-signing-key-file stake.skey \ 156 | --slot-no $SLOT_TIP \ 157 | --json > metadata.json 158 | ``` 159 | 160 | Submit the generated metadata to the blockchain in a transaction: 161 | 162 | ``` shell 163 | export UTXO=$(cardano-cli query utxo $NETWORK_ID --address $PAYMENT_ADDR | tail -n1 | awk '{print $1;}') 164 | export UTXO_TXIX=$(cardano-cli query utxo $NETWORK_ID --address $PAYMENT_ADDR | tail -n1 | awk '{print $2;}') 165 | echo "UTxO: $UTXO#$UTXO_TXIX" 166 | 167 | cardano-cli transaction build \ 168 | $NETWORK_ID \ 169 | --tx-in $UTXO#$UTXO_TXIX \ 170 | --change-address $PAYMENT_ADDR \ 171 | --metadata-json-file metadata.json \ 172 | --protocol-params-file protocol.json \ 173 | --out-file tx.raw 174 | 175 | cardano-cli transaction sign \ 176 | --tx-body-file tx.raw \ 177 | --signing-key-file payment.skey \ 178 | $NETWORK_ID \ 179 | --out-file tx.signed 180 | 181 | cardano-cli transaction submit \ 182 | --tx-file tx.signed \ 183 | $NETWORK_ID 184 | 185 | cardano-cli transaction txid --tx-file tx.signed 186 | ``` 187 | 188 | ## Confirm Vote Power 189 | 190 | The voting power associated with a stake address can be confirmed using the snapshot tool. 191 | 192 | The snapshot tool requires a fully synced `cardano-db-sync` database to retrieve voting power. 193 | 194 | Refer to [cardano-db-sync](https://github.com/input-output-hk/cardano-db-sync) for instructions on starting and building `cardano-db-sync`. In this example we assume it has been started using [docker-compose.yaml](https://github.com/input-output-hk/cardano-db-sync/blob/master/docker-compose.yml) (as described in the [Docker](https://github.com/input-output-hk/cardano-db-sync/blob/master/doc/docker.md) section). 195 | 196 | ``` shell 197 | export REWARDS_ADDRESS=$(cardano-cli address info --address $(cat stake.addr) | jq -r .base16) 198 | export DB=$(cat ../cardano-db-sync/config/secrets/postgres_db) 199 | export DB_USER=$(cat ../cardano-db-sync/config/secrets/postgres_user) 200 | export DB_PASS=$(cat ../cardano-db-sync/config/secrets/postgres_password) 201 | 202 | voting-tools \ 203 | $NETWORK_ID \ 204 | --db $DB \ 205 | --db-user $DB_USER \ 206 | --db-pass $DB_PASS \ 207 | --db-host localhost \ 208 | --out-file voting-snapshot.json 209 | 210 | cat voting-snapshot.json | jq --arg REWARDS_ADDRESS "$REWARDS_ADDRESS" '.[] | select(.rewards_address | contains($REWARDS_ADDRESS))' 211 | ``` 212 | 213 | ## Return Funds to Faucet 214 | 215 | It is polite to return funds used in the testnet to the faucet: 216 | 217 | ```shell 218 | export ADA_LEFT=$(cardano-cli query utxo $NETWORK_ID --address $PAYMENT_ADDR | tail -n1 | awk '{print $3;}') 219 | export UTXO=$(cardano-cli query utxo $NETWORK_ID --address $PAYMENT_ADDR | tail -n1 | awk '{print $1;}') 220 | export UTXO_TXIX=$(cardano-cli query utxo $NETWORK_ID --address $PAYMENT_ADDR | tail -n1 | awk '{print $2;}') 221 | export FAUCET_ADDR="addr_test1qqr585tvlc7ylnqvz8pyqwauzrdu0mxag3m7q56grgmgu7sxu2hyfhlkwuxupa9d5085eunq2qywy7hvmvej456flknswgndm3" 222 | 223 | echo 224 | echo "Building faucet refund transaction..." 225 | 226 | cardano-cli transaction build-raw \ 227 | --alonzo-era \ 228 | --fee 0 \ 229 | --tx-in $UTXO#$UTXO_TXIX \ 230 | --tx-out "$FAUCET_ADDR+$ADA_LEFT" \ 231 | --out-file return.raw 232 | 233 | export FEE=$(cardano-cli transaction calculate-min-fee \ 234 | $NETWORK_ID \ 235 | --tx-body-file return.raw \ 236 | --tx-in-count 1 \ 237 | --tx-out-count 1 \ 238 | --witness-count 1 \ 239 | --protocol-params-file protocol.json | awk '{print $1;}') 240 | export AMT_OUT=$(expr $ADA_LEFT - $FEE) 241 | 242 | cardano-cli transaction build-raw \ 243 | --alonzo-era \ 244 | --fee $FEE \ 245 | --tx-in $UTXO#$UTXO_TXIX \ 246 | --tx-out "$FAUCET_ADDR+$AMT_OUT" \ 247 | --out-file return.raw 248 | 249 | cardano-cli transaction sign \ 250 | --signing-key-file payment.skey \ 251 | --tx-body-file return.raw \ 252 | --out-file return.signed 253 | 254 | cardano-cli transaction submit \ 255 | $NETWORK_ID \ 256 | --tx-file return.signed 257 | 258 | echo 259 | echo "Awaiting refund..." 260 | sleep 60 261 | cardano-cli query utxo \ 262 | $NETWORK_ID \ 263 | --address $PAYMENT_ADDR 264 | ``` 265 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | dev: 3 | nix-shell --run "ghcid -c 'cabal repl $(target) --project-file=cabal-nix.project'" 4 | 5 | repl: 6 | nix-shell --run "cabal repl $(target) --project-file=cabal-nix.project" 7 | 8 | build-voting-tools: 9 | nix-build default.nix -A haskellPackages.voting-tools.components.exes.voting-tools -o voting-tools 10 | 11 | build-voter-registration: 12 | nix-build default.nix -A haskellPackages.voter-registration.components.exes.voter-registration -o voter-registration 13 | 14 | style: ## Apply stylish-haskell on all *.hs files 15 | nix-shell --pure --run 'find . -type f -name "*.hs" -not -path ".git" -not -path "*.stack-work*" -not -path "./dist*" -print0 | xargs -0 stylish-haskell -i' 16 | 17 | test: 18 | nix-build default.nix -A haskellPackages.voting-tools.checks.unit-tests 19 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Catalyst Voting Tools 2 | 3 |

4 | 5 | 6 |

7 | 8 | A library and series of executables to aid programmers and users to 9 | interact with the voting capabilities of Catalyst. 10 | 11 | The "voter-registration" executable creates transaction metadata in the correct format for submission with a transaction, to register a user to vote. 12 | 13 | The "voting-tools" creates a snapshot of the voting power of registrations and outputs it as JSON file. 14 | 15 | ## Obtaining 16 | 17 | ### Static binary 18 | 19 | A static binary for the "voter-registration" executable is provided. Due to limitations in our cross-compilation infrastructure (specifically, static binaries of postgresql libraries cannot be produced), a static binary cannot be provided for the "voting-tools" executable. 20 | 21 | The latest static binary can be found [here](https://hydra.iohk.io/job/Cardano/voting-tools/native.voterRegistrationTarball.x86_64-linux/latest/download/1/voter-registration.tar.gz). 22 | 23 | Or built with: 24 | 25 | ``` 26 | nix build .#voterRegistrationTarball 27 | ``` 28 | 29 | ### Build it yourself 30 | 31 | #### With Nix 32 | 33 | ``` 34 | nix build .#voter-registration -o voter-registration 35 | nix build .#voting-tools -o voting-tools 36 | 37 | ./voting-tools/bin/voting-tools --mainnet --db-user cardano-node --out-file snapshot.json 38 | ``` 39 | 40 | ## How to Register to Vote from Scratch 41 | 42 | See [Manual](https://github.com/input-output-hk/voting-tools/blob/master/MANUAL.md). 43 | 44 | ## Development 45 | 46 | ``` 47 | # Launch a ghcid session for the given target 48 | make dev target=lib:voting-tools 49 | make dev target=exe:voting-tools 50 | make dev target=exe:voter-registration 51 | # Launch a ghci session for the given target 52 | make repl target=lib:voting-tools 53 | ``` 54 | -------------------------------------------------------------------------------- /RELEASE.md: -------------------------------------------------------------------------------- 1 | # Release Checklist 2 | 3 | ## Preparing the release 4 | 5 | - Fetch the tip of `master`: 6 | 7 | ```shell 8 | $ git checkout master 9 | $ git pull 10 | ``` 11 | 12 | - Ensure that the versions of `voting-tools` and `voter-registration` have been bumped appropriately. 13 | 14 | - Create and push a signed release tag on the `HEAD` of `master`. 15 | 16 | ```shell 17 | $ git tag -s -m v0.4.0.0 v0.4.0.0 18 | $ git push origin refs/tags/v0.4.0.0 19 | ``` 20 | 21 | Where `v0.4.0.0` should be replaced by the actual date of the release. 22 | 23 | - Wait for the Hydra build of that commit to finish and then check the evaluation for the "voterRegistrationTarball.x86_64-linux" build (e.g. https://hydra.iohk.io/build/15320965 ). Copy the URL and SHA-256 hash of that build (click "Details") for use in creating the release notes. 24 | 25 | ## Create the release notes 26 | 27 | - Write release notes on the [release page](https://github.com/input-output-hk/voting-tools/releases). 28 | - Include the link to the `voter-registration.tar.gz` and SHA-256 hash from the previous step. 29 | 30 | - Remove items that are irrelevant to users (e.g. pure refactoring, improved testing). 31 | 32 | ## Manual ad-hoc verifications 33 | 34 | - Follow [Manual](https://github.com/input-output-hk/voting-tools/blob/master/MANUAL.md) using the binaries to be released. 35 | 36 | ## Publication 37 | 38 | - Once everyone has signed off (i.e. Catalyst Team, Tech lead, QA & Release manager), publish the release draft. 39 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bors.toml: -------------------------------------------------------------------------------- 1 | status = [ 2 | "buildkite/voting-tools", 3 | "ci/hydra-build:required", 4 | ] 5 | timeout_sec = 7200 6 | required_approvals = 1 7 | block_labels = [ "WIP", "DO NOT MERGE" ] 8 | delete_merged_branches = true 9 | -------------------------------------------------------------------------------- /cabal-nix.project: -------------------------------------------------------------------------------- 1 | packages: 2 | ./. 3 | ./registration 4 | tests: True 5 | benchmarks: True 6 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | index-state: 2021-10-05T00:00:00Z 2 | with-compiler: ghc-8.10.7 3 | 4 | packages: 5 | ./. 6 | ./registration 7 | 8 | package voting-tools 9 | tests: True 10 | 11 | package voter-registration 12 | tests: True 13 | 14 | source-repository-package 15 | type: git 16 | location: https://github.com/input-output-hk/cardano-node 17 | tag: 2cbe363874d0261bc62f52185cf23ed492cf4859 18 | --sha256: 0x5j0cynlc9kiyj9w7casax477z3fb74pfsyfl373dn7rv1grg4d 19 | subdir: cardano-api 20 | cardano-cli 21 | cardano-node 22 | cardano-node-chairman 23 | 24 | source-repository-package 25 | type: git 26 | location: https://github.com/input-output-hk/cardano-db-sync 27 | tag: 935e1fe5d5d11d694e9b6c54030a592b85742671 28 | --sha256: 1jc4gda82z1xh81p9xl83blbsfsbr556k1ksqfl80fjrhbycaw29 29 | subdir: cardano-db 30 | 31 | -- Using a fork until our patches can be merged upstream 32 | source-repository-package 33 | type: git 34 | location: https://github.com/input-output-hk/optparse-applicative 35 | tag: 7497a29cb998721a9068d5725d49461f2bba0e7a 36 | --sha256: 1gvsrg925vynwgqwplgjmp53vj953qyh3wbdf34pw21c8r47w35r 37 | 38 | source-repository-package 39 | type: git 40 | location: https://github.com/input-output-hk/hedgehog-extras 41 | tag: edf6945007177a638fbeb8802397f3a6f4e47c14 42 | --sha256: 0wc7qzkc7j4ns2rz562h6qrx2f8xyq7yjcb7zidnj7f6j0pcd0i9 43 | 44 | source-repository-package 45 | type: git 46 | location: https://github.com/input-output-hk/cardano-base 47 | tag: 654f5b7c76f7cc57900b4ddc664a82fc3b925fb0 48 | --sha256: 0j4x9zbx5dkww82sqi086h39p456iq5xr476ylmrnpwcpfb4xai4 49 | subdir: 50 | base-deriving-via 51 | binary 52 | binary/test 53 | cardano-crypto-class 54 | cardano-crypto-praos 55 | cardano-crypto-tests 56 | measures 57 | orphans-deriving-via 58 | slotting 59 | strict-containers 60 | 61 | source-repository-package 62 | type: git 63 | location: https://github.com/input-output-hk/cardano-crypto 64 | tag: f73079303f663e028288f9f4a9e08bcca39a923e 65 | --sha256: 1n87i15x54s0cjkh3nsxs4r1x016cdw1fypwmr68936n3xxsjn6q 66 | 67 | source-repository-package 68 | type: git 69 | location: https://github.com/input-output-hk/cardano-ledger-specs 70 | tag: bf008ce028751cae9fb0b53c3bef20f07c06e333 71 | --sha256: 0my3801w1vinc0kf5yh9lxl6saqxgwm6ccg0vvzi104pafcwwcqx 72 | subdir: 73 | eras/alonzo/impl 74 | eras/alonzo/test-suite 75 | eras/byron/chain/executable-spec 76 | eras/byron/crypto 77 | eras/byron/crypto/test 78 | eras/byron/ledger/executable-spec 79 | eras/byron/ledger/impl 80 | eras/byron/ledger/impl/test 81 | eras/shelley/impl 82 | eras/shelley/test-suite 83 | eras/shelley-ma/impl 84 | eras/shelley-ma/test-suite 85 | libs/cardano-ledger-core 86 | libs/cardano-ledger-pretty 87 | libs/cardano-protocol-tpraos 88 | libs/small-steps 89 | libs/small-steps-test 90 | libs/non-integral 91 | eras/shelley/chain-and-ledger/executable-spec 92 | eras/shelley/chain-and-ledger/shelley-spec-ledger-test 93 | eras/shelley/chain-and-ledger/dependencies/non-integer 94 | 95 | source-repository-package 96 | type: git 97 | location: https://github.com/input-output-hk/cardano-prelude 98 | tag: bb4ed71ba8e587f672d06edf9d2e376f4b055555 99 | --sha256: 00h10l5mmiza9819p9v5q5749nb9pzgi20vpzpy1d34zmh6gf1cj 100 | subdir: 101 | cardano-prelude 102 | cardano-prelude-test 103 | 104 | source-repository-package 105 | type: git 106 | location: https://github.com/input-output-hk/goblins 107 | tag: cde90a2b27f79187ca8310b6549331e59595e7ba 108 | --sha256: 17c88rbva3iw82yg9srlxjv2ia5wjb9cyqw44hik565f5v9svnyg 109 | 110 | source-repository-package 111 | type: git 112 | location: https://github.com/input-output-hk/iohk-monitoring-framework 113 | tag: 808724ff8a19a33d0ed06f9ef59fbd900b08553c 114 | --sha256: 0298dpl29gxzs9as9ha6y0w18hqwc00ipa3hzkxv7nlfrjjz8hmz 115 | subdir: 116 | contra-tracer 117 | iohk-monitoring 118 | plugins/backend-aggregation 119 | plugins/backend-ekg 120 | plugins/backend-monitoring 121 | plugins/backend-trace-forwarder 122 | plugins/scribe-systemd 123 | tracer-transformers 124 | 125 | source-repository-package 126 | type: git 127 | location: https://github.com/input-output-hk/Win32-network 128 | tag: 3825d3abf75f83f406c1f7161883c438dac7277d 129 | --sha256: 19wahfv726fa3mqajpqdqhnl9ica3xmf68i254q45iyjcpj1psqx 130 | 131 | source-repository-package 132 | type: git 133 | location: https://github.com/input-output-hk/ouroboros-network 134 | tag: 94782e5ca52f234ff8eeddc6322a46cca0b69c0e 135 | --sha256: 1da3pka4pn6sjf6w19d957aryjc9ip1a3g0vz7jz66pjri3v2n0j 136 | subdir: 137 | io-sim 138 | io-classes 139 | monoidal-synchronisation 140 | network-mux 141 | ouroboros-consensus 142 | ouroboros-consensus-byron 143 | ouroboros-consensus-cardano 144 | ouroboros-consensus-shelley 145 | ouroboros-network 146 | ouroboros-network-framework 147 | ouroboros-network-testing 148 | typed-protocols 149 | typed-protocols-cborg 150 | typed-protocols-examples 151 | 152 | source-repository-package 153 | type: git 154 | location: https://github.com/input-output-hk/plutus 155 | tag: 1efbb276ef1a10ca6961d0fd32e6141e9798bd11 156 | --sha256: 1jicyk4hr8p0xksj4048gdxndrb42jz4wsnkhc3ymxbm5v6snalf 157 | subdir: 158 | freer-extras 159 | plutus-core 160 | plutus-ledger 161 | plutus-ledger-api 162 | plutus-tx 163 | plutus-tx-plugin 164 | prettyprinter-configurable 165 | stubs/plutus-ghc-stub 166 | word-array 167 | 168 | source-repository-package 169 | type: git 170 | location: https://github.com/input-output-hk/ekg-forward 171 | tag: d9e8fd302fa6ba41c07183d371e6777286d37bc2 172 | --sha256: 0s8cblhq3i528jj7r7yd4v82nqzafj8vrgf0y80l7saxc3a5f2lk 173 | 174 | -- Drops an instance breaking our code. Should be released to Hackage eventually. 175 | source-repository-package 176 | type: git 177 | location: https://github.com/input-output-hk/flat 178 | tag: ee59880f47ab835dbd73bea0847dab7869fc20d8 179 | --sha256: 1lrzknw765pz2j97nvv9ip3l1mcpf2zr4n56hwlz0rk7wq7ls4cm 180 | 181 | source-repository-package 182 | type: git 183 | location: https://github.com/input-output-hk/cardano-config 184 | tag: e9de7a2cf70796f6ff26eac9f9540184ded0e4e6 185 | --sha256: 1wm1c99r5zvz22pdl8nhkp13falvqmj8dgkm8fxskwa9ydqz01ld 186 | 187 | constraints: 188 | hedgehog >= 1.0 189 | , bimap >= 0.4.0 190 | , libsystemd-journal >= 1.4.4 191 | , systemd >= 2.3.0 192 | -- systemd-2.3.0 requires at least network 3.1.1.0 but it doesn't declare 193 | -- that dependency 194 | , network >= 3.1.1.0 195 | -- needed until we update past cardano-ledger@43f7c7318e38c501c2d2a2c680251c7c1f78d0fd 196 | , hashable < 1.3.4.0 197 | , base16-bytestring == 1.0.1.0 198 | 199 | package comonad 200 | flags: -test-doctests 201 | 202 | package cardano-ledger-alonzo-test 203 | tests: False 204 | 205 | allow-newer: 206 | monoidal-containers:aeson, 207 | size-based:template-haskell 208 | 209 | package cardano-crypto-praos 210 | flags: -external-libsodium-vrf 211 | 212 | package cardano-api 213 | flags: -Wno-unused-packages 214 | 215 | package postgresql-libpq 216 | flags: +use-pkg-config 217 | -------------------------------------------------------------------------------- /docs/plant.uml: -------------------------------------------------------------------------------- 1 | @startuml 2 | 3 | title High Level Architecture 4 | 5 | frame snapshot { 6 | node Main as snapshotX 7 | snapshotX --> lib 8 | snapshotX --> backend 9 | } 10 | 11 | frame voter-registration { 12 | node Main as voterRegistrationX 13 | voterRegistrationX --> lib 14 | } 15 | 16 | frame catalyst-lib as lib { 17 | 18 | frame UI { 19 | node Presentation 20 | node Config 21 | UI --> Application 22 | } 23 | 24 | frame Application { 25 | node VotePower 26 | Application --> Domain 27 | } 28 | 29 | frame Domain { 30 | node Registration 31 | node "Query Interface" as intf 32 | Domain --> Infrastructure 33 | } 34 | 35 | frame Infrastructure { 36 | node Api.Extended 37 | node Db.Extended 38 | node Crypto 39 | } 40 | } 41 | 42 | frame catalyst-backend as backend { 43 | frame Domain as d { 44 | node "Query Implementation" as impl 45 | } 46 | } 47 | 48 | impl ..>> intf 49 | @enduml 50 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Voting Tools"; 3 | 4 | inputs = { 5 | nixpkgs.follows = "haskellNix/nixpkgs-2111"; 6 | haskellNix = { 7 | url = "github:input-output-hk/haskell.nix"; 8 | }; 9 | utils.url = "github:numtide/flake-utils"; 10 | iohkNix = { 11 | url = "github:input-output-hk/iohk-nix"; 12 | }; 13 | cardano-node = { 14 | url = "github:input-output-hk/cardano-node?ref=refs/tags/1.31.0"; 15 | }; 16 | cardano-db-sync = { 17 | url = "github:input-output-hk/cardano-db-sync?ref=refs/tags/12.0.2"; 18 | }; 19 | tullia.url = "github:input-output-hk/tullia"; 20 | }; 21 | 22 | outputs = { self, nixpkgs, utils, haskellNix, iohkNix, cardano-db-sync, tullia, ... } @ inputs: 23 | let 24 | inherit (nixpkgs) lib; 25 | inherit (lib) head systems mapAttrs recursiveUpdate mkDefault 26 | getAttrs optionalAttrs nameValuePair attrNames; 27 | inherit (utils.lib) eachSystem mkApp flattenTree; 28 | inherit (iohkNix.lib) prefixNamesWith collectExes; 29 | 30 | supportedSystems = import ./supported-systems.nix; 31 | defaultSystem = head supportedSystems; 32 | 33 | overlays = [ 34 | haskellNix.overlay 35 | iohkNix.overlays.haskell-nix-extra 36 | iohkNix.overlays.crypto 37 | iohkNix.overlays.cardano-lib 38 | iohkNix.overlays.utils 39 | (final: prev: { 40 | gitrev = self.rev or "dirty"; 41 | commonLib = lib // iohkNix.lib; 42 | }) 43 | (import ./nix/pkgs.nix) 44 | ]; 45 | 46 | mkHydraJobs = system: let 47 | jobs = recursiveUpdate self.packages.${system} self.checks.${system} // { 48 | nixosTests = import ./nix/nixos/tests/default.nix { 49 | inherit system inputs; 50 | pkgs = self.legacyPackages.${system}; 51 | }; 52 | }; 53 | in 54 | jobs // { 55 | required = with nixpkgs.legacyPackages.${system}; releaseTools.aggregate { 56 | name = "github-required"; 57 | meta.description = "All jobs required to pass CI"; 58 | constituents = lib.collect lib.isDerivation jobs ++ lib.singleton 59 | (writeText "forceNewEval" self.rev or "dirty"); 60 | }; 61 | }; 62 | in 63 | eachSystem supportedSystems (system: 64 | let 65 | pkgs = import nixpkgs { 66 | inherit system overlays; 67 | inherit (haskellNix) config; 68 | }; 69 | 70 | flake = pkgs.votingToolsHaskellProject.flake { 71 | crossPlatforms = p: with p; [ 72 | musl64 73 | ]; 74 | }; 75 | packages = collectExes flake.packages // { 76 | voterRegistrationTarball = pkgs.runCommandNoCC "voter-registration-tarball" { buildInputs = [ pkgs.gnutar pkgs.gzip ]; } '' 77 | cp ${flake.packages."x86_64-unknown-linux-musl:voter-registration:exe:voter-registration"}/bin/voter-registration ./ 78 | mkdir -p $out/nix-support 79 | tar -czvf $out/voter-registration.tar.gz voter-registration 80 | echo "file binary-dist $out/voter-registration.tar.gz" > $out/nix-support/hydra-build-products 81 | ''; 82 | 83 | votingToolsTarball = pkgs.runCommandNoCC "voting-tools-tarball" { buildInputs = [ pkgs.gnutar pkgs.gzip ]; } '' 84 | cp ${flake.packages."x86_64-unknown-linux-musl:voting-tools:exe:voting-tools"}/bin/voting-tools ./ 85 | mkdir -p $out/nix-support 86 | tar -czvf $out/voting-tools.tar.gz voting-tools 87 | echo "file binary-dist $out/voting-tools.tar.gz" > $out/nix-support/hydra-build-products 88 | ''; 89 | }; 90 | 91 | in recursiveUpdate flake { 92 | 93 | inherit packages; 94 | 95 | legacyPackages = pkgs; 96 | 97 | devShells.stylish = pkgs.mkShell { packages = with pkgs; [ stylish-haskell git ]; }; 98 | 99 | # Built by `nix build .` 100 | defaultPackage = flake.packages."voting-tools:exe:voting-tools"; 101 | 102 | # Run by `nix run .` 103 | defaultApp = flake.apps."voting-tools:exe:voting-tools"; 104 | 105 | inherit (flake) apps; 106 | } // 107 | tullia.fromSimple system (import nix/tullia.nix) 108 | ) // { 109 | # We can't use flake-utils' eachSystem for this 110 | # because, unexpectedly, it outputs a different structure for hydraJobs. 111 | hydraJobs = let 112 | perSystem = lib.genAttrs supportedSystems mkHydraJobs; 113 | in perSystem // { 114 | required = with nixpkgs.legacyPackages.${defaultSystem}; releaseTools.aggregate { 115 | name = "github-required"; 116 | meta.description = "All jobs required to pass CI"; 117 | constituents = 118 | map (s: s.required) (__attrValues perSystem) ++ 119 | lib.singleton (writeText "forceNewEval" self.rev or "dirty"); 120 | }; 121 | }; 122 | }; 123 | } 124 | -------------------------------------------------------------------------------- /nix/haskell.nix: -------------------------------------------------------------------------------- 1 | ############################################################################ 2 | # Builds Haskell packages with Haskell.nix 3 | ############################################################################ 4 | { haskell-nix 5 | , lib 6 | }: 7 | 8 | let 9 | inherit (haskell-nix) haskellLib; 10 | 11 | src = haskellLib.cleanSourceWith { 12 | src = ../.; 13 | name = "voting-tools-src"; 14 | filter = name: type: (lib.cleanSourceFilter name type) 15 | && (haskell-nix.haskellSourceFilter name type) 16 | # removes socket files 17 | && lib.elem type [ "regular" "directory" "symlink" ]; 18 | }; 19 | compiler-nix-name = "ghc8107"; 20 | cabalProjectLocal = '' 21 | allow-newer: terminfo:base 22 | ''; 23 | 24 | projectPackages = lib.attrNames (haskellLib.selectProjectPackages 25 | (haskell-nix.cabalProject { 26 | inherit src compiler-nix-name cabalProjectLocal; 27 | })); 28 | 29 | # This creates the Haskell package set. 30 | # https://input-output-hk.github.io/haskell.nix/user-guide/projects/ 31 | pkgSet = haskell-nix.cabalProject' ({ pkgs 32 | , config 33 | , buildProject 34 | , ... 35 | }:{ 36 | inherit src compiler-nix-name cabalProjectLocal; 37 | 38 | # This provides a development environment that can be used with nix-shell or 39 | # lorri. See https://input-output-hk.github.io/haskell.nix/user-guide/development/ 40 | shell = { 41 | name = "voting-tools-shell"; 42 | 43 | # If shellFor local packages selection is wrong, 44 | # then list all local packages then include source-repository-package that cabal complains about: 45 | packages = ps: lib.attrValues (haskellLib.selectProjectPackages ps); 46 | 47 | # These programs will be available inside the nix-shell. 48 | nativeBuildInputs = with buildProject.hsPkgs; [ 49 | bech32.components.exes.bech32 50 | ] ++ (with pkgs.buildPackages.buildPackages; [ 51 | git 52 | ghcid 53 | hlint 54 | pkgconfig 55 | stylish-haskell 56 | jormungandr 57 | cabalWrapped 58 | # we also add cabal (even if cabalWrapped will be used by default) for shell completion: 59 | cabal-install 60 | ]); 61 | 62 | # Prevents cabal from choosing alternate plans, so that 63 | # *all* dependencies are provided by Nix. 64 | exactDeps = true; 65 | 66 | withHoogle = true; 67 | 68 | GIT_SSL_CAINFO = "${pkgs.cacert}/etc/ssl/certs/ca-bundle.crt"; 69 | }; 70 | modules = [ 71 | # Allow reinstallation of Win32 72 | ({ pkgs, ... }: lib.mkIf pkgs.stdenv.hostPlatform.isWindows { 73 | nonReinstallablePkgs = 74 | [ "rts" "ghc-heap" "ghc-prim" "integer-gmp" "integer-simple" "base" 75 | "deepseq" "array" "ghc-boot-th" "pretty" "template-haskell" 76 | # ghcjs custom packages 77 | "ghcjs-prim" "ghcjs-th" 78 | "ghc-boot" 79 | "ghc" "array" "binary" "bytestring" "containers" 80 | "filepath" "ghc-boot" "ghc-compact" "ghc-prim" 81 | # "ghci" "haskeline" 82 | "hpc" 83 | "mtl" "parsec" "text" "transformers" 84 | "xhtml" 85 | # "stm" "terminfo" 86 | ]; 87 | }) 88 | ({ pkgs, ...}: { 89 | # Use the VRF fork of libsodium 90 | packages = lib.genAttrs [ "cardano-crypto-praos" "cardano-crypto-class" ] (_: { 91 | components.library.pkgconfig = lib.mkForce [ [ pkgs.libsodium-vrf ] ]; 92 | }); 93 | }) 94 | ({ pkgs, ...}: { 95 | # make sure that libsodium DLLs are available for windows binaries: 96 | packages = lib.genAttrs projectPackages (name: { 97 | postInstall = lib.optionalString pkgs.stdenv.hostPlatform.isWindows '' 98 | if [ -d $out/bin ]; then 99 | ${setLibSodium pkgs} 100 | fi 101 | ''; 102 | }); 103 | }) 104 | ({config, pkgs, ...}: { 105 | # Stamp executables with the git revision 106 | packages = lib.genAttrs ["cardano-node" "cardano-cli"] (name: { 107 | components.exes.${name}.postInstall = '' 108 | ${lib.optionalString pkgs.stdenv.hostPlatform.isWindows (setLibSodium pkgs)} 109 | ${setGitRev pkgs config.packages.cardano-node.src.rev} 110 | ''; 111 | }); 112 | }) 113 | ({ pkgs, config, ... }: { 114 | # Packages we wish to ignore version bounds of. 115 | # This is similar to jailbreakCabal, however it 116 | # does not require any messing with cabal files. 117 | packages.katip.doExactConfig = true; 118 | 119 | # split data output for ekg to reduce closure size 120 | packages.ekg.components.library.enableSeparateDataOutput = true; 121 | 122 | }) 123 | { 124 | packages = lib.genAttrs projectPackages 125 | (name: { configureFlags = [ "--ghc-option=-Werror" ]; }); 126 | } 127 | ({ pkgs, ... }: lib.mkIf pkgs.stdenv.hostPlatform.isLinux { 128 | # systemd can't be statically linked 129 | packages.cardano-config.flags.systemd = !pkgs.stdenv.hostPlatform.isMusl; 130 | packages.cardano-node.flags.systemd = !pkgs.stdenv.hostPlatform.isMusl; 131 | 132 | # FIXME: Error loading shared library libHSvoting-tools-0.2.0.0-HDZeaOp1VIwKhm4zJgwaOj.so: No such file or directory 133 | packages.voting-tools.components.tests.unit-tests.buildable = lib.mkForce (!pkgs.stdenv.hostPlatform.isMusl); 134 | # Run as part of a NixOS test 135 | packages.voting-tools.components.tests.integration-tests.doCheck = false; 136 | }) 137 | # Musl libc fully static build 138 | ({ pkgs, ... }: lib.mkIf pkgs.stdenv.hostPlatform.isMusl (let 139 | # Module options which adds GHC flags and libraries for a fully static build 140 | fullyStaticOptions = { 141 | enableShared = false; 142 | enableStatic = true; 143 | configureFlags = [ 144 | "--ghc-option=-optl=-lssl" 145 | "--ghc-option=-optl=-lcrypto" 146 | "--ghc-option=-optl=-L${pkgs.openssl.out}/lib" 147 | ]; 148 | }; 149 | in 150 | { 151 | packages = lib.genAttrs projectPackages (name: fullyStaticOptions); 152 | 153 | # Haddock not working and not needed for cross builds 154 | doHaddock = false; 155 | } 156 | )) 157 | 158 | ({ pkgs, ... }: lib.mkIf (pkgs.stdenv.hostPlatform != pkgs.stdenv.buildPlatform) { 159 | # Remove hsc2hs build-tool dependencies (suitable version will be available as part of the ghc derivation) 160 | packages.Win32.components.library.build-tools = lib.mkForce []; 161 | packages.terminal-size.components.library.build-tools = lib.mkForce []; 162 | packages.network.components.library.build-tools = lib.mkForce []; 163 | }) 164 | ]; 165 | }); 166 | # setGitRev is a postInstall script to stamp executables with 167 | # version info. It uses the "gitrev" argument, if set. Otherwise, 168 | # the revision is sourced from the local git work tree. 169 | setGitRev = pkgs: rev: ''${pkgs.buildPackages.haskellBuildUtils}/bin/set-git-rev "${rev}" $out/bin/*''; 170 | # package with libsodium: 171 | setLibSodium = pkgs : "ln -s ${pkgs.libsodium-vrf}/bin/libsodium-23.dll $out/bin/libsodium-23.dll"; 172 | in 173 | pkgSet 174 | -------------------------------------------------------------------------------- /nix/nixos/tests/db-password-auth.nix: -------------------------------------------------------------------------------- 1 | # Test that voting-tools supports password authentication to connect to the 2 | # cardano-db-sync database. 3 | { config, pkgs, system, lib, inputs, ... }: 4 | let 5 | voting-tools = inputs.self.packages.x86_64-linux."voting-tools:exe:voting-tools"; 6 | 7 | dbPassword = "openSesame"; 8 | in 9 | { 10 | name = "db-password-auth"; 11 | 12 | nodes = { 13 | machine = { 14 | nixpkgs.pkgs = pkgs; 15 | 16 | # Import cardano-db-sync nixos module so we can get access to database schema: 17 | # config.services.cardano-db-sync.dbSyncPkgs.schema. 18 | imports = [ 19 | inputs.cardano-db-sync.nixosModules.cardano-db-sync 20 | ]; 21 | 22 | # Ensure we have a postgres instance running with a db_sync database. 23 | services.postgresql = { 24 | enable = true; 25 | # Only allow connnections over socket or localhost 26 | enableTCPIP = false; 27 | # Disallow socket connections, only allow TCP/IP connections with password 28 | authentication = '' 29 | # _ database user address auth-method 30 | host db_sync db-sync all scram-sha-256 31 | ''; 32 | ensureDatabases = [ 33 | "db_sync" 34 | "hdb_catalog" 35 | ]; 36 | # Create a role that must login with a password 37 | initialScript = pkgs.writeText "init.sql" '' 38 | CREATE ROLE "db-sync" WITH LOGIN PASSWORD '${dbPassword}'; 39 | ''; 40 | ensureUsers = [ 41 | { 42 | name = "db-sync"; 43 | ensurePermissions = { 44 | "DATABASE db_sync" = "ALL PRIVILEGES"; 45 | "DATABASE hdb_catalog" = "ALL PRIVILEGES"; 46 | "ALL TABLES IN SCHEMA public" = "ALL PRIVILEGES"; 47 | "ALL TABLES IN SCHEMA information_schema" = "SELECT"; 48 | "ALL TABLES IN SCHEMA pg_catalog" = "SELECT"; 49 | }; 50 | } 51 | ]; 52 | # Ensure we support the scram auth method 53 | settings = { 54 | password_encryption = "scram-sha-256"; 55 | }; 56 | }; 57 | }; 58 | }; 59 | 60 | testScript = { nodes, ...}: '' 61 | start_all() 62 | 63 | # Ensure database has correct schema by running cardano-db-sync migrations. 64 | machine.wait_for_unit("postgresql.service") 65 | machine.succeed("echo 'Running db_sync migrations...'") 66 | machine.succeed("for file in ${nodes.machine.config.services.cardano-db-sync.dbSyncPkgs.schema}/*; do PGPASSWORD=${dbPassword} psql -U db-sync -d db_sync -h localhost -f $file; done") 67 | 68 | # Run voting-tools tests 69 | # Succeed with password authentication 70 | machine.succeed("${voting-tools}/bin/voting-tools --db db_sync --db-user db-sync --db-host localhost --db-pass ${dbPassword} --mainnet --out-file out.json") 71 | machine.succeed("cat out.json 1>&2") 72 | 73 | # Fail with wrong password 74 | machine.fail("${voting-tools}/bin/voting-tools --db db_sync --db-user db-sync --db-host localhost --db-pass wrongPassword --mainnet --out-file out.json") 75 | 76 | # Fail with peer authentication 77 | machine.fail("${voting-tools}/bin/voting-tools --db db_sync --db-user db-sync --db-host /run/postgresql --mainnet --out-file out.json") 78 | ''; 79 | } 80 | -------------------------------------------------------------------------------- /nix/nixos/tests/db-tests.nix: -------------------------------------------------------------------------------- 1 | { config, pkgs, system, lib, inputs, ... }: 2 | let 3 | integrationTest = inputs.self.packages.x86_64-linux."voting-tools:test:integration-tests"; 4 | in 5 | { 6 | name = "property-tests-db"; 7 | 8 | nodes = { 9 | machine = { 10 | nixpkgs.pkgs = pkgs; 11 | 12 | # Import cardano-db-sync nixos module so we can get access to database schema: 13 | # config.services.cardano-db-sync.dbSyncPkgs.schema. 14 | imports = [ 15 | inputs.cardano-db-sync.nixosModules.cardano-db-sync 16 | ]; 17 | 18 | # Ensure we have a postgres instance running with a db_sync database. 19 | services.postgresql = { 20 | enable = true; 21 | enableTCPIP = false; 22 | identMap = '' 23 | # map-name system-username database-username 24 | explorer-users postgres postgres 25 | explorer-users db-sync db-sync 26 | explorer-users root db-sync 27 | ''; 28 | authentication = '' 29 | local all all ident map=explorer-users 30 | local all all trust 31 | ''; 32 | ensureDatabases = [ 33 | "db_sync" 34 | "hdb_catalog" 35 | ]; 36 | ensureUsers = [ 37 | { 38 | name = "db-sync"; 39 | ensurePermissions = { 40 | "DATABASE db_sync" = "ALL PRIVILEGES"; 41 | "DATABASE hdb_catalog" = "ALL PRIVILEGES"; 42 | "ALL TABLES IN SCHEMA public" = "ALL PRIVILEGES"; 43 | "ALL TABLES IN SCHEMA information_schema" = "SELECT"; 44 | "ALL TABLES IN SCHEMA pg_catalog" = "SELECT"; 45 | }; 46 | } 47 | ]; 48 | initialScript = pkgs.writeText "init.sql" '' 49 | CREATE USER db-sync WITH SUPERUSER; 50 | ''; 51 | }; 52 | 53 | virtualisation.diskSize = pkgs.lib.mkDefault 4096; 54 | virtualisation.memorySize = pkgs.lib.mkDefault 4096; 55 | 56 | }; 57 | }; 58 | 59 | testScript = { nodes, ...}: '' 60 | start_all() 61 | 62 | # Ensure database has correct schema by running cardano-db-sync migrations. 63 | machine.wait_for_unit("postgresql.service") 64 | machine.succeed("echo 'Running db_sync migrations...'") 65 | machine.succeed("for file in ${nodes.machine.config.services.cardano-db-sync.dbSyncPkgs.schema}/*; do psql -U db-sync -d db_sync -f $file; done") 66 | 67 | # Run voting-tools tests 68 | machine.succeed('${integrationTest}/bin/integration-tests --db-name db_sync --db-user db-sync --db-host /run/postgresql') 69 | ''; 70 | } 71 | -------------------------------------------------------------------------------- /nix/nixos/tests/default.nix: -------------------------------------------------------------------------------- 1 | { pkgs 2 | , inputs 3 | , system 4 | }: 5 | 6 | with pkgs; 7 | with pkgs.commonLib; 8 | 9 | let 10 | forAllSystems = genAttrs supportedSystems; 11 | importTest = fn: args: system: let 12 | imported = import fn; 13 | test = import (pkgs.path + "/nixos/tests/make-test-python.nix") imported; 14 | in test ({ 15 | inherit pkgs system config inputs; 16 | } // args); 17 | callTest = fn: args: (importTest fn args system); 18 | in rec { 19 | db-password-auth = callTest ./db-password-auth.nix {}; 20 | mock-db = callTest ./mock-db.nix {}; 21 | db-tests = callTest ./db-tests.nix {}; 22 | } 23 | -------------------------------------------------------------------------------- /nix/nixos/tests/mock-db.nix: -------------------------------------------------------------------------------- 1 | { config, pkgs, system, lib, inputs, ... }: 2 | let 3 | nixpkgs = pkgs.lib.cleanSource pkgs.path; 4 | 5 | sources = import ../../sources.nix; 6 | 7 | cardanoNodePort = 3001; 8 | 9 | mock-data = 10 | pkgs.runCommandLocal "mock-data" {} 11 | '' 12 | mkdir -p $out 13 | 14 | cp -r ${./mock-db}/* $out/ 15 | ''; 16 | 17 | slotNo = 41778925; 18 | 19 | votingToolsPkg = inputs.self.packages."${system}".voting-tools; 20 | in 21 | { 22 | name = "vote-submission-test"; 23 | 24 | nodes = { 25 | machine = { 26 | nixpkgs.pkgs = pkgs; 27 | 28 | # Import cardano-db-sync nixos module so we can get access to database schema: 29 | # config.services.cardano-db-sync.dbSyncPkgs.schema. 30 | imports = [ 31 | inputs.cardano-db-sync.nixosModules.cardano-db-sync 32 | ]; 33 | 34 | environment.systemPackages = (with pkgs; [ 35 | jq 36 | ]); 37 | 38 | # Ensure we have a postgres instance running with a db_sync database. 39 | services.postgresql = { 40 | enable = true; 41 | enableTCPIP = false; 42 | identMap = '' 43 | # map-name system-username database-username 44 | explorer-users postgres postgres 45 | explorer-users db-sync db-sync 46 | explorer-users root db-sync 47 | ''; 48 | authentication = '' 49 | local all all ident map=explorer-users 50 | local all all trust 51 | ''; 52 | ensureDatabases = [ 53 | "db_sync" 54 | "hdb_catalog" 55 | ]; 56 | ensureUsers = [ 57 | { 58 | name = "db-sync"; 59 | ensurePermissions = { 60 | "DATABASE db_sync" = "ALL PRIVILEGES"; 61 | "DATABASE hdb_catalog" = "ALL PRIVILEGES"; 62 | "ALL TABLES IN SCHEMA public" = "ALL PRIVILEGES"; 63 | "ALL TABLES IN SCHEMA information_schema" = "SELECT"; 64 | "ALL TABLES IN SCHEMA pg_catalog" = "SELECT"; 65 | }; 66 | } 67 | ]; 68 | initialScript = pkgs.writeText "init.sql" '' 69 | CREATE USER db-sync WITH SUPERUSER; 70 | ''; 71 | }; 72 | 73 | }; 74 | }; 75 | 76 | testScript = { nodes, ...}: '' 77 | start_all() 78 | 79 | # Ensure database has correct schema by running cardano-db-sync migrations. 80 | machine.wait_for_unit("postgresql.service") 81 | machine.succeed("echo 'Running db_sync migrations...'") 82 | machine.succeed("for file in ${nodes.machine.config.services.cardano-db-sync.dbSyncPkgs.schema}/*; do psql -U db-sync -d db_sync -f $file; done") 83 | 84 | # Copy over mock data 85 | machine.succeed("psql -U db-sync -d db_sync -c \"\\copy slot_leader FROM '${mock-data}/slot_leader.csv' DELIMITER ',' HEADER CSV\"") 86 | machine.succeed("psql -U db-sync -d db_sync -c \"\\copy block FROM '${mock-data}/block.csv' DELIMITER ',' HEADER CSV\"") 87 | machine.succeed("psql -U db-sync -d db_sync -c \"\\copy tx FROM '${mock-data}/tx.csv' DELIMITER ',' HEADER CSV\"") 88 | machine.succeed("psql -U db-sync -d db_sync -c \"\\copy stake_address FROM '${mock-data}/stake_address.csv' DELIMITER ',' HEADER CSV\"") 89 | machine.succeed("psql -U db-sync -d db_sync -c \"\\copy tx_in FROM '${mock-data}/tx_in.csv' DELIMITER ',' HEADER CSV\"") 90 | machine.succeed("psql -U db-sync -d db_sync -c \"\\copy tx_out FROM '${mock-data}/tx_out.csv' DELIMITER ',' HEADER CSV\"") 91 | machine.succeed("psql -U db-sync -d db_sync -c \"\\copy tx_metadata FROM '${mock-data}/tx_metadata.csv' DELIMITER ',' HEADER CSV\"") 92 | 93 | # Run voting-tools 94 | machine.succeed("${votingToolsPkg}/bin/voting-tools --mainnet --db db_sync --db-user db-sync --out-file out.json --slot-no ${toString slotNo}") 95 | 96 | # Add a newline to the end of the JSON file if it doesn't already exist 97 | machine.succeed("sed -i -e '$a\\' out.json") 98 | 99 | # Ensure sorted for comparison purposes 100 | machine.succeed("jq 'sort_by(.stake_public_key)' ${mock-data}/out.json > out-expect.json") 101 | machine.succeed("jq 'sort_by(.stake_public_key)' out.json > out-actual.json") 102 | # Ensure generated file matches golden file 103 | machine.succeed("diff out-expect.json out-actual.json") 104 | ''; 105 | } 106 | -------------------------------------------------------------------------------- /nix/nixos/tests/mock-db/out.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "delegations": "0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5", 4 | "rewards_address": "0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe", 5 | "stake_public_key": "0xd8045127d6fa979ae2415d588b3a19c2aee6e1a09826ab5648e97eeac778612f", 6 | "voting_power": 3090202175829, 7 | "voting_purpose": 0 8 | }, 9 | { 10 | "delegations": "0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5", 11 | "rewards_address": "0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe", 12 | "stake_public_key": "0xe8b6c7656bd110a840fcabcdbe5c50c73783cfcb82f9792211a92acb2fa135e6ec38a7a65589490b6b87ed92b0d0408e89197ba7f8fb0a40b4afeb184f144f30", 13 | "voting_power": 5084038105139, 14 | "voting_purpose": 0 15 | }, 16 | { 17 | "delegations": "0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5", 18 | "rewards_address": "0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe", 19 | "stake_public_key": "0x1146568c1813126bbbd0d9b8364bbdeb18a4ba942b1a27a6cd4529827c2756eb", 20 | "voting_power": 3225355813036, 21 | "voting_purpose": 0 22 | }, 23 | { 24 | "delegations": "0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5", 25 | "rewards_address": "0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe", 26 | "stake_public_key": "0xb44812861600f8dae3ba8a7a422f9c28549bee6ad97f0cccc940783ba4d863ce", 27 | "voting_power": 500009775147, 28 | "voting_purpose": 0 29 | }, 30 | { 31 | "delegations": "0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5", 32 | "rewards_address": "0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe", 33 | "stake_public_key": "0xe62fec161be911a68371e6e3114d60b9fcc4ec45967793cf105e77b816baea90", 34 | "voting_power": 328603096768, 35 | "voting_purpose": 0 36 | }, 37 | { 38 | "delegations": "0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5", 39 | "rewards_address": "0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe", 40 | "stake_public_key": "0xb046fb6c353df8ef1d9c36ccae4e47e67cbdbba2d62b1f97fcc76b98749f6067", 41 | "voting_power": 328586706706, 42 | "voting_purpose": 0 43 | }, 44 | { 45 | "delegations": "0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5", 46 | "rewards_address": "0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe", 47 | "stake_public_key": "0xb6228cf378434ad9896e058a40ca0632f8284b3d6a9bcbf1b3618a808df51b2de97c3f1925f08cd68b16cf2fd0c823c3dc50b4276f2eeddeee2f141d0e4e5c8b", 48 | "voting_power": 915979291111, 49 | "voting_purpose": 0 50 | }, 51 | { 52 | "delegations": "0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5", 53 | "rewards_address": "0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe", 54 | "stake_public_key": "0x274042dd7cfcb84ef8750afefae74021146f4fa173e08e0702d67fdc334ff6f9", 55 | "voting_power": 500010000000, 56 | "voting_purpose": 0 57 | } 58 | ] 59 | -------------------------------------------------------------------------------- /nix/nixos/tests/mock-db/slot_leader.csv: -------------------------------------------------------------------------------- 1 | id,hash,pool_hash_id,description 2 | 1,\x5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d43,,Genesis slot leader 3 | -------------------------------------------------------------------------------- /nix/nixos/tests/mock-db/stake_address.csv: -------------------------------------------------------------------------------- 1 | id,hash_raw,view,script_hash,registered_tx_id 2 | 523238,\xe124df18dcede42986da9b37b124afc80960027fd979bfae61bfc61187,stake1uyjd7xxuahjznpk6nvmmzf90eqykqqnlm9umltnphlrprpch8nyxg,,3800113 3 | 523242,\xe120101aa634b6655d0c38befa9d3bca8631718e3dcaa94777610a9b38,stake1uyspqx4xxjmx2hgv8zl048fme2rrzuvw8h92j3mhvy9fkwql02yxj,,3800119 4 | 54385,\xe16b0c693a5cbcc95e09845851939e021abdc7789c19bd49de369c7b6b,stake1u94sc6f6tj7vjhsfs3v9ryu7qgdtm3mcnsvm6jw7x6w8k6c4tx20s,,2434650 5 | 1156005,\xe18b0cb459baf2237dc5e86a32f156902a0dcb51dc51e764cef6841232,stake1ux9sedzehtezxlw9ap4r9u2kjq4qmj63m3g7wexw76zpyvspn6k00,,5659537 6 | 889241,\xe1af9b7267b9352189b43eda4ef58f0f627e7ca02a8422ac84bb69e221,stake1uxhekun8hy6jrzd58mdyaav0pa38ul9q92zz9tyyhd57yggxhwc8q,,4742792 7 | 1156076,\xe1cf11974e7d8cce570b8bed7d47b650f8865471357be740b7266bdd9e,stake1u883r96w0kxvu4ct30kh63ak2rugv4r3x4a7ws9hye4am8su9qjkk,,5659803 8 | 486159,\xe10346ff67c972b072db0e6885112c2ad1bc09d310c7c51d0ce78d8e30,stake1uyp5dlm8e9etqukmpe5g2yfv9tgmczwnzrru28gvu7xcuvqzymnvt,,3690625 9 | 262725,\xe117b03a52cacccfbd0280159614c7d81c09db8920959802115a740cfc,stake1uytmqwjjetxvl0gzsq2ev9x8mqwqnkufyz2esqs3tf6qelqmwztdd,,3022823 10 | -------------------------------------------------------------------------------- /nix/nixos/tests/mock-db/tx_in.csv: -------------------------------------------------------------------------------- 1 | id,tx_in_id,tx_out_id,tx_out_index,redeemer_id 2 | 5640532,2617235,2434650,0, 3 | 5640531,2617235,2434744,0, 4 | 5640533,2617235,2596178,1, 5 | 5640553,2617244,2617235,1, 6 | 7875215,3733865,2617244,1, 7 | 7875214,3733865,2617924,0, 8 | 8949385,4288061,3022823,0, 9 | 16669848,7950492,3111555,0, 10 | 16669671,7950401,3130802,1, 11 | 6818925,3230349,3130812,0, 12 | 16669851,7950492,3130827,0, 13 | 16669857,7950492,3130837,1, 14 | 16669852,7950492,3130847,1, 15 | 7339627,3474218,3130857,1, 16 | 6774288,3206605,3130883,0, 17 | 16669860,7950492,3206605,0, 18 | 16669861,7950492,3206605,1, 19 | 16669849,7950492,3230349,0, 20 | 16669850,7950492,3230349,1, 21 | 16669846,7950492,3474218,0, 22 | 16669847,7950492,3474218,1, 23 | 39934570,19182699,3818682,0, 24 | 39931011,19181004,3818716,0, 25 | 39934571,19182699,3961105,1, 26 | 39931009,19181004,3961146,1, 27 | 39934569,19182699,3961210,1, 28 | 39930998,19181004,3961258,1, 29 | 16669858,7950492,4288061,0, 30 | 16669859,7950492,4288061,1, 31 | 39931015,19181004,4288922,1, 32 | 53056088,24638571,4742792,0, 33 | 53056602,24638750,4742814,0, 34 | 53056605,24638750,4742877,0, 35 | 16669854,7950492,5204245,0, 36 | 39934574,19182699,5306236,1, 37 | 39930991,19181004,5306302,1, 38 | 39934561,19182699,5306382,1, 39 | 39934576,19182699,5306672,1, 40 | 39930989,19181004,5306856,1, 41 | 39934558,19182699,5474876,1, 42 | 39930995,19181004,5474919,1, 43 | 39934584,19182699,5474956,1, 44 | 39934575,19182699,5474996,1, 45 | 39934577,19182699,5475028,1, 46 | 53056597,24638750,5475028,2, 47 | 39931019,19181004,5475152,1, 48 | 39931002,19181004,5475200,1, 49 | 39934586,19182699,5475243,1, 50 | 39934566,19182699,5620498,1, 51 | 39931017,19181004,5620530,1, 52 | 39931004,19181004,5620577,1, 53 | 39934562,19182699,5620610,1, 54 | 39931007,19181004,5620792,1, 55 | 53056601,24638750,5620792,2, 56 | 39934585,19182699,5620831,1, 57 | 39931012,19181004,5620870,1, 58 | 39934579,19182699,5620922,1, 59 | 12161227,5808628,5659537,0, 60 | 39934587,19182699,5801685,1, 61 | 39931013,19181004,5801751,1, 62 | 39930996,19181004,5801800,1, 63 | 39931018,19181004,5801825,1, 64 | 39934578,19182699,5801889,1, 65 | 53056598,24638750,5801889,2, 66 | 39930992,19181004,5801952,1, 67 | 12161225,5808628,5801952,2, 68 | 39934588,19182699,5801982,1, 69 | 39930999,19181004,5802029,1, 70 | 39934568,19182699,5974071,1, 71 | 39930997,19181004,5974097,1, 72 | 39934572,19182699,5974128,1, 73 | 39930986,19181004,5974144,1, 74 | 39934563,19182699,5974166,1, 75 | 53056587,24638750,5974166,2, 76 | 39931003,19181004,5974190,1, 77 | 39934581,19182699,5974214,1, 78 | 39931001,19181004,5974236,1, 79 | 16669853,7950492,6088434,65, 80 | 39934580,19182699,6175949,1, 81 | 39931010,19181004,6176019,1, 82 | 39934573,19182699,6176153,1, 83 | 39931020,19181004,6176186,1, 84 | 39934591,19182699,6176215,1, 85 | 53056604,24638750,6176215,2, 86 | 39931014,19181004,6176291,1, 87 | 39934560,19182699,6176462,1, 88 | 39930987,19181004,6176576,1, 89 | 39934592,19182699,6392097,1, 90 | 39930994,19181004,6392183,1, 91 | 39930988,19181004,6392294,1, 92 | 39934590,19182699,6392380,1, 93 | 39931000,19181004,6392477,1, 94 | 53056595,24638750,6392477,2, 95 | 39934582,19182699,6392561,1, 96 | 39930984,19181004,6392606,1, 97 | 39934559,19182699,6392653,1, 98 | 53056600,24638750,6586281,1, 99 | 53056590,24638750,6764718,1, 100 | 53056586,24638750,6992151,1, 101 | 53056592,24638750,7262138,1, 102 | 53056589,24638750,7571464,1, 103 | 39934565,19182699,7571684,0, 104 | 39930990,19181004,7571684,1, 105 | 53056593,24638750,7888264,1, 106 | 16669845,7950492,7950348,0, 107 | 16669855,7950492,7950401,0, 108 | 16669856,7950492,7950401,1, 109 | 52315897,24321341,7950492,0, 110 | 16732725,7978944,7978727,0, 111 | 16733059,7979112,7978855,0, 112 | 16733061,7979112,7978944,0, 113 | 53056596,24638750,8131738,1, 114 | 53056585,24638750,8339955,1, 115 | 37741017,18189637,8340176,1, 116 | 37741656,18189961,8340176,2, 117 | 53056599,24638750,8537268,1, 118 | 53056594,24638750,8711717,1, 119 | 39934555,19182699,8711895,1, 120 | 39930985,19181004,8711895,2, 121 | 53056603,24638750,8856932,1, 122 | 31221511,15085535,8889255,0, 123 | 31220309,15084839,8889426,0, 124 | 38009977,18317615,8992109,0, 125 | 52315705,24321227,8992191,1, 126 | 53056591,24638750,8992263,1, 127 | 52315703,24321227,9142820,1, 128 | 52315693,24321227,9277941,1, 129 | 39934567,19182699,9278459,1, 130 | 39930993,19181004,9278459,2, 131 | 52315692,24321227,9412492,1, 132 | 39934583,19182699,9412703,1, 133 | 39931008,19181004,9412703,2, 134 | 52315894,24321341,9563443,1, 135 | 39934589,19182699,9563572,1, 136 | 39931016,19181004,9563572,2, 137 | 52315702,24321227,9692342,1, 138 | 52315691,24321227,9826000,1, 139 | 52315698,24321227,9961410,1, 140 | 52315685,24321227,10094849,1, 141 | 52315696,24321227,10237522,1, 142 | 52315704,24321227,10397579,1, 143 | 52315690,24321227,10622605,1, 144 | 52315891,24321341,10866493,1, 145 | 37745214,18191766,11101050,0, 146 | 52315700,24321227,11200046,1, 147 | 52315694,24321227,11555659,1, 148 | 52315686,24321227,12435317,1, 149 | 52315900,24321341,12935760,1, 150 | 52315898,24321341,11956880,1, 151 | 52315688,24321227,13361843,1, 152 | 37745215,18191766,14031745,0, 153 | 52315701,24321227,13773482,1, 154 | 52315896,24321341,14229614,1, 155 | 52315893,24321341,14671495,1, 156 | 31220677,15085038,15084479,0, 157 | 52315699,24321227,15085000,1, 158 | 32756440,15820907,15085535,0, 159 | 31220678,15085038,15084839,0, 160 | 52315695,24321227,15459173,1, 161 | 32377709,15635352,15635261,0, 162 | 52315899,24321341,15635261,1, 163 | 52315697,24321227,16161152,1, 164 | 52315689,24321227,15805621,1, 165 | 52315901,24321341,16732506,1, 166 | 32377553,15635261,15631359,0, 167 | 37745612,18192001,17724724,0, 168 | 52315892,24321341,17323974,1, 169 | 37745611,18192001,18189961,0, 170 | 49167041,22894044,18317615,0, 171 | 49167042,22894044,18317615,1, 172 | 39922085,19176049,18189637,0, 173 | 39933446,19182213,19181320,0, 174 | 39934556,19182699,19176049,0, 175 | 39931788,19181320,19181004,0, 176 | 39935596,19183216,19182976,0, 177 | 51239754,23838046,19182213,0, 178 | 39935049,19182976,19182699,0, 179 | 51238927,23837646,19183216,0, 180 | 52315687,24321227,22894044,1, 181 | 51239753,23838046,23837230,0, 182 | 51238928,23837646,23836942,0, 183 | 55241292,25478481,23837802,0, 184 | 52315895,24321341,24321227,1, 185 | 55241893,25478751,23838046,1, 186 | 52316359,24321586,24321498,1, 187 | 53056588,24638750,24638571,1, 188 | 52316200,24321498,24321341,1, 189 | 55992594,25782795,24638869,1, 190 | 52316565,24321690,24321586,1, 191 | 53056913,24638869,24638750,1, 192 | 55241894,25478751,25443864,2, 193 | 55241291,25478481,25443152,4, 194 | 55241892,25478751,25443505,4, 195 | 56963708,26172169,25782795,1, 196 | 58217504,26659698,26172169,1, 197 | 58218184,26660028,26659698,1, 198 | 58218913,26660354,26660028,1, 199 | 59681537,27256893,26660354,1, 200 | 59684451,27258112,27257611,1, 201 | 59683213,27257611,27256893,1, 202 | 62233350,28329325,28005417,1, 203 | 61442722,28005417,27258112,1, 204 | 62239711,28332151,28330656,1, 205 | 62236068,28330656,28329325,1, 206 | 64666484,29350804,28332151,1, 207 | 64736986,29374597,29350804,1, 208 | 64803543,29394188,29374597,1, 209 | 66604473,30120036,29394188,1, 210 | 66720217,30158287,30151032,1, 211 | 66700470,30151032,30120036,1, 212 | 68738183,30922923,30158287,1, 213 | 68751661,30928092,30925818,1, 214 | 68746255,30925818,30922923,1, 215 | 70057048,31424819,30928895,1, 216 | 68754010,30928895,30928092,1, 217 | 70071999,31429605,31428172,1, 218 | 70063399,31426842,31424819,1, 219 | 70086224,31434111,31429605,1, 220 | 70067663,31428172,31426842,1, 221 | -------------------------------------------------------------------------------- /nix/nixos/tests/mock-db/tx_metadata.csv: -------------------------------------------------------------------------------- 1 | id,key,json,bytes,tx_id 2 | 221529,61284,"{""1"": ""0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5"", ""2"": ""0xe62fec161be911a68371e6e3114d60b9fcc4ec45967793cf105e77b816baea90"", ""3"": ""0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe"", ""4"": 31348024}",\xa119ef64a4015820bfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5025820e62fec161be911a68371e6e3114d60b9fcc4ec45967793cf105e77b816baea9003581de1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe041a01de5538,8572291 3 | 221530,61285,"{""1"": ""0xfdc06cf5ea772e29ecb6248484c848388dc6535451cad9e2be16d345441e0b9c065b6b407cb7a584ff84e066ae284688afe6fec9e5bae2d08f4cc34bd61db90c""}",\xa119ef65a1015840fdc06cf5ea772e29ecb6248484c848388dc6535451cad9e2be16d345441e0b9c065b6b407cb7a584ff84e066ae284688afe6fec9e5bae2d08f4cc34bd61db90c,8572291 4 | 221547,61284,"{""1"": ""0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5"", ""2"": ""0xb046fb6c353df8ef1d9c36ccae4e47e67cbdbba2d62b1f97fcc76b98749f6067"", ""3"": ""0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe"", ""4"": 31348111}",\xa119ef64a4015820bfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5025820b046fb6c353df8ef1d9c36ccae4e47e67cbdbba2d62b1f97fcc76b98749f606703581de1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe041a01de558f,8572333 5 | 221548,61285,"{""1"": ""0x7538530c0d5ad7cb2f0c3dcc969e6b21d3f88d0078387a34eb280beaef90018abf1450d9744e146f2bc9239394fdb13e37bd8293b99de982f8782b0c5bc28f02""}",\xa119ef65a10158407538530c0d5ad7cb2f0c3dcc969e6b21d3f88d0078387a34eb280beaef90018abf1450d9744e146f2bc9239394fdb13e37bd8293b99de982f8782b0c5bc28f02,8572333 6 | 221564,61284,"{""1"": ""0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5"", ""2"": ""0xb44812861600f8dae3ba8a7a422f9c28549bee6ad97f0cccc940783ba4d863ce"", ""3"": ""0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe"", ""4"": 31348224}",\xa119ef64a4015820bfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5025820b44812861600f8dae3ba8a7a422f9c28549bee6ad97f0cccc940783ba4d863ce03581de1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe041a01de5600,8572382 7 | 221565,61285,"{""1"": ""0xc8b681d40d5bb158f2d32e9993e379ba34f88677820611d15d4017db69cd5116ee33fb47fcb8e791348e86b15a497391f705f1c57101faf9f767e46911e88106""}",\xa119ef65a1015840c8b681d40d5bb158f2d32e9993e379ba34f88677820611d15d4017db69cd5116ee33fb47fcb8e791348e86b15a497391f705f1c57101faf9f767e46911e88106,8572382 8 | 221606,61284,"{""1"": ""0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5"", ""2"": ""0x1146568c1813126bbbd0d9b8364bbdeb18a4ba942b1a27a6cd4529827c2756eb"", ""3"": ""0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe"", ""4"": 31348454}",\xa119ef64a4015820bfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c50258201146568c1813126bbbd0d9b8364bbdeb18a4ba942b1a27a6cd4529827c2756eb03581de1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe041a01de56e6,8572509 9 | 221607,61285,"{""1"": ""0xeb4033fd1e42add412054627efcd519e21cbdaffe3f34da068843eb0f4b7eaf768d640f9466784a9b1ce109cbc7e62982428e036e0cc73a51462434b0a48160e""}",\xa119ef65a1015840eb4033fd1e42add412054627efcd519e21cbdaffe3f34da068843eb0f4b7eaf768d640f9466784a9b1ce109cbc7e62982428e036e0cc73a51462434b0a48160e,8572509 10 | 221948,61284,"{""1"": ""0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5"", ""2"": ""0xe8b6c7656bd110a840fcabcdbe5c50c73783cfcb82f9792211a92acb2fa135e6ec38a7a65589490b6b87ed92b0d0408e89197ba7f8fb0a40b4afeb184f144f30"", ""3"": ""0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe"", ""4"": 31351487}",\xa119ef64a4015820bfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5025840e8b6c7656bd110a840fcabcdbe5c50c73783cfcb82f9792211a92acb2fa135e6ec38a7a65589490b6b87ed92b0d0408e89197ba7f8fb0a40b4afeb184f144f3003581de1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe041a01de62bf,8574216 11 | 221949,61285,"{""1"": ""0x14489ec631c5d2408d95b816bc163493430ff4455980a82137c772c5becdeefaea5820d8b86feb42e271991fc8ee39c30552663a1e89c780e849610b4ee0260b""}",\xa119ef65a101584014489ec631c5d2408d95b816bc163493430ff4455980a82137c772c5becdeefaea5820d8b86feb42e271991fc8ee39c30552663a1e89c780e849610b4ee0260b,8574216 12 | 221964,61284,"{""1"": ""0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5"", ""2"": ""0xd8045127d6fa979ae2415d588b3a19c2aee6e1a09826ab5648e97eeac778612f"", ""3"": ""0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe"", ""4"": 31351603}",\xa119ef64a4015820bfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5025820d8045127d6fa979ae2415d588b3a19c2aee6e1a09826ab5648e97eeac778612f03581de1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe041a01de6333,8574264 13 | 221965,61285,"{""1"": ""0xc9d61db0d5bdbd50f661ed7b216029d97adaf48c8c0ed489227b5a1168ef70f8b6460507abad1a446afae3d3dbc9131948e243b57fe214303e81e5a28b66be0f""}",\xa119ef65a1015840c9d61db0d5bdbd50f661ed7b216029d97adaf48c8c0ed489227b5a1168ef70f8b6460507abad1a446afae3d3dbc9131948e243b57fe214303e81e5a28b66be0f,8574264 14 | 221975,61284,"{""1"": ""0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5"", ""2"": ""0x274042dd7cfcb84ef8750afefae74021146f4fa173e08e0702d67fdc334ff6f9"", ""3"": ""0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe"", ""4"": 31351670}",\xa119ef64a4015820bfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5025820274042dd7cfcb84ef8750afefae74021146f4fa173e08e0702d67fdc334ff6f903581de1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe041a01de6376,8574298 15 | 221976,61285,"{""1"": ""0xb11494b4a2acb93ac97bcd828e34a727877b95c11caa34b012743b47f9aaf524a9843e23f77bc4ce18d8d4c79ef89c7f99cf5662df0c70e69b64d80e822d1908""}",\xa119ef65a1015840b11494b4a2acb93ac97bcd828e34a727877b95c11caa34b012743b47f9aaf524a9843e23f77bc4ce18d8d4c79ef89c7f99cf5662df0c70e69b64d80e822d1908,8574298 16 | 454933,61284,"{""1"": ""0xbfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5"", ""2"": ""0xb6228cf378434ad9896e058a40ca0632f8284b3d6a9bcbf1b3618a808df51b2de97c3f1925f08cd68b16cf2fd0c823c3dc50b4276f2eeddeee2f141d0e4e5c8b"", ""3"": ""0xe1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe"", ""4"": 38504305}",\xa119ef64a4015820bfc319875c70565d1820cab2f3934585a7519b94a86dc0e434311eeb73f489c5025840b6228cf378434ad9896e058a40ca0632f8284b3d6a9bcbf1b3618a808df51b2de97c3f1925f08cd68b16cf2fd0c823c3dc50b4276f2eeddeee2f141d0e4e5c8b03581de1e6bc893eba164e519791f28b36d22c654165fd56123cf4edbdd78bfe041a024b8771,11436603 17 | 454934,61285,"{""1"": ""0x7188a97d19b37d418e5954402cd0539e728974ad259e48ad6f1393cda14bea578d74561c834592a09d671d3106926898b42f7a77949ae22b4ffeff9ffe2ad205""}",\xa119ef65a10158407188a97d19b37d418e5954402cd0539e728974ad259e48ad6f1393cda14bea578d74561c834592a09d671d3106926898b42f7a77949ae22b4ffeff9ffe2ad205,11436603 18 | -------------------------------------------------------------------------------- /nix/pkgs.nix: -------------------------------------------------------------------------------- 1 | # our packages overlay 2 | pkgs: prev: with pkgs; 3 | let 4 | compiler = config.haskellNix.compiler or "ghc8107"; 5 | in { 6 | votingToolsHaskellProject = import ./haskell.nix { 7 | inherit 8 | haskell-nix 9 | lib 10 | ; 11 | }; 12 | votingToolsHaskellPackages = import ./haskell.nix { 13 | inherit 14 | haskell-nix 15 | lib 16 | ; 17 | }; 18 | 19 | jormungandr = let 20 | jormungandr-src = pkgs.fetchurl { 21 | url = 22 | "https://github.com/input-output-hk/jormungandr/releases/download/v0.9.3/jormungandr-0.9.3-x86_64-unknown-linux-musl-generic.tar.gz"; 23 | sha256 = "sha256:14giz9yz94mdjrdr96rz5xsj21aacdw8mqrfdz031czh4qgnmnzh"; 24 | }; 25 | in pkgs.runCommand "jormungandr" { buildInputs = [ pkgs.gnutar ]; } '' 26 | mkdir -p $out/bin 27 | cd $out/bin 28 | tar -zxvf ${jormungandr-src} 29 | ''; 30 | 31 | # systemd can't be statically linked: 32 | postgresql = (prev.postgresql_11 33 | .overrideAttrs (_: { dontDisableStatic = stdenv.hostPlatform.isMusl; })) 34 | .override { 35 | enableSystemd = stdenv.hostPlatform.isLinux && !stdenv.hostPlatform.isMusl; 36 | gssSupport = stdenv.hostPlatform.isLinux && !stdenv.hostPlatform.isMusl; 37 | }; 38 | 39 | 40 | } 41 | -------------------------------------------------------------------------------- /nix/tullia.nix: -------------------------------------------------------------------------------- 1 | let 2 | ciInputName = "GitHub event"; 3 | repository = "input-output-hk/voting-tools"; 4 | in { 5 | tasks.ci = { 6 | config, 7 | lib, 8 | ... 9 | }: { 10 | preset = { 11 | nix.enable = true; 12 | 13 | github.ci = { 14 | # Tullia tasks can run locally or on Cicero. 15 | # When no facts are present we know that we are running locally and vice versa. 16 | # When running locally, the current directory is already 17 | # bind-mounted into the container, so we don't need to fetch the 18 | # source from GitHub and we don't want to report a GitHub status. 19 | enable = config.actionRun.facts != {}; 20 | repository = "input-output-hk/voting-tools"; 21 | revision = config.preset.github.lib.readRevision ciInputName null; 22 | }; 23 | }; 24 | 25 | command.text = config.preset.github.status.lib.reportBulk { 26 | bulk.text = '' 27 | nix eval .#hydraJobs --json \ 28 | --apply 'jobs: __attrNames (removeAttrs jobs [ "required" ])' \ 29 | | nix-systems -i 30 | ''; 31 | each.text = ''nix build -L .#hydraJobs."$1".required''; 32 | skippedDescription = lib.escapeShellArg "No nix builder available for this system"; 33 | }; 34 | 35 | memory = 1024 * 8; 36 | nomad.resources.cpu = 10000; 37 | }; 38 | 39 | actions."voting-tools/ci" = { 40 | task = "ci"; 41 | io = '' 42 | // This is a CUE expression that defines what events trigger a new run of this action. 43 | // There is no documentation for this yet. Ask SRE if you have trouble changing this. 44 | 45 | let github = { 46 | #input: "${ciInputName}" 47 | #repo: "${repository}" 48 | } 49 | 50 | #lib.merge 51 | #ios: [ 52 | #lib.io.github_push & github, 53 | { #lib.io.github_pr, github, #target_default: false }, 54 | ] 55 | ''; 56 | }; 57 | } 58 | -------------------------------------------------------------------------------- /registration/.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle/ 2 | dist/ 3 | result* 4 | *.local 5 | *.local~ 6 | TAGS -------------------------------------------------------------------------------- /registration/LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /registration/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module Main where 6 | 7 | import Cardano.Api (TxMetadataJsonSchema (..), metadataToJson, serialiseToCBOR) 8 | import Control.Monad.Except (runExceptT) 9 | import Control.Monad.IO.Class (liftIO) 10 | import qualified Data.Aeson as Aeson 11 | import qualified Data.ByteString.Char8 as BSC 12 | import qualified Data.ByteString.Lazy.Char8 as LBS 13 | import qualified Options.Applicative as Opt 14 | import Ouroboros.Network.Block (unSlotNo) 15 | 16 | import Cardano.Catalyst.Registration (VoteRewardsAddress (..), createVoteRegistration, 17 | voteToTxMetadata) 18 | import qualified Config.Registration as Register 19 | 20 | main :: IO () 21 | main = do 22 | regOpts <- Opt.execParser Register.opts 23 | eCfg <- runExceptT (Register.mkConfig regOpts) 24 | case eCfg of 25 | Left (err :: Register.ConfigError) -> 26 | fail $ show err 27 | Right (Register.Config rewardsAddr voteSign votePub slotNo outFormat) -> do 28 | -- Create a vote registration, encoding our registration 29 | -- as transaction metadata. 30 | let 31 | vote = createVoteRegistration voteSign votePub (Address rewardsAddr) (toInteger $ unSlotNo slotNo) 32 | meta = voteToTxMetadata vote 33 | 34 | case outFormat of 35 | Register.MetadataOutFormatJSON -> 36 | liftIO $ LBS.putStr $ Aeson.encode $ metadataToJson TxMetadataJsonNoSchema meta 37 | Register.MetadataOutFormatCBOR -> 38 | liftIO $ BSC.putStr $ serialiseToCBOR meta 39 | -------------------------------------------------------------------------------- /registration/src/Config/Registration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | 7 | -- | Handles configuration, which involves parsing command line 8 | -- arguments and reading key files. 9 | 10 | module Config.Registration 11 | ( Config(Config) 12 | , ConfigError 13 | , opts 14 | , mkConfig 15 | , Opts(Opts) 16 | , parseOpts 17 | , MetadataOutFormat(..) 18 | ) where 19 | 20 | import Cardano.Catalyst.Registration (DelegationWeight, Delegations (..)) 21 | import Control.Exception.Safe (try) 22 | import Control.Lens ((#)) 23 | import Control.Lens.TH 24 | import Control.Monad.Except (ExceptT, MonadError, throwError) 25 | import Control.Monad.IO.Class (MonadIO, liftIO) 26 | import qualified Data.Attoparsec.ByteString.Char8 as Atto 27 | import qualified Data.ByteString.Char8 as BC 28 | import Data.Char (isSpace) 29 | import Data.Foldable (asum) 30 | import Data.List.NonEmpty (NonEmpty) 31 | import qualified Data.List.NonEmpty as NE 32 | import Data.Text (Text) 33 | import qualified Data.Text as T 34 | import qualified Data.Text.IO as TIO 35 | import Data.Traversable (forM) 36 | import Data.Word (Word32) 37 | 38 | import Options.Applicative 39 | 40 | import Cardano.Api (AddressAny (..), Bech32DecodeError, StakeAddress) 41 | import qualified Cardano.Api as Api 42 | import Cardano.CLI.Shelley.Key (InputDecodeError) 43 | import Cardano.CLI.Types (SigningKeyFile (..)) 44 | import Cardano.Catalyst.Crypto (StakeSigningKey, readStakeSigningKeyFile) 45 | import Config.Common (versionOption) 46 | 47 | import Cardano.API.Extended (AsBech32DecodeError (_Bech32DecodeError), 48 | AsFileError (_FileIOError, __FileError), AsInputDecodeError (_InputDecodeError), 49 | AsType (AsVotingKeyPublic), VotingKeyPublic, deserialiseFromBech32', 50 | parseShelleyAddress, readerFromAttoParser) 51 | 52 | data Config = Config 53 | { cfgRewardsAddress :: Api.Address Api.ShelleyAddr 54 | , cfgStakeSigningKey :: StakeSigningKey 55 | , cfgDelegations :: Delegations VotingKeyPublic 56 | , cfgSlotNo :: Api.SlotNo 57 | , cfgOutFormat :: MetadataOutFormat 58 | } 59 | deriving (Show) 60 | 61 | data MetadataOutFormat = MetadataOutFormatJSON 62 | | MetadataOutFormatCBOR 63 | deriving (Eq, Show) 64 | 65 | data FileErrors = FileErrorInputDecode InputDecodeError 66 | deriving (Show) 67 | 68 | makePrisms ''FileErrors 69 | 70 | instance AsInputDecodeError FileErrors where 71 | _InputDecodeError = _FileErrorInputDecode 72 | 73 | data ConfigError = ConfigFailedToReadFile (Api.FileError FileErrors) 74 | | ConfigFailedToDecodeBech32 Bech32DecodeError 75 | deriving (Show) 76 | 77 | makePrisms ''ConfigError 78 | 79 | instance AsFileError ConfigError FileErrors where 80 | __FileError = _ConfigFailedToReadFile 81 | 82 | instance AsBech32DecodeError ConfigError where 83 | _Bech32DecodeError = _ConfigFailedToDecodeBech32 84 | 85 | mkConfig 86 | :: Opts 87 | -> ExceptT ConfigError IO Config 88 | mkConfig (Opts rewardsAddr delegations vskf slotNo outFormat) = do 89 | stkSign <- readStakeSigningKeyFile (SigningKeyFile vskf) 90 | 91 | delegations' <- case delegations of 92 | LegacyDelegationCLI vpkf -> do 93 | votepk <- readVotePublicKey vpkf 94 | pure $ Delegations $ (votepk, 1) NE.:| [] 95 | DelegationsCLI keyWeights -> 96 | fmap Delegations . forM keyWeights $ \(vpkf, weight) -> do 97 | votepk <- readVotePublicKey vpkf 98 | pure $ (votepk, weight) 99 | 100 | pure $ Config rewardsAddr stkSign delegations' slotNo outFormat 101 | 102 | data Opts = Opts 103 | { optRewardsAddress :: Api.Address Api.ShelleyAddr 104 | , optVotePublicKeyFile :: DelegationsCLI 105 | , optStakeSigningKeyFile :: FilePath 106 | , optSlotNo :: Api.SlotNo 107 | , optOutFormat :: MetadataOutFormat 108 | } 109 | deriving (Show) 110 | 111 | parseOpts :: Parser Opts 112 | parseOpts = Opts 113 | <$> option (readerFromAttoParser parseShelleyAddress) (long "rewards-address" <> metavar "STRING" <> help "address associated with rewards (Must be a Shelley Address)") 114 | <*> pDelegationsCLI 115 | <*> strOption (long "stake-signing-key-file" <> metavar "FILE" <> help "stake authorizing vote key") 116 | <*> pSlotNo 117 | <*> pOutFormat 118 | 119 | data DelegationsCLI 120 | = LegacyDelegationCLI FilePath 121 | | DelegationsCLI (NonEmpty (FilePath, DelegationWeight)) 122 | deriving Show 123 | 124 | pDelegationLegacy :: Parser DelegationsCLI 125 | pDelegationLegacy = 126 | LegacyDelegationCLI 127 | <$> strOption ( 128 | long "vote-public-key-file" 129 | <> metavar "FILE" 130 | <> help "vote key generated by jcli (corresponding private key must be ed25519extended)" 131 | ) 132 | 133 | pDelegationCIP36 :: Parser (FilePath, Word32) 134 | pDelegationCIP36 = 135 | option 136 | (readerFromAttoParser pSingleDelegationCIP36) 137 | ( long "delegate" 138 | <> metavar "FILE,WEIGHT" 139 | <> help "ED25519Extended public voting key and delegation weight" 140 | ) 141 | 142 | pSingleDelegationCIP36 :: Atto.Parser (FilePath, Word32) 143 | pSingleDelegationCIP36 = do 144 | _ <- pSpace 145 | vpkf <- pVotePublicKeyFile 146 | _ <- Atto.string "," 147 | weight <- pKeyWeight 148 | pure $ (vpkf, weight) 149 | where 150 | sep = ',' 151 | isSep = (== sep) 152 | pSpace = Atto.skipWhile isSpace 153 | pVotePublicKeyFile = BC.unpack <$> Atto.takeWhile1 (not . isSep) 154 | pKeyWeight = Atto.decimal 155 | 156 | pDelegationsCLI :: Parser DelegationsCLI 157 | pDelegationsCLI = 158 | pDelegationLegacy 159 | <|> ((DelegationsCLI . NE.fromList) <$> (some pDelegationCIP36)) 160 | 161 | 162 | opts :: ParserInfo Opts 163 | opts = 164 | info 165 | ( parseOpts <**> versionOption "0.3.0.0" <**> helper ) 166 | ( fullDesc 167 | <> progDesc "Create vote registration metadata" 168 | <> header "voter-registration - a tool to create vote registration metadata suitable for attaching to a transaction" 169 | ) 170 | 171 | stripTrailingNewlines :: Text -> Text 172 | stripTrailingNewlines = T.intercalate "\n" . filter (not . T.null) . T.lines 173 | 174 | readVotePublicKey 175 | :: ( MonadIO m 176 | , MonadError e m 177 | , AsFileError e d 178 | , AsBech32DecodeError e 179 | ) 180 | => FilePath 181 | -> m VotingKeyPublic 182 | readVotePublicKey path = do 183 | result <- liftIO . try $ TIO.readFile path 184 | raw <- either (\e -> throwError . (_FileIOError #) $ (path, e)) pure result 185 | let publicKeyBech32 = stripTrailingNewlines raw 186 | either (throwError . (_Bech32DecodeError #)) pure $ deserialiseFromBech32' AsVotingKeyPublic publicKeyBech32 187 | 188 | pOutFormat :: Parser MetadataOutFormat 189 | pOutFormat = asum 190 | [ flag' MetadataOutFormatJSON 191 | ( long "json" 192 | <> help "Output metadata in JSON format (using the 'NoSchema' TxMetadata JSON format - the default for cardano-cli)" 193 | ) 194 | , flag' MetadataOutFormatCBOR 195 | ( long "cbor" 196 | <> help "Output metadata in binary CBOR format" 197 | ) 198 | ] 199 | 200 | pSlotNo :: Parser Api.SlotNo 201 | pSlotNo = Api.SlotNo 202 | <$> option auto 203 | ( long "slot-no" 204 | <> metavar "WORD64" 205 | <> help "Slot number to encode in vote registration. Used to prevent replay attacks. Use the chain tip if you're unsure." 206 | ) 207 | -------------------------------------------------------------------------------- /registration/voter-registration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: voter-registration 3 | version: 0.3.0.0 4 | -- synopsis: 5 | -- description: 6 | -- bug-reports: 7 | -- license: 8 | license-file: LICENSE 9 | author: Samuel Evans-Powell 10 | maintainer: mail@sevanspowell.net 11 | -- copyright: 12 | -- category: 13 | build-type: Simple 14 | extra-source-files: ../CHANGELOG.md 15 | 16 | common project-config 17 | default-language: Haskell2010 18 | default-extensions: OverloadedStrings 19 | 20 | ghc-options: -Wall 21 | -Wcompat 22 | -Wincomplete-record-updates 23 | -Wincomplete-uni-patterns 24 | -Wpartial-fields 25 | -Wredundant-constraints 26 | -Wunused-packages 27 | library 28 | exposed-modules: Config.Registration 29 | build-depends: base 30 | , aeson 31 | , base16-bytestring 32 | , bytestring 33 | , cardano-api 34 | , mtl 35 | , optparse-applicative 36 | , ouroboros-network 37 | , voting-tools 38 | , cardano-cli 39 | , cardano-api 40 | , lens 41 | , text 42 | , attoparsec 43 | , safe-exceptions 44 | hs-source-dirs: src/ 45 | default-language: Haskell2010 46 | 47 | executable voter-registration 48 | import: project-config 49 | main-is: Main.hs 50 | build-depends: base 51 | , aeson 52 | , bytestring 53 | , cardano-api 54 | , mtl 55 | , optparse-applicative 56 | , ouroboros-network 57 | , voting-tools 58 | , cardano-api 59 | , voter-registration 60 | 61 | hs-source-dirs: app/ 62 | default-language: Haskell2010 63 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | # This file is used by nix-shell. 2 | # It just takes the shell attribute from default.nix. 3 | { config ? {} 4 | , sourcesOverride ? {} 5 | , withHoogle ? true 6 | , pkgs ? import ./nix { 7 | inherit config sourcesOverride; 8 | } 9 | }: 10 | 11 | with pkgs; with commonLib; 12 | let 13 | 14 | inherit (pkgs.haskell-nix.haskellLib) selectProjectPackages; 15 | 16 | cardano-node-nix = 17 | import (sources.cardano-node) { gitrev = sources.cardano-node.rev; }; 18 | bech32 = cardano-node-nix.bech32; 19 | 20 | jormungandr-src = pkgs.fetchurl { 21 | url = 22 | "https://github.com/input-output-hk/jormungandr/releases/download/v0.9.3/jormungandr-0.9.3-x86_64-unknown-linux-musl-generic.tar.gz"; 23 | sha256 = "sha256:14giz9yz94mdjrdr96rz5xsj21aacdw8mqrfdz031czh4qgnmnzh"; 24 | }; 25 | jormungandr = 26 | pkgs.runCommand "jormungandr" { buildInputs = [ pkgs.gnutar ]; } '' 27 | mkdir -p $out/bin 28 | cd $out/bin 29 | tar -zxvf ${jormungandr-src} 30 | ''; 31 | 32 | # This provides a development environment that can be used with nix-shell or 33 | # lorri. See https://input-output-hk.github.io/haskell.nix/user-guide/development/ 34 | shell = votingToolsHaskellPackages.shellFor { 35 | name = "voting-tools-shell"; 36 | 37 | # If shellFor local packages selection is wrong, 38 | # then list all local packages then include source-repository-package that cabal complains about: 39 | packages = ps: lib.attrValues (selectProjectPackages ps); 40 | 41 | nativeBuildInputs = [ 42 | pkgs.cabalWrapped 43 | ]; 44 | # These programs will be available inside the nix-shell. 45 | buildInputs = (with pkgs; [ 46 | # cabal-install 47 | ghcid 48 | git 49 | hlint 50 | niv 51 | nix 52 | pkgconfig 53 | stylish-haskell 54 | jormungandr 55 | bech32 56 | ]); 57 | 58 | # Prevents cabal from choosing alternate plans, so that 59 | # *all* dependencies are provided by Nix. 60 | exactDeps = true; 61 | 62 | inherit withHoogle; 63 | 64 | GIT_SSL_CAINFO = "${cacert}/etc/ssl/certs/ca-bundle.crt"; 65 | }; 66 | 67 | in 68 | 69 | shell 70 | -------------------------------------------------------------------------------- /src/Cardano/API/Extended.hs: -------------------------------------------------------------------------------- 1 | -- | Cardano.Api.Extended.Raw but I've made the errors "classy". Plus 2 | -- some utility functions. 3 | 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE FunctionalDependencies #-} 7 | {-# LANGUAGE GADTs #-} 8 | {-# LANGUAGE MultiParamTypeClasses #-} 9 | {-# LANGUAGE NamedFieldPuns #-} 10 | {-# LANGUAGE OverloadedStrings #-} 11 | {-# LANGUAGE RankNTypes #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# OPTIONS_GHC -fno-warn-orphans #-} 16 | 17 | module Cardano.API.Extended ( readSigningKeyFileAnyOf 18 | , AsFileError(..) 19 | , AsInputDecodeError(..) 20 | , Extended.readerFromAttoParser 21 | , Extended.parseStakeAddress 22 | , Extended.parseShelleyAddress 23 | , Extended.pNetworkId 24 | , AsBech32DecodeError(..) 25 | , AsBech32HumanReadablePartError(..) 26 | , Bech32HumanReadablePartError(Bech32HumanReadablePartError) 27 | , VotingKeyPublic(..) 28 | , deserialiseFromBech32' 29 | , serialiseToBech32' 30 | , SerialiseAsBech32'(bech32PrefixFor, bech32PrefixesPermitted) 31 | , AsType(AsVotingKeyPublic) 32 | ) where 33 | 34 | import qualified Cardano.Crypto.DSIGN as Crypto 35 | import qualified Cardano.Crypto.Hash.Blake2b as Crypto 36 | import Control.Lens ((#)) 37 | import Control.Lens.TH (makeClassyPrisms) 38 | import Control.Monad (guard) 39 | import Control.Monad.Except (MonadError, throwError) 40 | import Control.Monad.IO.Class (MonadIO, liftIO) 41 | import Data.Aeson (FromJSON, ToJSON) 42 | import qualified Data.Set as Set 43 | import Data.Text (Text) 44 | import qualified Data.Text as T 45 | import qualified Data.Text.Encoding as T 46 | 47 | import Cardano.Api (AsType, Bech32DecodeError (..), FileError (..), FromSomeType, 48 | HasTextEnvelope, HasTypeProxy (..), SerialiseAsBech32, SerialiseAsRawBytes (..), 49 | deserialiseFromRawBytesHex, serialiseToRawBytesHex) 50 | import Cardano.CLI.Shelley.Key (InputDecodeError) 51 | import qualified Cardano.CLI.Shelley.Key as Shelley 52 | import Cardano.CLI.Types (SigningKeyFile (..)) 53 | import qualified Codec.Binary.Bech32 as Bech32 54 | import qualified Data.Aeson as Aeson 55 | 56 | import qualified Cardano.API.Extended.Raw as Extended 57 | 58 | makeClassyPrisms ''FileError 59 | makeClassyPrisms ''InputDecodeError 60 | makeClassyPrisms ''Bech32DecodeError 61 | 62 | data Bech32HumanReadablePartError = Bech32HumanReadablePartError !(Bech32.HumanReadablePartError) 63 | deriving Show 64 | 65 | makeClassyPrisms ''Bech32HumanReadablePartError 66 | 67 | readSigningKeyFileAnyOf 68 | :: forall e m fileErr b. 69 | ( MonadIO m 70 | , MonadError e m 71 | , AsFileError e fileErr 72 | , AsInputDecodeError fileErr 73 | ) 74 | => [FromSomeType SerialiseAsBech32 b] 75 | -> [FromSomeType HasTextEnvelope b] 76 | -> SigningKeyFile 77 | -> m b 78 | readSigningKeyFileAnyOf bech32Types textEnvTypes f = do 79 | result <- liftIO $ Shelley.readSigningKeyFileAnyOf bech32Types textEnvTypes f 80 | case result of 81 | Right x -> pure x 82 | Left (FileError fp e) -> throwError (_FileError # (fp , _InputDecodeError # e)) 83 | Left (FileIOError fp e) -> throwError (_FileIOError # (fp, e)) 84 | Left (FileErrorTempFile fp tmp h) -> throwError (_FileErrorTempFile # (fp, tmp, h)) 85 | 86 | -- | Voting key types do not exist in the cardano-api yet. 87 | newtype VotingKeyPublic = VotingKeyPublic (Crypto.VerKeyDSIGN Crypto.Ed25519DSIGN) 88 | deriving (Eq, Show) 89 | 90 | instance Ord VotingKeyPublic where 91 | compare (VotingKeyPublic a) (VotingKeyPublic b) = 92 | compare 93 | (Crypto.hashVerKeyDSIGN @Crypto.Ed25519DSIGN @Crypto.Blake2b_256 a) 94 | (Crypto.hashVerKeyDSIGN @Crypto.Ed25519DSIGN @Crypto.Blake2b_256 b) 95 | 96 | instance ToJSON VotingKeyPublic where 97 | toJSON = Aeson.String . ("0x" <>) . T.decodeUtf8 . serialiseToRawBytesHex 98 | 99 | instance FromJSON VotingKeyPublic where 100 | parseJSON = Aeson.withText "VotingKeyPublic" $ \str -> case T.stripPrefix "0x" str of 101 | Nothing -> fail "Missing hex identifier '0x'." 102 | Just hex -> 103 | case deserialiseFromRawBytesHex AsVotingKeyPublic $ T.encodeUtf8 hex of 104 | Nothing -> fail "Failed to deserialise voting public key." 105 | Just votePub -> pure votePub 106 | 107 | instance HasTypeProxy VotingKeyPublic where 108 | data AsType VotingKeyPublic = AsVotingKeyPublic 109 | proxyToAsType _ = AsVotingKeyPublic 110 | 111 | instance SerialiseAsRawBytes VotingKeyPublic where 112 | serialiseToRawBytes (VotingKeyPublic vkey) = 113 | Crypto.rawSerialiseVerKeyDSIGN vkey 114 | deserialiseFromRawBytes AsVotingKeyPublic = 115 | fmap VotingKeyPublic . Crypto.rawDeserialiseVerKeyDSIGN 116 | 117 | instance SerialiseAsBech32' VotingKeyPublic where 118 | bech32PrefixFor _ = "ed25519_pk" 119 | bech32PrefixesPermitted AsVotingKeyPublic = ["ed25519_pk"] 120 | 121 | (?!.) :: Either e a -> (e -> e') -> Either e' a 122 | Left e ?!. f = Left (f e) 123 | Right x ?!. _ = Right x 124 | 125 | (?!) :: Maybe a -> e -> Either e a 126 | Nothing ?! e = Left e 127 | Just x ?! _ = Right x 128 | 129 | -- TODO Ask for this class to be exposed in Cardano.Api... 130 | -- The SerialiseAsBech32 class need to be exposed from the CardanoAPI 131 | -- for me to be able to define serialization for new types. 132 | 133 | -- instance SerialiseAsBech32 VotingKeyPublic where 134 | -- bech32PrefixFor (VotingKeyPublic) = "ed25519e_sk" 135 | 136 | -- bech32PrefixesPermitted AsVotingKeyPublic = ["ed25519e_sk"] 137 | 138 | class (HasTypeProxy a, SerialiseAsRawBytes a) => SerialiseAsBech32' a where 139 | 140 | -- | The human readable prefix to use when encoding this value to Bech32. 141 | -- 142 | bech32PrefixFor :: a -> Text 143 | 144 | -- | The set of human readable prefixes that can be used for this type. 145 | -- 146 | bech32PrefixesPermitted :: AsType a -> [Text] 147 | 148 | serialiseToBech32' :: SerialiseAsBech32' a => a -> Text 149 | serialiseToBech32' a = 150 | Bech32.encodeLenient 151 | humanReadablePart 152 | (Bech32.dataPartFromBytes (serialiseToRawBytes a)) 153 | where 154 | humanReadablePart = 155 | case Bech32.humanReadablePartFromText (bech32PrefixFor a) of 156 | Right p -> p 157 | Left err -> error $ "serialiseToBech32: invalid prefix " 158 | ++ show (bech32PrefixFor a) 159 | ++ ", " ++ show err 160 | 161 | 162 | deserialiseFromBech32' :: SerialiseAsBech32' a 163 | => AsType a -> Text -> Either Bech32DecodeError a 164 | deserialiseFromBech32' asType bech32Str = do 165 | (prefix, dataPart) <- Bech32.decodeLenient bech32Str 166 | ?!. Bech32DecodingError 167 | 168 | let actualPrefix = Bech32.humanReadablePartToText prefix 169 | permittedPrefixes = bech32PrefixesPermitted asType 170 | guard (actualPrefix `elem` permittedPrefixes) 171 | ?! Bech32UnexpectedPrefix actualPrefix (Set.fromList permittedPrefixes) 172 | 173 | payload <- Bech32.dataPartToBytes dataPart 174 | ?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart) 175 | 176 | value <- deserialiseFromRawBytes asType payload 177 | ?! Bech32DeserialiseFromBytesError payload 178 | 179 | let expectedPrefix = bech32PrefixFor value 180 | guard (actualPrefix == expectedPrefix) 181 | ?! Bech32WrongPrefix actualPrefix expectedPrefix 182 | 183 | return value 184 | -------------------------------------------------------------------------------- /src/Cardano/API/Extended/Raw.hs: -------------------------------------------------------------------------------- 1 | -- | Parts of the cardano-api that I need exposed but which aren't so 2 | -- I've replicated them here. 3 | 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE NamedFieldPuns #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE PatternGuards #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE ScopedTypeVariables #-} 10 | 11 | module Cardano.API.Extended.Raw where 12 | 13 | import Control.Applicative ((<|>)) 14 | import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) 15 | import qualified Data.Attoparsec.ByteString.Char8 as Atto 16 | import qualified Data.ByteString.Char8 as BSC 17 | import qualified Data.ByteString.Lazy as LBS 18 | import Data.Text (Text) 19 | import qualified Data.Text.Encoding as T 20 | import qualified Options.Applicative as Opt 21 | 22 | import Cardano.Api (AddressAny, AsType (AsAddressAny, AsShelleyAddress, AsStakeAddress), 23 | HasTextEnvelope, NetworkId (Mainnet, Testnet), NetworkMagic (..), StakeAddress, 24 | TextEnvelopeDescr, deserialiseAddress, serialiseToTextEnvelope) 25 | import Cardano.Api.Shelley (Address, ShelleyAddr) 26 | 27 | parseShelleyAddress :: Atto.Parser (Address ShelleyAddr) 28 | parseShelleyAddress = do 29 | str <- lexPlausibleAddressString 30 | case deserialiseAddress AsShelleyAddress str of 31 | Nothing -> fail "invalid shelley address" 32 | Just addr -> pure addr 33 | 34 | parseAddressAny :: Atto.Parser AddressAny 35 | parseAddressAny = do 36 | str <- lexPlausibleAddressString 37 | case deserialiseAddress AsAddressAny str of 38 | Nothing -> fail "invalid address" 39 | Just addr -> pure addr 40 | 41 | parseStakeAddress :: Atto.Parser StakeAddress 42 | parseStakeAddress = do 43 | str <- lexPlausibleAddressString 44 | case deserialiseAddress AsStakeAddress str of 45 | Nothing -> fail "invalid address" 46 | Just addr -> pure addr 47 | 48 | readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a 49 | readerFromAttoParser p = 50 | Opt.eitherReader (Atto.parseOnly (p <* Atto.endOfInput) . BSC.pack) 51 | 52 | pNetworkId :: Opt.Parser NetworkId 53 | pNetworkId = 54 | pMainnet' <|> fmap Testnet pTestnetMagic 55 | where 56 | pMainnet' :: Opt.Parser NetworkId 57 | pMainnet' = 58 | Opt.flag' Mainnet 59 | ( Opt.long "mainnet" 60 | <> Opt.help "Use the mainnet magic id." 61 | ) 62 | 63 | pTestnetMagic :: Opt.Parser NetworkMagic 64 | pTestnetMagic = 65 | NetworkMagic <$> 66 | Opt.option Opt.auto 67 | ( Opt.long "testnet-magic" 68 | <> Opt.metavar "NATURAL" 69 | <> Opt.help "Specify a testnet magic id." 70 | ) 71 | 72 | textEnvelopeJSONConfig :: Config 73 | textEnvelopeJSONConfig = defConfig { confCompare = textEnvelopeJSONKeyOrder } 74 | 75 | textEnvelopeToJSON :: HasTextEnvelope a => Maybe TextEnvelopeDescr -> a -> BSC.ByteString 76 | textEnvelopeToJSON mbDescr a = 77 | LBS.toStrict $ encodePretty' textEnvelopeJSONConfig 78 | (serialiseToTextEnvelope mbDescr a) 79 | <> "\n" 80 | 81 | textEnvelopeJSONKeyOrder :: Text -> Text -> Ordering 82 | textEnvelopeJSONKeyOrder = keyOrder ["type", "description", "cborHex"] 83 | 84 | lexPlausibleAddressString :: Atto.Parser Text 85 | lexPlausibleAddressString = 86 | T.decodeLatin1 <$> Atto.takeWhile1 isPlausibleAddressChar 87 | where 88 | -- Covers both base58 and bech32 (with constrained prefixes) 89 | isPlausibleAddressChar c = 90 | (c >= 'a' && c <= 'z') 91 | || (c >= 'A' && c <= 'Z') 92 | || (c >= '0' && c <= '9') 93 | || c == '_' 94 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Crypto.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | 9 | module Cardano.Catalyst.Crypto 10 | ( -- * SigningKey (private key) 11 | StakeSigningKey 12 | -- ** Creation 13 | , readStakeSigningKeyFile 14 | -- *** From Cardano.Api types 15 | , signingKeyFromStakeSigningKey 16 | , signingKeyFromStakeExtendedSigningKey 17 | -- ** Conversion 18 | -- *** To Cardano.Api types 19 | , withStakeSigningKey 20 | , withShelleySigningKey 21 | -- *** To verification key 22 | , getStakeVerificationKey 23 | -- * VerificationKey (public key) 24 | , StakeVerificationKey 25 | , AsType(AsStakeVerificationKey) 26 | , stakeVerificationKeyHash 27 | , serialiseStakeVerificationKeyToBech32 28 | -- ** Conversion 29 | , withStakeVerificationKey 30 | -- ** StakeAddress 31 | , stakeAddressFromKeyHash 32 | , stakeAddressFromVerificationKey 33 | -- * Operations 34 | , hashPayload 35 | , sign 36 | , verify 37 | ) where 38 | 39 | import Control.Monad.Except (MonadError) 40 | import Control.Monad.IO.Class (MonadIO) 41 | import Data.Aeson (FromJSON, ToJSON) 42 | import qualified Data.Aeson as Aeson 43 | import Data.ByteString (ByteString) 44 | import qualified Data.ByteString.Lazy as LBS 45 | import qualified Data.Text as T 46 | import qualified Data.Text.Encoding as T 47 | 48 | import Cardano.API.Extended (AsFileError, AsInputDecodeError, readSigningKeyFileAnyOf) 49 | import Cardano.Api 50 | (AsType (AsSigningKey, AsStakeExtendedKey, AsStakeKey, AsVerificationKey), 51 | FromSomeType (..), HasTypeProxy, Hash, Key, NetworkId, 52 | SerialiseAsRawBytes (deserialiseFromRawBytes, serialiseToRawBytes), SigningKey, 53 | StakeAddress, StakeExtendedKey, StakeKey, VerificationKey, castVerificationKey, 54 | deserialiseFromRawBytesHex, getVerificationKey, makeStakeAddress, proxyToAsType, 55 | serialiseToRawBytes, serialiseToRawBytesHex, verificationKeyHash) 56 | import Cardano.Api.Shelley (ShelleySigningKey, ShelleyWitnessSigningKey (..), 57 | SigningKey (..), StakeCredential (..), VerificationKey (StakeVerificationKey), 58 | makeShelleySignature, toShelleySigningKey) 59 | import Cardano.CLI.Types (SigningKeyFile) 60 | import qualified Cardano.Crypto.DSIGN.Class as Crypto 61 | import qualified Cardano.Crypto.Hashing as Crypto 62 | import qualified Cardano.Crypto.Util as Crypto 63 | import qualified Cardano.Ledger.Keys as Shelley 64 | 65 | import qualified Cardano.Api as Api 66 | import Data.Text (Text) 67 | 68 | import Cardano.Ledger.Crypto (Crypto (..), StandardCrypto) 69 | 70 | data StakeSigningKey 71 | = AStakeSigningKey (SigningKey StakeKey) 72 | | AStakeExtendedSigningKey (SigningKey StakeExtendedKey) 73 | deriving Show 74 | 75 | instance Eq StakeSigningKey where 76 | skey1 == skey2 = getStakeVerificationKey skey1 == getStakeVerificationKey skey2 77 | 78 | instance Ord StakeSigningKey where 79 | skey1 <= skey2 = getStakeVerificationKey skey1 <= getStakeVerificationKey skey2 80 | 81 | data StakeVerificationKey 82 | = AStakeVerificationKey (VerificationKey StakeKey) 83 | | AStakeExtendedVerificationKey (VerificationKey StakeExtendedKey) 84 | deriving (Eq, Show) 85 | 86 | instance Ord StakeVerificationKey where 87 | compare a b = 88 | compare (serialiseStakeVerificationKeyToBech32 a) 89 | (serialiseStakeVerificationKeyToBech32 b) 90 | 91 | serialiseStakeVerificationKeyToBech32 :: StakeVerificationKey -> Text 92 | serialiseStakeVerificationKeyToBech32 (AStakeVerificationKey verKey) 93 | = Api.serialiseToBech32 verKey 94 | serialiseStakeVerificationKeyToBech32 (AStakeExtendedVerificationKey verKey) 95 | = Api.serialiseToBech32 verKey 96 | 97 | stakeVerificationKeyHash :: StakeVerificationKey -> Hash StakeKey 98 | stakeVerificationKeyHash v = withStakeVerificationKey v (verificationKeyHash) 99 | 100 | instance ToJSON StakeVerificationKey where 101 | toJSON = Aeson.String . ("0x" <>) . T.decodeUtf8 . serialiseToRawBytesHex 102 | 103 | instance FromJSON StakeVerificationKey where 104 | parseJSON = Aeson.withText "StakeVerificationKey" $ \str -> case T.stripPrefix "0x" str of 105 | Nothing -> fail "Missing hex identifier '0x'." 106 | Just hex -> 107 | case deserialiseFromRawBytesHex AsStakeVerificationKey $ T.encodeUtf8 hex of 108 | Nothing -> fail "Failed to deserialise vote verification key." 109 | Just votePub -> pure votePub 110 | 111 | getStakeVerificationKey :: StakeSigningKey -> StakeVerificationKey 112 | getStakeVerificationKey (AStakeSigningKey skey) = AStakeVerificationKey $ getVerificationKey skey 113 | getStakeVerificationKey (AStakeExtendedSigningKey skey) = AStakeExtendedVerificationKey $ getVerificationKey skey 114 | 115 | withStakeVerificationKey :: StakeVerificationKey -> (VerificationKey StakeKey -> a) -> a 116 | withStakeVerificationKey ver f = 117 | let 118 | vkey = case ver of 119 | (AStakeVerificationKey vkey') -> vkey' 120 | (AStakeExtendedVerificationKey vkey') -> castVerificationKey vkey' 121 | in 122 | f vkey 123 | 124 | stakeAddressFromKeyHash :: NetworkId -> Hash StakeKey -> StakeAddress 125 | stakeAddressFromKeyHash nw = makeStakeAddress nw . StakeCredentialByKey 126 | 127 | stakeAddressFromVerificationKey :: NetworkId -> StakeVerificationKey -> StakeAddress 128 | stakeAddressFromVerificationKey nw = stakeAddressFromKeyHash nw . stakeVerificationKeyHash 129 | 130 | hashPayload :: ByteString -> ByteString 131 | hashPayload payload = Crypto.hashToBytes . Crypto.hashRaw $ LBS.fromStrict payload 132 | 133 | sign :: ByteString -> StakeSigningKey -> Crypto.SigDSIGN (DSIGN StandardCrypto) 134 | sign payload vsk = sign' (hashPayload payload) vsk 135 | 136 | sign' 137 | :: Crypto.SignableRepresentation tosign 138 | => tosign 139 | -> StakeSigningKey 140 | -> Crypto.SigDSIGN (DSIGN StandardCrypto) 141 | sign' payload vsk = 142 | withShelleySigningKey vsk $ \skey -> 143 | let 144 | (Crypto.SignedDSIGN sig) = makeShelleySignature payload skey 145 | in sig 146 | 147 | verify 148 | :: StakeVerificationKey 149 | -> ByteString 150 | -> Crypto.SigDSIGN (DSIGN StandardCrypto) 151 | -> Bool 152 | verify vkey payload sig = verify' vkey (hashPayload payload) sig 153 | 154 | verify' 155 | :: Crypto.SignableRepresentation tosign 156 | => StakeVerificationKey 157 | -> tosign 158 | -> Crypto.SigDSIGN (DSIGN StandardCrypto) 159 | -> Bool 160 | verify' vkey payload sig = 161 | withStakeVerificationKey vkey $ \(StakeVerificationKey (Shelley.VKey v)) -> 162 | either (const False) (const True) $ Crypto.verifyDSIGN () v payload sig 163 | 164 | withStakeSigningKey :: StakeSigningKey 165 | -> (forall keyrole. Key keyrole => SigningKey keyrole -> a) 166 | -> a 167 | withStakeSigningKey vsk f = 168 | case vsk of 169 | AStakeSigningKey sk -> f sk 170 | AStakeExtendedSigningKey sk -> f sk 171 | 172 | withShelleySigningKey :: StakeSigningKey -> (ShelleySigningKey -> a) -> a 173 | withShelleySigningKey vsk f = 174 | case vsk of 175 | AStakeSigningKey (StakeSigningKey dsign) -> f ( toShelleySigningKey $ WitnessStakeKey (StakeSigningKey dsign)) 176 | AStakeExtendedSigningKey (StakeExtendedSigningKey xprv) -> f ( toShelleySigningKey $ WitnessStakeExtendedKey (StakeExtendedSigningKey xprv)) 177 | 178 | signingKeyFromStakeSigningKey :: SigningKey StakeKey -> StakeSigningKey 179 | signingKeyFromStakeSigningKey sk = AStakeSigningKey sk 180 | 181 | signingKeyFromStakeExtendedSigningKey :: SigningKey StakeExtendedKey -> StakeSigningKey 182 | signingKeyFromStakeExtendedSigningKey sk = AStakeExtendedSigningKey sk 183 | 184 | readStakeSigningKeyFile 185 | :: ( MonadIO m 186 | , MonadError e m 187 | , AsFileError e fileErr 188 | , AsInputDecodeError fileErr 189 | ) 190 | => SigningKeyFile 191 | -> m StakeSigningKey 192 | readStakeSigningKeyFile skFile = 193 | readSigningKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile 194 | 195 | where 196 | textEnvFileTypes = 197 | [ FromSomeType (AsSigningKey AsStakeKey) 198 | AStakeSigningKey 199 | , FromSomeType (AsSigningKey AsStakeExtendedKey) 200 | AStakeExtendedSigningKey 201 | ] 202 | 203 | bech32FileTypes = 204 | [ FromSomeType (AsSigningKey AsStakeKey) 205 | AStakeSigningKey 206 | , FromSomeType (AsSigningKey AsStakeExtendedKey) 207 | AStakeExtendedSigningKey 208 | ] 209 | 210 | instance HasTypeProxy StakeVerificationKey where 211 | data AsType StakeVerificationKey = AsStakeVerificationKey 212 | proxyToAsType _ = AsStakeVerificationKey 213 | 214 | instance SerialiseAsRawBytes StakeVerificationKey where 215 | serialiseToRawBytes (AStakeVerificationKey vkey) = serialiseToRawBytes vkey 216 | serialiseToRawBytes (AStakeExtendedVerificationKey vkey) = serialiseToRawBytes vkey 217 | 218 | deserialiseFromRawBytes AsStakeVerificationKey bs = 219 | case (AStakeExtendedVerificationKey <$> deserialiseFromRawBytes (AsVerificationKey AsStakeExtendedKey) bs) of 220 | Nothing -> (AStakeVerificationKey <$> deserialiseFromRawBytes (AsVerificationKey AsStakeKey) bs) 221 | x -> x 222 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Query/Esqueleto.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TupleSections #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | {-# LANGUAGE TypeOperators #-} 7 | 8 | module Cardano.Catalyst.Query.Esqueleto where 9 | 10 | import Cardano.Catalyst.Query.Types (Query) 11 | import Cardano.Catalyst.Registration (MetadataParsingError, metadataMetaKey, 12 | signatureMetaKey) 13 | import Cardano.Db (Block, DbLovelace (..), DbWord64 (..), EntityField (..), Key, 14 | StakeAddress, Tx, TxId, TxIn, TxMetadata, TxOut, txMetadataJson) 15 | import Control.Lens.TH (makeClassyPrisms) 16 | import Control.Monad.IO.Class (MonadIO) 17 | import Control.Monad.Reader (ReaderT) 18 | import Data.ByteString (ByteString) 19 | import Data.Foldable (foldl') 20 | import Data.Map.Strict (Map) 21 | import Data.Maybe (fromMaybe) 22 | import Data.Monoid (Sum (..)) 23 | import Data.Text (Text) 24 | import Database.Esqueleto.Legacy (Entity (..), InnerJoin (..), Value (..), from, 25 | isNothing, on, select, unValue, val, where_, (<=.), (==.), (?.), (^.)) 26 | import Database.Persist.Sql (SqlBackend) 27 | 28 | import qualified Cardano.Api as Api 29 | import qualified Cardano.Catalyst.Query.Types as Query 30 | import qualified Data.Aeson as Aeson 31 | import qualified Data.HashMap.Strict as HM 32 | import qualified Data.Map.Strict as M 33 | import qualified Data.Text as T 34 | import qualified Data.Text.Lazy as TL 35 | import qualified Data.Text.Lazy.Encoding as TL 36 | 37 | import qualified Database.Esqueleto.Experimental as E 38 | 39 | data MetadataRetrievalError 40 | = MetadataFailedToDecodeMetadataField !TxId !Text 41 | | MetadataFailedToDecodeSignatureField !TxId !Text 42 | | MetadataFailedToDecodeTxMetadata !TxId !Api.TxMetadataJsonError 43 | | MetadataFailedToParseVoteRegistration !TxId !MetadataParsingError 44 | deriving (Eq, Show) 45 | 46 | makeClassyPrisms ''MetadataRetrievalError 47 | 48 | esqlQuery 49 | :: MonadIO m 50 | => Query (ReaderT SqlBackend m) TxId 51 | esqlQuery = 52 | Query.Query { Query.queryVoteRegistrations = queryVoteRegistrations 53 | , Query.queryStakeValue = queryStakeValue 54 | , Query.queryStakeValues = queryStakeValues 55 | } 56 | 57 | queryVoteRegistrations 58 | :: MonadIO m 59 | => Maybe Api.SlotNo 60 | -> ReaderT SqlBackend m [( Key Tx 61 | -- ^ Tx Id 62 | , Aeson.Value 63 | -- ^ Registration Tx Metadata 64 | )] 65 | queryVoteRegistrations mSlotNo = do 66 | (metadataRaw :: [(Value (Key Tx), Entity TxMetadata, Entity TxMetadata)]) <- 67 | select $ from $ 68 | \(metaTable `InnerJoin` tx `InnerJoin` sigTable `InnerJoin` block) -> do 69 | on (metaTable ^. TxMetadataTxId ==. tx ^. TxId) 70 | on (sigTable ^. TxMetadataTxId ==. tx ^. TxId) 71 | on (block ^. BlockId ==. tx ^. TxBlockId) 72 | where_ (metaTable ^. TxMetadataKey ==. val (DbWord64 $ metadataMetaKey)) 73 | where_ (sigTable ^. TxMetadataKey ==. val (DbWord64 $ signatureMetaKey)) 74 | where_ (case mSlotNo of 75 | Nothing -> 76 | val True 77 | Just slotNo -> 78 | block ^. BlockSlotNo <=. val (Just (Api.unSlotNo slotNo)) 79 | ) 80 | 81 | pure (tx ^. TxId, metaTable, sigTable) 82 | 83 | -- Reconstruct full JSON from individual metadata entries 84 | pure $ flip foldMap metadataRaw $ \( Value txId 85 | , (Entity _idRego regoMeta) 86 | , (Entity _idSig sigMeta) 87 | ) -> do 88 | let 89 | regoJSON :: Aeson.Value 90 | regoJSON = Aeson.Object $ either mempty id $ decodeMetadata regoMeta 91 | 92 | sigJSON :: Aeson.Value 93 | sigJSON = Aeson.Object $ either mempty id $ decodeMetadata sigMeta 94 | 95 | metaObj :: Aeson.Value 96 | metaObj = Aeson.Object $ HM.fromList [ ( T.pack $ show metadataMetaKey 97 | , regoJSON 98 | ) 99 | , ( T.pack $ show signatureMetaKey 100 | , sigJSON 101 | ) 102 | ] 103 | 104 | [(txId, metaObj)] 105 | 106 | queryStakeValues 107 | :: MonadIO m 108 | => Maybe Api.SlotNo 109 | -> [Api.StakeAddress] 110 | -> ReaderT SqlBackend m [(Api.StakeAddress, Integer)] 111 | queryStakeValues mSlotNo stakeAddrs = do 112 | (stakeValuesRaw :: [(Value ByteString, Value DbLovelace)]) <- E.select $ do 113 | -- Given a snapshot of the txins and outs before the given slot number, 114 | (txOut E.:& stakeAddress E.:& txIn) <- 115 | E.from $ utxoSnapshot mSlotNo stakeAddrs 116 | -- return those that haven't been spent. 117 | E.where_ (isNothing $ txIn ?. TxInTxInId) 118 | pure ( stakeAddress ^. StakeAddressHashRaw 119 | , txOut ^. TxOutValue 120 | ) 121 | 122 | let 123 | -- Ensure every stake hash asked for is represented to ensure that the size 124 | -- of the input list matches the size of the output list. 125 | stakeValuesZero :: Map Api.StakeAddress (Sum Integer) 126 | stakeValuesZero = M.fromList $ (, Sum 0) <$> stakeAddrs 127 | 128 | -- Add a queried stake value to the map. Ensure we sum in an unbounded type 129 | -- (Integer) to prevent Int overflow. Stake hashes that fail to deserialise 130 | -- are ignored. 131 | addStakeValue 132 | :: Map Api.StakeAddress (Sum Integer) 133 | -> (Value ByteString, Value DbLovelace) 134 | -> Map Api.StakeAddress (Sum Integer) 135 | addStakeValue acc (Value stakeAddrHashRaw, Value (DbLovelace v)) = 136 | case Api.deserialiseFromRawBytes Api.AsStakeAddress stakeAddrHashRaw of 137 | Nothing -> acc 138 | Just stakeAddr -> M.insertWith (<>) stakeAddr (Sum . fromIntegral $ v) acc 139 | 140 | -- Add all queried stake values. 141 | stakeValues :: Map Api.StakeAddress (Sum Integer) 142 | stakeValues = foldl' addStakeValue stakeValuesZero stakeValuesRaw 143 | 144 | -- Return summed stake values as list. 145 | pure $ M.toList $ fmap getSum stakeValues 146 | 147 | queryStakeValue 148 | :: MonadIO m 149 | => Maybe Api.SlotNo 150 | -> Api.StakeAddress 151 | -> ReaderT SqlBackend m Integer 152 | queryStakeValue mSlotNo stakeAddr = do 153 | (values :: [Value DbLovelace]) <- E.select $ do 154 | -- Given a snapshot of the txins and outs before the given slot number, 155 | (txOut E.:& _stakeAddress E.:& txIn) <- 156 | E.from $ utxoSnapshot mSlotNo [stakeAddr] 157 | -- return those that haven't been spent. 158 | E.where_ (isNothing $ txIn ?. TxInTxInId) 159 | pure ( txOut ^. TxOutValue ) 160 | 161 | pure $ getSum $ foldMap (Sum . fromIntegral . unDbLovelace . unValue) values 162 | 163 | utxoSnapshot 164 | :: Maybe Api.SlotNo 165 | -> [Api.StakeAddress] 166 | -> E.From ( E.SqlExpr (Entity TxOut) 167 | E.:& E.SqlExpr (Entity StakeAddress) 168 | E.:& E.SqlExpr (Maybe (Entity TxIn)) 169 | ) 170 | utxoSnapshot mSlotNo stakeAddrs = 171 | txOutSnapshot `E.leftJoin` txInSnapshot 172 | -- match TxIns & TxOuts on appropriate indices, 173 | `E.on` (\((txOut E.:& _) E.:& txIn) -> 174 | E.just (txOut ^. TxOutTxId) E.==. txIn ?. TxInTxOutId 175 | E.&&. E.just (txOut ^. TxOutIndex) E.==. txIn ?. TxInTxOutIndex) 176 | where 177 | -- A snapshot of all TxIn's that occur before the given slot number. 178 | txInSnapshot :: E.SqlQuery (E.SqlExpr (Entity TxIn)) 179 | txInSnapshot = do 180 | (txIn E.:& _tx E.:& block) <- 181 | E.from $ E.table @TxIn 182 | `E.innerJoin` E.table @Tx 183 | `E.on` (\(txIn E.:& tx) -> 184 | txIn ^. TxInTxInId E.==. tx ^. TxId) 185 | `E.innerJoin` E.table @Block 186 | `E.on` (\(_ E.:& tx E.:& block) -> 187 | tx ^. TxBlockId E.==. block ^. BlockId) 188 | E.where_ (case mSlotNo of 189 | Nothing -> 190 | val True 191 | Just slotNo -> 192 | block ^. BlockSlotNo E.<=. E.val (Just (Api.unSlotNo slotNo)) 193 | ) 194 | pure txIn 195 | 196 | -- A snapshot of all TxOuts that occur before the given slot number and that 197 | -- are associated with a stake address in the given stake addresses. 198 | txOutSnapshot :: E.SqlQuery ( E.SqlExpr (Entity TxOut) 199 | E.:& E.SqlExpr (Entity StakeAddress) 200 | ) 201 | txOutSnapshot = do 202 | (txOut E.:& stakeAddress E.:& _tx E.:& block) <- 203 | E.from $ E.table @TxOut 204 | `E.innerJoin` E.table @StakeAddress 205 | `E.on` (\(txOut E.:& stakeAddress) -> 206 | E.just (stakeAddress ^. StakeAddressId) E.==. txOut ^. TxOutStakeAddressId) 207 | `E.innerJoin` E.table @Tx 208 | `E.on` (\(txOut E.:& _ E.:& tx) -> 209 | txOut ^. TxOutTxId E.==. tx ^. TxId) 210 | `E.innerJoin` E.table @Block 211 | `E.on` (\(_ E.:& _ E.:& tx E.:& block) -> 212 | tx ^. TxBlockId E.==. block ^. BlockId) 213 | E.where_ $ stakeAddress ^. StakeAddressHashRaw 214 | `E.in_` E.valList (Api.serialiseToRawBytes <$> stakeAddrs) 215 | E.where_ (case mSlotNo of 216 | Nothing -> 217 | val True 218 | Just slotNo -> 219 | block ^. BlockSlotNo E.<=. E.val (Just (Api.unSlotNo slotNo)) 220 | ) 221 | pure (txOut E.:& stakeAddress) 222 | 223 | decodeMetadata :: TxMetadata -> Either String Aeson.Object 224 | decodeMetadata = 225 | Aeson.eitherDecode' 226 | . TL.encodeUtf8 227 | . TL.fromStrict 228 | . fromMaybe mempty 229 | . txMetadataJson 230 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Query/Sql.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | 6 | module Cardano.Catalyst.Query.Sql where 7 | 8 | import Cardano.Catalyst.Query.Types (Query) 9 | import Cardano.Db (DbLovelace (DbLovelace), TxId) 10 | import Control.Monad.Except (runExceptT, throwError) 11 | import Control.Monad.IO.Class (MonadIO) 12 | import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT) 13 | import Data.ByteString (ByteString) 14 | import qualified Data.ByteString.Char8 as BC 15 | import Data.Either (rights) 16 | import Data.Monoid (Sum (..)) 17 | import Data.Text (Text) 18 | import qualified Data.Text as T 19 | import qualified Data.Text.Lazy as TL 20 | import qualified Data.Text.Lazy.Encoding as TL 21 | import Data.Traversable (forM) 22 | import Database.Persist.Postgresql (BackendCompatible, Single (..), SqlBackend, 23 | rawExecute, rawSql) 24 | import Ouroboros.Network.Block (unSlotNo) 25 | 26 | import Cardano.Api (SlotNo) 27 | import qualified Cardano.Api as Api 28 | import qualified Cardano.Catalyst.Query.Types as Query 29 | import Cardano.Catalyst.Registration (MetadataParsingError, metadataMetaKey, 30 | signatureMetaKey) 31 | import Control.Lens ((#)) 32 | import Control.Lens.TH (makeClassyPrisms) 33 | import qualified Data.Aeson as Aeson 34 | import qualified Data.HashMap.Strict as HM 35 | 36 | data MetadataRetrievalError 37 | = MetadataFailedToRetrieveMetadataField !TxId 38 | | MetadataFailedToRetrieveSignatureField !TxId 39 | | MetadataFailedToDecodeMetadataField !TxId !Text 40 | | MetadataFailedToDecodeSignatureField !TxId !Text 41 | | MetadataFailedToDecodeTxMetadata !TxId !Api.TxMetadataJsonError 42 | | MetadataFailedToParseVoteRegistration !TxId !MetadataParsingError 43 | deriving (Eq, Show) 44 | 45 | makeClassyPrisms ''MetadataRetrievalError 46 | 47 | sqlQuery 48 | :: MonadIO m 49 | => Query (ReaderT SqlBackend m) TxId 50 | sqlQuery = 51 | Query.Query { Query.queryVoteRegistrations = queryVoteRegistrations 52 | , Query.queryStakeValue = queryStakeValue 53 | , Query.queryStakeValues = queryStakeValues 54 | } 55 | 56 | queryVoteRegistrations 57 | :: ( MonadIO m 58 | , MonadReader backend m 59 | , BackendCompatible SqlBackend backend 60 | ) 61 | => Maybe SlotNo 62 | -> m [(TxId, Aeson.Value)] 63 | queryVoteRegistrations mSlotNo = 64 | let 65 | -- Join the transaction information with the metadata information for that 66 | -- transaction. The metadata we are interested in is made up of two parts: 67 | -- the metadata value under key '61284' (voting metadata) and the metadata 68 | -- under the key '61285' (voting signature metadata). 69 | sqlBase = "WITH meta_table AS (select tx_id, json AS metadata from tx_metadata where key = '" <> T.pack (show metadataMetaKey) <> "') , sig_table AS (select tx_id, json AS signature from tx_metadata where key = '" <> T.pack (show signatureMetaKey) <> "') SELECT tx.hash,tx_id,metadata,signature FROM meta_table INNER JOIN tx ON tx.id = meta_table.tx_id INNER JOIN sig_table USING(tx_id)" 70 | in do 71 | let 72 | sql = case mSlotNo of 73 | Just slot -> (sqlBase <> "INNER JOIN block ON block.id = tx.block_id WHERE block.slot_no <= " <> T.pack (show $ unSlotNo slot) <> " ORDER BY metadata -> '4' ASC;") 74 | -- TODO handle lower bound on slot no too 75 | Nothing -> (sqlBase <> " ORDER BY metadata -> '4' ASC;") 76 | r <- ask 77 | (results :: [(Single ByteString, Single TxId, Single (Maybe Text), Single (Maybe Text))]) <- (flip runReaderT) r $ rawSql sql [] 78 | (parseResults :: [Either MetadataRetrievalError (TxId, Aeson.Value)]) <- 79 | sequence $ fmap runExceptT $ (flip fmap) results $ \(Single _txHash, Single txId, Single mMetadata, Single mSignature) -> do 80 | let 81 | handleEither f = 82 | either (throwError . f) pure 83 | -- DECISION #01: 84 | -- When querying the transaction/metadata/signature information, the 85 | -- given row did not have a metadata entry under the key '61284' (i.e. 86 | -- it did not have any voting metadata). 87 | -- 88 | -- Found entry 89 | -- └── But it contained no voting metadata 90 | -- 91 | -- FIXME: Isn't this prevented by the query? Wouldn't it always be Just? 92 | -- Answer is yes - there is no need to make this a "Maybe". 93 | metadata <- 94 | maybe 95 | (throwError $ _MetadataFailedToRetrieveMetadataField # txId) 96 | pure 97 | mMetadata 98 | -- DECISION #02: 99 | -- When querying the transaction/metadata/signature information, the 100 | -- given row did not have a metadata signature entry under the key 101 | -- '61285' (i.e. it did not have any signature metadata). 102 | -- 103 | -- Found entry 104 | -- └── But it contained no signature information 105 | -- 106 | -- FIXME: Isn't this prevented by the query? Wouldn't it always be Just? 107 | -- Answer is yes - there is no need to make this a "Maybe". 108 | signature <- 109 | maybe 110 | (throwError $ _MetadataFailedToRetrieveSignatureField # txId) 111 | pure 112 | mSignature 113 | 114 | -- DECISION #03: 115 | -- We found an entry with the right keys but failed to parse the voting 116 | -- metadata because it wasn't a JSON value. 117 | -- 118 | -- Found entry 119 | -- └── It had the right metadata keys 120 | -- └── But the voting metadata value wasn't JSON 121 | -- 122 | -- This is programmer error - the database should only accept JSON values 123 | -- into the 'json' column, and even if it doesn't, the tool that submits 124 | -- the data should only submit valid json. This isn't the voter's fault. 125 | metadataObj <- 126 | handleEither (\e -> _MetadataFailedToDecodeMetadataField # (txId, T.pack e)) 127 | $ Aeson.eitherDecode' $ TL.encodeUtf8 $ TL.fromStrict $ metadata 128 | -- DECISION #04: 129 | -- We found an entry with the right keys but failed to parse the signature 130 | -- metadata because it wasn't a JSON value. 131 | -- 132 | -- Found entry 133 | -- └── It had the right metadata keys 134 | -- └── But the signature metadata value wasn't JSON 135 | -- 136 | -- This is programmer error - the database should only accept JSON values 137 | -- into the 'json' column, and even if it doesn't, the tool that submits 138 | -- the data should only submit valid json. This isn't the voter's fault. 139 | signatureObj <- 140 | handleEither (\e -> _MetadataFailedToDecodeSignatureField # (txId, T.pack e)) 141 | $ Aeson.eitherDecode' $ TL.encodeUtf8 $ TL.fromStrict $ signature 142 | 143 | let 144 | metaObj :: Aeson.Value 145 | metaObj = Aeson.Object $ HM.fromList 146 | [ (T.pack $ show metadataMetaKey, metadataObj) 147 | , (T.pack $ show signatureMetaKey, signatureObj) 148 | ] 149 | 150 | pure $ (txId, metaObj) 151 | pure $ rights $ parseResults 152 | 153 | queryStakeValues 154 | :: MonadIO m 155 | => Maybe SlotNo 156 | -> [Api.StakeAddress] 157 | -> ReaderT SqlBackend m [(Api.StakeAddress, Integer)] 158 | queryStakeValues mSlotNo stakeAddrs = do 159 | mkStakeSnapshotTable mSlotNo 160 | forM stakeAddrs $ \stakeAddr -> do 161 | stake <- queryStakeValue' mSlotNo stakeAddr 162 | pure (stakeAddr, stake) 163 | 164 | queryStakeValue 165 | :: MonadIO m 166 | => Maybe Api.SlotNo 167 | -> Api.StakeAddress 168 | -> ReaderT SqlBackend m Integer 169 | queryStakeValue mSlotNo stakeAddr = do 170 | mkStakeSnapshotTable mSlotNo 171 | queryStakeValue' mSlotNo stakeAddr 172 | 173 | queryStakeValue' 174 | :: MonadIO m 175 | => Maybe Api.SlotNo 176 | -> Api.StakeAddress 177 | -> ReaderT SqlBackend m Integer 178 | queryStakeValue' _mSlotNo stakeAddress = do 179 | let 180 | stakeAddressHex = T.pack (BC.unpack $ Api.serialiseToRawBytesHex stakeAddress) 181 | -- Don't do SUM here, lovelace is a bounded integer type defined by 182 | -- cardano-db-sync, unless you perform a conversion to an unbounded type, 183 | -- it will overflow if the SUM exceeds the max value of a lovelace db 184 | -- type. 185 | stakeQuerySql = "SELECT utxo_snapshot.value FROM utxo_snapshot WHERE stake_credential = decode('" <> stakeAddressHex <> "', 'hex');" 186 | (stakeValues :: [Single (Maybe DbLovelace)]) <- rawSql stakeQuerySql [] 187 | pure $ getSum $ foldMap (\case 188 | Single Nothing -> 189 | Sum 0 190 | Single (Just (DbLovelace stake)) -> 191 | Sum $ fromIntegral stake 192 | ) stakeValues 193 | 194 | mkStakeSnapshotTable 195 | :: MonadIO m 196 | => Maybe Api.SlotNo 197 | -> ReaderT SqlBackend m () 198 | -- Voting power is calculated from unspent UTxOs, so we look for TxOuts that 199 | -- have no associated TxIn. 200 | -- In the following, txIn.tx_in_id is NULL when the transaction output has not 201 | -- been spent (due to the left outer join). 202 | mkStakeSnapshotTable Nothing = do 203 | let stake_credential_index = "CREATE INDEX IF NOT EXISTS utxo_snapshot_stake_credential ON utxo_snapshot(stake_credential);" 204 | analyze_table = "ANALYZE utxo_snapshot;" 205 | utxo_snapshot = "CREATE TEMPORARY TABLE IF NOT EXISTS utxo_snapshot AS (SELECT tx_out.*, stake_address.hash_raw AS stake_credential FROM tx_out LEFT OUTER JOIN tx_in ON tx_out.tx_id = tx_in.tx_out_id AND tx_out.index = tx_in.tx_out_index INNER JOIN stake_address ON stake_address.id = tx_out.stake_address_id WHERE tx_in.tx_in_id IS NULL);" 206 | rawExecute (utxo_snapshot <> stake_credential_index <> analyze_table) [] 207 | mkStakeSnapshotTable (Just slotNo) = do 208 | let tx_out_snapshot = "CREATE TEMPORARY TABLE IF NOT EXISTS tx_out_snapshot AS (\ 209 | \ SELECT tx_out.*,\ 210 | \ stake_address.hash_raw AS stake_credential\ 211 | \ FROM tx_out\ 212 | \ INNER JOIN tx ON tx_out.tx_id = tx.id\ 213 | \ INNER JOIN block ON tx.block_id = block.id\ 214 | \ INNER JOIN stake_address ON stake_address.id = tx_out.stake_address_id\ 215 | \ WHERE block.slot_no <= " <> T.pack (show $ unSlotNo slotNo) <> ");" 216 | tx_in_snapshot = "CREATE TEMPORARY TABLE IF NOT EXISTS tx_in_snapshot AS (\ 217 | \ SELECT tx_in.* FROM tx_in\ 218 | \ INNER JOIN tx ON tx_in.tx_in_id = tx.id\ 219 | \ INNER JOIN block ON tx.block_id = block.id\ 220 | \ WHERE block.slot_no <= " <> T.pack (show $ unSlotNo slotNo) <> ");" 221 | utxo_snapshot = "CREATE TEMPORARY TABLE IF NOT EXISTS utxo_snapshot AS (\ 222 | \ SELECT tx_out_snapshot.* FROM tx_out_snapshot\ 223 | \ LEFT OUTER JOIN tx_in_snapshot\ 224 | \ ON tx_out_snapshot.tx_id = tx_in_snapshot.tx_out_id\ 225 | \ AND tx_out_snapshot.index = tx_in_snapshot.tx_out_index\ 226 | \ WHERE tx_in_snapshot.tx_in_id IS NULL);" 227 | stake_credential_index = "CREATE INDEX IF NOT EXISTS utxo_snapshot_stake_credential ON utxo_snapshot(stake_credential);" 228 | analyze_tx_out_snapshot = "ANALYZE tx_out_snapshot;" 229 | analyze_tx_in_snapshot = "ANALYZE tx_in_snapshot;" 230 | analyze_utxo_snapshot = "ANALYZE utxo_snapshot;" 231 | rawExecute ( tx_out_snapshot 232 | <> analyze_tx_out_snapshot 233 | <> tx_in_snapshot 234 | <> analyze_tx_in_snapshot 235 | <> utxo_snapshot 236 | <> stake_credential_index 237 | <> analyze_utxo_snapshot 238 | ) [] 239 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Query/Types.hs: -------------------------------------------------------------------------------- 1 | 2 | module Cardano.Catalyst.Query.Types where 3 | 4 | import qualified Cardano.Api as Api 5 | import qualified Data.Aeson as Aeson 6 | 7 | -- | The Query datatype represents the interface to a data source that can 8 | -- provide the information necessary to run the voting-tools application. 9 | -- 10 | -- In this case 'm' refers to some monadic context, and 't' refers to a 11 | -- "time-like" value that can be used to order vote registrations according to 12 | -- time of registration. 13 | data Query m t = 14 | Query { queryVoteRegistrations 15 | :: Maybe Api.SlotNo -> m [(t, Aeson.Value)] 16 | -- ^ Get the vote registrations made at and before the slot number. 17 | , queryStakeValue 18 | :: Maybe Api.SlotNo 19 | -> Api.StakeAddress 20 | -> m Integer 21 | -- ^ Get the ADA associated with a stake address at a slot number. 22 | , queryStakeValues 23 | :: Maybe Api.SlotNo 24 | -> [Api.StakeAddress] 25 | -> m [(Api.StakeAddress, Integer)] 26 | -- ^ Get the ADA associated with a list of stake addresses at a slot 27 | -- number. The plural of 'queryStakeValue'. 28 | -- 29 | -- ∀xs. length xs === length (queryStakeValues xs) 30 | -- ∀xs. queryStakeValues xs === zip stakeAddrs <$> traverse queryStakeValue xs 31 | } 32 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Registration.hs: -------------------------------------------------------------------------------- 1 | module Cardano.Catalyst.Registration 2 | ( -- * Logic 3 | isNewer 4 | , chooseNewer 5 | , filterLatestRegistrations 6 | , accumulateRegistrations 7 | -- * Types 8 | , module Cardano.Catalyst.Registration.Types 9 | , module Cardano.Catalyst.Registration.Types.Purpose 10 | ) where 11 | 12 | import Data.Foldable (foldl') 13 | import Data.Map.Strict (Map) 14 | 15 | import qualified Cardano.Api as Api 16 | import qualified Data.Map.Strict as M 17 | 18 | import Cardano.Catalyst.Registration.Types 19 | import Cardano.Catalyst.Registration.Types.Purpose 20 | 21 | filterLatestRegistrations :: Ord a => [(a, Vote)] -> [Vote] 22 | filterLatestRegistrations regos = 23 | fmap snd $ M.elems $ foldl' (flip accumulateRegistrations) mempty regos 24 | 25 | accumulateRegistrations 26 | :: Ord a 27 | => (a, Vote) 28 | -> Map (Api.Hash Api.StakeKey) (a, Vote) 29 | -> Map (Api.Hash Api.StakeKey) (a, Vote) 30 | accumulateRegistrations r@(_, rego) = 31 | let 32 | stakeHash :: Api.Hash Api.StakeKey 33 | stakeHash = voteRegistrationStakeHash rego 34 | in 35 | M.insertWith chooseNewer stakeHash r 36 | 37 | chooseNewer 38 | :: Ord a 39 | => (a, Vote) -> (a, Vote) -> (a, Vote) 40 | chooseNewer a b = if b `isNewer` a then b else a 41 | 42 | -- | A newer registration will apply over an older one iff the nonce of the new 43 | -- registration is greater than the old. 44 | isNewer 45 | :: Ord a 46 | => (a, Vote) 47 | -> (a, Vote) 48 | -> Bool 49 | isNewer a@(tA, _regoA) b@(tB, _regoB) = 50 | let 51 | (new, old) = if tA > tB then (a, b) else (b, a) 52 | 53 | slotNew = voteRegistrationSlot $ snd new 54 | slotOld = voteRegistrationSlot $ snd old 55 | in 56 | a == (if slotNew > slotOld then new else old) 57 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Registration/Types/Purpose.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | {- | 4 | Module : Cardano.Catalyst.Registration.Types.Purpose 5 | Description : Purpose for vote registrations 6 | Maintainer : sevanspowell 7 | Stability : experimental 8 | 9 | This module encapsulates the idea of a 'vote registration purpose'. 10 | 11 | A vote registration purpose can be any non-negative integer. 12 | 13 | At this stage only a single vote registration purpose exists: "Catalyst". The 14 | "Catalyst" vote purpose is represented by the integer 0. 15 | 16 | -} 17 | 18 | module Cardano.Catalyst.Registration.Types.Purpose 19 | ( Purpose 20 | , catalystPurpose 21 | , mkPurpose 22 | , purposeNumber 23 | , toTxMetadataValue 24 | , fromTxMetadataValue 25 | ) 26 | where 27 | 28 | import Data.Aeson (FromJSON (..), ToJSON (..), withScientific) 29 | import Data.Scientific (floatingOrInteger) 30 | import Data.Text (Text) 31 | 32 | import qualified Cardano.Api as Api 33 | import qualified Data.Text as T 34 | 35 | -- | A vote registration purpose. 36 | data Purpose = CatalystPurpose 37 | -- ^ A vote registration for the Catalyst project. 38 | | OtherPurpose Integer 39 | -- ^ Other vote registration purpose. 40 | deriving (Eq, Ord, Show) 41 | 42 | -- | Creates a vote registration purpose from an integer. 43 | -- 44 | -- Will throw an error if provided with a negative integer. 45 | mkPurpose :: Integer -> Either Text Purpose 46 | mkPurpose 0 = Right CatalystPurpose 47 | mkPurpose x | x > 0 = Right $ OtherPurpose x 48 | mkPurpose _ = Left "expected a positive integer, got a negative integer" 49 | 50 | -- | Retrieves the non-negative integer representing a vote registration 51 | -- purpose. 52 | purposeNumber :: Purpose -> Integer 53 | purposeNumber CatalystPurpose = 0 54 | purposeNumber (OtherPurpose x) = x 55 | 56 | -- | The Catalyst vote registration purpose. 57 | catalystPurpose :: Purpose 58 | catalystPurpose = CatalystPurpose 59 | 60 | -- | Convert a vote registration purpose to cardano-api transaction metadata. 61 | toTxMetadataValue :: Purpose -> Api.TxMetadataValue 62 | toTxMetadataValue CatalystPurpose = Api.TxMetaNumber 0 63 | toTxMetadataValue (OtherPurpose x) = Api.TxMetaNumber x 64 | 65 | -- | Parse a vote registration purpose from cardano-api transaction metadata. 66 | fromTxMetadataValue :: Api.TxMetadataValue -> Either Text Purpose 67 | fromTxMetadataValue (Api.TxMetaNumber x) = 68 | mkPurpose x 69 | fromTxMetadataValue x = 70 | Left $ "expected a number, got: " <> T.pack (show x) 71 | 72 | instance ToJSON Purpose where 73 | toJSON = Api.metadataValueToJsonNoSchema . toTxMetadataValue 74 | 75 | instance FromJSON Purpose where 76 | parseJSON = withScientific "voting purpose" $ \s -> 77 | case floatingOrInteger s of 78 | Left (f :: Double) -> 79 | fail $ 80 | "Expected non-negative integer, found floating number: " <> show f 81 | Right i -> 82 | either (fail . T.unpack) pure $ mkPurpose i 83 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Test/DSL.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | 3 | Module : Cardano.Catalyst.Test.DSL 4 | Description : Testing DSL. 5 | Maintainer : sevanspowell 6 | Stability : experimental 7 | 8 | Collection of types and functions used to form the testing DSL for voting-tools. 9 | 10 | For further documentation and usage, see the documentation for: 11 | 12 | - "Cardano.Catalyst.Test.DSL.Internal.Types" 13 | - "Cardano.Catalyst.Test.DSL.Internal.Db" 14 | - "Cardano.Catalyst.Test.DSL.Gen" 15 | -} 16 | 17 | module Cardano.Catalyst.Test.DSL 18 | ( -- * Types 19 | Types.PersistState(..) 20 | , Types.UInteger(..) 21 | , Types.SlotNo 22 | -- ** Transaction 23 | , Types.Transaction(Types.TransactionE) 24 | , Types.transactionTx 25 | , Types.transactionBlock 26 | , Types.transactionSlotLeader 27 | , Types.setTransactionSlot 28 | , Types.getTransactionSlot 29 | , Types.getTxKey 30 | , Types.getBlockKey 31 | , Types.getSlotLeaderKey 32 | -- ** UTxO 33 | , Types.UTxO(Types.UTxOE) 34 | , Types.utxoTxOut 35 | , Types.utxoTx 36 | , Types.setUTxOSlot 37 | , Types.utxoValue 38 | , Types.setStakeAddressId 39 | , Types.getStakeAddressId 40 | -- ** Registration 41 | , Types.Registration(..) 42 | , Types.getRegistrationVote 43 | , Types.getRegistrationVotePayload 44 | , Types.signed 45 | , Types.unsigned 46 | , Types.setSlotNo 47 | -- ** Stake Registration 48 | , Types.StakeRegistration(Types.StakeRegistrationE) 49 | , Types.stakeRegoKey 50 | , Types.stakeRegoTx 51 | , Types.stakeRegoAddress 52 | , Types.getStakeRegoKey 53 | , Types.getStakeAddress 54 | , Types.setStakeAddressRegistrationSlot 55 | -- ** Graph 56 | , Types.Graph(..) 57 | , Types.contributionAmount 58 | , Types.getRegistrations 59 | , Types.setRegistrations 60 | , Types.modifyRegistrations 61 | , Types.getGraphVote 62 | 63 | -- * Database 64 | , Db.writeTx 65 | , Db.writeUTxO 66 | , Db.writeRegistration 67 | , Db.writeStakeRego 68 | , Db.writeGraph 69 | , Db.apiToDbMetadata 70 | 71 | -- * Generators 72 | , Gen.genUniqueHash32 73 | , Gen.genUniqueHash28 74 | , Gen.genUTCTime 75 | , Gen.genLovelace 76 | , Gen.genSlotLeader 77 | , Gen.genTxMetadata 78 | , Gen.genWord64 79 | , Gen.genWord32 80 | , Gen.genUInteger 81 | , Gen.genWord63 82 | , Gen.genWord16 83 | , Gen.genInt64 84 | , Gen.genBlock 85 | , Gen.genTx 86 | , Gen.genTransaction 87 | , Gen.genVoteRegistration 88 | , Gen.genStakeAddressRegistration 89 | , Gen.genStakeAddressForVerificationKey 90 | , Gen.genTxOut 91 | , Gen.genTxIn 92 | , Gen.genUTxO 93 | , Gen.genGraph 94 | ) where 95 | 96 | import qualified Cardano.Catalyst.Test.DSL.Gen as Gen 97 | import qualified Cardano.Catalyst.Test.DSL.Internal.Db as Db 98 | import qualified Cardano.Catalyst.Test.DSL.Internal.Types as Types 99 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Test/DSL/Internal/Db.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DerivingStrategies #-} 3 | {-# LANGUAGE DerivingVia #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE GADTs #-} 7 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 8 | {-# LANGUAGE KindSignatures #-} 9 | {-# LANGUAGE LambdaCase #-} 10 | {-# LANGUAGE StandaloneDeriving #-} 11 | {-# LANGUAGE TypeFamilies #-} 12 | 13 | {- | 14 | 15 | Module : Cardano.Catalyst.Test.DSL.Internal.Db 16 | Description : Functions for writing Test DSL types to the database. 17 | Maintainer : sevanspowell 18 | Stability : experimental 19 | 20 | 21 | __WARNING This is an internal module. It is recommended to import "Cardano.Catalyst.Test.DSL" instead.__ 22 | 23 | This module provides the code necessary to write the terms generated in 24 | "Cardano.Catalyst.Test.DSL.Internal.Types" to the database. 25 | 26 | In perticular it is capable of converting DSL terms from the 27 | 'Cardano.Catalyst.Test.DSL.Internal.Types.Ephemeral' to state 28 | 'Cardano.Catalyst.Test.DSL.Internal.Types.Persistent' state. 29 | 30 | For example: 31 | 32 | @ 33 | persistStakeRegistration 34 | :: SqlBackend 35 | -> 'StakeRegistration' \''Ephemeral' 36 | -> ReaderT SqlBackend IO ('StakeRegistration' \''Persisted') 37 | persistStakeRegistration backend stakeRego = 38 | runSqlConn ('writeStakeRego' stakeRego) backend 39 | @ 40 | -} 41 | 42 | module Cardano.Catalyst.Test.DSL.Internal.Db where 43 | 44 | import Cardano.Catalyst.Registration (votePayloadToTxMetadata, voteToTxMetadata) 45 | import Cardano.Catalyst.Test.DSL.Internal.Types (Graph (..), PersistState (..), 46 | Registration (..), StakeRegistration (..), Transaction (..), UTxO (..), 47 | getRegistrationVote, getRegistrationVotePayload, getStakeRegoKey, getTxKey, 48 | stakeRegoAddress, stakeRegoKey, stakeRegoTx, transactionBlock, 49 | transactionSlotLeader, transactionTx, utxoTx, utxoTxOut) 50 | import Control.Monad.IO.Class (MonadIO) 51 | import Control.Monad.Reader (ReaderT) 52 | import Data.Foldable (traverse_) 53 | import Data.Function ((&)) 54 | import Data.Word (Word64) 55 | import Database.Persist.Postgresql (Key) 56 | import Database.Persist.Sql (Entity (..), SqlBackend) 57 | 58 | import qualified Cardano.Api as Cardano 59 | import qualified Cardano.Db as Db 60 | import qualified Data.Aeson as Aeson 61 | import qualified Data.ByteString.Lazy as BSL 62 | import qualified Data.Map.Strict as M 63 | import qualified Data.Text.Encoding as T 64 | import qualified Database.Persist.Class as Sql 65 | 66 | -- | Query to write the 'Transaction' to the database. 67 | -- 68 | -- Re-writes the foreign keys so that: 69 | -- 70 | -- - The 'Cardano.Db.blockSlotLeaderId' points to the 'transactionSlotLeader'. 71 | -- - The 'Cardano.Db.txBlockId' points to the 'transactionBlock'. 72 | -- 73 | -- Returns the persisted 'Transaction'. 74 | writeTx 75 | :: MonadIO m 76 | => Transaction 'Ephemeral 77 | -> ReaderT SqlBackend m (Transaction 'Persisted) 78 | writeTx tx = do 79 | let slotLeader = transactionSlotLeader tx 80 | slotLeaderId <- Sql.insert slotLeader 81 | 82 | let block' = (transactionBlock tx) { Db.blockSlotLeaderId = slotLeaderId } 83 | blockId <- Sql.insert block' 84 | 85 | let tx' = (transactionTx tx) { Db.txBlockId = blockId } 86 | txId <- Sql.insert tx' 87 | 88 | pure $ TransactionP 89 | { transactionTxP = Entity txId tx' 90 | , transactionBlockP = Entity blockId block' 91 | , transactionSlotLeaderP = Entity slotLeaderId slotLeader 92 | } 93 | 94 | -- | Query to write a 'UTxO' to the database. 95 | -- 96 | -- Re-writes the foreign keys so that: 97 | -- 98 | -- - The 'utxoTx' foreign keys are valid (see 'writeTx'). 99 | -- - The 'Cardano.Db.txOutTxId' comes from the 'utxoTx'. 100 | -- - The 'Cardano.Db.txOutStakeAddressId' points to the given 101 | -- 'Cardano.Db.StakeAddress'. 102 | -- 103 | -- Returns the persisted 'UTxO'. 104 | writeUTxO 105 | :: (m ~ ReaderT SqlBackend IO) 106 | => Key Db.StakeAddress 107 | -> UTxO 'Ephemeral 108 | -> m (UTxO 'Persisted) 109 | writeUTxO stakeAddressId utxo = do 110 | transaction' <- writeTx $ utxoTx utxo 111 | 112 | let txOut' = (utxoTxOut utxo) { Db.txOutTxId = getTxKey transaction' 113 | , Db.txOutStakeAddressId = Just stakeAddressId 114 | } 115 | txOutId <- Sql.insert txOut' 116 | 117 | pure $ UTxOP 118 | { utxoTxOutP = Entity txOutId txOut' 119 | , utxoTxP = transaction' 120 | } 121 | 122 | -- | Query to write a 'Registration' to the database. 123 | -- 124 | -- The 'Registration' is re-written so that: 125 | -- 126 | -- - The 'registrationTx' foreign keys are valid (see 'writeTx'). 127 | -- - The 'Registration's 'Cardano.TxMetadata' is associated with the 128 | -- 'registrationTx'. 129 | -- 130 | -- Returns the persisted 'Registration'. 131 | writeRegistration 132 | :: (m ~ ReaderT SqlBackend IO) 133 | => Registration 'Ephemeral 134 | -> m (Registration 'Persisted) 135 | writeRegistration rego = do 136 | transaction' <- writeTx (registrationTx rego) 137 | 138 | let 139 | voteMeta :: Cardano.TxMetadata 140 | voteMeta = 141 | case getRegistrationVote rego of 142 | Nothing -> 143 | votePayloadToTxMetadata $ getRegistrationVotePayload rego 144 | Just vote -> 145 | voteToTxMetadata vote 146 | 147 | let 148 | txId = getTxKey transaction' 149 | 150 | traverse_ Sql.insert (apiToDbMetadata voteMeta txId ) 151 | 152 | pure $ rego { registrationTx = transaction' } 153 | 154 | -- | Query to write a 'StakeRegistration' to the database. 155 | -- 156 | -- Re-writes the foreign keys so that: 157 | -- 158 | -- - The 'stakeRegoTx's foreign keys are valid (see 'writeTx'). 159 | -- - The 'Db.stakeAddressRegisteredTxId' was registered in the 'stakeRegoTx'. 160 | -- 161 | -- Returns the persisted 'StakeRegistration'. 162 | writeStakeRego 163 | :: (m ~ ReaderT SqlBackend IO) 164 | => StakeRegistration 'Ephemeral 165 | -> m (StakeRegistration 'Persisted) 166 | writeStakeRego stakeRego = do 167 | -- Write transaction in which stake address was registered 168 | stakeRegoTx' <- writeTx (stakeRegoTx stakeRego) 169 | 170 | let stakeRegoTxId = getTxKey stakeRegoTx' 171 | 172 | -- Write stake address 173 | let 174 | stakeAddr' = 175 | (stakeRegoAddress stakeRego) { 176 | Db.stakeAddressRegisteredTxId = stakeRegoTxId 177 | } 178 | stakeAddrId <- Sql.insert stakeAddr' 179 | 180 | pure $ 181 | StakeRegistrationP 182 | (stakeRegoKey stakeRego) 183 | stakeRegoTx' 184 | (Entity stakeAddrId stakeAddr') 185 | 186 | -- | Query to write a 'Graph' to the database. 187 | -- 188 | -- The 'Graph' is re-written so that: 189 | -- 190 | -- - The 'graphStakeAddressRegistration' foreign keys are valid (see 191 | -- 'writeStakeRego'). 192 | -- - The 'graphRegistrations' foreign keys are valid (see 193 | -- 'writeRegistration'). 194 | -- - The 'graphUTxOs' foreign keys are valid (see 'writeUTxO'). 195 | -- 196 | -- Returns the persisted 'Graph'. 197 | writeGraph 198 | :: (m ~ ReaderT SqlBackend IO) 199 | => Graph 'Ephemeral 200 | -> m (Graph 'Persisted) 201 | writeGraph (Graph stakeRego regos utxos) = do 202 | -- Write stake address registration 203 | stakeRego' <- writeStakeRego stakeRego 204 | 205 | -- Write contributions against stake address 206 | utxos' <- traverse (writeUTxO $ getStakeRegoKey stakeRego') utxos 207 | 208 | -- Write registrations 209 | regos' <- traverse writeRegistration regos 210 | 211 | -- Return re-written Graph 212 | pure $ Graph stakeRego' regos' utxos' 213 | 214 | -- | Convert between cardano-api tx metadata and cardano-db-sync tx metadata. 215 | -- 216 | -- Converts 'Cardano.TxMetadata' to a list of 'Db.TxMetadata' entries. 217 | apiToDbMetadata 218 | :: Cardano.TxMetadata 219 | -- ^ Cardano.Api.TxMetadata. 220 | -> Key Db.Tx 221 | -- ^ Database key of the transaction to which this transaction metadata should 222 | -- belong. 223 | -> [Db.TxMetadata] 224 | -- ^ Cardano.Db.TxMetadata ephemeral database entities (not yet written to 225 | -- database). 226 | apiToDbMetadata txMeta txId = 227 | let 228 | metaMap :: M.Map Word64 Cardano.TxMetadataValue 229 | (Cardano.TxMetadata metaMap) = txMeta 230 | 231 | metaMapJSON :: M.Map Word64 Aeson.Value 232 | metaMapJSON = 233 | fmap Cardano.metadataValueToJsonNoSchema metaMap 234 | 235 | dbMeta :: [Db.TxMetadata] 236 | dbMeta = 237 | M.toList metaMapJSON 238 | & fmap (\(k, json) -> 239 | let 240 | jsonBytes = BSL.toStrict $ Aeson.encode json 241 | jsonText = T.decodeUtf8 jsonBytes 242 | in 243 | Db.TxMetadata 244 | (Db.DbWord64 k) 245 | (Just jsonText) 246 | jsonBytes 247 | txId 248 | ) 249 | in 250 | dbMeta 251 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/Test/VotePower/Gen.hs: -------------------------------------------------------------------------------- 1 | 2 | module Cardano.Catalyst.Test.VotePower.Gen where 3 | 4 | import Cardano.Catalyst.Registration (purposeNumber) 5 | import Cardano.Catalyst.Test.DSL.Gen (genDelegations, genPurpose, genRewardsAddress, 6 | genStakeVerificationKey) 7 | import Cardano.Catalyst.VotePower (VotingPower (..)) 8 | import Control.Monad.IO.Class (MonadIO) 9 | import Hedgehog (MonadGen) 10 | 11 | import qualified Hedgehog.Gen as Gen 12 | import qualified Hedgehog.Range as Range 13 | 14 | votingPower :: (MonadGen m, MonadIO m) => m VotingPower 15 | votingPower = 16 | VotingPower 17 | <$> genDelegations 18 | <*> genStakeVerificationKey 19 | <*> genRewardsAddress 20 | <*> (fromIntegral <$> Gen.word64 Range.constantBounded) 21 | <*> (purposeNumber <$> genPurpose) 22 | -------------------------------------------------------------------------------- /src/Cardano/Catalyst/VotePower.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | {- | 6 | 7 | Module – Cardano.Catalyst.VotePower 8 | Description – Application to find voting power associated with vote registrations. 9 | Maintainer – sevanspowell 10 | Stability – experimental 11 | 12 | This module represents the "application layer" of the voting-tools "find vote 13 | power" executable. It provides a single function that provides the amount of ADA 14 | associated with each of the latest vote registrations available at a particular 15 | point in time. 16 | -} 17 | 18 | module Cardano.Catalyst.VotePower where 19 | 20 | import Cardano.API.Extended (VotingKeyPublic) 21 | import Cardano.Catalyst.Crypto (StakeVerificationKey) 22 | import Cardano.Catalyst.Query.Types (Query (..)) 23 | import Cardano.Catalyst.Registration (Delegations (..), VoteRewardsAddress (..), Vote, 24 | catalystPurpose, filterLatestRegistrations, parseRegistration, purposeNumber, 25 | voteRegistrationDelegations, voteRegistrationPurpose, 26 | voteRegistrationRewardsAddress, voteRegistrationStakeAddress, 27 | voteRegistrationVerificationKey) 28 | import Control.Monad.IO.Class 29 | import Control.Monad.Logger (MonadLogger, logDebugN, logInfoN) 30 | import Data.Aeson (FromJSON, ToJSON) 31 | import Data.Char (toLower) 32 | import Data.Either (partitionEithers) 33 | import Data.List.NonEmpty (NonEmpty) 34 | import Data.Maybe (fromMaybe) 35 | import Data.Ratio (Ratio, (%)) 36 | import qualified Data.Text as T 37 | import GHC.Generics (Generic) 38 | 39 | import qualified Cardano.Api as Api 40 | import qualified Data.Aeson as Aeson 41 | import qualified Data.List.NonEmpty as NE 42 | 43 | data VotingPower 44 | = VotingPower { _powerDelegations :: Delegations VotingKeyPublic 45 | , _powerStakePublicKey :: StakeVerificationKey 46 | , _powerRewardsAddress :: VoteRewardsAddress 47 | , _powerVotingPower :: Integer 48 | , _powerVotingPurpose :: Integer 49 | } 50 | deriving (Eq, Ord, Show, Generic) 51 | 52 | votingPowerJsonParserOptions :: Aeson.Options 53 | votingPowerJsonParserOptions = Aeson.defaultOptions 54 | { Aeson.fieldLabelModifier = fmap toLower . Aeson.camelTo2 '_' . (drop 6) } 55 | 56 | instance ToJSON VotingPower where 57 | toJSON = Aeson.genericToJSON votingPowerJsonParserOptions 58 | 59 | instance FromJSON VotingPower where 60 | parseJSON = Aeson.genericParseJSON votingPowerJsonParserOptions 61 | 62 | jsonParserOptions :: Aeson.Options 63 | jsonParserOptions = Aeson.defaultOptions { Aeson.fieldLabelModifier = (fmap toLower) . (drop 2) } 64 | 65 | getVoteRegistrationADA 66 | :: ( Monad m 67 | , Ord t 68 | , MonadIO m 69 | , MonadLogger m 70 | , Show t 71 | ) 72 | => Query m t 73 | -> Api.NetworkId 74 | -> Maybe Api.SlotNo 75 | -> m [VotingPower] 76 | getVoteRegistrationADA q nw slotNo = do 77 | (regosRaw :: [(t, Aeson.Value)]) <- (queryVoteRegistrations q) slotNo 78 | logInfoN $ "Found " <> textShowLength regosRaw <> " votes" 79 | logDebugN $ T.pack $ show regosRaw 80 | 81 | let 82 | regos :: [(t, Vote)] 83 | (voteParseFails, regos) = 84 | partitionEithers $ flip fmap regosRaw $ \(t, regoRaw) -> do 85 | case parseRegistration regoRaw of 86 | Left e -> Left (e, t, regoRaw) 87 | Right rego -> Right (t, rego) 88 | logInfoN $ "Managed to succesfully parse " <> textShowLength regos <> " votes" 89 | logDebugN $ "These parsing failures occured: " <> T.pack (show voteParseFails) 90 | 91 | let 92 | latestRegos :: [Vote] 93 | latestRegos = filterLatestRegistrations regos 94 | 95 | (regoStakes :: [(Api.StakeAddress, Integer)]) <- 96 | (queryStakeValues q) slotNo 97 | $ fmap (voteRegistrationStakeAddress nw) latestRegos 98 | 99 | let 100 | regoValues :: [(Vote, Integer)] 101 | regoValues = (zip latestRegos . fmap snd) regoStakes 102 | 103 | let 104 | (legacy, new) = partitionEithers $ flip fmap regoValues $ \(vote, _) -> 105 | case voteRegistrationRewardsAddress vote of 106 | RewardsAddress addr -> Left addr 107 | Address addr -> Right addr 108 | 109 | logInfoN $ "Found " <> textShowLength regoValues <> " distinct stake keys" 110 | logInfoN $ T.concat 111 | [ "Found ", textShowLength new 112 | , " of them with valid Shelley address payment credentials, while " 113 | , textShowLength legacy, " use legacy stake reward addresses" 114 | ] 115 | 116 | pure $ votingPowerFromRegoValues regoValues 117 | 118 | votingPowerFromRegoValues :: [(Vote, Integer)] -> [VotingPower] 119 | votingPowerFromRegoValues regoValues = 120 | fmap (uncurry votingPowerFromRegoValue) regoValues 121 | 122 | votingPowerFromRegoValue :: Vote -> Integer -> VotingPower 123 | votingPowerFromRegoValue rego power = 124 | let 125 | ds :: Delegations VotingKeyPublic 126 | ds = voteRegistrationDelegations rego 127 | 128 | stakeKey = voteRegistrationVerificationKey rego 129 | rewardsAddr = voteRegistrationRewardsAddress rego 130 | purpose = 131 | purposeNumber $ fromMaybe catalystPurpose $ voteRegistrationPurpose rego 132 | in 133 | VotingPower ds stakeKey rewardsAddr (max power 0) purpose 134 | 135 | delegateVotingPower 136 | :: forall key 137 | . Delegations key 138 | -> Integer 139 | -> NonEmpty (key, Integer) 140 | delegateVotingPower (LegacyDelegation key) power = 141 | (key, max 0 power) NE.:| [] 142 | delegateVotingPower (Delegations keyWeights) power = 143 | let 144 | -- Get the total weight of all delegations. 145 | weightTotal :: Integer 146 | weightTotal = sum $ fmap (fromIntegral . snd) keyWeights 147 | 148 | -- Clamp power to 0 in case its negative. 149 | powerTotal = max power 0 150 | in 151 | let 152 | -- Divide each weight by the total to get the percentage weight of 153 | -- each delegation. 154 | percentage :: NonEmpty (key, Ratio Integer) 155 | percentage = 156 | -- Prevent divide by zero 157 | if weightTotal == 0 158 | then fmap (fmap (const 0)) keyWeights 159 | else fmap (fmap ((% weightTotal) . fromIntegral)) keyWeights 160 | 161 | -- Multiply each percentage by the total vote power. 162 | portion :: NonEmpty (key, Ratio Integer) 163 | portion = fmap (fmap (* (powerTotal % 1))) percentage 164 | 165 | -- Round the voting power down. 166 | floored :: NonEmpty (key, Integer) 167 | floored = fmap (fmap floor) portion 168 | 169 | -- Assign remaining vote power to final key. 170 | flooredVotePower :: Integer 171 | flooredVotePower = sum $ fmap snd floored 172 | 173 | remainingVotePower :: Integer 174 | remainingVotePower = powerTotal - flooredVotePower 175 | in 176 | case (NE.init floored, NE.last floored) of 177 | (initial, (lastVotePub, lastPower)) -> 178 | NE.fromList $ 179 | initial <> [(lastVotePub, lastPower + remainingVotePower)] 180 | 181 | textShowLength :: [a] -> T.Text 182 | textShowLength = T.pack . show . length 183 | -------------------------------------------------------------------------------- /src/Cardano/Db/Extended.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE StandaloneDeriving #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | 4 | module Cardano.Db.Extended where 5 | 6 | import Cardano.Db 7 | 8 | deriving instance Show TxMetadata 9 | deriving instance Show Tx 10 | deriving instance Show Block 11 | deriving instance Show SlotLeader 12 | deriving instance Show TxOut 13 | deriving instance Show StakeAddress 14 | 15 | deriving instance Eq TxMetadata 16 | deriving instance Eq Tx 17 | deriving instance Eq Block 18 | deriving instance Eq SlotLeader 19 | deriving instance Eq TxOut 20 | deriving instance Eq StakeAddress 21 | 22 | deriving instance Ord TxMetadata 23 | deriving instance Ord Tx 24 | deriving instance Ord Block 25 | deriving instance Ord SlotLeader 26 | deriving instance Ord TxOut 27 | deriving instance Ord StakeAddress 28 | deriving instance Ord DbWord64 29 | -------------------------------------------------------------------------------- /src/Config/Common.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE StandaloneDeriving #-} 3 | 4 | module Config.Common where 5 | 6 | import Cardano.Api (AnyCardanoEra (..), CardanoEra (..), SlotNo (..)) 7 | import qualified Data.ByteString.Char8 as BSC 8 | import Data.Foldable (asum) 9 | import Database.Persist.Postgresql (ConnectionString) 10 | import Options.Applicative (Parser, auto, flag', help, infoOption, long, metavar, option) 11 | 12 | data DatabaseConfig 13 | = DatabaseConfig { _dbName :: String 14 | , _dbUser :: String 15 | , _dbHost :: String 16 | , _dbPassword :: Maybe String 17 | } 18 | deriving (Eq, Show) 19 | 20 | pgConnectionString :: DatabaseConfig -> ConnectionString 21 | pgConnectionString (DatabaseConfig dbName dbUser dbHost mDbPassword) = 22 | BSC.pack 23 | $ "host=" <> dbHost 24 | <> " dbname=" <> dbName 25 | <> " user=" <> dbUser 26 | <> maybe "" (" password=" <>) mDbPassword 27 | 28 | pSlotNo :: Parser SlotNo 29 | pSlotNo = SlotNo 30 | <$> option auto 31 | ( long "slot-no" 32 | <> metavar "WORD64" 33 | <> help "Slot number to query" 34 | ) 35 | 36 | pCardanoEra :: Parser AnyCardanoEra 37 | pCardanoEra = asum 38 | [ flag' (AnyCardanoEra ByronEra) 39 | ( long "byron-era" 40 | <> help "Specify the Byron era" 41 | ) 42 | , flag' (AnyCardanoEra ShelleyEra) 43 | ( long "shelley-era" 44 | <> help "Specify the Shelley era" 45 | ) 46 | , flag' (AnyCardanoEra AllegraEra) 47 | ( long "allegra-era" 48 | <> help "Specify the Allegra era" 49 | ) 50 | , flag' (AnyCardanoEra MaryEra) 51 | ( long "mary-era" 52 | <> help "Specify the Mary era (default)" 53 | ) 54 | , flag' (AnyCardanoEra AlonzoEra) 55 | ( long "alonzo-era" 56 | <> help "Specify the Alonzo era" 57 | ) 58 | 59 | -- Default for now: 60 | , pure (AnyCardanoEra MaryEra) 61 | ] 62 | 63 | versionOption :: String -> Parser (a -> a) 64 | versionOption v = 65 | infoOption ("v" <> v) (long "version" <> help "Show version") 66 | -------------------------------------------------------------------------------- /src/Config/Snapshot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | 8 | -- | Handles configuration, which involves parsing command line 9 | -- arguments and reading key files. 10 | 11 | module Config.Snapshot 12 | ( Config(Config) 13 | , opts 14 | , mkConfig 15 | , Opts(Opts) 16 | , parseOpts 17 | , ConfigError 18 | ) where 19 | 20 | import Control.Lens.TH (makeClassyPrisms) 21 | import Control.Monad.Except (ExceptT) 22 | import Options.Applicative (Parser, ParserInfo, auto, flag, fullDesc, header, help, helper, 23 | info, long, metavar, option, optional, progDesc, showDefault, strOption, value, 24 | (<**>)) 25 | 26 | import Cardano.API.Extended (pNetworkId) 27 | import Cardano.Api (NetworkId, SlotNo) 28 | 29 | import Config.Common (DatabaseConfig (DatabaseConfig), pSlotNo, versionOption) 30 | 31 | data Config = Config 32 | { cfgNetworkId :: NetworkId 33 | -- ^ Network (mainnet / testnet magic) 34 | , cfgScale :: Int 35 | -- ^ Scale the voting funds by this amount to arrive at the voting power 36 | , cfgDb :: DatabaseConfig 37 | -- ^ cardano-db-sync database configuration 38 | , cfgSlot :: Maybe SlotNo 39 | -- ^ Slot to view state of, defaults to tip of chain. Queries registrations placed before or equal to (<=) this slotNo. 40 | , cfgOutFile :: FilePath 41 | -- ^ File to output snapshot to 42 | , cfgVerbose :: Bool 43 | -- ^ Enable verbose logging 44 | } 45 | deriving (Eq, Show) 46 | 47 | data ConfigError = ConfigFileJSONDecodeError FilePath String 48 | deriving (Show) 49 | 50 | makeClassyPrisms ''ConfigError 51 | 52 | mkConfig 53 | :: Opts 54 | -> ExceptT ConfigError IO Config 55 | mkConfig (Opts networkId dbName dbUser dbHost dbPass mSlotNo scale outfile verbose) = do 56 | pure $ Config networkId scale (DatabaseConfig dbName dbUser dbHost dbPass) mSlotNo outfile verbose 57 | 58 | data Opts = Opts 59 | { optNetworkId :: NetworkId 60 | , optDbName :: String 61 | , optDbUser :: String 62 | , optDbHost :: FilePath 63 | , optDbPass :: Maybe String 64 | , optSlotNo :: Maybe SlotNo 65 | , optScale :: Int 66 | , optOutFile :: FilePath 67 | , optVerbose :: Bool 68 | } 69 | deriving (Eq, Show) 70 | 71 | parseOpts :: Parser Opts 72 | parseOpts = Opts 73 | <$> pNetworkId 74 | <*> strOption (long "db" <> metavar "DB_NAME" <> showDefault <> value "cexplorer" <> help "Name of the cardano-db-sync database") 75 | <*> strOption (long "db-user" <> metavar "DB_USER" <> showDefault <> value "cexplorer" <> help "User to connect to the cardano-db-sync database with") 76 | <*> strOption (long "db-host" <> metavar "DB_HOST" <> showDefault <> value "/run/postgresql" <> help "Host for the cardano-db-sync database connection") 77 | <*> optional (strOption (long "db-pass" <> metavar "DB_PASS" <> showDefault <> value "" <> help "Password for the cardano-db-sync database connection")) 78 | <*> optional pSlotNo 79 | <*> fmap fromIntegral (option auto (long "scale" <> metavar "DOUBLE" <> showDefault <> value (1 :: Integer) <> help "Scale the voting funds by this amount to arrive at the voting power")) 80 | <*> strOption (long "out-file" <> metavar "FILE" <> help "File to output the signed transaction to") 81 | <*> flag False True (long "verbose" <> help "Adds more verbose logs.") 82 | 83 | opts :: ParserInfo Opts 84 | opts = 85 | info 86 | ( parseOpts <**> versionOption "0.3.0.0" <**> helper ) 87 | ( fullDesc 88 | <> progDesc "Create a voting power snapshot" 89 | <> header "voting-tools snapshot - tool to grab snapshot of voting power" 90 | ) 91 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | module Main where 4 | 5 | import Cardano.Catalyst.VotePower (getVoteRegistrationADA) 6 | import Control.Monad.Except (runExceptT) 7 | import Control.Monad.Logger (LogLevel (..), LoggingT, filterLogger, logInfoN, 8 | runStdoutLoggingT) 9 | import qualified Data.Aeson as Aeson 10 | import qualified Data.Aeson.Encode.Pretty as Aeson 11 | import qualified Data.ByteString.Lazy.Char8 as BLC 12 | import qualified Data.Text as T 13 | import Database.Persist.Postgresql (IsolationLevel (Serializable), SqlPersistT, 14 | runSqlConnWithIsolation, withPostgresqlConn) 15 | import qualified Options.Applicative as Opt 16 | 17 | import qualified Cardano.Catalyst.Query.Sql as Sql 18 | import Config.Common (DatabaseConfig (..), pgConnectionString) 19 | import qualified Config.Snapshot as Snapshot 20 | 21 | main :: IO () 22 | main = do 23 | options <- Opt.execParser Snapshot.opts 24 | 25 | eCfg <- runExceptT (Snapshot.mkConfig options) 26 | case eCfg of 27 | Left (err :: Snapshot.ConfigError) -> 28 | fail $ show err 29 | Right (Snapshot.Config networkId _scale db slotNo outfile verbose) -> do 30 | votingPower <- 31 | runQuery db verbose $ getVoteRegistrationADA (Sql.sqlQuery) networkId slotNo 32 | 33 | BLC.writeFile outfile . toJSON Aeson.Generic $ votingPower 34 | 35 | toJSON :: Aeson.ToJSON a => Aeson.NumberFormat -> a -> BLC.ByteString 36 | toJSON numFormat = Aeson.encodePretty' (Aeson.defConfig { Aeson.confCompare = Aeson.compare, Aeson.confNumFormat = numFormat }) 37 | 38 | runQuery :: DatabaseConfig -> Bool -> SqlPersistT (LoggingT IO) a -> IO a 39 | runQuery dbConfig verbose q = runStdoutLoggingT $ filterLogger f $ do 40 | logInfoN $ T.pack $ "Connecting to database at " <> _dbHost dbConfig 41 | withPostgresqlConn (pgConnectionString dbConfig) $ \backend -> do 42 | runSqlConnWithIsolation q backend Serializable 43 | where 44 | f _ level 45 | | verbose = True 46 | | otherwise = level > LevelDebug 47 | -------------------------------------------------------------------------------- /supported-systems.nix: -------------------------------------------------------------------------------- 1 | [ "x86_64-linux" ] 2 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | import Test.Tasty (TestTree, defaultMain, testGroup) 2 | 3 | import qualified Test.Cardano.API.Extended 4 | import qualified Test.Cardano.Catalyst.Crypto 5 | import qualified Test.Cardano.Catalyst.Registration 6 | import qualified Test.Cardano.Catalyst.VotePower 7 | 8 | main :: IO () 9 | main = defaultMain tests 10 | 11 | tests :: TestTree 12 | tests = do 13 | testGroup "Unit tests" 14 | [ Test.Cardano.Catalyst.Registration.tests 15 | , Test.Cardano.API.Extended.tests 16 | , Test.Cardano.Catalyst.VotePower.tests 17 | , Test.Cardano.Catalyst.Crypto.tests 18 | ] 19 | -------------------------------------------------------------------------------- /test/Test/Cardano/API/Extended.hs: -------------------------------------------------------------------------------- 1 | 2 | module Test.Cardano.API.Extended 3 | ( tests 4 | ) 5 | where 6 | 7 | import qualified Data.Aeson as Aeson 8 | import Hedgehog (Property, forAll, property, tripping) 9 | import Test.Tasty (TestTree, testGroup) 10 | import Test.Tasty.Hedgehog (testProperty) 11 | 12 | import qualified Cardano.Catalyst.Test.DSL.Gen as Gen 13 | 14 | tests :: TestTree 15 | tests = testGroup "Test.Cardano.API.Extended" 16 | [ testProperty "JSON roundtrip VotingKeyPublic" prop_votingKeyPublic_json_roundtrip 17 | ] 18 | 19 | prop_votingKeyPublic_json_roundtrip :: Property 20 | prop_votingKeyPublic_json_roundtrip = property $ do 21 | votepub <- forAll Gen.genVotingKeyPublic 22 | tripping votepub Aeson.encode Aeson.eitherDecode' 23 | -------------------------------------------------------------------------------- /test/Test/Cardano/Catalyst/Crypto.hs: -------------------------------------------------------------------------------- 1 | module Test.Cardano.Catalyst.Crypto 2 | ( tests 3 | ) 4 | where 5 | 6 | import qualified Data.Aeson as Aeson 7 | import Hedgehog (Property, property, tripping) 8 | import Hedgehog.Internal.Property (forAllT) 9 | import Test.Tasty (TestTree, testGroup) 10 | import Test.Tasty.Hedgehog (testProperty) 11 | 12 | import qualified Cardano.Catalyst.Test.DSL.Gen as Gen 13 | 14 | tests :: TestTree 15 | tests = testGroup "Test.Cardano.Catalyst.Crypto" 16 | [ testProperty "JSON roundtrip StakeVerificationKey" prop_stakeVerificationKey_json_roundtrip 17 | ] 18 | 19 | prop_stakeVerificationKey_json_roundtrip :: Property 20 | prop_stakeVerificationKey_json_roundtrip = property $ do 21 | stakePub <- forAllT Gen.genStakeVerificationKey 22 | tripping stakePub Aeson.encode Aeson.eitherDecode' 23 | -------------------------------------------------------------------------------- /test/Test/Cardano/Catalyst/VotePower.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | module Test.Cardano.Catalyst.VotePower 4 | ( tests 5 | ) 6 | where 7 | 8 | import Cardano.Catalyst.Registration (Delegations (..), Vote, delegations) 9 | import Cardano.Catalyst.VotePower 10 | import qualified Data.Aeson as Aeson 11 | import Hedgehog (Property, annotate, cover, property, tripping, (===)) 12 | import Hedgehog.Internal.Property (forAllT) 13 | import Test.Tasty (TestTree, testGroup) 14 | import Test.Tasty.HUnit (Assertion, testCase, (@?=)) 15 | import Test.Tasty.Hedgehog (testProperty) 16 | 17 | import qualified Cardano.Catalyst.Test.DSL.Gen as Gen 18 | import qualified Cardano.Catalyst.Test.VotePower.Gen as Gen 19 | import qualified Data.List.NonEmpty as NE 20 | import qualified Hedgehog.Gen as Gen 21 | import qualified Hedgehog.Range as Range 22 | 23 | tests :: TestTree 24 | tests = testGroup "Test.Cardano.Catalyst.VotePower" 25 | [ testProperty "JSON roundtrip VotingPower" prop_votingPower_json_roundtrip 26 | , testProperty "delegation value conserved" prop_delegateVotingPower_value_conserved 27 | , testProperty "value conserved" prop_registration_value_conserved 28 | , testProperty "values conserved" prop_registration_values_conserved 29 | , testCase "delegation assigns remaining voting power to final vote" test_remainder_votingPower 30 | , testCase "delegation assigns remaining voting power to final vote when weights are zero" test_remainder_votingPower_zero 31 | , testCase "delegation assigns voting power correctly" test_votingPower 32 | ] 33 | 34 | prop_votingPower_json_roundtrip :: Property 35 | prop_votingPower_json_roundtrip = property $ do 36 | votePower <- forAllT Gen.votingPower 37 | tripping votePower Aeson.encode Aeson.eitherDecode' 38 | 39 | -- | Voting power is assigned correctly. 40 | test_votingPower :: Assertion 41 | test_votingPower = 42 | let 43 | -- Given a voting power of 12, 44 | power = 12 45 | 46 | -- and a total voting weight of 6, we expect the voting power to be assigned 47 | -- in the following manner: 48 | -- [(a, 6), (b, 2), (c, 4)] 49 | delegate = Delegations . NE.fromList $ 50 | [ ( 'a', 3 ) 51 | , ( 'b', 1 ) 52 | , ( 'c', 2 ) 53 | ] 54 | in 55 | -- Hence our expectation: 56 | delegateVotingPower delegate power 57 | @?= NE.fromList [ ('a', 6) 58 | , ('b', 2) 59 | , ('c', 4) 60 | ] 61 | 62 | -- | When voting power is rounded down, remainder is assigned to last 63 | -- delegation. 64 | test_remainder_votingPower :: Assertion 65 | test_remainder_votingPower = 66 | let 67 | -- Given a voting power of 3, 68 | power = 3 69 | 70 | -- and a total voting weight of 4, we expect the voting power to be assigned 71 | -- in the following manner: 72 | -- [(a, 0.75), (b, 0.75), (c, 1.5)] 73 | -- However, we know from the spec 74 | -- (https://github.com/cardano-foundation/CIPs/blob/1cc035d873082c39c7e3b1faf3204c552e34d5a1/CIP-0036/README.md#associating-voting-power-with-a-voting-key) 75 | -- that fractional ADA amounts are rounded down, giving us: 76 | -- [(a, 0), (b, 0), (c, 1)] 77 | -- But we also know that the remaining vote power must be associated with 78 | -- the last delegation: 79 | -- [(a, 0), (b, 0), (c, 3)] 80 | delegate = Delegations . NE.fromList $ 81 | [ ( 'a', 1 ) 82 | , ( 'b', 1 ) 83 | , ( 'c', 2 ) 84 | ] 85 | in 86 | -- Hence our expectation: 87 | delegateVotingPower delegate power 88 | @?= NE.fromList [ ('a', 0) 89 | , ('b', 0) 90 | , ('c', 3) 91 | ] 92 | 93 | test_remainder_votingPower_zero :: Assertion 94 | test_remainder_votingPower_zero = 95 | let 96 | -- Given a voting power of 10, 97 | power = 10 98 | 99 | -- when the sum of weights is zero, we expect the voting power to be 100 | -- assigned to the last key. 101 | -- This ensures that total voting power is maintained despite a poor choice 102 | -- in weights. 103 | delegate = Delegations . NE.fromList $ 104 | [ ( 'a', 0 ) 105 | , ( 'b', 0 ) 106 | ] 107 | in 108 | delegateVotingPower delegate power 109 | @?= NE.fromList [ ( 'a', 0) 110 | , ( 'b', 10) 111 | ] 112 | 113 | prop_delegateVotingPower_value_conserved :: Property 114 | prop_delegateVotingPower_value_conserved = property $ do 115 | delegs <- forAllT Gen.genDelegations 116 | cover 10 "zero weights" $ 117 | and $ (\(_key, weight) -> weight == 0) <$> delegations delegs 118 | cover 30 "non-zero weights" $ 119 | and $ (\(_key, weight) -> weight /= 0) <$> delegations delegs 120 | cover 10 "legacy delegations" $ 121 | case delegs of 122 | (LegacyDelegation _) -> True 123 | _ -> False 124 | cover 10 "new delegations" $ 125 | case delegs of 126 | (Delegations _) -> True 127 | _ -> False 128 | cover 10 "one delegation" $ length (delegations delegs) == 1 129 | cover 10 "many delegations" $ length (delegations delegs) > 3 130 | power <- forAllT $ fromIntegral <$> Gen.int64 (Range.linearBounded) 131 | 132 | let 133 | delegated = delegateVotingPower delegs power 134 | delegatedSum = sum $ fmap snd delegated 135 | 136 | -- Negative power should be clamped to zero. 137 | if power >= 0 138 | then delegatedSum === power 139 | else delegatedSum === 0 140 | 141 | prop_registration_value_conserved :: Property 142 | prop_registration_value_conserved = property $ do 143 | rego <- forAllT $ Gen.genVote 144 | power <- forAllT $ fromIntegral <$> Gen.int64 (Range.linearBounded) 145 | 146 | let 147 | votingPower :: VotingPower 148 | votingPower = votingPowerFromRegoValue rego power 149 | 150 | votingPowerSum :: Integer 151 | votingPowerSum = _powerVotingPower votingPower 152 | 153 | annotate $ "votingPower: " <> show votingPower 154 | 155 | if power >= 0 156 | then votingPowerSum === power 157 | else votingPowerSum === 0 158 | 159 | prop_registration_values_conserved :: Property 160 | prop_registration_values_conserved = property $ do 161 | (regoValues :: [(Vote, Integer)]) <- 162 | forAllT $ Gen.list (Range.linear 0 15) $ do 163 | rego <- Gen.genVote 164 | power <- fromIntegral <$> Gen.int64 (Range.linearBounded) 165 | pure (rego, power) 166 | 167 | let 168 | -- Negative values should not be considered when summing. 169 | clampNegative :: Integer -> Integer -> Integer 170 | clampNegative clamp v = if v < 0 then clamp else v 171 | 172 | -- Sum total power of registrations (ignoring negative power). 173 | regoValuesSum :: Integer 174 | regoValuesSum = sum $ fmap (clampNegative 0 . snd) regoValues 175 | 176 | -- Run function under test. 177 | votingPower :: [VotingPower] 178 | votingPower = votingPowerFromRegoValues regoValues 179 | 180 | -- Get the sum of the voting power. 181 | votingPowerSum :: Integer 182 | votingPowerSum = sum $ fmap (_powerVotingPower) votingPower 183 | 184 | annotate $ "votingPower: " <> show votingPower 185 | 186 | -- Ensure total power of registrations matches voting power sum. 187 | votingPowerSum === regoValuesSum 188 | -------------------------------------------------------------------------------- /test/integration/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | import Config.Common (DatabaseConfig (..), pgConnectionString) 4 | import Control.Monad.Logger 5 | import Data.Pool (Pool) 6 | import Data.Proxy (Proxy (..)) 7 | import Data.Text (Text) 8 | import Database.Persist.Postgresql (ConnectionString, SqlBackend, createPostgresqlPool) 9 | import Test.Tasty (TestTree, askOption, defaultIngredients, defaultMainWithIngredients, 10 | includingOptions, localOption, testGroup) 11 | import Test.Tasty.Options (IsOption (..), OptionDescription (..)) 12 | import Test.Tasty.Runners (NumThreads (..)) 13 | 14 | import qualified Cardano.Catalyst.Query.Esqueleto as Esql 15 | import qualified Cardano.Catalyst.Query.Sql as Sql 16 | import qualified Data.Pool as Pool 17 | import qualified Data.Text as T 18 | import qualified Test.Tasty as Tasty 19 | 20 | import qualified Test.Cardano.Catalyst.Db 21 | import qualified Test.Cardano.Catalyst.Query 22 | 23 | main :: IO () 24 | main = 25 | defaultMainWithIngredients 26 | (includingOptions dbOptions : defaultIngredients) 27 | tests 28 | 29 | withPostgresPool :: ConnectionString -> (IO (Pool SqlBackend) -> TestTree) -> TestTree 30 | withPostgresPool connStr = 31 | Tasty.withResource 32 | (runStdoutLoggingT $ createPostgresqlPool connStr numConnections) 33 | Pool.destroyAllResources 34 | where 35 | numConnections = 1 36 | 37 | tests :: TestTree 38 | tests = 39 | -- Force sequential execution, as these database tests need to execute one 40 | -- after the other. 41 | localOption (NumThreads 1) $ 42 | -- Get database config 43 | askOption $ \(DbName dbName) -> 44 | askOption $ \(DbUser dbUser) -> 45 | askOption $ \(DbHost dbHost) -> 46 | askOption $ \(DbPass mDbPass) -> 47 | let 48 | connStr = pgConnectionString 49 | $ DatabaseConfig (T.unpack dbName) (T.unpack dbUser) (T.unpack dbHost) (T.unpack <$> mDbPass) 50 | in do 51 | -- Establish and share postgres connection between tests 52 | withPostgresPool connStr $ \getConnPool -> do 53 | testGroup "Integration tests" 54 | [ Test.Cardano.Catalyst.Db.tests (Sql.sqlQuery) getConnPool 55 | , Test.Cardano.Catalyst.Db.tests (Esql.esqlQuery) getConnPool 56 | , Test.Cardano.Catalyst.Query.tests (Sql.sqlQuery) getConnPool 57 | , Test.Cardano.Catalyst.Query.tests (Esql.esqlQuery) getConnPool 58 | ] 59 | 60 | newtype DbName = DbName Text 61 | newtype DbUser = DbUser Text 62 | newtype DbHost = DbHost Text 63 | newtype DbPass = DbPass (Maybe Text) 64 | 65 | instance IsOption DbName where 66 | defaultValue = DbName "" 67 | parseValue str = Just $ DbName $ T.pack str 68 | optionName = return "db-name" 69 | optionHelp = return "Name of Postgres cardano-db-sync database to use for testing (WARNING will wipe database!)." 70 | 71 | instance IsOption DbUser where 72 | defaultValue = DbUser "" 73 | parseValue str = Just $ DbUser $ T.pack str 74 | optionName = return "db-user" 75 | optionHelp = return "User of Postgres cardano-db-sync database to use for testing (WARNING will wipe database!)." 76 | 77 | instance IsOption DbHost where 78 | defaultValue = DbHost "" 79 | parseValue str = Just $ DbHost $ T.pack str 80 | optionName = return "db-host" 81 | optionHelp = return "Host of Postgres cardano-db-sync database to use for testing (WARNING will wipe database!)." 82 | 83 | instance IsOption DbPass where 84 | defaultValue = DbPass Nothing 85 | parseValue str = Just $ DbPass $ Just $ T.pack str 86 | optionName = return "db-pass" 87 | optionHelp = return "Password of Postgres cardano-db-sync database to use for testing (WARNING will wipe database!)." 88 | 89 | dbOptions :: [OptionDescription] 90 | dbOptions = 91 | [ Option (Proxy @DbName) 92 | , Option (Proxy @DbUser) 93 | , Option (Proxy @DbHost) 94 | , Option (Proxy @DbPass) 95 | ] 96 | -------------------------------------------------------------------------------- /test/integration/Test/Cardano/Catalyst/Helpers.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TupleSections #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | 8 | module Test.Cardano.Catalyst.Helpers where 9 | 10 | import Control.Exception.Lifted (bracket_) 11 | import Control.Monad.Base (liftBase) 12 | import Control.Monad.IO.Class (MonadIO, liftIO) 13 | import Control.Monad.Reader (ReaderT) 14 | import Control.Monad.Trans.Control (MonadBaseControl) 15 | import Control.Monad.Trans.Resource (MonadUnliftIO) 16 | import Data.Pool (Pool) 17 | import Database.Persist.Postgresql (IsolationLevel (Serializable), SqlBackend, rawExecute, 18 | runSqlPoolNoTransaction) 19 | 20 | import qualified Database.Persist.Class as Sql 21 | 22 | -- Isolate a set of queries to a single transaction. The transaction is rolled 23 | -- back if the enclosing code finishes successfully or throws an exception. 24 | -- 25 | -- Provides an appropriate function to the action to run queries. This function 26 | -- can be called zero or many times. 27 | -- 28 | -- Importantly this includes ANY exceptions thrown by the code, not just 29 | -- database-related exceptions. This means that failing test code will also 30 | -- cause the transaction to be rolled back. 31 | withinTransaction 32 | :: forall m b 33 | . ( MonadBaseControl IO m 34 | , MonadIO m 35 | ) 36 | => Pool SqlBackend 37 | -- ^ Sql connection pool 38 | -> ((forall a. ReaderT SqlBackend IO a -> m a) -> m b) 39 | -- ^ Action, given a function to run Sql queries 40 | -> m b 41 | -- ^ Result 42 | withinTransaction pool action = 43 | bracket_ 44 | (liftBase (runQueryNoTransaction pool $ rawExecute "BEGIN" [])) 45 | (liftBase (runQueryNoTransaction pool $ rawExecute "ROLLBACK" [])) 46 | (action $ liftIO . runQueryNoTransaction pool) 47 | 48 | -- Run a query without the wrapping transaction. Useful as we want to wrap 49 | -- multiple queries in a single transaction (see @withinTransaction@). 50 | -- 51 | -- We want to wrap in a single transaction so that Haskell code exceptions (test 52 | -- failures) cause the transaction to be rolled back. Postgres doesn't support 53 | -- nested transactions so we can't just start a new transaction for each query. 54 | runQueryNoTransaction 55 | :: forall backend m a 56 | . ( MonadUnliftIO m 57 | , Sql.BackendCompatible SqlBackend backend 58 | ) 59 | => Pool backend 60 | -> ReaderT backend m a 61 | -> m a 62 | runQueryNoTransaction backend query = 63 | runSqlPoolNoTransaction 64 | query 65 | backend 66 | (Just Serializable) 67 | -- See https://www.postgresql.org/docs/9.5/transaction-iso.html for more 68 | -- information. Serializable is probably more strict a isolation level than 69 | -- we need. The logic in this test suite should prevent transactions running 70 | -- concurrently (see withinTransaction and NumThreads) but a strict 71 | -- isolation level is only harmful if we need to retry transactions due to 72 | -- serialization failures. So if we start seeing that, consider changing 73 | -- this to something looser. 74 | -------------------------------------------------------------------------------- /test/integration/Test/Cardano/Catalyst/Query.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TupleSections #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | 8 | module Test.Cardano.Catalyst.Query where 9 | 10 | import Cardano.Catalyst.Query.Types 11 | import Cardano.Catalyst.Test.DSL (genGraph, getStakeAddress, 12 | graphStakeAddressRegistration, writeGraph) 13 | import Control.Monad.IO.Class (liftIO) 14 | import Control.Monad.Reader (ReaderT) 15 | import Data.Foldable (traverse_) 16 | import Data.List (sort) 17 | import Data.Pool (Pool) 18 | import Database.Persist.Postgresql (SqlBackend) 19 | import Hedgehog (Property, distributeT, property, (===)) 20 | import Hedgehog.Internal.Property (forAllT) 21 | import Test.Cardano.Catalyst.Helpers (withinTransaction) 22 | import Test.Tasty (TestTree, testGroup) 23 | import Test.Tasty.Hedgehog (testProperty) 24 | 25 | import qualified Cardano.Api as Cardano 26 | import qualified Cardano.Api.Shelley as Api 27 | import qualified Control.Monad.State.Strict as State 28 | import qualified Hedgehog.Gen as Gen 29 | import qualified Hedgehog.Range as Range 30 | 31 | tests :: Query (ReaderT SqlBackend IO) t -> IO (Pool SqlBackend) -> TestTree 32 | tests intf getConnPool = 33 | testGroup "Test.Cardano.Catalyst.Query" 34 | [ 35 | -- ∀xs. length xs === length (queryStakeValues xs) 36 | testProperty "prop_stakeValuesLength" (prop_stakeValuesLength intf getConnPool) 37 | -- ∀xs. queryStakeValues xs === zip stakeAddrs <$> traverse queryStakeValue xs 38 | , testProperty "prop_stakeValues_stakeValue" (prop_stakeValues_stakeValue intf getConnPool) 39 | ] 40 | 41 | nw :: Cardano.NetworkId 42 | nw = Cardano.Mainnet 43 | 44 | -- | The length of the returned stake values should match the length of stake 45 | -- addresses requested. 46 | -- 47 | -- That is, any stake addresses without any value should be given a value of 0. 48 | prop_stakeValuesLength :: Query (ReaderT SqlBackend IO) t -> IO (Pool SqlBackend) -> Property 49 | prop_stakeValuesLength intf getConnPool = 50 | property $ do 51 | pool <- liftIO getConnPool 52 | 53 | graphs <- 54 | flip State.evalStateT [1..] $ distributeT $ 55 | forAllT (Gen.list (Range.linear 0 10) $ genGraph nw) 56 | 57 | let 58 | stakeAddrs :: [Api.StakeAddress] 59 | stakeAddrs = 60 | fmap (getStakeAddress Cardano.Mainnet . graphStakeAddressRegistration) graphs 61 | 62 | withinTransaction pool $ \runQuery -> do 63 | stakeValues <- runQuery $ do 64 | traverse_ writeGraph graphs 65 | queryStakeValues intf Nothing stakeAddrs 66 | 67 | length stakeAddrs === length stakeValues 68 | 69 | -- | Querying using 'queryStakeValues' with a list of stake addresses should 70 | -- match querying each individual stake address with 'queryStakeValue'. 71 | prop_stakeValues_stakeValue 72 | :: Query (ReaderT SqlBackend IO) t 73 | -> IO (Pool SqlBackend) 74 | -> Property 75 | prop_stakeValues_stakeValue intf getConnPool = 76 | property $ do 77 | pool <- liftIO getConnPool 78 | 79 | graphs <- 80 | flip State.evalStateT [1..] $ distributeT $ 81 | forAllT (Gen.list (Range.linear 0 10) $ genGraph nw) 82 | 83 | let 84 | stakeAddrs :: [Api.StakeAddress] 85 | stakeAddrs = 86 | fmap (getStakeAddress Cardano.Mainnet . graphStakeAddressRegistration) graphs 87 | 88 | withinTransaction pool $ \runQuery -> do 89 | (stakeValues, stakeValueList) <- runQuery $ do 90 | traverse_ writeGraph graphs 91 | stakeValues <- queryStakeValues intf Nothing stakeAddrs 92 | stakeValueList <- zip stakeAddrs <$> traverse (queryStakeValue intf Nothing) stakeAddrs 93 | pure (stakeValues, stakeValueList) 94 | 95 | sort stakeValues === sort stakeValueList 96 | -------------------------------------------------------------------------------- /voting-tools.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: voting-tools 3 | version: 0.3.0.0 4 | -- synopsis: 5 | -- description: 6 | -- bug-reports: 7 | -- license: 8 | license-file: LICENSE 9 | author: Samuel Evans-Powell 10 | maintainer: mail@sevanspowell.net 11 | -- copyright: 12 | -- cate gory: 13 | build-type: Simple 14 | extra-source-files: CHANGELOG.md 15 | 16 | common project-config 17 | default-language: Haskell2010 18 | default-extensions: OverloadedStrings 19 | 20 | ghc-options: -Wall 21 | -Wcompat 22 | -Wincomplete-record-updates 23 | -Wincomplete-uni-patterns 24 | -Wpartial-fields 25 | -Wredundant-constraints 26 | -Wunused-packages 27 | 28 | library 29 | import: project-config 30 | hs-source-dirs: src 31 | 32 | exposed-modules: Cardano.API.Extended 33 | , Cardano.API.Extended.Raw 34 | , Cardano.Catalyst.Crypto 35 | , Cardano.Catalyst.Test.DSL 36 | , Cardano.Catalyst.Test.DSL.Gen 37 | , Cardano.Catalyst.Test.VotePower.Gen 38 | , Cardano.Catalyst.Test.DSL.Internal.Db 39 | , Cardano.Catalyst.Test.DSL.Internal.Types 40 | , Cardano.Catalyst.Query.Types 41 | , Cardano.Catalyst.Query.Sql 42 | , Cardano.Catalyst.Registration 43 | , Cardano.Catalyst.Registration.Types 44 | , Cardano.Catalyst.Registration.Types.Purpose 45 | , Cardano.Catalyst.VotePower 46 | , Cardano.Db.Extended 47 | , Config.Snapshot 48 | , Config.Common 49 | 50 | build-depends: base 51 | , aeson 52 | , aeson-pretty 53 | , attoparsec 54 | , base16-bytestring == 1.0.1.0 55 | , bech32 56 | , binary 57 | , bytestring 58 | , cardano-db 59 | , cardano-api 60 | , cardano-binary 61 | , cardano-cli 62 | , cardano-crypto-class 63 | , cardano-crypto-wrapper 64 | , cardano-ledger-core 65 | , containers 66 | , hedgehog 67 | , lens 68 | , monad-logger 69 | , mtl 70 | , optparse-applicative 71 | , ouroboros-network 72 | , persistent 73 | , persistent-postgresql 74 | , scientific 75 | , text 76 | , time 77 | , unordered-containers 78 | , vector 79 | 80 | executable voting-tools 81 | import: project-config 82 | main-is: Main.hs 83 | build-depends: base 84 | , aeson 85 | , aeson-pretty 86 | , attoparsec 87 | , base16-bytestring 88 | , bech32 89 | , bytestring 90 | , cardano-api 91 | , scientific 92 | , cardano-binary 93 | , cardano-cli 94 | , cardano-crypto-class 95 | , cardano-crypto-wrapper 96 | , cardano-db 97 | , cardano-ledger-core 98 | , containers 99 | , lens 100 | , monad-logger 101 | , mtl 102 | , optparse-applicative 103 | , ouroboros-network 104 | , persistent-postgresql 105 | , text 106 | , unordered-containers 107 | , vector 108 | 109 | hs-source-dirs: src/ 110 | default-language: Haskell2010 111 | other-modules: Cardano.API.Extended 112 | , Cardano.API.Extended.Raw 113 | , Cardano.Catalyst.Query.Sql 114 | , Cardano.Catalyst.Query.Types 115 | , Cardano.Catalyst.Registration 116 | , Cardano.Catalyst.Registration.Types 117 | , Cardano.Catalyst.VotePower 118 | , Cardano.Db.Extended 119 | , Cardano.Catalyst.Crypto 120 | , Config.Common 121 | , Config.Snapshot 122 | , Cardano.Catalyst.Registration.Types.Purpose 123 | 124 | test-suite unit-tests 125 | import: project-config 126 | hs-source-dirs: test 127 | main-is: Main.hs 128 | type: exitcode-stdio-1.0 129 | 130 | build-depends: base >=4.12 && <5 131 | , aeson 132 | , cardano-api 133 | , containers 134 | , hedgehog 135 | , hedgehog 136 | , text 137 | , tasty 138 | , tasty-hedgehog 139 | , base16-bytestring 140 | , tasty-hunit 141 | , unordered-containers 142 | , voting-tools 143 | , cardano-crypto-class 144 | , vector 145 | 146 | other-modules: Test.Cardano.Catalyst.Registration 147 | Test.Cardano.API.Extended 148 | Test.Cardano.Catalyst.VotePower 149 | Test.Cardano.Catalyst.Crypto 150 | 151 | test-suite integration-tests 152 | import: project-config 153 | hs-source-dirs: test/integration 154 | test 155 | src 156 | main-is: Main.hs 157 | type: exitcode-stdio-1.0 158 | 159 | build-depends: base >=4.12 && <5 160 | , hedgehog 161 | , lifted-base 162 | , monad-control 163 | , monad-logger 164 | , mtl 165 | , persistent 166 | , persistent-postgresql 167 | , resource-pool 168 | , vector 169 | , resourcet 170 | , scientific 171 | , text 172 | , transformers-base 173 | , esqueleto 174 | , tasty 175 | , tasty-hedgehog 176 | 177 | , aeson 178 | , aeson-pretty 179 | , attoparsec 180 | , bech32 181 | , binary 182 | , bytestring 183 | , cardano-api 184 | , cardano-binary 185 | , cardano-cli 186 | , cardano-crypto-class 187 | , cardano-crypto-wrapper 188 | , cardano-db 189 | , cardano-ledger-core 190 | , containers 191 | , lens 192 | , monad-logger 193 | , mtl 194 | , optparse-applicative 195 | , ouroboros-network 196 | , persistent-postgresql 197 | , text 198 | , time 199 | , unordered-containers 200 | 201 | other-modules: Test.Cardano.Catalyst.Db 202 | Test.Cardano.Catalyst.Query 203 | Cardano.Catalyst.Query.Sql 204 | Test.Cardano.Catalyst.Helpers 205 | Cardano.Catalyst.Query.Sql 206 | Cardano.Catalyst.Query.Esqueleto 207 | Cardano.Catalyst.Query.Types 208 | Cardano.Catalyst.Registration 209 | Cardano.Catalyst.Registration.Types 210 | Cardano.Catalyst.Registration.Types.Purpose 211 | Cardano.Catalyst.VotePower 212 | Cardano.API.Extended 213 | Cardano.API.Extended.Raw 214 | Cardano.Catalyst.Crypto 215 | Cardano.Catalyst.Test.DSL 216 | Cardano.Catalyst.Test.DSL.Gen 217 | Cardano.Catalyst.Test.DSL.Internal.Db 218 | Cardano.Catalyst.Test.DSL.Internal.Types 219 | Cardano.Catalyst.Test.VotePower.Gen 220 | Config.Common 221 | Cardano.Db.Extended 222 | --------------------------------------------------------------------------------