├── .envrc ├── .gitignore ├── .markdownlint.yaml ├── LICENSE ├── NOTICE ├── README.md ├── coop-docs ├── .envrc ├── .imgs │ ├── Orcfax-orcfax-diagram.png │ ├── linking.png │ └── orcfax-diagram.png ├── 00-design.md ├── 01-roadmap.md ├── 02-plutus-protocol.md ├── 03-frontend-protocol.md ├── 04-backend-protocol.md ├── 05-json-plutus.md ├── build.nix └── images │ └── coop-logo.png ├── coop-extras ├── coop-env │ ├── .envrc │ ├── aux.bash │ ├── build.nix │ ├── coop-proto │ ├── protocol.json │ └── resources ├── json-fact-statement-store │ ├── .envrc │ ├── CHANGELOG.md │ ├── Makefile │ ├── app │ │ ├── BeamConfig.hs │ │ ├── FactStatementStoreGrpc.hs │ │ ├── Genesis.hs │ │ ├── InsertFs.hs │ │ └── Main.hs │ ├── build.nix │ ├── cabal.project │ ├── hie.yaml │ ├── json-fact-statement-store.cabal │ └── resources │ │ └── ssl-extensions-x509.conf └── plutus-json │ ├── .envrc │ ├── CHANGELOG.md │ ├── app │ └── Main.hs │ ├── build.nix │ ├── cabal.project │ ├── hie.yaml │ ├── plutus-json.cabal │ ├── src │ └── PlutusJson.hs │ └── test │ └── Main.hs ├── coop-hs-types ├── .envrc ├── LICENSE ├── build.nix ├── cabal.project ├── coop-hs-types.cabal ├── hie.yaml └── src │ └── Coop │ ├── PlutusOrphans.hs │ └── Types.hs ├── coop-pab ├── .envrc ├── LICENSE ├── app │ ├── Coop │ │ └── Cli │ │ │ ├── Aux.hs │ │ │ ├── Deploy.hs │ │ │ ├── GarbageCollect.hs │ │ │ ├── GetState.hs │ │ │ ├── MintAuth.hs │ │ │ ├── MintCertRdmrs.hs │ │ │ ├── RedistributeAuth.hs │ │ │ └── TxBuilderGrpc.hs │ └── Main.hs ├── aux.bash ├── build.nix ├── cabal.project ├── coop-pab.cabal ├── hie.yaml ├── resources │ ├── pabConfig.yaml │ ├── protocol.json │ └── ssl-extensions-x509.conf ├── src │ └── Coop │ │ ├── Pab.hs │ │ └── Pab │ │ └── Aux.hs └── test │ ├── Aux.hs │ └── Main.hs ├── coop-plutus ├── .envrc ├── LICENSE ├── app │ ├── Coop │ │ └── Cli │ │ │ └── Compile.hs │ └── Main.hs ├── build.nix ├── cabal.project ├── coop-plutus.cabal ├── hie.yaml ├── resources │ ├── sample.json │ └── sample.pd.cbor ├── src │ └── Coop │ │ ├── Plutus.hs │ │ └── Plutus │ │ ├── Aux.hs │ │ └── Types.hs └── test │ ├── Coop │ └── Plutus │ │ ├── Test.hs │ │ └── Test │ │ └── Generators.hs │ └── Main.hs ├── coop-proto ├── .envrc ├── Makefile ├── build.nix ├── cardano-proto-extras │ ├── .envrc │ ├── CHANGELOG.md │ ├── build.nix │ ├── cabal.project │ ├── cardano-proto-extras.cabal │ ├── hie.yaml │ └── src │ │ └── Cardano │ │ └── Proto │ │ └── Aux.hs ├── cardano.proto ├── fact-statement-store-service.proto ├── js │ ├── Makefile │ ├── client.js │ ├── index.html │ ├── package-lock.json │ └── package.json ├── publisher-service.proto └── tx-builder-service.proto ├── coop-publisher ├── .envrc ├── app │ ├── Coop │ │ └── Cli │ │ │ └── PublisherGrpc.hs │ └── Main.hs ├── aux.bash ├── build.nix ├── cabal.project ├── coop-publisher.cabal ├── hie.yaml └── resources │ └── ssl-extensions-x509.conf ├── flake.lock ├── flake.nix ├── fourmolu.yaml ├── nix └── protobuf-hs.nix └── pre-commit-check.nix /.envrc: -------------------------------------------------------------------------------- 1 | use flake .#dev-pre-commit 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .direnv 2 | dist-newstyle 3 | result 4 | /.pre-commit-config.yaml 5 | .vscode/ 6 | *~ 7 | *#* 8 | .pre-commit-config.yaml -------------------------------------------------------------------------------- /.markdownlint.yaml: -------------------------------------------------------------------------------- 1 | default: true 2 | MD013: false 3 | MD024: false 4 | MD033: false 5 | -------------------------------------------------------------------------------- /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 -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2023 Orcfax Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. -------------------------------------------------------------------------------- /coop-docs/.envrc: -------------------------------------------------------------------------------- 1 | use flake ..#dev-docs 2 | -------------------------------------------------------------------------------- /coop-docs/.imgs/Orcfax-orcfax-diagram.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mlabs-haskell/cardano-open-oracle-protocol/5f8f97e1b8ba35f60e0dae44d0bd79560c96aacf/coop-docs/.imgs/Orcfax-orcfax-diagram.png -------------------------------------------------------------------------------- /coop-docs/.imgs/linking.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mlabs-haskell/cardano-open-oracle-protocol/5f8f97e1b8ba35f60e0dae44d0bd79560c96aacf/coop-docs/.imgs/linking.png -------------------------------------------------------------------------------- /coop-docs/.imgs/orcfax-diagram.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mlabs-haskell/cardano-open-oracle-protocol/5f8f97e1b8ba35f60e0dae44d0bd79560c96aacf/coop-docs/.imgs/orcfax-diagram.png -------------------------------------------------------------------------------- /coop-docs/01-roadmap.md: -------------------------------------------------------------------------------- 1 | # Roadmap document 2 | 3 | For the Cardano open oracle protocol, this document breaks down the project into 4 | milestone that group features in a progressively expanding scope until the 5 | launch version, and outlines the timeline for the milestones at a high level. 6 | -------------------------------------------------------------------------------- /coop-docs/03-frontend-protocol.md: -------------------------------------------------------------------------------- 1 | # COOP Frontend protocol 2 | 3 | This document contains information about how users must interact with the COOP Publisher in order to publish new Fact Statements and garbage collect obsolete Fact Statements. 4 | 5 | ## Publishing a Fact Statement 6 | 7 | The successful result of this operation is a [Fact Statement Publishing transaction](02-plutus-protocol.md#mint-fact-statement-tx). 8 | 9 | The user we call `Submitter` approaches the [COOP Publisher gRPC](../coop-proto/publisher-service.proto) service with a Fact Statement identifier that exists in the underlying Oracle's `Fact Statement Store`. 10 | 11 | The `Submitter` provides the desired Fact Statement IDs they want published, alongside the validity time after which the produced [Fact Statement UTxOs](02-plutus-protocol.md#fs-validator) can be garbage collected. Of course, the public key hash of the `Submitter` wallets needs to be provided as well as the back-end transaction building process requires that information to construct the transaction. 12 | 13 | ```mermaid 14 | sequenceDiagram 15 | title Successfully publish a single Fact Statement on Cardano 16 | actor cardano as Cardano 17 | actor submitterWallet as Submitter's wallet 18 | actor submitter as Submitter 19 | actor publisher as COOP Publisher gRPC 20 | 21 | submitter ->>+ publisher: Publisher.createMintFsTx([(fs_id, gc_after, submitter_pkh)]) 22 | note right of publisher: Publisher successfully services the request 23 | publisher -->>- submitter: mint_fs_tx 24 | submitter ->>+ submitterWallet: sign(mint_fs_tx) 25 | submitterWallet -->>- submitter: mint_fs_tx_signed 26 | submitter ->>+ cardano: submit(mint_fs_tx_signed) 27 | cardano -->>- submitter: mint_fs_tx_id 28 | ``` 29 | 30 | The service, if successful, responds with the CBOR+base16 encoded Cardano transaction that can be further signed by the `Submitter` and sent to the network (see [mint-fact-statement-tx](02-plutus-protocol.md#mint-fact-statement-tx)). 31 | 32 | > The service will only include Fact Statements in the publishing transaction if they aren't already published. 33 | 34 | Anyone can now inspect the [Fact Statement UTxOs](02-plutus-protocol.md#fs-validator) and reference the published Fact Statements (see [ref-fact-statement-tx](02-plutus-protocol.md#mint-fact-statement-tx#ref-fact-statement-tx)). 35 | 36 | ## Garbage collecting obsolete Fact Statements 37 | 38 | The successful result of this operation is a [Fact Statement Garbage Collecting transaction](02-plutus-protocol.md#gc-fact-statement-tx). 39 | 40 | The `Submitter` approaches the [COOP Publisher gRPC](../coop-proto/publisher-service.proto) service with a Fact Statement identifier that is published in a [Fact Statement UTxO](02-plutus-protocol.md#fs-validator). 41 | 42 | The `Submitter` provides the desired Fact Statement IDs they want garbage collected, along with the public key hash of the `Submitter` wallet that submitted the [Fact Statement Publishing](02-plutus-protocol.md#mint-fact-statement-tx) transaction. 43 | 44 | ```mermaid 45 | sequenceDiagram 46 | title Successfully garbage collect a single obsolete Fact Statement 47 | actor cardano as Cardano 48 | actor submitterWallet as Submitter's wallet 49 | actor submitter as Submitter 50 | actor publisher as COOP Publisher gRPC 51 | 52 | submitter ->>+ publisher: Publisher.createGcFsTx([(fs_id, submitter_pkh)]) 53 | note right of publisher: Publisher successfully services the request 54 | publisher -->>- submitter: gc_fs_tx 55 | submitter ->>+ submitterWallet: sign(gc_fs_tx) 56 | submitterWallet -->>- submitter: gc_fs_tx_signed 57 | submitter ->>+ cardano: submit(gc_fs_tx_signed) 58 | cardano -->>- submitter: gc_fs_tx_id 59 | ``` 60 | 61 | The service, if successful, responds with the CBOR+base16 encoded Cardano transaction that can be further signed by the `Submitter` and sent to the network (see [gc-fact-statement-tx](02-plutus-protocol.md#gc-fact-statement-tx)). 62 | 63 | > The Submitter can only garbage collect [Fact Statement UTxOs](02-plutus-protocol.md#fs-validator) that they themselves created with the [Fact Statement Publishing](02-plutus-protocol.md#mint-fact-statement-tx) transaction. 64 | -------------------------------------------------------------------------------- /coop-docs/04-backend-protocol.md: -------------------------------------------------------------------------------- 1 | # COOP Backend protocol 2 | 3 | This document contains information on the back-end operations needed to serve the [Frontend protocol](03-frontend-protocol.md). 4 | 5 | ## Publishing a Fact Statement 6 | 7 | The successful result of this operation is a [Fact Statement Publishing transaction](02-plutus-protocol.md#mins-fact-statement-tx). 8 | 9 | The [COOP Publisher gRPC](../coop-proto/publisher-service.proto) service starts off by looking up the requests Fact Statement IDs in the [COOP FactStatementStore gRPC](../coop-proto/fact-statement-store-service.proto) service. 10 | This service provides the [PlutusData](https://github.com/input-output-hk/plutus/blob/master/plutus-core/plutus-core/src/PlutusCore/Data.hs#L40) encoding of the requested Fact Statements, and this representation format is what gets included in the [Fact Statement UTxOs]([Fact Statement UTxOs](02-plutus-protocol.md#fs-validator)) directly, which makes it possible for Consumer dApps to reference and intepret the information held within. 11 | We provide a [JSON Fact Statement Store](../coop-extras/json-fact-statement-store) implementation of the [COOP FactStatementStore gRPC](../coop-proto/fact-statement-store-service.proto) service which can serve as a convenient low-scale backend that maintains JSON encoded Fact Statements. 12 | This service uses a [Plutus Json](../coop-extras/plutus-json) canonical mapping library between the JSON and [PlutusData](https://github.com/input-output-hk/plutus/blob/master/plutus-core/plutus-core/src/PlutusCore/Data.hs#L40) data representation formats. 13 | 14 | ```mermaid 15 | sequenceDiagram 16 | title Successfully service a Fact Statement Publishing request 17 | actor publisher as COOP Publisher gRPC 18 | actor fsStore as COOP FactStatementStore gRPC 19 | actor pab as COOP TxBuilder gRPC 20 | actor cardano as Cardano 21 | actor authenticator as Authenticator wallet 22 | 23 | note right of publisher: Servicing createMintFsTx request with (fs_id, submitter_pkh) 24 | publisher ->>+ fsStore: FactStatementStore.getFactStatement(fs_id) 25 | note right of fsStore: Looks for Fact Statements managed by an Oracle 26 | fsStore -->>- publisher: fact_statement_pd 27 | 28 | publisher ->>+ pab: TxBuilder.createMintFsTx(fact_statement_pd, fs_id, submitter_pkh) 29 | pab ->>+ cardano: Get information about the Submitter, existing Fact Statements, Certificates and Authentication tokens 30 | cardano -->>- pab: (Submitter Collateral and Fee UTxOs, Authenticator and Certificate UTxOs) 31 | pab ->>+ authenticator: sign(signed_mint_fs_tx) 32 | authenticator -->>- pab: signed_mint_fs_tx 33 | pab -->>- publisher: signed_mint_fs_tx 34 | 35 | 36 | note right of publisher: Replying with signed_mint_fs_tx 37 | ``` 38 | 39 | The [COOP TxBuilder gRPC](../coop-proto/tx-builder-service.proto) service is the only component that talks to the Cardano network. 40 | It does so exclusively to discover information necessary to build a transaction: 41 | 42 | - [Fact Statement UTxOs](02-plutus-protocol.md#fs-validator) for asserting which of the Fact Statements have already been published, 43 | - [Collateral UTxOs](https://docs.cardano.org/plutus/collateral-mechanism) at the `Submitter` wallet, 44 | - [Fee UTxOs](02-plutus-protocol.md#fee-token) at the `Submitter` wallet, 45 | - [Authentication UTxOs](02-plutus-protocol.md#auth-token) at the [Authenticator wallet](02-plutus-protocol.md#authenticator), 46 | - [Certificate UTxOs](02-plutus-protocol.md#cert-token) for asserting the validity of the provided [Authentication tokens](02-plutus-protocol.md#auth-token). 47 | 48 | [Authenticator wallets](02-plutus-protocol.md#authenticator) provide their own signatures to the [Fact Statement Publishing transaction](02-plutus-protocol.md#mins-fact-statement-tx) to authenticate the spending of the [Authentication tokens](02-plutus-protocol.md#auth-token). 49 | 50 | ## Garbage collecting obsolete Fact Statements 51 | 52 | The successful result of this operation is a [Fact Statement Garbage Collecting transaction](02-plutus-protocol.md#gc-fact-statement-tx). 53 | 54 | ```mermaid 55 | sequenceDiagram 56 | title Successfully service a Fact Statement Garbage Collection request 57 | actor publisher as COOP Publisher gRPC 58 | actor pab as TxBuilder gRPC 59 | actor cardano as Cardano 60 | note right of publisher: Servicing createGcFsTx request with (fs_id, submitter_pkh) 61 | 62 | publisher ->>+ pab: TxBuilder.createGcFsTx(fs_id, submitter_pkh) 63 | pab ->>+ cardano: Get information about the Submitter and Fact Statements 64 | cardano -->>- pab: (Submitter Collateral and Fact Statement UTxOs) 65 | pab -->>- publisher: gc_fs_tx 66 | 67 | 68 | note right of publisher: Replying with gc_fs_tx 69 | ``` 70 | 71 | The [COOP TxBuilder gRPC](../coop-proto/tx-builder-service.proto) service is the only component that talks to the Cardano network. 72 | It does so exclusively to discover information necessary to build a transaction: 73 | 74 | - [Fact Statement UTxOs](02-plutus-protocol.md#fs-validator) for asserting which of the Fact Statements are indeed obsolete and can be garbage collected, 75 | - [Collateral UTxOs](https://docs.cardano.org/plutus/collateral-mechanism) at the `Submitter` wallet. 76 | -------------------------------------------------------------------------------- /coop-docs/05-json-plutus.md: -------------------------------------------------------------------------------- 1 | # Reversible embedding from JSON to Plutus Data 2 | 3 | Publishers would like to store and provide their Fact Statements in JSON format 4 | ([ECMA-404](https://www.ecma-international.org/publications-and-standards/standards/ecma-404/)), 5 | but the Cardano Ledger ([Alonzo 6 | CDDL](https://github.com/input-output-hk/cardano-ledger/blob/master/eras/alonzo/test-suite/cddl-files/alonzo.cddl)) 7 | requires utxo datums to be serialized in the Plutus Data format 8 | ([PlutusCore.Data](https://github.com/input-output-hk/plutus/blob/master/plutus-core/plutus-core/src/PlutusCore/Data.hs)). 9 | 10 | In the COOP framework, we have adopted the following reversible embedding from 11 | JSON values to Plutus Data values. This embedding allows any JSON value to be 12 | converted into a Plutus Data value and allows the converted value to be 13 | converted back to the original JSON value. However, not all Plutus Data values 14 | can be converted to JSON by the embedding -- this is fine because the intended 15 | use for the embedding is to convert JSON to Plutus Data, publish the Plutus Data 16 | on the Cardano blockchain, read the Plutus Data from the Cardano blockchain, and 17 | convert it back to the original JSON. 18 | 19 | A JSON value can be of any of the following: 20 | 21 | - **Object** -- a collection of zero or more name-value pairs. Names must be 22 | strings, while values can be of any JSON type. 23 | - **Array** -- a sequence of zero or more values. 24 | - **Number** -- a floating-point number, excluding any numbers that cannot be 25 | represented using digits (e.g. Infinity and NaN). 26 | - **String** -- a sequence of UTF-8 code points. 27 | - **`true`** 28 | - **`false`** 29 | - **`null`** 30 | 31 | A Plutus Data value can be any of the following: 32 | 33 | - **Constructor** -- an integer-tagged sequence of values. This is intended to 34 | be used to represent sum types, which are types that provide multiple possible 35 | options for their values and use a different tag for each option. For example, 36 | the result of a fallible numeric calculation can be represented as either a 37 | textual description of an error or a numeric correct result of the 38 | calculation. 39 | - **Map** -- a collection of zero or more value-value pairs. 40 | - **List** -- a sequence of zero or more values. 41 | - **Integer** -- a whole number than can be zero (0), positive (1, 2, 3, ...), 42 | or negative (-1, -2, -3, ...). 43 | - **Bytestring** -- a sequence of bytes. 44 | 45 | A JSON value can be converted to a Plutus Data value as follows: 46 | 47 | - A JSON **Object** is converted into a Plutus Data **Map**. For each name-value 48 | pair in the JSON Object, the name (a JSON String) is converted into a Plutus 49 | Data Bytestring and the value is converted into a corresponding Plutus Data 50 | value. 51 | - A JSON **Array** is converted into a Plutus Data **List**. Each value in the 52 | JSON Array is converted into a corresponding Plutus Data value. 53 | - A JSON **Number** is converted into either a Plutus Data **Integer** or a 54 | Plutus Data **Constructor**: 55 | - If the JSON Number can be safely converted into an integer without rounding, 56 | then it is converted into a Plutus Data Integer. 57 | - Otherwise, the JSON Number is converted into a Plutus Data Constructor 58 | tagged by the integer `3`. The JSON Number's significand is placed as a 59 | Plutus Data Integer into the first position of the Constructor, and the JSON 60 | Number's base-10 exponent is place as a Plutus Data Integer into the second 61 | position. 62 | - A JSON **String** is converted into a Plutus Data **Bytestring** by encoding 63 | the sequence of UTF-8 code points into a sequence of bytes. 64 | - A JSON **`true`** value is converted into a Plutus Data **Constructor** tagged 65 | by the integer **`1`**, with an empty sequence of values. 66 | - A JSON **`false`** value is converted into a Plutus Data **Constructor** 67 | tagged by the integer **`0`**, with an empty sequence of values. 68 | - A JSON **`null`** value is converted into a Plutus Data **Constructor** tagged 69 | by the integer **`2`**, with an empty sequence of values. 70 | 71 | A Plutus Data value that was derived via the embedding from a JSON value can 72 | always be converted back to that JSON value: 73 | 74 | - A Plutus Data **Constructor** is converted into a corresponding JSON value 75 | based on its integer tag: 76 | - If the tag is **`0`**, then it is converted into a JSON **`false`** value. 77 | - If the tag is **`1`**, then it is converted into a JSON **`true`** value. 78 | - If the tag is **`2`**, then it is converted into a JSON **`null`** value. 79 | - If the tag is **`3`**, then a JSON **Number** is constructed using the 80 | significand in the Constructor's first position and the base-10 exponent in 81 | the Constructor's second position. 82 | - A Plutus Data **Map** is converted into a JSON **Object**. For each 83 | value-value pair in the Plutus Data Map, the first value is converted into a 84 | JSON String and the second value is converted into a corresponding JSON value. 85 | - A Plutus Data **List** is converted into a JSON **Array**. Each value in the 86 | Plutus Data List is converted into a corresponding JSON value. 87 | - A Plutus Data **Integer** is converted into a JSON **Number**, with the 88 | base-10 exponent set to 0. 89 | - A Plutus Data **Bytestring** is converted into a JSON **String** by decoding 90 | the sequence of bytes into a sequence of UTF-8 code points. 91 | 92 | The conversion into JSON will fail for the following Plutus Data values: 93 | 94 | - A Plutus Data **Constructor** tagged by a different integer than 0, 1, 2, or 95 | 3. 96 | - A Plutus Data **Constructor** tagged by the integer 3 that does not contain 97 | exactly two Plutus Data Integers in its sequence of values. 98 | - A Plutus Data **Map** that contains a value-value pair whose first value 99 | cannot be converted into a JSON String. 100 | - A Plutus Data **Bytestring** that cannot be decoded into a sequence of UTF-8 101 | code points. 102 | -------------------------------------------------------------------------------- /coop-docs/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, markdownlint-cli, shellHook }: 2 | pkgs.mkShell { 3 | name = "docs-env"; 4 | 5 | packages = [ markdownlint-cli ]; 6 | 7 | shellHook = '' 8 | cd docs 9 | ${shellHook} 10 | ''; 11 | } 12 | -------------------------------------------------------------------------------- /coop-docs/images/coop-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mlabs-haskell/cardano-open-oracle-protocol/5f8f97e1b8ba35f60e0dae44d0bd79560c96aacf/coop-docs/images/coop-logo.png -------------------------------------------------------------------------------- /coop-extras/coop-env/.envrc: -------------------------------------------------------------------------------- 1 | use flake ../../#dev-tutorial 2 | -------------------------------------------------------------------------------- /coop-extras/coop-env/aux.bash: -------------------------------------------------------------------------------- 1 | # shellcheck disable=SC2085,SC2155,SC2002,SC2003,SC2086 2 | JS_STORE_DIR=.json-fs-store 3 | COOP_PAB_DIR=.coop-pab-cli 4 | COOP_PUBLISHER_DIR=.coop-publisher-cli 5 | CLUSTER_DIR=.local-cluster # As specified in resources/pabConfig.yaml 6 | 7 | WALLETS=.wallets 8 | 9 | RESOURCES=resources # Symlinked by Nix env 10 | COOP_PROTO=coop-proto # Symlinked by Nix env 11 | 12 | function clean { 13 | rm -fR $JS_STORE_DIR 14 | rm -fR $COOP_PAB_DIR 15 | rm -fR $COOP_PUBLISHER_DIR 16 | rm -fR $CLUSTER_DIR 17 | rm -fR $WALLETS 18 | } 19 | 20 | # Generate TLS keys for Publisher, FactStatementStore and TxBuilder services 21 | function generate-keys { 22 | openssl genrsa -out $1/key.pem 2048 23 | openssl req -new -key $1/key.pem -out $1/certificate.csr -subj "/C=US/ST=st/L=l/O=o/OU=IT/CN=localhost" 24 | openssl x509 -req -in $1/certificate.csr -signkey $1/key.pem -out $1/certificate.pem -extfile $RESOURCES/ssl-extensions-x509.conf -extensions v3_ca -subj "/C=US/ST=st/L=l/O=o/OU=IT/CN=localhost" 25 | openssl x509 -text -in $1/certificate.pem 26 | } 27 | 28 | # Prelude and run the FactStatementStore gRpc with a generic Json implementation 29 | function run-js-fs-store { 30 | mkdir $JS_STORE_DIR 31 | sqlite3 -batch $JS_STORE_DIR/json-store.db "" 32 | json-fs-store-cli genesis --db $JS_STORE_DIR/json-store.db 33 | json-fs-store-cli insert-fact-statement --db $JS_STORE_DIR/json-store.db --fact_statement_id "someidA" --json "[1,2,3]" 34 | json-fs-store-cli insert-fact-statement --db $JS_STORE_DIR/json-store.db --fact_statement_id "someidB" --json "[4,5,6]" 35 | json-fs-store-cli insert-fact-statement --db $JS_STORE_DIR/json-store.db --fact_statement_id "someidC" --json "[7,8,9]" 36 | echo "SELECT * FROM fact_statements" | sqlite3 $JS_STORE_DIR/json-store.db 37 | generate-keys $JS_STORE_DIR 38 | json-fs-store-cli fact-statement-store-grpc --db $JS_STORE_DIR/json-store.db 39 | } 40 | 41 | # Prelude and run the Plutip Local Cluster (cardano-node and wallet creation) 42 | function run-cluster { 43 | mkdir $CLUSTER_DIR 44 | mkdir $CLUSTER_DIR/scripts 45 | mkdir $CLUSTER_DIR/txs 46 | mkdir $WALLETS 47 | local-cluster --dump-info-json $CLUSTER_DIR/local-cluster-info.json \ 48 | --wallet-dir $WALLETS \ 49 | -n 10 --utxos 5 \ 50 | --chain-index-port 9084 \ 51 | --slot-len 1s --epoch-size 100000 52 | } 53 | 54 | function on-load { 55 | if [ -f $CLUSTER_DIR/local-cluster-info.json ]; then 56 | make-exports 57 | if [ -f $WALLETS/signing-key-"$SUBMITTER_PKH".skey ]; then 58 | mv $WALLETS/signing-key-"$SUBMITTER_PKH".skey $WALLETS/my-signing-key-"$SUBMITTER_PKH".skey 59 | fi 60 | fi; 61 | } 62 | 63 | # Export the variables used across 64 | function make-exports { 65 | export GOD_PKH=$(cat $CLUSTER_DIR/local-cluster-info.json | jq -r ".ciWallets[0][0]") 66 | export AA_PKH=$(cat $CLUSTER_DIR/local-cluster-info.json | jq -r ".ciWallets[1][0]") 67 | export AUTH_PKH=$(cat $CLUSTER_DIR/local-cluster-info.json | jq -r ".ciWallets[2][0]") 68 | export CERT_RDMR_PKH=$(cat $CLUSTER_DIR/local-cluster-info.json | jq -r ".ciWallets[3][0]") 69 | export FEE_PKH=$(cat $CLUSTER_DIR/local-cluster-info.json | jq -r ".ciWallets[4][0]") 70 | export SUBMITTER_PKH=$(cat $CLUSTER_DIR/local-cluster-info.json | jq -r ".ciWallets[5][0]") 71 | export CARDANO_NODE_SOCKET_PATH=$(cat $CLUSTER_DIR/local-cluster-info.json | jq -r ".ciNodeSocket") 72 | } 73 | 74 | # Prelude and run the TxBuilder gRpc 75 | function run-tx-builder { 76 | make-exports 77 | coop-genesis 78 | coop-mint-cert-redeemers 79 | coop-mint-authentication 80 | coop-redist-auth 81 | generate-keys $COOP_PAB_DIR 82 | coop-run-tx-builder-grpc 83 | } 84 | 85 | function coop-genesis { 86 | mkdir $COOP_PAB_DIR 87 | coop-pab-cli deploy --god-wallet $GOD_PKH --aa-wallet $AA_PKH 88 | } 89 | 90 | function coop-mint-cert-redeemers { 91 | coop-pab-cli mint-cert-redeemers --cert-rdmr-wallet $CERT_RDMR_PKH --cert-rdmrs-to-mint 100 92 | } 93 | 94 | function coop-mint-authentication { 95 | NOW=$(get-onchain-time) && coop-pab-cli mint-auth --aa-wallet $AA_PKH --certificate-valid-from $NOW --certificate-valid-to "$(expr $NOW + 60 \* 60 \* 1000)" --auth-wallet $AUTH_PKH 96 | } 97 | 98 | function coop-redist-auth { 99 | coop-pab-cli redistribute-auth --auth-wallet $AUTH_PKH 100 | } 101 | 102 | function coop-run-tx-builder-grpc { 103 | coop-pab-cli tx-builder-grpc --auth-wallet $AUTH_PKH --fee-wallet $FEE_PKH 104 | } 105 | 106 | function show-env { 107 | export | grep -E "([A-Z_]+)_PKH|CARDANO_NODE_SOCKET_PATH" 108 | } 109 | 110 | function coop-garbage-collect { 111 | coop-pab-cli garbage-collect --cert-rdmr-wallet $CERT_RDMR_PKH 112 | } 113 | 114 | function coop-get-state { 115 | coop-pab-cli get-state --any-wallet $GOD_PKH 116 | cat $COOP_PAB_DIR/coop-state.json | jq 117 | } 118 | 119 | function coop-poll-state { 120 | while true; do 121 | clear; 122 | coop-get-state; 123 | sleep 5; 124 | done; 125 | } 126 | 127 | function fs-store-insert { 128 | json-fs-store-cli insert-fact-statement --db $JS_STORE_DIR/json-store.db --fact_statement_id "$1" --json "$2" 129 | } 130 | 131 | function get-onchain-time { 132 | coop-pab-cli get-state --any-wallet $GOD_PKH | grep "Current node client time range" | grep POSIXTime | grep -E -o "[0-9]+" 133 | } 134 | 135 | function run-grpcui { 136 | grpcui -insecure -import-path $COOP_PROTO -proto $COOP_PROTO/publisher-service.proto localhost:5080 137 | } 138 | 139 | function run-publisher { 140 | mkdir $COOP_PUBLISHER_DIR 141 | generate-keys $COOP_PUBLISHER_DIR 142 | make-exports 143 | coop-publisher-cli publisher-grpc 144 | } 145 | 146 | function run-all { 147 | run-cluster & 148 | while [ ! -f $CLUSTER_DIR/local-cluster-info.json ]; do sleep 1; done; 149 | make-exports 150 | mv $WALLETS/signing-key-"$SUBMITTER_PKH".skey $WALLETS/my-signing-key-"$SUBMITTER_PKH".skey 151 | run-js-fs-store & 152 | run-tx-builder & 153 | run-publisher & 154 | } 155 | 156 | function coop-mint-fs { 157 | make-exports 158 | req=$(cat < $COOP_PUBLISHER_DIR/signed 191 | if [ "$(echo $resp | jq "has(\"mintFsTx\")")" == true ]; then 192 | cardano-cli transaction sign --tx-file $COOP_PUBLISHER_DIR/signed --signing-key-file $WALLETS/my-signing-key-"$SUBMITTER_PKH".skey --out-file $COOP_PUBLISHER_DIR/ready 193 | cardano-cli transaction submit --tx-file $COOP_PUBLISHER_DIR/ready --mainnet 194 | else 195 | echo "No transaction to submit" 196 | fi 197 | } 198 | 199 | function coop-gc-fs { 200 | make-exports 201 | req=$(cat < $COOP_PUBLISHER_DIR/signed 222 | if [ "$(echo $resp | jq "has(\"gcFsTx\")")" == true ]; then 223 | cardano-cli transaction sign --tx-body-file $COOP_PUBLISHER_DIR/signed --signing-key-file $WALLETS/my-signing-key-"$SUBMITTER_PKH".skey --out-file $COOP_PUBLISHER_DIR/ready 224 | cardano-cli transaction submit --tx-file $COOP_PUBLISHER_DIR/ready --mainnet 225 | else 226 | echo "No transaction to submit" 227 | fi 228 | } 229 | -------------------------------------------------------------------------------- /coop-extras/coop-env/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs 2 | , cardanoCli 3 | , cardanoNode 4 | , chainIndex 5 | , plutipLocalCluster 6 | , coopClis 7 | }: 8 | pkgs.mkShell { 9 | packages = with pkgs; [ 10 | jq 11 | sqlite 12 | protobuf 13 | protoc-gen-grpc-web 14 | haskellPackages.proto-lens-protoc 15 | nodePackages.npm 16 | nodejs 17 | grpcui 18 | grpcurl 19 | chainIndex 20 | cardanoCli 21 | cardanoNode 22 | plutipLocalCluster 23 | ] ++ builtins.attrValues coopClis; 24 | shellHook = '' 25 | echo "Making proto and resources symlinks" 26 | rm -f coop-proto 27 | ln -s ${../../coop-proto} coop-proto 28 | rm -f resources 29 | ln -s ${../../coop-pab/resources} resources 30 | echo "Sourcing ${./aux.bash}" 31 | . ${./aux.bash} 32 | echo "Running on-load" 33 | on-load 34 | # WARN(bladyjoker): Running COOP services requires having $ export LC_CTYPE=C.UTF-8 LC_ALL=C.UTF-8 LANG=C.UTF-8 35 | echo "Exporting locale" 36 | export LC_CTYPE=C.UTF-8 37 | export LC_ALL=C.UTF-8 38 | export LANG=C.UTF-8 39 | export PS1='\[\e[0m\][\[\e[0;1;38;5;142m\]coop-env \[\e[0m\]~ \[\e[0m\]\W\[\e[0m\]] \[\e[0m\]\$ \[\e[0m\]' 40 | echo "Done" 41 | ''; 42 | } 43 | -------------------------------------------------------------------------------- /coop-extras/coop-env/coop-proto: -------------------------------------------------------------------------------- 1 | /nix/store/6fkdhxfxc6x0di3nrz2zyi0ihcx2s094-coop-proto -------------------------------------------------------------------------------- /coop-extras/coop-env/resources: -------------------------------------------------------------------------------- 1 | /nix/store/p02c25p0vpz52sha6n9aispkd996ydgq-resources -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/.envrc: -------------------------------------------------------------------------------- 1 | use flake ../../#dev-extras-json-store 2 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for json-fact-statement-store 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/Makefile: -------------------------------------------------------------------------------- 1 | generate-keys: 2 | openssl genrsa -out .json-fs-store/key.pem 2048 3 | openssl req -new -key .json-fs-store/key.pem -out .json-fs-store/certificate.csr 4 | openssl x509 -req -in .json-fs-store/certificate.csr -signkey .json-fs-store/key.pem -out .json-fs-store/certificate.pem -extfile ./resources/ssl-extensions-x509.conf -extensions v3_ca 5 | openssl x509 -text -in .json-fs-store/certificate.pem 6 | 7 | genesis: 8 | rm .json-fs-store/json-store.db || true 9 | sqlite3 -batch .json-fs-store/json-store.db "" 10 | cabal run json-fs-store-cli -- genesis --db .json-fs-store/json-store.db 11 | 12 | serve: 13 | cabal run json-fs-store-cli -- fact-statement-store-grpc --db .json-fs-store/json-store.db 14 | 15 | insert: 16 | cabal run json-fs-store-cli -- insert-fact-statement --db .json-fs-store/json-store.db --fact_statement_id "someidA" --json "[1,2,3]" 17 | cabal run json-fs-store-cli -- insert-fact-statement --db .json-fs-store/json-store.db --fact_statement_id "someidB" --json "[1,2,3]" 18 | cabal run json-fs-store-cli -- insert-fact-statement --db .json-fs-store/json-store.db --fact_statement_id "someidC" --json "[1,2,3]" 19 | 20 | showdb: 21 | echo "SELECT * FROM fact_statements" | sqlite3 .json-fs-store/json-store.db 22 | 23 | test-grpc: 24 | grpcurl -vv -servername localhost:5081 -insecure -import-path ../../coop-proto -proto ../../coop-proto/fact-statement-store-service.proto -d '{"fsIds": [{ "value": "c29tZWlkQQ==" }, { "value": "c29tZWlkQg==" }, { "value": "c29tZWlkQw==" }]}' localhost:5082 coop.FactStatementStore/getFactStatement 25 | 26 | run-grpcui: 27 | grpcui -insecure -import-path ../../coop-proto -proto ../../coop-proto/fact-statement-store-service.proto localhost:5082 28 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/app/BeamConfig.hs: -------------------------------------------------------------------------------- 1 | -- | Beam definitions and wiring 2 | module BeamConfig (fsStoreSettings, FactStatementT (..), FsStore (fsTbl), factStatementsCreateTable) where 3 | 4 | import Data.ByteString (ByteString) 5 | import Database.Beam (Beamable, Columnar, Database, DatabaseSettings, Generic, Table (PrimaryKey, primaryKey), TableEntity, dbModification, defaultDbSettings, fieldNamed, modifyTableFields, setEntityName, tableModification, withDbModification) 6 | 7 | data FactStatementT f = FactStatement 8 | { _factStatementId :: Columnar f ByteString 9 | , _json :: Columnar f ByteString 10 | } 11 | deriving stock (Generic) 12 | 13 | instance Beamable FactStatementT 14 | 15 | instance Table FactStatementT where 16 | data PrimaryKey FactStatementT f = FsId (Columnar f ByteString) 17 | deriving stock (Generic) 18 | deriving anyclass (Beamable) 19 | primaryKey = FsId . _factStatementId 20 | 21 | newtype FsStore f = FsStore 22 | {fsTbl :: f (TableEntity FactStatementT)} 23 | deriving stock (Generic) 24 | deriving anyclass (Database be) 25 | 26 | fsStoreSettings :: DatabaseSettings be FsStore 27 | fsStoreSettings = 28 | defaultDbSettings 29 | `withDbModification` dbModification 30 | { fsTbl = 31 | setEntityName "fact_statements" 32 | <> modifyTableFields 33 | tableModification 34 | { _factStatementId = fieldNamed "fact_statement_id" 35 | , _json = fieldNamed "json" 36 | } 37 | } 38 | 39 | factStatementsCreateTable :: String 40 | factStatementsCreateTable = "CREATE TABLE fact_statements (fact_statement_id BLOB NOT NULL, json BLOB NOT NULL, PRIMARY KEY( fact_statement_id ))" 41 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/app/FactStatementStoreGrpc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BlockArguments #-} 2 | {-# OPTIONS_GHC -Wno-missing-import-lists #-} 3 | 4 | module FactStatementStoreGrpc (factStatementStoreService, FactStatementStoreGrpcOpts (FactStatementStoreGrpcOpts)) where 5 | 6 | import BeamConfig (FactStatementT (_factStatementId, _json), FsStore (fsTbl), fsStoreSettings) 7 | import Cardano.Proto.Aux () 8 | import Control.Lens (makeLenses, (&), (.~), (^.)) 9 | import Data.Aeson (json) 10 | import Data.Aeson.Parser (decodeStrictWith) 11 | import Data.Functor.Identity (Identity) 12 | import Data.List (nub) 13 | import Data.ProtoLens (Message (defMessage)) 14 | import Data.String (IsString (fromString)) 15 | import Data.Text (Text) 16 | import Data.Text qualified as Text 17 | import Data.Traversable (for) 18 | import Database.Beam (SqlValable (val_), runSelectReturningOne) 19 | import Database.Beam.Query (SqlEq ((==.)), all_, filter_, select) 20 | import Database.Beam.Sqlite (runBeamSqliteDebug) 21 | import Database.SQLite.Simple (open) 22 | import Network.GRPC.HTTP2.Encoding as Encoding ( 23 | gzip, 24 | uncompressed, 25 | ) 26 | import Network.GRPC.HTTP2.ProtoLens (RPC (RPC)) 27 | import Network.GRPC.Server as Server ( 28 | ServiceHandler, 29 | UnaryHandler, 30 | runGrpc, 31 | unary, 32 | ) 33 | import Network.Wai.Handler.Warp qualified as Warp 34 | import Network.Wai.Handler.WarpTLS (tlsSettings) 35 | import PlutusJson (jsonToPlutusData) 36 | import PlutusTx (fromData) 37 | import Proto.FactStatementStoreService (FactStatementStore, GetFactStatementRequest, GetFactStatementResponse, Success'FsIdAndPlutus) 38 | import Proto.FactStatementStoreService_Fields (error, fsId, fsIds, fsIdsWithPlutus, msg, otherErr, plutusData, success) 39 | import Prelude hiding (error, succ) 40 | 41 | data FactStatementStoreGrpcOpts = FactStatementStoreGrpcOpts 42 | { _db :: FilePath 43 | , _grpcAddress :: String 44 | , _grpcPort :: Int 45 | , _tlsCertFile :: FilePath 46 | , _tlsKeyFile :: FilePath 47 | } 48 | deriving stock (Show, Eq) 49 | 50 | makeLenses ''FactStatementStoreGrpcOpts 51 | 52 | factStatementStoreService :: FactStatementStoreGrpcOpts -> IO () 53 | factStatementStoreService opts = do 54 | let routes :: [ServiceHandler] 55 | routes = 56 | [Server.unary (RPC :: RPC FactStatementStore "getFactStatement") (handleReq $ opts ^. db)] 57 | 58 | runServer 59 | routes 60 | (fromString $ opts ^. grpcAddress, opts ^. grpcPort) 61 | (opts ^. tlsCertFile, opts ^. tlsKeyFile) 62 | 63 | runServer :: [ServiceHandler] -> (Warp.HostPreference, Int) -> (FilePath, FilePath) -> IO () 64 | runServer routes (h, p) (certFile, keyFile) = do 65 | let warpSettings = 66 | Warp.defaultSettings 67 | & Warp.setPort p 68 | & Warp.setHost h 69 | Server.runGrpc 70 | (tlsSettings certFile keyFile) 71 | warpSettings 72 | routes 73 | [ Encoding.uncompressed 74 | , Encoding.gzip 75 | ] 76 | 77 | type FsT = FactStatementT Identity 78 | 79 | handleReq :: FilePath -> Server.UnaryHandler IO GetFactStatementRequest GetFactStatementResponse 80 | handleReq dbPath _ req = do 81 | putStrLn $ "Establishing the database connection to: " <> dbPath 82 | fsDb <- open dbPath 83 | let fsTbl' = fsTbl fsStoreSettings 84 | ids = nub $ req ^. fsIds 85 | 86 | idsWithRes :: [Either Text Success'FsIdAndPlutus] <- 87 | for 88 | ids 89 | ( \i -> do 90 | (mayFsT :: Maybe FsT) <- runBeamSqliteDebug Prelude.putStrLn fsDb $ runSelectReturningOne (select $ filter_ (\fs -> _factStatementId fs ==. val_ i) (all_ fsTbl')) 91 | maybe 92 | (return (Left $ Text.pack "Not found requested Fact Statement with ID " <> (Text.pack . show $ i))) 93 | ( \fs -> do 94 | let maySucc :: Maybe Success'FsIdAndPlutus = do 95 | decoded <- decodeStrictWith json return (_json @Identity $ fs) 96 | let plData = jsonToPlutusData decoded 97 | prData <- fromData plData 98 | return $ 99 | defMessage 100 | & fsId .~ _factStatementId @Identity fs 101 | & plutusData .~ prData 102 | 103 | maybe (return (Left $ Text.pack "Failed formatting to PlutusData for Fact Statement with ID: " <> (Text.pack . show $ i))) (return . Right) maySucc 104 | ) 105 | mayFsT 106 | ) 107 | 108 | -- If any contains an error report that 109 | let allSuccOrErr = sequence idsWithRes 110 | return $ 111 | either 112 | (\err -> defMessage & error . otherErr . msg .~ err) 113 | (\succ -> defMessage & success . fsIdsWithPlutus .~ succ) 114 | allSuccOrErr 115 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/app/Genesis.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BlockArguments #-} 2 | 3 | module Genesis (genesis, GenesisOpts (GenesisOpts)) where 4 | 5 | import BeamConfig (factStatementsCreateTable) 6 | import Cardano.Proto.Aux () 7 | import Control.Lens (makeLenses, (^.)) 8 | import Data.String (IsString (fromString)) 9 | import Database.SQLite.Simple (execute_, open) 10 | 11 | newtype GenesisOpts = GenesisOpts 12 | { _db :: FilePath 13 | } 14 | deriving stock (Show, Eq) 15 | 16 | makeLenses ''GenesisOpts 17 | 18 | genesis :: GenesisOpts -> IO () 19 | genesis opts = do 20 | conn <- open (opts ^. db) 21 | execute_ conn (fromString factStatementsCreateTable) 22 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/app/InsertFs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BlockArguments #-} 2 | 3 | module InsertFs (insertFs, InsertFsOpts (InsertFsOpts)) where 4 | 5 | import BeamConfig (FactStatementT (FactStatement), FsStore (fsTbl), fsStoreSettings) 6 | import Cardano.Proto.Aux () 7 | import Control.Lens (makeLenses, (^.)) 8 | import Data.Functor.Identity (Identity) 9 | import Data.Text (Text) 10 | import Data.Text.Encoding (encodeUtf8) 11 | import Database.Beam.Query (insert, insertValues, runInsert) 12 | import Database.Beam.Sqlite (runBeamSqliteDebug) 13 | import Database.SQLite.Simple (open) 14 | 15 | data InsertFsOpts = InsertFsOpts 16 | { _db :: FilePath 17 | , _fsId :: Text 18 | , _json :: Text 19 | } 20 | deriving stock (Show, Eq) 21 | 22 | makeLenses ''InsertFsOpts 23 | 24 | insertFs :: InsertFsOpts -> IO () 25 | insertFs opts = do 26 | conn <- open (opts ^. db) 27 | runBeamSqliteDebug putStrLn conn $ do 28 | runInsert $ 29 | insert (fsTbl fsStoreSettings) $ 30 | insertValues 31 | [ FactStatement (encodeUtf8 (opts ^. fsId)) (encodeUtf8 (opts ^. json)) :: FactStatementT Identity 32 | ] 33 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Control.Applicative ((<**>)) 4 | import FactStatementStoreGrpc (FactStatementStoreGrpcOpts (FactStatementStoreGrpcOpts), factStatementStoreService) 5 | import Genesis (GenesisOpts (GenesisOpts), genesis) 6 | import InsertFs (InsertFsOpts (InsertFsOpts), insertFs) 7 | import Options.Applicative ( 8 | Parser, 9 | ParserInfo, 10 | auto, 11 | command, 12 | customExecParser, 13 | fullDesc, 14 | help, 15 | helper, 16 | info, 17 | long, 18 | metavar, 19 | option, 20 | prefs, 21 | progDesc, 22 | showDefault, 23 | showHelpOnEmpty, 24 | showHelpOnError, 25 | strOption, 26 | subparser, 27 | value, 28 | ) 29 | 30 | data Command 31 | = Genesis GenesisOpts 32 | | FactStatementStoreGrpc FactStatementStoreGrpcOpts 33 | | InsertFs InsertFsOpts 34 | 35 | dbOpt :: Parser [Char] 36 | dbOpt = 37 | strOption 38 | ( long "db" 39 | <> metavar "DB" 40 | <> help "SQLite database file location" 41 | <> value ".json-fs-store/json-store.db" 42 | <> showDefault 43 | ) 44 | 45 | genesisOpts :: Parser GenesisOpts 46 | genesisOpts = 47 | GenesisOpts <$> dbOpt 48 | 49 | fsStoreGrpcOpts :: Parser FactStatementStoreGrpcOpts 50 | fsStoreGrpcOpts = 51 | FactStatementStoreGrpcOpts 52 | <$> dbOpt 53 | <*> strOption 54 | ( long "address" 55 | <> metavar "ADDR" 56 | <> help "Local IP address or host name to bing the FactStatementStore gRpc service to" 57 | <> value "localhost" 58 | <> showDefault 59 | ) 60 | <*> option 61 | auto 62 | ( long "port" 63 | <> metavar "PORT" 64 | <> help "TCP port to bind the FactStatementStore gRpc service to" 65 | <> value 5082 66 | <> showDefault 67 | ) 68 | <*> strOption 69 | ( long "cert-file" 70 | <> metavar "CERT_FILE" 71 | <> help "Certificate file to use for TLS" 72 | <> value ".json-fs-store/certificate.pem" 73 | <> showDefault 74 | ) 75 | <*> strOption 76 | ( long "key-file" 77 | <> metavar "KEY_FILE" 78 | <> help "Private key file to use for TLS" 79 | <> value ".json-fs-store/key.pem" 80 | <> showDefault 81 | ) 82 | 83 | insertFsOpts :: Parser InsertFsOpts 84 | insertFsOpts = 85 | InsertFsOpts 86 | <$> dbOpt 87 | <*> strOption 88 | ( long "fact_statement_id" 89 | <> metavar "FS_ID" 90 | <> help "Fact Statement ID to insert into the store" 91 | ) 92 | <*> strOption 93 | ( long "json" 94 | <> metavar "FS_JSON" 95 | <> help "Fact Statement in a Json format to insert into the store" 96 | ) 97 | 98 | optionsP :: Parser Command 99 | optionsP = 100 | subparser $ 101 | command 102 | "fact-statement-store-grpc" 103 | (info (FactStatementStoreGrpc <$> fsStoreGrpcOpts <* helper) (progDesc "Run a FactStatementStore gRpc service")) 104 | <> command 105 | "genesis" 106 | (info (Genesis <$> genesisOpts <* helper) (progDesc "Initialise the service")) 107 | <> command 108 | "insert-fact-statement" 109 | (info (InsertFs <$> insertFsOpts <* helper) (progDesc "Insert a Fact Statement into the store")) 110 | 111 | parserInfo :: ParserInfo Command 112 | parserInfo = info (optionsP <**> helper) (fullDesc <> progDesc "JSON COOP Fact Statement Store cli tools") 113 | 114 | main :: IO () 115 | main = do 116 | cmd <- customExecParser (prefs (showHelpOnEmpty <> showHelpOnError)) parserInfo 117 | case cmd of 118 | FactStatementStoreGrpc opts -> factStatementStoreService opts 119 | Genesis opts -> genesis opts 120 | InsertFs opts -> insertFs opts 121 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, haskell-nix, compiler-nix-name, plutip, plutusJson, factStatementStoreProtoHs, cardanoProtoExtras, cardanoProtoHs, http2-grpc-native, shellHook }: 2 | let 3 | proj = haskell-nix.cabalProject' { 4 | src = ./.; 5 | name = "coop-extras-json-fact-statement-store"; 6 | inherit compiler-nix-name; 7 | index-state = "2022-05-16T00:00:00Z"; 8 | inherit (plutip) cabalProjectLocal; 9 | modules = plutip.haskellModules ++ [ 10 | { 11 | packages = { 12 | # Enable strict builds 13 | json-fact-statement-store.configureFlags = [ "-f-dev" ]; 14 | 15 | # FIXME: This is annoying 16 | # Add proto compilation execs 17 | proto-lens-protobuf-types.components.library.build-tools = [ 18 | pkgs.protobuf 19 | pkgs.haskellPackages.proto-lens-protoc 20 | ]; 21 | 22 | }; 23 | } 24 | ]; 25 | 26 | extraSources = plutip.extraSources ++ [ 27 | { 28 | src = http2-grpc-native; 29 | subdirs = [ 30 | "http2-client-grpc" 31 | "http2-grpc-proto-lens" 32 | "http2-grpc-types" 33 | "warp-grpc" 34 | ]; 35 | } 36 | { 37 | src = factStatementStoreProtoHs; 38 | subdirs = [ "." ]; 39 | } 40 | { 41 | src = plutusJson; 42 | subdirs = [ "." ]; 43 | } 44 | { 45 | src = cardanoProtoExtras; 46 | subdirs = [ "." ]; 47 | } 48 | { 49 | src = cardanoProtoHs; 50 | subdirs = [ "." ]; 51 | } 52 | ]; 53 | 54 | shell = { 55 | withHoogle = true; 56 | 57 | exactDeps = true; 58 | 59 | nativeBuildInputs = with pkgs; [ 60 | # Code quality 61 | ## Haskell/Cabal 62 | haskellPackages.apply-refact 63 | haskellPackages.fourmolu 64 | haskellPackages.cabal-fmt 65 | hlint 66 | grpcui 67 | grpcurl 68 | ]; 69 | 70 | additional = ps: [ 71 | ps.plutus-json 72 | ps.cardano-proto-extras 73 | ps.coop-cardano-proto 74 | 75 | # Needed to run the coop.TxBuilder gRpc service 76 | ps.http2-client-grpc 77 | ps.http2-grpc-proto-lens 78 | ps.http2-grpc-types 79 | ps.warp-grpc 80 | ps.coop-fact-statement-store-service-proto 81 | ]; 82 | 83 | tools = { 84 | cabal = { }; 85 | haskell-language-server = { }; 86 | }; 87 | 88 | shellHook = '' 89 | export LC_CTYPE=C.UTF-8 90 | export LC_ALL=C.UTF-8 91 | export LANG=C.UTF-8 92 | ${shellHook} 93 | ''; 94 | 95 | }; 96 | }; 97 | in 98 | proj 99 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./. 2 | 3 | tests: true 4 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/json-fact-statement-store.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: json-fact-statement-store 3 | version: 0.1.0.0 4 | maintainer: bladyjoker@gmail.com 5 | author: Drazen Popovic 6 | extra-source-files: CHANGELOG.md 7 | 8 | flag dev 9 | description: Enable non-strict compilation for development 10 | manual: True 11 | 12 | common common-language 13 | ghc-options: 14 | -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind 15 | -Wno-partial-type-signatures -Wmissing-export-lists 16 | -Wincomplete-record-updates -Wmissing-deriving-strategies 17 | -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls 18 | -fprint-explicit-kinds -fwarn-missing-import-lists -Wname-shadowing 19 | -Wunused-packages 20 | 21 | if !flag(dev) 22 | ghc-options: -Werror 23 | 24 | default-extensions: 25 | NoStarIsType 26 | BangPatterns 27 | BinaryLiterals 28 | ConstrainedClassMethods 29 | ConstraintKinds 30 | DataKinds 31 | DeriveAnyClass 32 | DeriveDataTypeable 33 | DeriveFoldable 34 | DeriveFunctor 35 | DeriveGeneric 36 | DeriveLift 37 | DeriveTraversable 38 | DerivingStrategies 39 | DerivingVia 40 | DoAndIfThenElse 41 | EmptyCase 42 | EmptyDataDecls 43 | EmptyDataDeriving 44 | ExistentialQuantification 45 | ExplicitForAll 46 | ExplicitNamespaces 47 | FlexibleContexts 48 | FlexibleInstances 49 | ForeignFunctionInterface 50 | GADTSyntax 51 | GeneralisedNewtypeDeriving 52 | HexFloatLiterals 53 | ImportQualifiedPost 54 | InstanceSigs 55 | KindSignatures 56 | LambdaCase 57 | MonomorphismRestriction 58 | MultiParamTypeClasses 59 | NamedFieldPuns 60 | NamedWildCards 61 | NumericUnderscores 62 | OverloadedStrings 63 | PartialTypeSignatures 64 | PatternGuards 65 | PolyKinds 66 | PostfixOperators 67 | RankNTypes 68 | RelaxedPolyRec 69 | ScopedTypeVariables 70 | StandaloneDeriving 71 | StandaloneKindSignatures 72 | TemplateHaskell 73 | TraditionalRecordSyntax 74 | TupleSections 75 | TypeApplications 76 | TypeFamilies 77 | TypeOperators 78 | TypeSynonymInstances 79 | ViewPatterns 80 | 81 | default-language: Haskell2010 82 | 83 | executable json-fs-store-cli 84 | import: common-language 85 | main-is: Main.hs 86 | hs-source-dirs: app 87 | other-modules: 88 | BeamConfig 89 | FactStatementStoreGrpc 90 | Genesis 91 | InsertFs 92 | 93 | build-depends: 94 | , aeson 95 | , base 96 | , beam-core 97 | , beam-sqlite 98 | , bytestring 99 | , cardano-proto-extras 100 | , coop-fact-statement-store-service-proto 101 | , http2-grpc-proto-lens 102 | , http2-grpc-types 103 | , lens 104 | , optparse-applicative 105 | , plutus-json 106 | , plutus-tx 107 | , proto-lens 108 | , sqlite-simple 109 | , text 110 | , warp 111 | , warp-grpc 112 | , warp-tls 113 | -------------------------------------------------------------------------------- /coop-extras/json-fact-statement-store/resources/ssl-extensions-x509.conf: -------------------------------------------------------------------------------- 1 | [v3_ca] 2 | basicConstraints = CA:FALSE 3 | keyUsage = digitalSignature, keyEncipherment 4 | subjectAltName = IP:127.0.0.1, DNS:localhost 5 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/.envrc: -------------------------------------------------------------------------------- 1 | use flake ../../#dev-extras-plutus-json 2 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for plutus-json 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | 4 | module Main (main) where 5 | 6 | import Control.Applicative (Alternative (many), (<**>)) 7 | 8 | import Codec.Serialise (deserialise, deserialiseOrFail) 9 | import Data.Aeson (decode, decodeStrict', encodeFile, json) 10 | import Data.Aeson.Parser (decodeStrictWith) 11 | import Data.ByteString qualified as B 12 | import Data.ByteString.Lazy qualified as LB 13 | import Data.Maybe (fromMaybe) 14 | import Options.Applicative ( 15 | Parser, 16 | ParserInfo, 17 | command, 18 | customExecParser, 19 | flag, 20 | fullDesc, 21 | help, 22 | helper, 23 | info, 24 | long, 25 | metavar, 26 | prefs, 27 | progDesc, 28 | short, 29 | showDefault, 30 | showHelpOnEmpty, 31 | showHelpOnError, 32 | strOption, 33 | subparser, 34 | ) 35 | import PlutusJson (jsonToPlutusData, plutusDataToJson) 36 | import PlutusTx (Data, ToData (toBuiltinData)) 37 | import PlutusTx.Builtins (dataToBuiltinData, fromBuiltin, serialiseData, toBuiltin) 38 | 39 | data Command 40 | = ToJson FilePath FilePath 41 | | FromJson FilePath FilePath 42 | 43 | toJsonOptsP :: Parser Command 44 | toJsonOptsP = 45 | ToJson 46 | <$> strOption 47 | ( long "in" 48 | <> short 'i' 49 | <> metavar "FILEPATH" 50 | <> help "PlutusData file (CBOR encoded) to translate into a Json file" 51 | ) 52 | <*> strOption 53 | ( long "out" 54 | <> short 'o' 55 | <> metavar "FILEPATH" 56 | <> help "Translated Json file" 57 | ) 58 | 59 | fromJsonOptsP :: Parser Command 60 | fromJsonOptsP = 61 | FromJson 62 | <$> strOption 63 | ( long "in" 64 | <> short 'i' 65 | <> metavar "FILEPATH" 66 | <> help "Json file to translate into a PlutusData file (CBOR encoded)" 67 | ) 68 | <*> strOption 69 | ( long "out" 70 | <> short 'o' 71 | <> metavar "FILEPATH" 72 | <> help "Translated PlutusData file (CBOR encoded)" 73 | ) 74 | 75 | optionsP :: Parser Command 76 | optionsP = 77 | subparser $ 78 | command 79 | "to-json" 80 | (info (toJsonOptsP <* helper) (progDesc "Translate a PlutusData file (CBOR encoded) into a Json file")) 81 | <> command 82 | "from-json" 83 | (info (fromJsonOptsP <* helper) (progDesc "Translate a Json file into a PlutusData file (CBOR encoded)")) 84 | 85 | parserInfo :: ParserInfo Command 86 | parserInfo = info (optionsP <**> helper) (fullDesc <> progDesc "COOP plutus-json") 87 | 88 | main :: IO () 89 | main = do 90 | cmd <- customExecParser (prefs (showHelpOnEmpty <> showHelpOnError)) parserInfo 91 | case cmd of 92 | ToJson inf outf -> do 93 | cborBytes <- LB.readFile inf 94 | let errOrDecoded = deserialiseOrFail @Data cborBytes 95 | plData <- either (\err -> error $ "File " <> inf <> " can't be parsed into PlutusData CBOR: " <> show err) return errOrDecoded 96 | jsVal <- plutusDataToJson plData 97 | encodeFile outf jsVal 98 | FromJson inf outf -> do 99 | jsonBytes <- B.readFile inf 100 | let mayDecoded = decodeStrictWith json return jsonBytes 101 | decoded <- maybe (error $ "File " <> inf <> " can't be parsed into Json") return mayDecoded 102 | let plData = jsonToPlutusData decoded 103 | B.writeFile outf (fromBuiltin . serialiseData . dataToBuiltinData $ plData) 104 | return () 105 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/build.nix: -------------------------------------------------------------------------------- 1 | # TODO: Get rid of Plutarch 2 | { pkgs, haskell-nix, compiler-nix-name, plutarch, shellHook }: 3 | let 4 | hn-extra-hackage = plutarch.inputs.haskell-nix-extra-hackage; 5 | myHackage = hn-extra-hackage.mkHackagesFor pkgs.system compiler-nix-name [ 6 | "${plutarch.inputs.plutus}/plutus-tx" 7 | ]; 8 | in 9 | haskell-nix.cabalProject' (plutarch.applyPlutarchDep pkgs rec { 10 | src = ./.; 11 | name = "coop-extras-plutus-json"; 12 | inherit compiler-nix-name; 13 | inherit (myHackage) extra-hackages extra-hackage-tarballs; 14 | modules = myHackage.modules ++ [{ 15 | packages = { }; 16 | }]; 17 | shell = { 18 | withHoogle = true; 19 | 20 | exactDeps = true; 21 | 22 | nativeBuildInputs = with pkgs; [ 23 | # Code quality 24 | ## Haskell/Cabal 25 | haskellPackages.apply-refact 26 | haskellPackages.fourmolu 27 | haskellPackages.cabal-fmt 28 | hlint 29 | (plutarch.hlsFor compiler-nix-name pkgs.system) 30 | ]; 31 | 32 | additional = ps: [ 33 | ps.plutus-tx 34 | ]; 35 | 36 | tools = { 37 | cabal = { }; 38 | }; 39 | 40 | shellHook = '' 41 | export LC_CTYPE=C.UTF-8 42 | export LC_ALL=C.UTF-8 43 | export LANG=C.UTF-8 44 | ${shellHook} 45 | ''; 46 | 47 | }; 48 | }) 49 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./. 2 | 3 | tests: true 4 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/plutus-json.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: plutus-json 3 | version: 0.1.0.0 4 | maintainer: bladyjoker@gmail.com 5 | author: Drazen Popovic 6 | extra-source-files: CHANGELOG.md 7 | 8 | library 9 | exposed-modules: PlutusJson 10 | hs-source-dirs: src 11 | default-language: Haskell2010 12 | build-depends: 13 | , aeson 14 | , base 15 | , plutus-tx 16 | , scientific 17 | , text 18 | , vector 19 | 20 | executable plutus-json-cli 21 | main-is: Main.hs 22 | hs-source-dirs: app 23 | default-language: Haskell2010 24 | build-depends: 25 | , aeson 26 | , base 27 | , bytestring 28 | , optparse-applicative 29 | , plutus-json 30 | , plutus-tx 31 | , serialise 32 | 33 | test-suite plutus-json-tests 34 | type: exitcode-stdio-1.0 35 | main-is: Main.hs 36 | hs-source-dirs: test 37 | default-language: Haskell2010 38 | build-depends: 39 | , aeson 40 | , base 41 | , bytestring 42 | , containers 43 | , hspec 44 | , plutus-json 45 | , plutus-tx 46 | , QuickCheck 47 | , tasty 48 | , text 49 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/src/PlutusJson.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BlockArguments #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE ImportQualifiedPost #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | module PlutusJson (plutusDataToJson, jsonToPlutusData) where 8 | 9 | import Data.Aeson qualified as Aeson 10 | import Data.Aeson.Key (fromText, toText) 11 | import Data.Aeson.KeyMap (fromList, keys, toAscList) 12 | import Data.Foldable (fold) 13 | import Data.Int (Int64) 14 | import Data.Scientific qualified as Sci 15 | import Data.Text.Encoding (decodeUtf8', encodeUtf8) 16 | import Data.Traversable (for) 17 | import Data.Vector qualified as Vector 18 | import PlutusTx (Data (B, Constr, I, List, Map), FromData (fromBuiltinData), ToData (toBuiltinData), builtinDataToData, dataToBuiltinData) 19 | 20 | plutusDataToJson :: MonadFail m => Data -> m Aeson.Value 21 | plutusDataToJson (Map elements) = 22 | Aeson.Object . fromList 23 | <$> for 24 | elements 25 | ( \(k, v) -> do 26 | k' <- plutusDataToObjectKey k 27 | v' <- plutusDataToJson v 28 | return (k', v') 29 | ) 30 | plutusDataToJson (List xs) = Aeson.Array . Vector.fromList <$> for xs plutusDataToJson 31 | plutusDataToJson (B bs) = Aeson.String <$> (either (fail . show) return . decodeUtf8' $ bs) 32 | plutusDataToJson (I i) = return (Aeson.Number (fromInteger i)) 33 | plutusDataToJson (Constr i fields) = case i of 34 | 0 -> return (Aeson.Bool False) 35 | 1 -> return (Aeson.Bool True) 36 | 2 -> return Aeson.Null 37 | 3 -> case fields of 38 | [I coeff, I exp] -> return (Aeson.Number $ Sci.scientific coeff (fromInteger exp)) 39 | _ -> fail "PlutusData Constr with index 3 must be in Scientific form with fields [I coefficient, I base10exponent]" 40 | _ -> fail "PlutusData Constr indices must be either 0 - False | 1 - True | 2 - Null | 3 - Number" 41 | 42 | objectKeyToPlutusData :: Aeson.Key -> Data 43 | objectKeyToPlutusData = B . encodeUtf8 . toText 44 | 45 | plutusDataToObjectKey :: MonadFail m => Data -> m Aeson.Key 46 | plutusDataToObjectKey (B bs) = either (fail . show) (return . fromText) $ decodeUtf8' bs 47 | plutusDataToObjectKey _ = fail "JSON Object key must be a UTF8 encoded bytestring" 48 | 49 | jsonToPlutusData :: Aeson.Value -> Data 50 | jsonToPlutusData (Aeson.Object obj) = Map [(objectKeyToPlutusData k, jsonToPlutusData v) | (k, v) <- toAscList obj] 51 | jsonToPlutusData (Aeson.Array vec) = List (jsonToPlutusData <$> Vector.toList vec) 52 | jsonToPlutusData (Aeson.String s) = B . encodeUtf8 $ s 53 | jsonToPlutusData (Aeson.Number s) = case Sci.toBoundedInteger s of 54 | Just (n :: Int64) -> I (toInteger n) 55 | Nothing -> Constr 3 [I (Sci.coefficient s), I (toInteger $ Sci.base10Exponent s)] 56 | jsonToPlutusData (Aeson.Bool b) = if b then Constr 1 [] else Constr 0 [] 57 | jsonToPlutusData Aeson.Null = Constr 2 [] 58 | 59 | instance ToData Aeson.Value where 60 | toBuiltinData = dataToBuiltinData . jsonToPlutusData 61 | 62 | instance FromData Aeson.Value where 63 | fromBuiltinData = plutusDataToJson . builtinDataToData 64 | -------------------------------------------------------------------------------- /coop-extras/plutus-json/test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import PlutusJson (jsonToPlutusData, plutusDataToJson) 4 | import PlutusTx (Data) 5 | import Test.Hspec (Spec, describe, hspec, shouldBe) 6 | import Test.Hspec.QuickCheck (prop) 7 | 8 | main :: IO () 9 | main = hspec spec 10 | 11 | spec :: Spec 12 | spec = do 13 | describe "plutus-json-tests" $ do 14 | prop "Json -> PlutusData -> Json should yield the same object" $ \aes -> do 15 | let pd = jsonToPlutusData aes 16 | aes' <- plutusDataToJson pd 17 | aes `shouldBe` aes' 18 | -------------------------------------------------------------------------------- /coop-hs-types/.envrc: -------------------------------------------------------------------------------- 1 | use flake ..#dev-hs-types 2 | -------------------------------------------------------------------------------- /coop-hs-types/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2022 mlabs-haskell 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /coop-hs-types/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, haskell-nix, compiler-nix-name, plutip, shellHook }: 2 | haskell-nix.cabalProject' { 3 | src = ./.; 4 | name = "coop-hs-types"; 5 | inherit compiler-nix-name; 6 | index-state = "2022-05-16T00:00:00Z"; 7 | inherit (plutip) cabalProjectLocal; 8 | modules = plutip.haskellModules ++ [{ 9 | packages = { 10 | # Enable strict builds 11 | oracle-hs-types.configureFlags = [ "-f-dev" ]; 12 | }; 13 | }]; 14 | 15 | extraSources = plutip.extraSources; 16 | 17 | shell = { 18 | withHoogle = true; 19 | 20 | exactDeps = true; 21 | 22 | nativeBuildInputs = with pkgs; [ 23 | # Code quality 24 | ## Haskell/Cabal 25 | haskellPackages.apply-refact 26 | haskellPackages.fourmolu 27 | haskellPackages.cabal-fmt 28 | hlint 29 | ]; 30 | 31 | additional = ps: [ ps.plutus-ledger-api ps.plutus-tx ps.serialise ]; 32 | 33 | tools = { 34 | cabal = { }; 35 | haskell-language-server = { }; 36 | }; 37 | 38 | shellHook = '' 39 | export LC_CTYPE=C.UTF-8 40 | export LC_ALL=C.UTF-8 41 | export LANG=C.UTF-8 42 | ${shellHook} 43 | ''; 44 | 45 | }; 46 | } 47 | -------------------------------------------------------------------------------- /coop-hs-types/cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./. 2 | 3 | tests: true 4 | -------------------------------------------------------------------------------- /coop-hs-types/coop-hs-types.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: coop-hs-types 3 | version: 0.1.0.0 4 | license: MIT 5 | license-file: LICENSE 6 | maintainer: info@mlabs.city 7 | author: mlabs-haskell 8 | description: 9 | COOP Haskell types shared across different COOP Haskell projects. 10 | 11 | flag new-ledger-namespace 12 | description: Use the new plutus-ledger-api namespace (0a8b1ad) 13 | manual: True 14 | default: False 15 | 16 | flag dev 17 | description: Enable non-strict compilation for development 18 | manual: True 19 | 20 | common common-language 21 | ghc-options: 22 | -Wall -Wcompat -Wincomplete-uni-patterns -Wunused-do-bind 23 | -Wpartial-type-signatures -Wmissing-export-lists 24 | -Wincomplete-record-updates -Wmissing-deriving-strategies 25 | -Wname-shadowing -Wunused-foralls -fprint-explicit-foralls 26 | -fprint-explicit-kinds -fwarn-missing-import-lists 27 | -Wredundant-constraints -Wmissing-export-lists 28 | -Wmissing-deriving-strategies -Wname-shadowing -Wunused-packages 29 | -Weverything 30 | 31 | if !flag(dev) 32 | ghc-options: -Werror 33 | 34 | if flag(new-ledger-namespace) 35 | cpp-options: -DNEW_LEDGER_NAMESPACE 36 | 37 | default-extensions: 38 | NoStarIsType 39 | BangPatterns 40 | BinaryLiterals 41 | ConstrainedClassMethods 42 | ConstraintKinds 43 | DataKinds 44 | DeriveAnyClass 45 | DeriveDataTypeable 46 | DeriveFoldable 47 | DeriveFunctor 48 | DeriveGeneric 49 | DeriveLift 50 | DeriveTraversable 51 | DerivingStrategies 52 | DerivingVia 53 | DoAndIfThenElse 54 | EmptyCase 55 | EmptyDataDecls 56 | EmptyDataDeriving 57 | ExistentialQuantification 58 | ExplicitForAll 59 | ExplicitNamespaces 60 | FlexibleContexts 61 | FlexibleInstances 62 | ForeignFunctionInterface 63 | GADTSyntax 64 | GeneralisedNewtypeDeriving 65 | HexFloatLiterals 66 | ImportQualifiedPost 67 | InstanceSigs 68 | KindSignatures 69 | LambdaCase 70 | MonomorphismRestriction 71 | MultiParamTypeClasses 72 | NamedFieldPuns 73 | NamedWildCards 74 | NumericUnderscores 75 | OverloadedStrings 76 | PartialTypeSignatures 77 | PatternGuards 78 | PolyKinds 79 | PostfixOperators 80 | RankNTypes 81 | RelaxedPolyRec 82 | ScopedTypeVariables 83 | StandaloneDeriving 84 | StandaloneKindSignatures 85 | TemplateHaskell 86 | TraditionalRecordSyntax 87 | TupleSections 88 | TypeApplications 89 | TypeFamilies 90 | TypeOperators 91 | TypeSynonymInstances 92 | ViewPatterns 93 | 94 | default-language: Haskell2010 95 | 96 | library 97 | import: common-language 98 | exposed-modules: 99 | Coop.PlutusOrphans 100 | Coop.Types 101 | 102 | hs-source-dirs: src 103 | build-depends: 104 | , aeson 105 | , base 106 | , base16-bytestring 107 | , bytestring 108 | , lens 109 | , plutus-ledger-api 110 | , plutus-tx 111 | , serialise 112 | , text 113 | -------------------------------------------------------------------------------- /coop-hs-types/hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /coop-hs-types/src/Coop/PlutusOrphans.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# OPTIONS_GHC -Wno-all-missed-specialisations #-} 3 | {-# OPTIONS_GHC -Wno-implicit-prelude #-} 4 | {-# OPTIONS_GHC -Wno-missing-local-signatures #-} 5 | {-# OPTIONS_GHC -Wno-missing-safe-haskell-mode #-} 6 | {-# OPTIONS_GHC -Wno-orphans #-} 7 | {-# OPTIONS_GHC -Wno-unsafe #-} 8 | 9 | module Coop.PlutusOrphans () where 10 | 11 | import Codec.Serialise (deserialise, serialise) 12 | import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON)) 13 | import Data.Aeson.Types (prependFailure, typeMismatch) 14 | import Data.Aeson.Types qualified as Aeson 15 | import Data.ByteString (ByteString) 16 | import Data.ByteString.Base16 qualified as Base16S 17 | import Data.ByteString.Lazy (fromStrict, toStrict) 18 | import Data.Text.Encoding (decodeUtf8, encodeUtf8) 19 | 20 | #ifdef NEW_LEDGER_NAMESPACE 21 | import PlutusLedgerApi.V2 (Script, LedgerBytes(LedgerBytes), PubKeyHash, CurrencySymbol, Address, BuiltinByteString, fromBuiltin, toBuiltin, Credential, StakingCredential, ValidatorHash, Validator, MintingPolicy, POSIXTime, POSIXTimeRange, LowerBound, UpperBound, Extended, TokenName(TokenName), TxOutRef, TxId, Data, BuiltinData (BuiltinData)) 22 | import PlutusLedgerApi.V1.Value (AssetClass) 23 | #else 24 | import Plutus.V2.Ledger.Api (Script, LedgerBytes(LedgerBytes), PubKeyHash, CurrencySymbol, Address, BuiltinByteString, fromBuiltin, toBuiltin, Credential, StakingCredential, ValidatorHash, Validator, MintingPolicy, POSIXTime, POSIXTimeRange, LowerBound, UpperBound, Extended, TokenName(TokenName), TxOutRef, TxId, Data, BuiltinData (BuiltinData)) 25 | import Plutus.V1.Ledger.Value (AssetClass) 26 | #endif 27 | 28 | instance ToJSON Script where 29 | toJSON = toJSON . toStrict . serialise 30 | 31 | instance FromJSON Script where 32 | parseJSON json = deserialise . fromStrict <$> parseJSON json 33 | 34 | instance ToJSON ByteString where 35 | toJSON = toJSON . decodeUtf8 . Base16S.encode 36 | 37 | instance FromJSON ByteString where 38 | parseJSON (Aeson.String text) = either fail pure (Base16S.decode . encodeUtf8 $ text) 39 | parseJSON invalid = 40 | prependFailure 41 | "parsing ByteString failed, " 42 | (typeMismatch "base16 encoded bytes" invalid) 43 | 44 | instance ToJSON MintingPolicy 45 | instance FromJSON MintingPolicy 46 | 47 | instance ToJSON Validator 48 | instance FromJSON Validator 49 | 50 | instance ToJSON PubKeyHash 51 | instance FromJSON PubKeyHash 52 | 53 | instance ToJSON Address 54 | instance FromJSON Address 55 | 56 | instance ToJSON CurrencySymbol 57 | instance FromJSON CurrencySymbol 58 | 59 | instance ToJSON Credential 60 | instance FromJSON Credential 61 | 62 | instance ToJSON StakingCredential 63 | instance FromJSON StakingCredential 64 | 65 | instance ToJSON ValidatorHash 66 | instance FromJSON ValidatorHash 67 | 68 | deriving newtype instance ToJSON LedgerBytes 69 | deriving newtype instance FromJSON LedgerBytes 70 | 71 | deriving newtype instance ToJSON TokenName 72 | deriving newtype instance FromJSON TokenName 73 | 74 | instance ToJSON POSIXTime 75 | instance FromJSON POSIXTime 76 | 77 | instance ToJSON POSIXTimeRange 78 | instance FromJSON POSIXTimeRange 79 | 80 | instance ToJSON (LowerBound POSIXTime) 81 | instance FromJSON (LowerBound POSIXTime) 82 | 83 | instance ToJSON (UpperBound POSIXTime) 84 | instance FromJSON (UpperBound POSIXTime) 85 | 86 | instance ToJSON (Extended POSIXTime) 87 | instance FromJSON (Extended POSIXTime) 88 | 89 | instance ToJSON BuiltinByteString where 90 | toJSON = toJSON . fromBuiltin @_ @ByteString 91 | 92 | instance FromJSON BuiltinByteString where 93 | parseJSON v = toBuiltin <$> parseJSON @ByteString v 94 | 95 | instance ToJSON AssetClass 96 | instance FromJSON AssetClass 97 | 98 | instance ToJSON TxOutRef 99 | instance FromJSON TxOutRef 100 | 101 | instance ToJSON TxId 102 | instance FromJSON TxId 103 | 104 | instance ToJSON Data 105 | instance FromJSON Data 106 | 107 | instance ToJSON BuiltinData where 108 | toJSON (BuiltinData d) = toJSON d 109 | 110 | instance FromJSON BuiltinData where 111 | parseJSON v = BuiltinData <$> parseJSON @Data v 112 | -------------------------------------------------------------------------------- /coop-hs-types/src/Coop/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# OPTIONS_GHC -Wno-all-missed-specialisations #-} 3 | {-# OPTIONS_GHC -Wno-implicit-prelude #-} 4 | {-# OPTIONS_GHC -Wno-missing-local-signatures #-} 5 | {-# OPTIONS_GHC -Wno-missing-safe-haskell-mode #-} 6 | {-# OPTIONS_GHC -Wno-unsafe #-} 7 | 8 | module Coop.Types ( 9 | CoopPlutus (..), 10 | CoopDeployment (..), 11 | FsMpParams (..), 12 | FsMpRedeemer (..), 13 | FactStatement (), 14 | FactStatementId (), 15 | FsDatum (..), 16 | CertDatum (..), 17 | AuthParams (..), 18 | AuthMpParams (..), 19 | AuthMpRedeemer (..), 20 | CertMpParams (..), 21 | CertMpRedeemer (..), 22 | AuthBatchId, 23 | AuthDeployment (..), 24 | CoopState (..), 25 | ) where 26 | 27 | import Control.Lens (makeFields) 28 | import Coop.PlutusOrphans () 29 | import Data.Aeson (FromJSON, ToJSON) 30 | import GHC.Generics (Generic) 31 | import PlutusTx qualified 32 | 33 | #ifdef NEW_LEDGER_NAMESPACE 34 | import PlutusLedgerApi.V2 (Script, LedgerBytes, CurrencySymbol, Address, Validator, MintingPolicy, POSIXTime, Extended, POSIXTimeRange, PubKeyHash, BuiltinData) 35 | import PlutusLedgerApi.V1.Value (AssetClass) 36 | #else 37 | import Plutus.V2.Ledger.Api (Script, LedgerBytes, CurrencySymbol, Address, Validator, MintingPolicy, POSIXTime, Extended, POSIXTimeRange, PubKeyHash, BuiltinData) 38 | import Plutus.V1.Ledger.Value (AssetClass) 39 | #endif 40 | 41 | -- * COOP offchain types 42 | 43 | -- | Plutus scripts as generated by `coop-plutus-cli compile` command 44 | data CoopPlutus = CoopPlutus 45 | { cp'mkOneShotMp :: Script 46 | -- ^ Makes the $ONE-SHOT minting policy `:: Integer -> TokenName -> TxOutRef -> MintingPolicy` 47 | , cp'mkAuthMp :: Script 48 | -- ^ Makes the $AUTH minting policy `:: AuthMpParams -> MintingPolicy` 49 | , cp'mkCertMp :: Script 50 | -- ^ Makes the $CERT minting policy `:: CertMpParams -> MintingPolicy` 51 | , cp'certV :: Script 52 | -- ^ Certificate validator @CertV `:: Validator`` 53 | , cp'mkFsMp :: Script 54 | -- ^ Makes the $FS minting policy `:: FsMpParams -> MintingPolicy` 55 | , cp'fsV :: Script 56 | -- ^ Fact Statement validator @FsV `:: Validator` 57 | } 58 | deriving stock (Show, Eq, Generic) 59 | deriving anyclass (ToJSON, FromJSON) 60 | 61 | -- | COOP deployment (per oracle) 62 | data CoopDeployment = CoopDeployment 63 | { cd'coopAsset :: AssetClass 64 | -- ^ $COOP one-shot token denoting the COOP deployment 65 | , cd'fsPolicy :: MintingPolicy 66 | -- ^ Deployed COOP Fact Statement minting policy 67 | , cd'fsSymbol :: CurrencySymbol 68 | -- ^ Deployed COOP $FS currency symbol (policy id) 69 | , cd'fsValidator :: Validator 70 | -- ^ Deployed COOP Fact Statement validator 71 | , cd'fsAddress :: Address 72 | -- ^ Deployed COOP Fact Statement validator address 73 | , cd'auth :: AuthDeployment 74 | -- ^ Deployed COOP authentication deployment 75 | } 76 | deriving stock (Show, Eq, Generic) 77 | deriving anyclass (ToJSON, FromJSON) 78 | 79 | -- | COOP state 80 | data CoopState = CoopState 81 | { cs'certificates :: [CertDatum] 82 | -- ^ COOP certificate datums attached at @CertV with $CERT datums 83 | , cs'factStatements :: [FsDatum] 84 | -- ^ COOP fact statement datums attached at @FsV with $FS datums 85 | , cs'currentTime :: (POSIXTime, POSIXTime) 86 | -- ^ Current Cardano time (slot = interval posixtime) 87 | } 88 | deriving stock (Show, Eq, Generic) 89 | deriving anyclass (ToJSON, FromJSON) 90 | 91 | -- * COOP Plutus (on-chain) types 92 | 93 | -- | A fact statement is just Plutus Data 94 | type FactStatement = BuiltinData 95 | 96 | -- | A fact statement ID is just bytes 97 | type FactStatementId = LedgerBytes 98 | 99 | -- | A datum holding the FactStatement that's locked at @FsV 100 | data FsDatum = FsDatum 101 | { fd'fs :: FactStatement 102 | -- ^ Fact statement 103 | , fd'fsId :: FactStatementId 104 | -- ^ Fact statement ID as provided by the oracle 105 | , fs'gcAfter :: Extended POSIXTime 106 | -- ^ After this time the Submitter can 'garbage collect' the @FsV UTxO 107 | , fs'submitter :: PubKeyHash 108 | -- ^ Public key hash of the wallet that submitted the $FS minting transaction 109 | } 110 | deriving stock (Show, Generic, Eq) 111 | deriving anyclass (ToJSON, FromJSON) 112 | 113 | -- | FsMp initial parameters 114 | data FsMpParams = FsMpParams 115 | { fmp'coopAc :: AssetClass 116 | -- ^ $COOP one-shot token asset class denoting the COOP instance 117 | , fmp'fsVAddress :: Address 118 | -- ^ @FsV fact statement validator address where the minted $FS tokens are paid to 119 | , fmp'authParams :: AuthParams 120 | -- ^ Authentication parameters 121 | } 122 | deriving stock (Show, Generic, Eq) 123 | deriving anyclass (ToJSON, FromJSON) 124 | 125 | -- | FsMp initial authentication parameters 126 | data AuthParams = AuthParams 127 | { ap'authTokenCs :: CurrencySymbol 128 | -- ^ $AUTH token CurrencySymbol required to authorize $FS minting 129 | , ap'certTokenCs :: CurrencySymbol 130 | -- ^ $CERT token CurrencySymbol required to authorize $FS minting 131 | } 132 | deriving stock (Show, Generic, Eq) 133 | deriving anyclass (ToJSON, FromJSON) 134 | 135 | -- | FsMp redeemer denoting $FS mint or burning actions 136 | data FsMpRedeemer = FsMpBurn | FsMpMint 137 | deriving stock (Show, Generic, Eq) 138 | deriving anyclass (ToJSON, FromJSON) 139 | 140 | -- ** COOP Authentication 141 | 142 | -- | COOP Authentication deployment 143 | data AuthDeployment = AuthDeployment 144 | { ad'authorityAsset :: AssetClass 145 | -- ^ Authentication authority asset class $AA that can authorize minting $AUTH and $CERT tokens 146 | , ad'certValidator :: Validator 147 | -- ^ @CertV Certificate validator holding $CERTs and CertDatums 148 | , ad'certAddress :: Address 149 | -- ^ @CertV Certificate validator address 150 | , ad'certPolicy :: MintingPolicy 151 | -- ^ Minting policy for $CERT tokens 152 | , ad'certSymbol :: CurrencySymbol 153 | -- ^ Currency symbol (policy id) for $CERT tokens 154 | , ad'authPolicy :: MintingPolicy 155 | -- ^ Minting policy for $AUTH tokens 156 | , ad'authSymbol :: CurrencySymbol 157 | -- ^ Currency symbol (policy id) for $AUTH tokens 158 | } 159 | deriving stock (Show, Generic, Eq) 160 | deriving anyclass (ToJSON, FromJSON) 161 | 162 | -- | Authentication batch identifier (certificates + authentication tokens) 163 | type AuthBatchId = LedgerBytes 164 | 165 | -- | Datum locked at @CertV containing information about $AUTH tokens used in authorizing $FS minting 166 | data CertDatum = CertDatum 167 | { cert'id :: AuthBatchId 168 | -- ^ Certificate unique identifier (matches $CERT and $AUTH token names) 169 | , cert'validity :: POSIXTimeRange 170 | -- ^ Certificate validity interval after which associated $AUTH tokens can't be used to authorize $FS minting 171 | , cert'redeemerAc :: AssetClass 172 | -- ^ $CERT-RMDR asset class that must be spent to 'garbage collect' the @CertV UTxO after the certificate had expired 173 | } 174 | deriving stock (Show, Generic, Eq) 175 | deriving anyclass (ToJSON, FromJSON) 176 | 177 | -- | CertMp redeemer denoting $CERT mint or burning actions 178 | data CertMpRedeemer = CertMpBurn | CertMpMint 179 | deriving stock (Show, Generic, Eq) 180 | deriving anyclass (ToJSON, FromJSON) 181 | 182 | -- | CertMp initial parameters 183 | data CertMpParams = CertMpParams 184 | { cmp'authAuthorityAc :: AssetClass 185 | -- ^ $AA (Authentication authority) tokens required to authorize $CERT minting 186 | , cmp'requiredAtLeastAaQ :: Integer 187 | -- ^ $AA token quantity required to authorize $CERT minting 188 | , cmp'certVAddress :: Address 189 | -- ^ Certificate validator @CertV address to pay the $CERT tokens to 190 | } 191 | deriving stock (Show, Generic, Eq) 192 | deriving anyclass (ToJSON, FromJSON) 193 | 194 | -- | AuthMp redeemer denoting $AUTH mint or burning actions 195 | data AuthMpRedeemer = AuthMpBurn | AuthMpMint 196 | deriving stock (Show, Generic, Eq) 197 | deriving anyclass (ToJSON, FromJSON) 198 | 199 | -- | AuthMp initial parameters 200 | data AuthMpParams = AuthMpParams 201 | { amp'authAuthorityAc :: AssetClass 202 | -- ^ $AA (Authentication authority) tokens required to authorize $AUTH minting 203 | , amp'requiredAtLeastAaQ :: Integer 204 | -- ^ $AA token quantity required to authorize $AUTH minting 205 | } 206 | deriving stock (Show, Generic, Eq) 207 | deriving anyclass (ToJSON, FromJSON) 208 | 209 | -- | Plutus ToData/FromData instances 210 | PlutusTx.unstableMakeIsData ''CertDatum 211 | PlutusTx.unstableMakeIsData ''AuthParams 212 | PlutusTx.unstableMakeIsData ''CertMpParams 213 | PlutusTx.unstableMakeIsData ''CertMpRedeemer 214 | PlutusTx.unstableMakeIsData ''AuthMpParams 215 | PlutusTx.unstableMakeIsData ''AuthMpRedeemer 216 | 217 | PlutusTx.unstableMakeIsData ''FsMpParams 218 | PlutusTx.unstableMakeIsData ''FsDatum 219 | PlutusTx.unstableMakeIsData ''FsMpRedeemer 220 | 221 | -- | Lenses 222 | makeFields ''CoopPlutus 223 | makeFields ''CoopDeployment 224 | makeFields ''FsMpParams 225 | makeFields ''FsDatum 226 | makeFields ''FsMpRedeemer 227 | 228 | makeFields ''AuthDeployment 229 | makeFields ''CertDatum 230 | makeFields ''AuthParams 231 | makeFields ''CertMpParams 232 | makeFields ''CertMpRedeemer 233 | makeFields ''AuthMpParams 234 | makeFields ''AuthMpRedeemer 235 | -------------------------------------------------------------------------------- /coop-pab/.envrc: -------------------------------------------------------------------------------- 1 | use flake ..#dev-pab 2 | -------------------------------------------------------------------------------- /coop-pab/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2022 mlabs-haskell 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /coop-pab/app/Coop/Cli/Aux.hs: -------------------------------------------------------------------------------- 1 | module Coop.Cli.Aux (pubKeyHashOpt, assetClassOpt, posixTimeOpt) where 2 | 3 | import Coop.PlutusOrphans () 4 | import Data.Aeson (eitherDecodeStrict) 5 | import Data.ByteString (ByteString) 6 | import Data.Hex (unhex) 7 | import Data.String (fromString) 8 | import Options.Applicative (Mod, OptionFields, Parser, auto, eitherReader, option) 9 | import Plutus.V1.Ledger.Value (AssetClass) 10 | import Plutus.V2.Ledger.Api (POSIXTime (POSIXTime), PubKeyHash (PubKeyHash), toBuiltin) 11 | 12 | -- TODO: Implement support for all address formats 13 | pubKeyHashOpt :: Mod OptionFields PubKeyHash -> Parser PubKeyHash 14 | pubKeyHashOpt = option $ eitherReader (\s -> PubKeyHash . toBuiltin <$> unhex (fromString @ByteString s)) 15 | 16 | assetClassOpt :: Mod OptionFields AssetClass -> Parser AssetClass 17 | assetClassOpt = 18 | option $ 19 | eitherReader 20 | ( \s -> unhex (fromString @ByteString s) >>= eitherDecodeStrict @AssetClass 21 | ) 22 | 23 | posixTimeOpt :: Mod OptionFields POSIXTime -> Parser POSIXTime 24 | posixTimeOpt = option $ POSIXTime <$> auto @Integer 25 | -------------------------------------------------------------------------------- /coop-pab/app/Coop/Cli/Deploy.hs: -------------------------------------------------------------------------------- 1 | module Coop.Cli.Deploy (DeployOpts (..), deploy) where 2 | 3 | import BotPlutusInterface.Config (loadPABConfig) 4 | import BotPlutusInterface.Types (PABConfig (pcOwnPubKeyHash)) 5 | 6 | import Coop.Pab qualified as Pab 7 | import Coop.Pab.Aux (DeployMode, loadCoopPlutus, runBpi) 8 | import Data.Aeson (encodeFile) 9 | import Data.Text (Text) 10 | import Ledger (PaymentPubKeyHash (PaymentPubKeyHash)) 11 | import Plutus.V2.Ledger.Api (PubKeyHash) 12 | 13 | data DeployOpts = DeployOpts 14 | { do'mode :: DeployMode 15 | , do'pabConfig :: FilePath 16 | , do'deploymentFile :: FilePath 17 | , do'godWalletPkh :: PubKeyHash 18 | , do'aaWalletPkh :: PubKeyHash 19 | , do'atLeastAaQRequired :: Integer 20 | , do'aaQToMint :: Integer 21 | } 22 | deriving stock (Show, Eq) 23 | 24 | deploy :: DeployOpts -> IO () 25 | deploy opts = do 26 | coopPlutus <- loadCoopPlutus (do'mode opts) 27 | pabConf <- 28 | either error id <$> loadPABConfig (do'pabConfig opts) 29 | 30 | (_, errOrCoopDeployment) <- 31 | runBpi @Text 32 | pabConf 33 | { pcOwnPubKeyHash = do'godWalletPkh opts 34 | } 35 | $ Pab.deployCoop @Text 36 | coopPlutus 37 | (PaymentPubKeyHash $ do'aaWalletPkh opts) 38 | (do'atLeastAaQRequired opts) 39 | (do'aaQToMint opts) 40 | coopDeployment <- either (fail . show) pure errOrCoopDeployment 41 | encodeFile (do'deploymentFile opts) coopDeployment 42 | return () 43 | -------------------------------------------------------------------------------- /coop-pab/app/Coop/Cli/GarbageCollect.hs: -------------------------------------------------------------------------------- 1 | module Coop.Cli.GarbageCollect (GarbageCollectOpts (..), garbageCollect) where 2 | 3 | import BotPlutusInterface.Config (loadPABConfig) 4 | import BotPlutusInterface.Types (PABConfig (pcOwnPubKeyHash)) 5 | 6 | import Codec.Serialise (readFileDeserialise) 7 | import Coop.Pab (burnCerts) 8 | import Coop.Pab.Aux (runBpi) 9 | import Coop.Types (CoopDeployment) 10 | import Data.Aeson (decodeFileStrict) 11 | import Data.Maybe (fromMaybe) 12 | import Data.Text (Text) 13 | import Plutus.V2.Ledger.Api (PubKeyHash) 14 | 15 | data GarbageCollectOpts = GarbageCollectOpts 16 | { gco'pabConfig :: FilePath 17 | , gco'coopDeploymentFile :: FilePath 18 | , gco'certRdmrWalletPkh :: PubKeyHash 19 | , gco'certRdmrAcFile :: FilePath 20 | } 21 | deriving stock (Show, Eq) 22 | 23 | garbageCollect :: GarbageCollectOpts -> IO () 24 | garbageCollect opts = do 25 | coopDeployment <- fromMaybe (error "garbageCollect: Must have a CoopDeployment file in JSON") <$> decodeFileStrict @CoopDeployment (gco'coopDeploymentFile opts) 26 | pabConf <- either (\err -> error $ "garbageCollect: Must have a PABConfig file in Config format: " <> err) id <$> loadPABConfig (gco'pabConfig opts) 27 | certRdmrAc <- readFileDeserialise (gco'certRdmrAcFile opts) 28 | (_, errOrAcs) <- 29 | runBpi @Text 30 | pabConf 31 | { pcOwnPubKeyHash = gco'certRdmrWalletPkh opts 32 | } 33 | $ burnCerts coopDeployment certRdmrAc 34 | either 35 | (\err -> error $ "garbageCollect: " <> show err) 36 | (\_ -> putStrLn "garbageCollect: Collected $CERT UTxOs from @CertV using $CERT-RDMR tokens") 37 | errOrAcs 38 | return () 39 | -------------------------------------------------------------------------------- /coop-pab/app/Coop/Cli/GetState.hs: -------------------------------------------------------------------------------- 1 | module Coop.Cli.GetState (GetStateOpts (..), getState) where 2 | 3 | import BotPlutusInterface.Config (loadPABConfig) 4 | 5 | import BotPlutusInterface.Types (PABConfig (pcOwnPubKeyHash)) 6 | import Coop.Pab qualified as Pab 7 | import Coop.Pab.Aux (runBpi) 8 | import Coop.Types (CoopDeployment) 9 | import Data.Aeson (decodeFileStrict, encodeFile) 10 | import Data.Maybe (fromMaybe) 11 | import Data.Text (Text) 12 | import Ledger (PubKeyHash) 13 | 14 | data GetStateOpts = GetStateOpts 15 | { gco'pabConfig :: FilePath 16 | , gco'coopDeploymentFile :: FilePath 17 | , gco'anyPkh :: PubKeyHash 18 | , gco'coopStateFile :: FilePath 19 | } 20 | deriving stock (Show, Eq) 21 | 22 | getState :: GetStateOpts -> IO () 23 | getState opts = do 24 | coopDeployment <- fromMaybe (error "getState: Must have a CoopDeployment file in JSON") <$> decodeFileStrict @CoopDeployment (gco'coopDeploymentFile opts) 25 | pabConf <- either (\err -> error $ "getState: Must have a PABConfig file in Config format: " <> err) id <$> loadPABConfig (gco'pabConfig opts) 26 | 27 | (_, errOrAcs) <- 28 | runBpi @Text 29 | pabConf 30 | { pcOwnPubKeyHash = gco'anyPkh opts 31 | } 32 | $ Pab.getState coopDeployment 33 | either 34 | (\err -> error $ "getState: " <> show err) 35 | ( \coopState -> do 36 | putStrLn "getState: Success" 37 | encodeFile (gco'coopStateFile opts) coopState 38 | ) 39 | errOrAcs 40 | return () 41 | -------------------------------------------------------------------------------- /coop-pab/app/Coop/Cli/MintAuth.hs: -------------------------------------------------------------------------------- 1 | module Coop.Cli.MintAuth (MintAuthOpts (..), mintAuth) where 2 | 3 | import BotPlutusInterface.Config (loadPABConfig) 4 | import BotPlutusInterface.Types (PABConfig (pcOwnPubKeyHash)) 5 | 6 | import Codec.Serialise (readFileDeserialise) 7 | import Coop.Pab (mintAuthAndCert) 8 | import Coop.Pab.Aux (runBpi) 9 | import Coop.Types (CoopDeployment) 10 | import Data.Aeson (decodeFileStrict) 11 | import Data.Maybe (fromMaybe) 12 | import Data.Text (Text) 13 | import Ledger (AssetClass, PaymentPubKeyHash (PaymentPubKeyHash)) 14 | import Plutus.V2.Ledger.Api (POSIXTime, PubKeyHash) 15 | 16 | data MintAuthOpts = MintAuthOpts 17 | { mao'pabConfig :: FilePath 18 | , mao'coopDeploymentFile :: FilePath 19 | , mao'aaWalletPkh :: PubKeyHash 20 | , mao'certificateValidFrom :: POSIXTime 21 | , mao'certificateValidTo :: POSIXTime 22 | , mao'nAuthTokensPerWallet :: Integer 23 | , mao'certRdmrAcFile :: FilePath 24 | , mao'authWalletPkhs :: [PubKeyHash] 25 | } 26 | deriving stock (Show, Eq) 27 | 28 | mintAuth :: MintAuthOpts -> IO () 29 | mintAuth opts = do 30 | coopDeployment <- fromMaybe (error "mintAuth: Must have a CoopDeployment file in JSON") <$> decodeFileStrict @CoopDeployment (mao'coopDeploymentFile opts) 31 | pabConf <- either (\err -> error $ "mintAuth: Must have a PABConfig file in Config format: " <> err) id <$> loadPABConfig (mao'pabConfig opts) 32 | certRdmrAc <- readFileDeserialise @AssetClass (mao'certRdmrAcFile opts) 33 | 34 | (_, errOrAcs) <- 35 | runBpi @Text 36 | pabConf 37 | { pcOwnPubKeyHash = mao'aaWalletPkh opts 38 | } 39 | $ mintAuthAndCert coopDeployment (PaymentPubKeyHash <$> mao'authWalletPkhs opts) (mao'nAuthTokensPerWallet opts) certRdmrAc (mao'certificateValidFrom opts) (mao'certificateValidTo opts) 40 | either 41 | (\err -> error $ "mintAuth: Must have $AUTH and $CERT asset classes" <> show err) 42 | ( \(certAc, authAc) -> do 43 | putStrLn $ "mintAuth: Minted $CERT " <> show certAc 44 | putStrLn $ "mintAuth: Minted $AUTH " <> show authAc 45 | ) 46 | errOrAcs 47 | return () 48 | -------------------------------------------------------------------------------- /coop-pab/app/Coop/Cli/MintCertRdmrs.hs: -------------------------------------------------------------------------------- 1 | module Coop.Cli.MintCertRdmrs (MintCertRdmrsOpts (..), mintCertRdmrs) where 2 | 3 | import BotPlutusInterface.Config (loadPABConfig) 4 | import BotPlutusInterface.Types (PABConfig (pcOwnPubKeyHash)) 5 | 6 | import Codec.Serialise (writeFileSerialise) 7 | import Coop.Pab (mintCertRedeemers) 8 | import Coop.Pab.Aux (DeployMode, loadCoopPlutus, runBpi) 9 | import Data.Text (Text) 10 | import Plutus.V2.Ledger.Api (PubKeyHash) 11 | 12 | data MintCertRdmrsOpts = MintCertRdmrsOpts 13 | { mcro'mode :: DeployMode 14 | , mcro'pabConfig :: FilePath 15 | , mcro'certRdmrWalletPkh :: PubKeyHash 16 | , mcro'nCertRdmrTokens :: Integer 17 | , mcro'certRdmrAcFile :: FilePath 18 | } 19 | deriving stock (Show, Eq) 20 | 21 | mintCertRdmrs :: MintCertRdmrsOpts -> IO () 22 | mintCertRdmrs opts = do 23 | coopPlutus <- loadCoopPlutus (mcro'mode opts) 24 | 25 | pabConf <- either (\err -> error $ "mintCertRdmrs: Must have a PABConfig file in Config format: " <> err) id <$> loadPABConfig (mcro'pabConfig opts) 26 | 27 | (_, errOrAcs) <- 28 | runBpi @Text 29 | pabConf 30 | { pcOwnPubKeyHash = mcro'certRdmrWalletPkh opts 31 | } 32 | $ mintCertRedeemers coopPlutus (mcro'nCertRdmrTokens opts) 33 | either 34 | (\err -> error $ "mintCertRdmrs: Must have $CERT-RDMR asset class" <> show err) 35 | ( \certRdmrAc -> do 36 | putStrLn $ "mintCertRdmrs: Minted $CERT-RDMR tokens with AssetClass " <> show certRdmrAc 37 | -- FIXME: Why is it complaining NOW about the OverlappingInstances when using Aeson? 38 | writeFileSerialise (mcro'certRdmrAcFile opts) certRdmrAc 39 | ) 40 | errOrAcs 41 | return () 42 | -------------------------------------------------------------------------------- /coop-pab/app/Coop/Cli/RedistributeAuth.hs: -------------------------------------------------------------------------------- 1 | module Coop.Cli.RedistributeAuth (RedistributeAuthOpts (..), redistributeAuth) where 2 | 3 | import BotPlutusInterface.Config (loadPABConfig) 4 | import BotPlutusInterface.Types (PABConfig (pcOwnPubKeyHash)) 5 | 6 | import Control.Lens (makeLenses, (^.)) 7 | import Coop.Pab (runRedistributeAuthsTrx) 8 | import Coop.Pab.Aux (runBpi) 9 | import Coop.Types (CoopDeployment) 10 | import Data.Aeson (decodeFileStrict) 11 | import Data.Foldable (for_) 12 | import Data.Maybe (fromMaybe) 13 | import Data.Text (Text) 14 | import Ledger (PaymentPubKeyHash (PaymentPubKeyHash)) 15 | import Plutus.V2.Ledger.Api (PubKeyHash) 16 | 17 | data RedistributeAuthOpts = RedistributeAuthOpts 18 | { _pabConfig :: FilePath 19 | , _coopDeploymentFile :: FilePath 20 | , _howManyOutputs :: Int 21 | , _authWalletPkhs :: [PubKeyHash] 22 | } 23 | deriving stock (Show, Eq) 24 | 25 | makeLenses ''RedistributeAuthOpts 26 | 27 | redistributeAuth :: RedistributeAuthOpts -> IO () 28 | redistributeAuth opts = do 29 | coopDeployment <- fromMaybe (error "redistributeAuth: Must have a CoopDeployment file in JSON") <$> decodeFileStrict @CoopDeployment (opts ^. coopDeploymentFile) 30 | pabConf <- either (\err -> error $ "redistributeAuth: Must have a PABConfig file in Config format: " <> err) id <$> loadPABConfig (opts ^. pabConfig) 31 | 32 | for_ 33 | (opts ^. authWalletPkhs) 34 | ( \authWallet -> do 35 | (_, errOrAcs) <- 36 | runBpi @Text 37 | pabConf 38 | { pcOwnPubKeyHash = authWallet 39 | } 40 | $ runRedistributeAuthsTrx 41 | coopDeployment 42 | (PaymentPubKeyHash authWallet) 43 | (opts ^. howManyOutputs) 44 | 45 | either 46 | (\err -> error $ "redistributeAuth: Failed redistributing output for Authenticator " <> show authWallet <> "with error " <> show err) 47 | ( \_ -> do 48 | putStrLn $ "redistributeAuth: Redistributed outputs for Authenticator " <> show authWallet 49 | ) 50 | errOrAcs 51 | ) 52 | -------------------------------------------------------------------------------- /coop-pab/app/Coop/Cli/TxBuilderGrpc.hs: -------------------------------------------------------------------------------- 1 | module Coop.Cli.TxBuilderGrpc (txBuilderService, TxBuilderGrpcOpts (..)) where 2 | 3 | import Control.Lens (makeLenses, (&), (.~), (^.)) 4 | import Network.GRPC.HTTP2.Encoding as Encoding ( 5 | gzip, 6 | uncompressed, 7 | ) 8 | import Network.GRPC.HTTP2.ProtoLens (RPC (RPC)) 9 | import Network.GRPC.Server as Server ( 10 | ServiceHandler, 11 | UnaryHandler, 12 | runGrpc, 13 | unary, 14 | ) 15 | import Network.Wai.Handler.Warp qualified as Warp 16 | import Network.Wai.Handler.WarpTLS (tlsSettings) 17 | import Plutus.V1.Ledger.Value (AssetClass, assetClassValue) 18 | import Plutus.V2.Ledger.Api (PubKeyHash) 19 | import Proto.TxBuilderService (CreateGcFsTxReq, CreateGcFsTxResp, CreateMintFsTxReq, CreateMintFsTxResp, TxBuilder) 20 | 21 | import BotPlutusInterface.Config (loadPABConfig) 22 | import BotPlutusInterface.Files (txFileName) 23 | import BotPlutusInterface.Types (PABConfig, RawTx (_cborHex), pcOwnPubKeyHash, pcTxFileDir) 24 | import Cardano.Proto.Aux (ProtoCardano (toCardano)) 25 | import Coop.Pab (runGcFsTx, runMintFsTx) 26 | import Coop.Pab.Aux (runBpi) 27 | import Coop.Types (CoopDeployment) 28 | import Data.Aeson (decodeFileStrict) 29 | import Data.Maybe (fromMaybe) 30 | import Data.ProtoLens (Message (defMessage)) 31 | import Data.Text (Text, unpack) 32 | import Data.Text qualified as Text 33 | import GHC.Exts (fromString) 34 | import Ledger (PaymentPubKeyHash (PaymentPubKeyHash), TxId) 35 | import Proto.Cardano_Fields (cborBase16) 36 | import Proto.TxBuilderService_Fields (gcFsTx, info, mintFsTx, msg, otherErr, submitter, success) 37 | import Proto.TxBuilderService_Fields qualified as Proto.TxBuilderService 38 | import System.Directory (doesFileExist, makeAbsolute) 39 | import System.FilePath (()) 40 | 41 | data TxBuilderGrpcOpts = TxBuilderGrpcOpts 42 | { _pabConfig :: FilePath 43 | , _coopDeploymentFile :: FilePath 44 | , _authWallets :: [PubKeyHash] 45 | , _fee :: (PubKeyHash, AssetClass, Integer) 46 | , _grpcAddress :: String 47 | , _grpcPort :: Int 48 | , _tlsCertFile :: FilePath 49 | , _tlsKeyFile :: FilePath 50 | , _mintFsTxValidityMinutes :: Integer 51 | } 52 | deriving stock (Show, Eq) 53 | 54 | makeLenses ''TxBuilderGrpcOpts 55 | 56 | txBuilderService :: TxBuilderGrpcOpts -> IO () 57 | txBuilderService opts = do 58 | coopDeployment <- fromMaybe (error "txBuilderService: Must have a CoopDeployment file in JSON") <$> decodeFileStrict @CoopDeployment (opts ^. coopDeploymentFile) 59 | pabConf <- either (\err -> error $ "txBuilderService: Must have a PABConfig file in Config format: " <> err) id <$> loadPABConfig (opts ^. pabConfig) 60 | 61 | let (feeCollector, feeAc, feeQ) = opts ^. fee 62 | feeValue = assetClassValue feeAc feeQ 63 | authenticators = PaymentPubKeyHash <$> opts ^. authWallets 64 | runMintFsTxOnReq = 65 | runMintFsTx 66 | coopDeployment 67 | authenticators 68 | (feeValue, PaymentPubKeyHash feeCollector) 69 | (False, opts ^. mintFsTxValidityMinutes) 70 | 71 | handleCreateMintFsTx :: Server.UnaryHandler IO CreateMintFsTxReq CreateMintFsTxResp 72 | handleCreateMintFsTx _ req = do 73 | print ("TxBuilder got CreateMintFsTxReq:" <> show req) 74 | sub <- toCardano (req ^. submitter) 75 | (_, errOrAcs) <- 76 | runBpi @Text 77 | pabConf 78 | { pcOwnPubKeyHash = sub 79 | } 80 | (runMintFsTxOnReq req) 81 | either 82 | (\err -> return $ defMessage & Proto.TxBuilderService.error . otherErr . msg .~ "Failed running a BPI contract with: " <> err) 83 | ( \(mayTxId, info') -> do 84 | maybe 85 | ( return $ 86 | defMessage 87 | & Proto.TxBuilderService.error . otherErr . msg .~ "Failed creating mint-fact-statement-tx" 88 | & info .~ info' 89 | ) 90 | ( \txId -> do 91 | mayRawTx <- readSignedTx pabConf Partial txId 92 | either 93 | ( \err -> 94 | return $ 95 | defMessage 96 | & Proto.TxBuilderService.error . otherErr . msg .~ ("Failed creating mint-fact-statement-tx: " <> err) 97 | & info .~ info' 98 | ) 99 | ( \rawTx -> 100 | return $ 101 | defMessage 102 | & info .~ info' 103 | & success . mintFsTx . cborBase16 .~ rawTx 104 | ) 105 | mayRawTx 106 | ) 107 | mayTxId 108 | ) 109 | errOrAcs 110 | 111 | runGcFsTxOnReq = 112 | runGcFsTx 113 | coopDeployment 114 | False 115 | 116 | handleCreateGcFsTx :: Server.UnaryHandler IO CreateGcFsTxReq CreateGcFsTxResp 117 | handleCreateGcFsTx _ req = do 118 | print ("TxBuilder got CreateGcFsTxReq:" <> show req) 119 | sub <- toCardano (req ^. submitter) 120 | (_, errOrAcs) <- 121 | runBpi @Text 122 | pabConf 123 | { pcOwnPubKeyHash = sub 124 | } 125 | (runGcFsTxOnReq req) 126 | either 127 | (\err -> return $ defMessage & Proto.TxBuilderService.error . otherErr . msg .~ "Failed running a BPI contract with: " <> err) 128 | ( \(mayTxId, info') -> do 129 | maybe 130 | ( return $ 131 | defMessage 132 | & Proto.TxBuilderService.error . otherErr . msg .~ "Failed creating a gc-fact-statement-tx" 133 | & info .~ info' 134 | ) 135 | ( \txId -> do 136 | print $ "Reading tx with" <> show txId 137 | mayRawTx <- readSignedTx pabConf None txId 138 | either 139 | ( \err -> 140 | return $ 141 | defMessage 142 | & Proto.TxBuilderService.error . otherErr . msg .~ ("Failed creating a gc-fact-statement-tx: " <> err) 143 | & info .~ info' 144 | ) 145 | ( \rawTx -> 146 | return $ 147 | defMessage 148 | & success . gcFsTx . cborBase16 .~ rawTx 149 | & info .~ info' 150 | ) 151 | mayRawTx 152 | ) 153 | mayTxId 154 | ) 155 | errOrAcs 156 | 157 | routes :: [ServiceHandler] 158 | routes = 159 | [ Server.unary (RPC :: RPC TxBuilder "createMintFsTx") handleCreateMintFsTx 160 | , Server.unary (RPC :: RPC TxBuilder "createGcFsTx") handleCreateGcFsTx 161 | ] 162 | 163 | runServer 164 | routes 165 | (fromString $ opts ^. grpcAddress, opts ^. grpcPort) 166 | (opts ^. tlsCertFile, opts ^. tlsKeyFile) 167 | 168 | runServer :: [ServiceHandler] -> (Warp.HostPreference, Int) -> (FilePath, FilePath) -> IO () 169 | runServer routes (h, p) (certFile, keyFile) = do 170 | let warpSettings = 171 | Warp.defaultSettings 172 | & Warp.setPort p 173 | & Warp.setHost h 174 | Server.runGrpc 175 | (tlsSettings certFile keyFile) 176 | warpSettings 177 | routes 178 | [ Encoding.uncompressed 179 | , Encoding.gzip 180 | ] 181 | 182 | data Signed = Partial | None 183 | 184 | readSignedTx :: PABConfig -> Signed -> TxId -> IO (Either Text Text) 185 | readSignedTx pabConf signed txId = do 186 | txFolderPath <- makeAbsolute (unpack . pcTxFileDir $ pabConf) 187 | let path :: FilePath 188 | path = 189 | txFolderPath 190 | unpack 191 | ( txFileName 192 | txId 193 | ( case signed of 194 | None -> "raw" 195 | Partial -> "signed" 196 | ) 197 | ) 198 | fileExists <- doesFileExist path 199 | if fileExists 200 | then do 201 | mayRawTx <- decodeFileStrict @RawTx path 202 | maybe 203 | ( do 204 | return . Left . Text.pack $ "Must have a properly formatter RawTx in Json at " <> path 205 | ) 206 | (return . Right . _cborHex) 207 | mayRawTx 208 | else do 209 | return . Left . Text.pack $ "Must find signed transaction file at " <> path 210 | -------------------------------------------------------------------------------- /coop-pab/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Coop.Cli.Deploy (DeployOpts (DeployOpts), deploy) 4 | import Coop.Pab.Aux (DeployMode (DEPLOY_DEBUG)) 5 | 6 | import Control.Applicative (Alternative (many), (<**>)) 7 | import Coop.Cli.Aux (assetClassOpt, posixTimeOpt, pubKeyHashOpt) 8 | import Coop.Cli.GarbageCollect (GarbageCollectOpts (GarbageCollectOpts), garbageCollect) 9 | import Coop.Cli.GetState (GetStateOpts (GetStateOpts), getState) 10 | import Coop.Cli.MintAuth (MintAuthOpts (MintAuthOpts), mintAuth) 11 | import Coop.Cli.MintCertRdmrs (MintCertRdmrsOpts (MintCertRdmrsOpts), mintCertRdmrs) 12 | import Coop.Cli.RedistributeAuth (RedistributeAuthOpts (RedistributeAuthOpts), redistributeAuth) 13 | import Coop.Cli.TxBuilderGrpc (TxBuilderGrpcOpts (TxBuilderGrpcOpts), txBuilderService) 14 | import Options.Applicative ( 15 | Parser, 16 | ParserInfo, 17 | auto, 18 | command, 19 | customExecParser, 20 | fullDesc, 21 | help, 22 | helper, 23 | info, 24 | long, 25 | metavar, 26 | option, 27 | prefs, 28 | progDesc, 29 | showDefault, 30 | showHelpOnEmpty, 31 | showHelpOnError, 32 | strOption, 33 | subparser, 34 | value, 35 | ) 36 | import Plutus.V1.Ledger.Value (AssetClass, adaSymbol, adaToken, assetClass) 37 | import Plutus.V2.Ledger.Api (PubKeyHash) 38 | 39 | data Command 40 | = Deploy DeployOpts 41 | | MintCertRdmrs MintCertRdmrsOpts 42 | | MintAuth MintAuthOpts 43 | | GarbageCollect GarbageCollectOpts 44 | | GetState GetStateOpts 45 | | TxBuilderGrpc TxBuilderGrpcOpts 46 | | RedistributeAuth RedistributeAuthOpts 47 | 48 | pabConfigOptP :: Parser [Char] 49 | pabConfigOptP = 50 | strOption 51 | ( long "pab-config" 52 | <> metavar "PAB_CONFIG" 53 | <> help "A bot-plutus-interface PAB config file" 54 | <> value "resources/pabConfig.yaml" 55 | <> showDefault 56 | ) 57 | 58 | deploymentFileOptP :: Parser [Char] 59 | deploymentFileOptP = 60 | strOption 61 | ( long "deployment-file" 62 | <> metavar "DEPLOYMENT_FILE" 63 | <> help "A JSON file to write the COOP deployment information to" 64 | <> value ".coop-pab-cli/coop-deployment.json" 65 | <> showDefault 66 | ) 67 | 68 | modeOptP :: Parser DeployMode 69 | modeOptP = 70 | option 71 | auto 72 | ( long "mode" 73 | <> metavar "DEPLOY_MODE" 74 | <> help "Compilation mode for Plutus scripts that enables tracing logs (ie. DEPLOY_DEBUG|DEPLOY_PROD)" 75 | <> value DEPLOY_DEBUG 76 | <> showDefault 77 | ) 78 | 79 | aaWalletPkhOptP :: Parser PubKeyHash 80 | aaWalletPkhOptP = 81 | pubKeyHashOpt 82 | ( long "aa-wallet" 83 | <> metavar "AA_WALLET" 84 | <> help "A wallet hexed PubKeyHash (eq. 04efa495982b94e07511eaa07c738a0a7ec356729e4b751159d96001) holding $AA tokens" 85 | ) 86 | 87 | certRdmrAcOptP :: Parser FilePath 88 | certRdmrAcOptP = 89 | strOption 90 | ( long "cert-rdmr-ac-file" 91 | <> metavar "CERT_RDMR_AC_FILE" 92 | <> help "A Haskell `serialise` encoded file containing the $CERT-RDMR AssetClass" 93 | <> value ".coop-pab-cli/cert-rdmr-ac.show" 94 | <> showDefault 95 | ) 96 | 97 | certRdmrWalletOptP :: Parser PubKeyHash 98 | certRdmrWalletOptP = 99 | pubKeyHashOpt 100 | ( long "cert-rdmr-wallet" 101 | <> metavar "CERTRDMR_WALLET" 102 | <> help "A wallet hexed PubKeyHash (eq. 04efa495982b94e07511eaa07c738a0a7ec356729e4b751159d96001) holding $CERT-RDMR tokens that will perform `coop-pab-cli garbage-collect`" 103 | ) 104 | 105 | authWalletsOpt :: Parser [PubKeyHash] 106 | authWalletsOpt = 107 | many 108 | ( pubKeyHashOpt 109 | ( long "auth-wallet" 110 | <> metavar "AUTH_WALLET" 111 | <> help "Wallet hexed PubKeyHash (eq. 04efa495982b94e07511eaa07c738a0a7ec356729e4b751159d96001) holding $AUTH tokens" 112 | ) 113 | ) 114 | 115 | feeOptP :: Parser (PubKeyHash, AssetClass, Integer) 116 | feeOptP = 117 | (,,) 118 | <$> pubKeyHashOpt 119 | ( long "fee-wallet" 120 | <> metavar "FEE_WALLET" 121 | <> help "Wallet hexed PubKeyHash (eq. 04efa495982b94e07511eaa07c738a0a7ec356729e4b751159d96001) holding $FEE tokens" 122 | ) 123 | <*> assetClassOpt 124 | ( long "fee-ac" 125 | <> metavar "FEE_AC" 126 | <> help "$FEE asset class used to pay the COOP Publisher for publishing Fact Statements" 127 | <> value (assetClass adaSymbol adaToken) 128 | <> showDefault 129 | ) 130 | <*> option 131 | auto 132 | ( long "fee-quantity" 133 | <> metavar "FEE_Q" 134 | <> help "$FEE amount to pay the COOP Publisher for publishing Fact Statements" 135 | <> value 1 136 | <> showDefault 137 | ) 138 | 139 | deployOptsP :: Parser DeployOpts 140 | deployOptsP = 141 | DeployOpts 142 | <$> modeOptP 143 | <*> pabConfigOptP 144 | <*> deploymentFileOptP 145 | <*> pubKeyHashOpt 146 | ( long "god-wallet" 147 | <> metavar "GOD_WALLET" 148 | <> help "A wallet hexed PubKeyHash (eq. 04efa495982b94e07511eaa07c738a0a7ec356729e4b751159d96001) used to perform the COOP genesis" 149 | ) 150 | <*> aaWalletPkhOptP 151 | <*> option 152 | auto 153 | ( long "at-least-aa-required" 154 | <> metavar "AA_Q_REQUIRED" 155 | <> help "$AA (authentication authority) token quantity required to mint authentication (ie. `coop-pab-cli mint-auth`)" 156 | <> value 1 157 | <> showDefault 158 | ) 159 | <*> option 160 | auto 161 | ( long "aa-to-mint" 162 | <> metavar "AA_Q" 163 | <> help "$AA (authentication authority) tokens to mint and pay to AA_WALLET" 164 | <> value 3 165 | <> showDefault 166 | ) 167 | 168 | mintCertRdmrsOptsP :: Parser MintCertRdmrsOpts 169 | mintCertRdmrsOptsP = 170 | MintCertRdmrsOpts 171 | <$> modeOptP 172 | <*> pabConfigOptP 173 | <*> certRdmrWalletOptP 174 | <*> option 175 | auto 176 | ( long "cert-rdmrs-to-mint" 177 | <> metavar "CERTRDMR_Q" 178 | <> help "$CERT-RDMR (certificate redeemer) tokens to mint and pay to CERTRDMR_WALLET" 179 | <> value 100 180 | <> showDefault 181 | ) 182 | <*> certRdmrAcOptP 183 | 184 | mintAuthOptsP :: Parser MintAuthOpts 185 | mintAuthOptsP = 186 | MintAuthOpts 187 | <$> pabConfigOptP 188 | <*> deploymentFileOptP 189 | <*> aaWalletPkhOptP 190 | <*> posixTimeOpt 191 | ( long "certificate-valid-from" 192 | <> metavar "CERT_VALID_FROM" 193 | <> help "POSIXTime denoting the Ledger time the certificate is valid from" 194 | ) 195 | <*> posixTimeOpt 196 | ( long "certificate-valid-to" 197 | <> metavar "CERT_VALID_TO" 198 | <> help "POSIXTime denoting the Ledger time the certificate is valid until" 199 | ) 200 | <*> option 201 | auto 202 | ( long "auth-tokens-per-wallet-to-mint" 203 | <> metavar "AUTH_Q_PER_WALLET" 204 | <> help "$AUTH tokens to mint and pay to each specified Auth wallet (AUTH_WALLET)" 205 | <> value 100 206 | <> showDefault 207 | ) 208 | <*> certRdmrAcOptP 209 | <*> authWalletsOpt 210 | 211 | garbageCollectOptsP :: Parser GarbageCollectOpts 212 | garbageCollectOptsP = 213 | GarbageCollectOpts 214 | <$> pabConfigOptP 215 | <*> deploymentFileOptP 216 | <*> certRdmrWalletOptP 217 | <*> certRdmrAcOptP 218 | 219 | getStateOptsP :: Parser GetStateOpts 220 | getStateOptsP = 221 | GetStateOpts 222 | <$> pabConfigOptP 223 | <*> deploymentFileOptP 224 | <*> pubKeyHashOpt 225 | ( long "any-wallet" 226 | <> metavar "ANY_WALLET" 227 | <> help "Wallet hexed PubKeyHash (eq. 04efa495982b94e07511eaa07c738a0a7ec356729e4b751159d96001) used to run the query contracts" 228 | ) 229 | <*> strOption 230 | ( long "state-file" 231 | <> metavar "STATE_FILE" 232 | <> help "A JSON file to write the COOP state information to" 233 | <> value ".coop-pab-cli/coop-state.json" 234 | <> showDefault 235 | ) 236 | 237 | txBuilderGrpcOpts :: Parser TxBuilderGrpcOpts 238 | txBuilderGrpcOpts = 239 | TxBuilderGrpcOpts 240 | <$> pabConfigOptP 241 | <*> deploymentFileOptP 242 | <*> authWalletsOpt 243 | <*> feeOptP 244 | <*> strOption 245 | ( long "address" 246 | <> metavar "ADDR" 247 | <> help "Local IP address or host name to bing the TxBuilder gRpc service to" 248 | <> value "localhost" 249 | <> showDefault 250 | ) 251 | <*> option 252 | auto 253 | ( long "port" 254 | <> metavar "PORT" 255 | <> help "TCP port to bind the TxBuilder gRpc service to" 256 | <> value 5081 257 | <> showDefault 258 | ) 259 | <*> strOption 260 | ( long "cert-file" 261 | <> metavar "CERT_FILE" 262 | <> help "Certificate file to use for TLS" 263 | <> value ".coop-pab-cli/certificate.pem" 264 | <> showDefault 265 | ) 266 | <*> strOption 267 | ( long "key-file" 268 | <> metavar "KEY_FILE" 269 | <> help "Private key file to use for TLS" 270 | <> value ".coop-pab-cli/key.pem" 271 | <> showDefault 272 | ) 273 | <*> option 274 | auto 275 | ( long "mint-fs-tx-validity-minutes" 276 | <> metavar "MINT_VALIDITY_MINUTES" 277 | <> help "mint-fact-statement-tx validity range setting validityRange = " 278 | <> value 10 279 | <> showDefault 280 | ) 281 | 282 | redistAuthOptsP :: Parser RedistributeAuthOpts 283 | redistAuthOptsP = 284 | RedistributeAuthOpts 285 | <$> pabConfigOptP 286 | <*> deploymentFileOptP 287 | <*> option 288 | auto 289 | ( long "how-many-outputs" 290 | <> metavar "N_OUTPUTS" 291 | <> help "Number of outputs to create on an Authenticator each with 1 $AUTH token" 292 | <> value 10 293 | <> showDefault 294 | ) 295 | <*> authWalletsOpt 296 | 297 | optionsP :: Parser Command 298 | optionsP = 299 | subparser $ 300 | command 301 | "deploy" 302 | (info (Deploy <$> deployOptsP <* helper) (progDesc "Deploy COOP on the Cardano network and write the deployment information to a file")) 303 | <> command 304 | "mint-cert-redeemers" 305 | (info (MintCertRdmrs <$> mintCertRdmrsOptsP <* helper) (progDesc "Mint $CERT-RDMR (one shot) tokens and pay them to a wallet that will perform garbage collection")) 306 | <> command 307 | "mint-auth" 308 | (info (MintAuth <$> mintAuthOptsP <* helper) (progDesc "Mint and pay to @CertV a $CERT token with a specified $CERT-RDMR asset class and validty range along with minting and paying associated $AUTH tokens to each Auth wallet")) 309 | <> command 310 | "garbage-collect" 311 | (info (GarbageCollect <$> garbageCollectOptsP <* helper) (progDesc "Spend expired $CERT tokens locked at @CertV using $CERT-RDMR tokens")) 312 | <> command 313 | "get-state" 314 | (info (GetState <$> getStateOptsP <* helper) (progDesc "Get COOP state")) 315 | <> command 316 | "tx-builder-grpc" 317 | (info (TxBuilderGrpc <$> txBuilderGrpcOpts <* helper) (progDesc "Run a TxBuilder gRpc service")) 318 | <> command 319 | "redistribute-auth" 320 | (info (RedistributeAuth <$> redistAuthOptsP <* helper) (progDesc "Redistribute Authenticator UTxOs with many $AUTH tokens into separate outputs with 1 $AUTH tokens")) 321 | 322 | parserInfo :: ParserInfo Command 323 | parserInfo = info (optionsP <**> helper) (fullDesc <> progDesc "COOP PAB cli tools") 324 | 325 | main :: IO () 326 | main = do 327 | cmd <- customExecParser (prefs (showHelpOnEmpty <> showHelpOnError)) parserInfo 328 | case cmd of 329 | Deploy opts -> deploy opts 330 | MintCertRdmrs opts -> mintCertRdmrs opts 331 | MintAuth opts -> mintAuth opts 332 | GarbageCollect opts -> garbageCollect opts 333 | GetState opts -> getState opts 334 | TxBuilderGrpc opts -> txBuilderService opts 335 | RedistributeAuth opts -> redistributeAuth opts 336 | -------------------------------------------------------------------------------- /coop-pab/aux.bash: -------------------------------------------------------------------------------- 1 | # shellcheck disable=SC2155,SC2002,SC2003 2 | function generate-keys { 3 | local WORKDIR=.coop-pab-cli 4 | local RESOURCES=resources 5 | openssl genrsa -out $WORKDIR/key.pem 2048 6 | openssl req -new -key $WORKDIR/key.pem -out $WORKDIR/certificate.csr 7 | openssl x509 -req -in $WORKDIR/certificate.csr -signkey $WORKDIR/key.pem -out $WORKDIR/certificate.pem -extfile $RESOURCES/ssl-extensions-x509.conf -extensions v3_ca 8 | openssl x509 -text -in $WORKDIR/certificate.pem 9 | } 10 | 11 | function start-cluster { 12 | # As specified in resources/pabConfig.yaml 13 | rm -fR .wallets 14 | rm -fR .local-cluster 15 | mkdir .wallets 16 | mkdir .local-cluster 17 | mkdir .local-cluster/txs 18 | mkdir .local-cluster/scripts 19 | local-cluster --wallet-dir .wallets -n 10 --utxos 5 --chain-index-port 9084 --slot-len 1s --epoch-size 100000 20 | } 21 | 22 | function parse-cluster-config { 23 | cat > .coop-pab-cli/plutip-cluster-config 24 | make-exports 25 | mv .wallets/signing-key-"$SUBMITTER_PKH".skey .wallets/no-plutip-signing-key-"$SUBMITTER_PKH".skey 26 | } 27 | 28 | function make-exports { 29 | export GOD_PKH=$(cat .coop-pab-cli/plutip-cluster-config | grep -E "Wallet 1 PKH" | cut -d ":" -f 2 | xargs) 30 | export AA_PKH=$(cat .coop-pab-cli/plutip-cluster-config | grep -E "Wallet 2 PKH" | cut -d ":" -f 2 | xargs) 31 | export AUTH_PKH=$(cat .coop-pab-cli/plutip-cluster-config | grep -E "Wallet 3 PKH" | cut -d ":" -f 2 | xargs) 32 | export CERT_RDMR_PKH=$(cat .coop-pab-cli/plutip-cluster-config | grep -E "Wallet 4 PKH" | cut -d ":" -f 2 | xargs) 33 | export FEE_PKH=$(cat .coop-pab-cli/plutip-cluster-config | grep -E "Wallet 5 PKH" | cut -d ":" -f 2 | xargs) 34 | export SUBMITTER_PKH=$(cat .coop-pab-cli/plutip-cluster-config | grep -E "Wallet 6 PKH" | cut -d ":" -f 2 | xargs) 35 | export CARDANO_NODE_SOCKET_PATH=$(cat .coop-pab-cli/plutip-cluster-config | grep CardanoNodeConn | grep -E -o '"[^"]+"' | sed s/\"//g) 36 | } 37 | 38 | function dump-env { 39 | export | grep -E "WALLET|CARDANO_NODE_SOCKET_PATH" 40 | } 41 | 42 | function coop-genesis { 43 | make-exports 44 | cabal clean 45 | cabal run coop-pab-cli -- deploy --god-wallet "$GOD_PKH" --aa-wallet "$AA_PKH" 46 | } 47 | 48 | function coop-mint-cert-redeemers { 49 | make-exports 50 | cabal run coop-pab-cli -- mint-cert-redeemers --cert-rdmr-wallet "$CERT_RDMR_PKH" --cert-rdmrs-to-mint 100 51 | } 52 | 53 | function coop-mint-authentication { 54 | make-exports 55 | NOW=$(get-onchain-time) && cabal run coop-pab-cli -- mint-auth --aa-wallet "$AA_PKH" --certificate-valid-from "$NOW" --certificate-valid-to "$(expr "$NOW" + 60 \* 60 \* 1000)" --auth-wallet "$AUTH_PKH" 56 | } 57 | 58 | function coop-redist-auth { 59 | make-exports 60 | cabal run coop-pab-cli -- redistribute-auth --auth-wallet "$AUTH_PKH" 61 | } 62 | 63 | function coop-run-tx-builder-grpc { 64 | make-exports 65 | cabal run coop-pab-cli -- tx-builder-grpc --auth-wallet "$AUTH_PKH" --fee-wallet "$FEE_PKH" 66 | } 67 | 68 | function coop-garbage-collect { 69 | make-exports 70 | cabal run coop-pab-cli -- garbage-collect --cert-rdmr-wallet "$CERT_RDMR_PKH" 71 | } 72 | 73 | function coop-get-state { 74 | make-exports 75 | cabal run coop-pab-cli -- get-state --any-wallet "$GOD_PKH" 76 | cat .coop-pab-cli/coop-state.json | json_pp 77 | } 78 | 79 | function coop-poll-state { 80 | make-exports 81 | while true; do 82 | clear; 83 | coop-get-state; 84 | sleep 5; 85 | done; 86 | } 87 | 88 | function get-onchain-time { 89 | make-exports 90 | cabal run coop-pab-cli -- get-state --any-wallet "$GOD_PKH" | grep "Current node client time range" | grep POSIXTime | grep -E -o "[0-9]+" 91 | } 92 | 93 | function run-grpcui { 94 | make-exports 95 | grpcui -insecure -import-path ../coop-proto -proto ../coop-proto/tx-builder-service.proto localhost:5081 96 | } 97 | 98 | function coop-mint-fs { 99 | make-exports 100 | resp=$(grpcurl -insecure -import-path ../coop-proto -proto ../coop-proto/tx-builder-service.proto -d @ localhost:5081 coop.tx_builder.TxBuilder/createMintFsTx < .coop-pab-cli/signed 179 | cardano-cli transaction sign --tx-file .coop-pab-cli/signed --signing-key-file .wallets/no-plutip-signing-key-"$SUBMITTER_PKH".skey --out-file .coop-pab-cli/ready 180 | cardano-cli transaction submit --tx-file .coop-pab-cli/ready --mainnet 181 | } 182 | 183 | function coop-gc-fs { 184 | make-exports 185 | resp=$(grpcurl -insecure -import-path ../coop-proto -proto ../coop-proto/tx-builder-service.proto -d @ localhost:5081 coop.tx_builder.TxBuilder/createGcFsTx < .coop-pab-cli/signed 204 | cardano-cli transaction sign --tx-body-file .coop-pab-cli/signed --signing-key-file .wallets/no-plutip-signing-key-"$SUBMITTER_PKH".skey --out-file .coop-pab-cli/ready 205 | cardano-cli transaction submit --tx-file .coop-pab-cli/ready --mainnet 206 | } 207 | 208 | function coop-prelude { 209 | make-exports 210 | coop-genesis 211 | coop-mint-cert-redeemers 212 | coop-mint-authentication 213 | coop-redist-auth 214 | coop-run-tx-builder-grpc 215 | } 216 | -------------------------------------------------------------------------------- /coop-pab/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, haskell-nix, compiler-nix-name, plutip, coopPlutusCli, plutipLocalCluster, coop-hs-types, txBuilderProtoHs, cardanoProtoHs, cardanoProtoExtras, http2-grpc-native, shellHook }: 2 | let 3 | # FIXME: Use idiomatic cardano-node from bpi input 4 | cardanoNode = proj.hsPkgs.cardano-node.components.exes.cardano-node; 5 | cardanoCli = proj.hsPkgs.cardano-cli.components.exes.cardano-cli; 6 | proj = haskell-nix.cabalProject' { 7 | src = ./.; 8 | name = "coop-pab"; 9 | inherit compiler-nix-name; 10 | index-state = "2022-05-16T00:00:00Z"; 11 | inherit (plutip) cabalProjectLocal; 12 | modules = plutip.haskellModules ++ [ 13 | { 14 | packages = { 15 | # Enable strict builds 16 | coop-pab.configureFlags = [ "-f-dev" ]; 17 | 18 | # Link coop-plutus-cli into tests 19 | coop-pab.components.tests.coop-pab-tests.build-tools = [ 20 | coopPlutusCli 21 | cardanoNode 22 | cardanoCli 23 | ]; 24 | 25 | # Don't use the new-ledger-namespace 26 | coop-hs-types.configureFlags = [ "-f-new-ledger-namespace" ]; 27 | 28 | # FIXME: This is annoying 29 | # Add proto compilation execs 30 | proto-lens-protobuf-types.components.library.build-tools = [ 31 | pkgs.protobuf 32 | pkgs.haskellPackages.proto-lens-protoc 33 | ]; 34 | 35 | }; 36 | } 37 | ]; 38 | 39 | extraSources = plutip.extraSources ++ [ 40 | { 41 | src = plutip; 42 | subdirs = [ "." ]; 43 | } 44 | { 45 | src = coop-hs-types; 46 | subdirs = [ "." ]; 47 | } 48 | { 49 | src = http2-grpc-native; 50 | subdirs = [ 51 | "http2-client-grpc" 52 | "http2-grpc-proto-lens" 53 | "http2-grpc-types" 54 | "warp-grpc" 55 | ]; 56 | } 57 | { 58 | src = txBuilderProtoHs; 59 | subdirs = [ "." ]; 60 | } 61 | { 62 | src = cardanoProtoHs; 63 | subdirs = [ "." ]; 64 | } 65 | { 66 | src = cardanoProtoExtras; 67 | subdirs = [ "." ]; 68 | } 69 | ]; 70 | 71 | shell = { 72 | withHoogle = true; 73 | 74 | exactDeps = true; 75 | 76 | nativeBuildInputs = with pkgs; [ 77 | # Code quality 78 | ## Haskell/Cabal 79 | haskellPackages.apply-refact 80 | haskellPackages.fourmolu 81 | haskellPackages.cabal-fmt 82 | hlint 83 | coopPlutusCli 84 | cardanoNode 85 | cardanoCli 86 | grpcui 87 | grpcurl 88 | 89 | plutipLocalCluster 90 | ]; 91 | 92 | additional = ps: [ 93 | ps.bot-plutus-interface 94 | ps.plutip 95 | ps.coop-hs-types 96 | ps.cardano-proto-extras 97 | ps.coop-cardano-proto 98 | 99 | # Needed to run the coop.TxBuilder gRpc service 100 | ps.http2-client-grpc 101 | ps.http2-grpc-proto-lens 102 | ps.http2-grpc-types 103 | ps.warp-grpc 104 | ps.coop-tx-builder-service-proto 105 | ]; 106 | 107 | tools = { 108 | cabal = { }; 109 | haskell-language-server = { }; 110 | }; 111 | 112 | shellHook = '' 113 | ${shellHook} 114 | export LC_CTYPE=C.UTF-8 115 | export LC_ALL=C.UTF-8 116 | export LANG=C.UTF-8 117 | source ${./aux.bash} 118 | ''; 119 | 120 | }; 121 | }; 122 | in 123 | proj 124 | -------------------------------------------------------------------------------- /coop-pab/cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./. 2 | 3 | tests: true 4 | -------------------------------------------------------------------------------- /coop-pab/coop-pab.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: coop-pab 3 | version: 0.1.0.0 4 | license: MIT 5 | license-file: LICENSE 6 | maintainer: info@mlabs.city 7 | author: mlabs-haskell 8 | description: 9 | COOP BPI based PAB programs (Contracts) for testing and interacting with the Plutus counterpart 10 | 11 | flag dev 12 | description: Enable non-strict compilation for development 13 | manual: True 14 | 15 | common common-language 16 | ghc-options: 17 | -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind 18 | -Wno-partial-type-signatures -Wmissing-export-lists 19 | -Wincomplete-record-updates -Wmissing-deriving-strategies 20 | -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls 21 | -fprint-explicit-kinds -fwarn-missing-import-lists -Wname-shadowing 22 | -Wunused-packages -fprint-potential-instances 23 | 24 | if !flag(dev) 25 | ghc-options: -Werror 26 | 27 | default-extensions: 28 | NoStarIsType 29 | BangPatterns 30 | BinaryLiterals 31 | ConstrainedClassMethods 32 | ConstraintKinds 33 | DataKinds 34 | DeriveAnyClass 35 | DeriveDataTypeable 36 | DeriveFoldable 37 | DeriveFunctor 38 | DeriveGeneric 39 | DeriveLift 40 | DeriveTraversable 41 | DerivingStrategies 42 | DerivingVia 43 | DoAndIfThenElse 44 | EmptyCase 45 | EmptyDataDecls 46 | EmptyDataDeriving 47 | ExistentialQuantification 48 | ExplicitForAll 49 | ExplicitNamespaces 50 | FlexibleContexts 51 | FlexibleInstances 52 | ForeignFunctionInterface 53 | GADTSyntax 54 | GeneralisedNewtypeDeriving 55 | HexFloatLiterals 56 | ImportQualifiedPost 57 | InstanceSigs 58 | KindSignatures 59 | LambdaCase 60 | MonomorphismRestriction 61 | MultiParamTypeClasses 62 | NamedFieldPuns 63 | NamedWildCards 64 | NumericUnderscores 65 | OverloadedStrings 66 | PartialTypeSignatures 67 | PatternGuards 68 | PolyKinds 69 | PostfixOperators 70 | RankNTypes 71 | RelaxedPolyRec 72 | ScopedTypeVariables 73 | StandaloneDeriving 74 | StandaloneKindSignatures 75 | TemplateHaskell 76 | TraditionalRecordSyntax 77 | TupleSections 78 | TypeApplications 79 | TypeFamilies 80 | TypeOperators 81 | TypeSynonymInstances 82 | ViewPatterns 83 | 84 | default-language: Haskell2010 85 | 86 | library 87 | import: common-language 88 | exposed-modules: 89 | Coop.Pab 90 | Coop.Pab.Aux 91 | 92 | hs-source-dirs: src 93 | build-depends: 94 | , aeson 95 | , base 96 | , bot-plutus-interface 97 | , bytestring 98 | , cardano-proto-extras 99 | , containers 100 | , coop-hs-types 101 | , coop-tx-builder-service-proto 102 | , cryptonite 103 | , directory 104 | , filepath 105 | , lens 106 | , memory 107 | , plutip 108 | , plutus-contract 109 | , plutus-ledger 110 | , plutus-ledger-api 111 | , plutus-pab 112 | , plutus-script-utils 113 | , plutus-tx 114 | , process 115 | , proto-lens 116 | , stm 117 | , text 118 | , uuid 119 | 120 | test-suite coop-pab-tests 121 | import: common-language 122 | build-depends: 123 | , base 124 | , bot-plutus-interface 125 | , bytestring 126 | , cardano-proto-extras 127 | , containers 128 | , coop-hs-types 129 | , coop-pab 130 | , coop-tx-builder-service-proto 131 | , data-default 132 | , lens 133 | , mtl 134 | , plutip 135 | , plutus-contract 136 | , plutus-ledger 137 | , plutus-ledger-api 138 | , plutus-script-utils 139 | , proto-lens 140 | , tasty 141 | , text 142 | 143 | hs-source-dirs: test 144 | main-is: Main.hs 145 | other-modules: Aux 146 | ghc-options: -Wall -threaded -rtsopts 147 | type: exitcode-stdio-1.0 148 | 149 | executable coop-pab-cli 150 | import: common-language 151 | main-is: Main.hs 152 | hs-source-dirs: app 153 | other-modules: 154 | Coop.Cli.Aux 155 | Coop.Cli.Deploy 156 | Coop.Cli.GarbageCollect 157 | Coop.Cli.GetState 158 | Coop.Cli.MintAuth 159 | Coop.Cli.MintCertRdmrs 160 | Coop.Cli.RedistributeAuth 161 | Coop.Cli.TxBuilderGrpc 162 | 163 | build-depends: 164 | , aeson 165 | , base 166 | , bot-plutus-interface 167 | , bytestring 168 | , cardano-proto-extras 169 | , coop-cardano-proto 170 | , coop-hs-types 171 | , coop-pab 172 | , coop-tx-builder-service-proto 173 | , directory 174 | , filepath 175 | , hex 176 | , http2-grpc-proto-lens 177 | , http2-grpc-types 178 | , lens 179 | , optparse-applicative 180 | , plutus-ledger 181 | , plutus-ledger-api 182 | , proto-lens 183 | , serialise 184 | , text 185 | , warp 186 | , warp-grpc 187 | , warp-tls 188 | -------------------------------------------------------------------------------- /coop-pab/hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /coop-pab/resources/pabConfig.yaml: -------------------------------------------------------------------------------- 1 | -- Calling the cli locally or through an ssh connection 2 | cliLocation: local 3 | chainIndexUrl: "http://localhost:9084" 4 | networkId: Mainnet 5 | 6 | -- Directory name of the script and data files 7 | scriptFileDir: ".local-cluster/scripts" 8 | 9 | -- Directory for the signing key file(s) 10 | signingKeyFileDir: ".wallets" 11 | 12 | -- Directory where the encoded transaction files will be saved 13 | txFileDir: ".local-cluster/txs" 14 | 15 | -- | Directory name of metadata files 16 | metadataDir: ".local-cluster/metadata" 17 | 18 | -- Dry run mode will build the tx, but skip the submit step 19 | dryRun: false 20 | logLevel: debug 21 | port: 9080 22 | enableTxEndpoint: true 23 | 24 | -- Save some stats during contract run (only transactions execution budgets supported atm) 25 | collectStats: true 26 | 27 | -- Save logs from contract execution: pab request logs and contract logs 28 | collectLogs: true 29 | -------------------------------------------------------------------------------- /coop-pab/resources/ssl-extensions-x509.conf: -------------------------------------------------------------------------------- 1 | [v3_ca] 2 | basicConstraints = CA:FALSE 3 | keyUsage = digitalSignature, keyEncipherment 4 | subjectAltName = IP:127.0.0.1, DNS:localhost 5 | -------------------------------------------------------------------------------- /coop-pab/test/Aux.hs: -------------------------------------------------------------------------------- 1 | module Aux (runAfter, withSuccessContract) where 2 | 3 | import Control.Monad.Reader (ReaderT) 4 | import Data.Bifunctor (Bifunctor (second)) 5 | import Data.List.NonEmpty (NonEmpty) 6 | import Ledger (PaymentPubKeyHash) 7 | import Plutus.Contract (Contract) 8 | import Test.Plutip.Contract (TestWallets, withContractAs) 9 | import Test.Plutip.Contract.Types (TestContractConstraints) 10 | import Test.Plutip.Internal.Types (ClusterEnv, ExecutionResult (outcome)) 11 | import Test.Plutip.LocalCluster (BpiWallet) 12 | import Test.Tasty (DependencyType (AllFinish), TestName, TestTree, after) 13 | 14 | runAfter :: 15 | TestName -> 16 | (TestWallets, IO (ClusterEnv, NonEmpty BpiWallet) -> TestTree) -> 17 | (TestWallets, IO (ClusterEnv, NonEmpty BpiWallet) -> TestTree) 18 | runAfter testName = second (fmap . after AllFinish $ '/' : testName ++ "/") 19 | 20 | withSuccessContract :: TestContractConstraints w e a => Int -> ([PaymentPubKeyHash] -> Contract w s e a) -> ReaderT (ClusterEnv, NonEmpty BpiWallet) IO a 21 | withSuccessContract ixWallet contract = do 22 | res <- 23 | withContractAs ixWallet contract 24 | either 25 | (fail . show) 26 | (\(res', _) -> pure res') 27 | $ outcome res 28 | -------------------------------------------------------------------------------- /coop-plutus/.envrc: -------------------------------------------------------------------------------- 1 | use flake ..#dev-plutus 2 | -------------------------------------------------------------------------------- /coop-plutus/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2022 mlabs-haskell 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /coop-plutus/app/Coop/Cli/Compile.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | 3 | module Coop.Cli.Compile (CompileOpts (..), CompileMode (..), compile) where 4 | 5 | import Coop.Plutus (certV, fsV, mkAuthMp, mkCertMp, mkFsMp) 6 | import Coop.Plutus.Aux (mkOneShotMp) 7 | import Coop.Types (CoopPlutus (CoopPlutus, cp'certV, cp'fsV, cp'mkAuthMp, cp'mkCertMp, cp'mkFsMp, cp'mkOneShotMp)) 8 | import Data.Aeson (encode) 9 | import Data.ByteString.Lazy (writeFile) 10 | import Data.Kind (Type) 11 | import Plutarch (Config (Config), TracingMode (DoTracing, NoTracing)) 12 | import Plutarch qualified (compile) 13 | 14 | type CompileMode :: Type 15 | data CompileMode = COMPILE_PROD | COMPILE_DEBUG deriving stock (Show, Read, Eq) 16 | 17 | type CompileOpts :: Type 18 | data CompileOpts = CompileOpts 19 | { co'Mode :: CompileMode 20 | , co'File :: FilePath 21 | } 22 | deriving stock (Show, Eq) 23 | 24 | compile :: CompileOpts -> IO () 25 | compile opts = do 26 | let cfg = case co'Mode opts of 27 | COMPILE_PROD -> Config NoTracing 28 | COMPILE_DEBUG -> Config DoTracing 29 | mkOneShotMp' <- either (\err -> fail $ "Failed compiling mkOneShotMp with " <> show err) pure (Plutarch.compile cfg mkOneShotMp) 30 | mkAuthMp' <- either (\err -> fail $ "Failed compiling mkAuthMp with " <> show err) pure (Plutarch.compile cfg mkAuthMp) 31 | mkCertMp' <- either (\err -> fail $ "Failed compiling mkCertMp with " <> show err) pure (Plutarch.compile cfg mkCertMp) 32 | certV' <- either (\err -> fail $ "Failed compiling certV with " <> show err) pure (Plutarch.compile cfg certV) 33 | mkFsMp' <- either (\err -> fail $ "Failed compiling mkFsMp with " <> show err) pure (Plutarch.compile cfg mkFsMp) 34 | fsV' <- either (\err -> fail $ "Failed compiling fsV with " <> show err) pure (Plutarch.compile cfg fsV) 35 | 36 | let cs = 37 | CoopPlutus 38 | { cp'mkOneShotMp = mkOneShotMp' 39 | , cp'mkAuthMp = mkAuthMp' 40 | , cp'mkCertMp = mkCertMp' 41 | , cp'certV = certV' 42 | , cp'mkFsMp = mkFsMp' 43 | , cp'fsV = fsV' 44 | } 45 | Data.ByteString.Lazy.writeFile (co'File opts) (encode cs) 46 | return () 47 | -------------------------------------------------------------------------------- /coop-plutus/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} 2 | 3 | {-# HLINT ignore "Use newtype instead of data" #-} 4 | module Main (main) where 5 | 6 | import Coop.Cli.Compile (CompileMode (COMPILE_DEBUG), CompileOpts (CompileOpts), compile) 7 | 8 | import Control.Applicative ((<**>)) 9 | import Data.Kind (Type) 10 | import Options.Applicative ( 11 | Parser, 12 | ParserInfo, 13 | auto, 14 | command, 15 | customExecParser, 16 | fullDesc, 17 | help, 18 | helper, 19 | info, 20 | long, 21 | metavar, 22 | option, 23 | prefs, 24 | progDesc, 25 | showDefault, 26 | showHelpOnEmpty, 27 | showHelpOnError, 28 | strOption, 29 | subparser, 30 | value, 31 | ) 32 | 33 | type Command :: Type 34 | data Command 35 | = Compile CompileOpts 36 | 37 | compileOpts :: Parser CompileOpts 38 | compileOpts = 39 | CompileOpts 40 | <$> option 41 | auto 42 | ( long "mode" 43 | <> metavar "COMPILE_MODE" 44 | <> help "Mode of compilation COMPILE_DEBUG|COMPILE_PROD" 45 | <> value COMPILE_DEBUG 46 | <> showDefault 47 | ) 48 | <*> strOption 49 | ( long "file" 50 | <> metavar "COMPILE_FILE" 51 | <> help "A JSON file to store the compiled scripts" 52 | <> value "coop-plutus.json" 53 | <> showDefault 54 | ) 55 | 56 | options :: Parser Command 57 | options = 58 | subparser $ 59 | command 60 | "compile" 61 | (info (Compile <$> compileOpts <* helper) (progDesc "Compile scripts and write them to a file")) 62 | 63 | parserInfo :: ParserInfo Command 64 | parserInfo = info (options <**> helper) (fullDesc <> progDesc "COOP Plutus cli tools") 65 | 66 | main :: IO () 67 | main = do 68 | cmd <- customExecParser (prefs (showHelpOnEmpty <> showHelpOnError)) parserInfo 69 | case cmd of 70 | Compile opts -> compile opts 71 | -------------------------------------------------------------------------------- /coop-plutus/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, haskell-nix, compiler-nix-name, coop-hs-types, plutarch, shellHook }: 2 | let 3 | hn-extra-hackage = plutarch.inputs.haskell-nix-extra-hackage; 4 | myHackage = hn-extra-hackage.mkHackagesFor pkgs.system compiler-nix-name [ 5 | "${plutarch}" 6 | "${plutarch}/plutarch-extra" 7 | "${plutarch}/plutarch-test" 8 | "${plutarch.inputs.plutus}/plutus-ledger-api" 9 | "${coop-hs-types}" 10 | ]; 11 | in 12 | haskell-nix.cabalProject' (plutarch.applyPlutarchDep pkgs rec { 13 | src = ./.; 14 | name = "coop-plutus"; 15 | inherit compiler-nix-name; 16 | inherit (myHackage) extra-hackages extra-hackage-tarballs; 17 | modules = myHackage.modules ++ [{ 18 | packages = { 19 | # Enable strict builds 20 | coop-plutus.configureFlags = [ "-f-dev" ]; 21 | coop-plutus.package.extraSrcFiles = [ "resources/sample.json" "resources/sample.pd.cbor" ]; # TODO(bladyjoker): I would like to get rid of this as haskell-nix should pick it up from the Cabal file 22 | # Use the new-ledger-namespace 23 | coop-hs-types.configureFlags = [ "-fnew-ledger-namespace" ]; 24 | }; 25 | }]; 26 | shell = { 27 | # FIXME: withHoogle = true doesn't work 28 | withHoogle = false; 29 | 30 | exactDeps = true; 31 | 32 | nativeBuildInputs = with pkgs; [ 33 | # Code quality 34 | ## Haskell/Cabal 35 | haskellPackages.apply-refact 36 | haskellPackages.fourmolu 37 | haskellPackages.cabal-fmt 38 | hlint 39 | (plutarch.hlsFor compiler-nix-name pkgs.system) 40 | ]; 41 | 42 | additional = ps: [ 43 | ps.plutarch 44 | ps.plutarch-extra 45 | ps.plutarch-test 46 | ps.plutus-ledger-api 47 | ps.coop-hs-types 48 | ]; 49 | 50 | tools = { 51 | cabal = { }; 52 | }; 53 | shellHook = '' 54 | export LC_CTYPE=C.UTF-8 55 | export LC_ALL=C.UTF-8 56 | export LANG=C.UTF-8 57 | ${shellHook} 58 | ''; 59 | 60 | }; 61 | }) 62 | -------------------------------------------------------------------------------- /coop-plutus/cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./. 2 | 3 | tests: true 4 | -------------------------------------------------------------------------------- /coop-plutus/coop-plutus.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: coop-plutus 3 | version: 0.1.0.0 4 | license: MIT 5 | license-file: LICENSE 6 | maintainer: info@mlabs.city 7 | author: mlabs-haskell 8 | description: COOP Plutus programs (validators and minting policies) 9 | 10 | flag dev 11 | description: Enable non-strict compilation for development 12 | manual: True 13 | 14 | common common-language 15 | ghc-options: 16 | -Wall -Wcompat -Wincomplete-uni-patterns -Wunused-do-bind 17 | -Wpartial-type-signatures -Wmissing-export-lists 18 | -Wincomplete-record-updates -Wmissing-deriving-strategies 19 | -Wname-shadowing -Wunused-foralls -fprint-explicit-foralls 20 | -fprint-explicit-kinds -fwarn-missing-import-lists 21 | -Wredundant-constraints -Wmissing-export-lists 22 | -Wmissing-deriving-strategies -Wname-shadowing -Wunused-packages 23 | 24 | if !flag(dev) 25 | ghc-options: -Werror 26 | 27 | default-extensions: 28 | NoStarIsType 29 | BangPatterns 30 | BinaryLiterals 31 | ConstrainedClassMethods 32 | ConstraintKinds 33 | DataKinds 34 | DeriveAnyClass 35 | DeriveDataTypeable 36 | DeriveFoldable 37 | DeriveFunctor 38 | DeriveGeneric 39 | DeriveLift 40 | DeriveTraversable 41 | DerivingStrategies 42 | DerivingVia 43 | DoAndIfThenElse 44 | EmptyCase 45 | EmptyDataDecls 46 | EmptyDataDeriving 47 | ExistentialQuantification 48 | ExplicitForAll 49 | ExplicitNamespaces 50 | FlexibleContexts 51 | FlexibleInstances 52 | ForeignFunctionInterface 53 | GADTSyntax 54 | GeneralisedNewtypeDeriving 55 | HexFloatLiterals 56 | ImportQualifiedPost 57 | InstanceSigs 58 | KindSignatures 59 | LambdaCase 60 | MonomorphismRestriction 61 | MultiParamTypeClasses 62 | NamedFieldPuns 63 | NamedWildCards 64 | NumericUnderscores 65 | OverloadedRecordDot 66 | OverloadedStrings 67 | PartialTypeSignatures 68 | PatternGuards 69 | PolyKinds 70 | PostfixOperators 71 | QualifiedDo 72 | RankNTypes 73 | RelaxedPolyRec 74 | ScopedTypeVariables 75 | StandaloneDeriving 76 | StandaloneKindSignatures 77 | TemplateHaskell 78 | TraditionalRecordSyntax 79 | TupleSections 80 | TypeApplications 81 | TypeFamilies 82 | TypeOperators 83 | TypeSynonymInstances 84 | ViewPatterns 85 | 86 | default-language: Haskell2010 87 | 88 | library 89 | import: common-language 90 | exposed-modules: 91 | Coop.Plutus 92 | Coop.Plutus.Aux 93 | Coop.Plutus.Types 94 | 95 | hs-source-dirs: src 96 | build-depends: 97 | , base 98 | , bytestring 99 | , coop-hs-types 100 | , cryptonite 101 | , generics-sop 102 | , memory 103 | , plutarch 104 | , plutarch-extra 105 | , plutus-ledger-api 106 | , plutus-tx 107 | 108 | executable coop-plutus-cli 109 | import: common-language 110 | main-is: Main.hs 111 | hs-source-dirs: app 112 | other-modules: Coop.Cli.Compile 113 | build-depends: 114 | , aeson 115 | , base 116 | , bytestring 117 | , coop-hs-types 118 | , coop-plutus 119 | , optparse-applicative 120 | , plutarch 121 | 122 | test-suite coop-plutus-tests 123 | import: common-language 124 | type: exitcode-stdio-1.0 125 | hs-source-dirs: test 126 | main-is: Main.hs 127 | other-modules: 128 | Coop.Plutus.Test 129 | Coop.Plutus.Test.Generators 130 | 131 | build-depends: 132 | , base 133 | , bytestring 134 | , containers 135 | , coop-hs-types 136 | , coop-plutus 137 | , hspec 138 | , plutarch 139 | , plutarch-test 140 | , plutus-ledger-api 141 | , plutus-tx 142 | , QuickCheck 143 | , serialise 144 | , text 145 | -------------------------------------------------------------------------------- /coop-plutus/hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /coop-plutus/resources/sample.json: -------------------------------------------------------------------------------- 1 | { 2 | "array": [ 3 | 1, 4 | 2, 5 | 3 6 | ], 7 | "boolean": true, 8 | "null": null, 9 | "integer": 123, 10 | "big_integer": 12300000000000000000000000, 11 | "real": 123.123, 12 | "big_real": 12300000000000000000000000.123, 13 | "string": "Hello World" 14 | } 15 | -------------------------------------------------------------------------------- /coop-plutus/resources/sample.pd.cbor: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mlabs-haskell/cardano-open-oracle-protocol/5f8f97e1b8ba35f60e0dae44d0bd79560c96aacf/coop-plutus/resources/sample.pd.cbor -------------------------------------------------------------------------------- /coop-plutus/src/Coop/Plutus/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE UndecidableInstances #-} 2 | {-# OPTIONS_GHC -Wno-orphans #-} 3 | 4 | module Coop.Plutus.Types ( 5 | PFsMpParams (..), 6 | PFsMpRedeemer (..), 7 | PFsDatum (..), 8 | PCertDatum (..), 9 | PAuthParams (..), 10 | PAuthMpParams (..), 11 | PAuthMpRedeemer (..), 12 | PCertMpParams (..), 13 | PCertMpRedeemer (..), 14 | ) where 15 | 16 | import Coop.Types (AuthMpParams, AuthMpRedeemer, AuthParams, CertDatum, CertMpParams, CertMpRedeemer, FsDatum, FsMpParams, FsMpRedeemer) 17 | import Data.Typeable (Typeable) 18 | import GHC.Generics qualified as GHC 19 | import Generics.SOP (Generic) 20 | import Plutarch (DerivePlutusType (DPTStrat)) 21 | import Plutarch.Api.V2 ( 22 | PAddress, 23 | PCurrencySymbol, 24 | PExtended, 25 | PInterval, 26 | PLowerBound, 27 | PPOSIXTime, 28 | PPOSIXTimeRange, 29 | PPubKeyHash, 30 | PTokenName, 31 | PTuple, 32 | PUpperBound, 33 | ) 34 | import Plutarch.ByteString (PByteString) 35 | import Plutarch.DataRepr ( 36 | DerivePConstantViaData (DerivePConstantViaData), 37 | PDataFields, 38 | PlutusTypeData, 39 | ) 40 | import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) 41 | import Plutarch.Prelude (PAsData, PBool, PData, PDataRecord, PEq, PInteger, PIsData, PLabeledType ((:=)), PTryFrom, PlutusType, S, Term) 42 | import PlutusLedgerApi.V1.Value (AssetClass) 43 | 44 | newtype PFsDatum s 45 | = PFsDatum 46 | ( Term 47 | s 48 | ( PDataRecord 49 | '[ "fd'fs" ':= PData 50 | , "fd'fsId" ':= PByteString 51 | , "fd'gcAfter" ':= PExtended PPOSIXTime 52 | , "fd'submitter" ':= PPubKeyHash 53 | ] 54 | ) 55 | ) 56 | deriving stock (GHC.Generic, Typeable) 57 | deriving anyclass (Generic, PlutusType, PIsData, PEq, PTryFrom PData, PDataFields) 58 | 59 | instance DerivePlutusType PFsDatum where type DPTStrat _ = PlutusTypeData 60 | instance PUnsafeLiftDecl PFsDatum where type PLifted PFsDatum = FsDatum 61 | deriving via (DerivePConstantViaData FsDatum PFsDatum) instance (PConstantDecl FsDatum) 62 | instance PTryFrom PData (PAsData PFsDatum) 63 | 64 | data PFsMpRedeemer s 65 | = PFsMpBurn (Term s (PDataRecord '[])) 66 | | PFsMpMint (Term s (PDataRecord '[])) 67 | deriving stock (GHC.Generic, Typeable) 68 | deriving anyclass (Generic, PlutusType, PIsData, PEq) 69 | 70 | instance DerivePlutusType PFsMpRedeemer where type DPTStrat _ = PlutusTypeData 71 | instance PUnsafeLiftDecl PFsMpRedeemer where type PLifted PFsMpRedeemer = FsMpRedeemer 72 | deriving via (DerivePConstantViaData FsMpRedeemer PFsMpRedeemer) instance (PConstantDecl FsMpRedeemer) 73 | instance PTryFrom PData (PAsData PFsMpRedeemer) 74 | 75 | newtype PFsMpParams s 76 | = PFsMpParams 77 | ( Term 78 | s 79 | ( PDataRecord 80 | '[ "fmp'coopAc" ':= PTuple PCurrencySymbol PTokenName 81 | , "fmp'fsVAddress" ':= PAddress 82 | , "fmp'authParams" ':= PAuthParams 83 | ] 84 | ) 85 | ) 86 | deriving stock (GHC.Generic, Typeable) 87 | deriving anyclass (Generic, PlutusType, PIsData, PEq, PDataFields) 88 | 89 | instance DerivePlutusType PFsMpParams where type DPTStrat _ = PlutusTypeData 90 | instance PUnsafeLiftDecl PFsMpParams where type PLifted PFsMpParams = FsMpParams 91 | deriving via (DerivePConstantViaData FsMpParams PFsMpParams) instance (PConstantDecl FsMpParams) 92 | instance PTryFrom PData (PAsData PFsMpParams) 93 | 94 | newtype PAuthParams s 95 | = PAuthParams 96 | ( Term 97 | s 98 | ( PDataRecord 99 | '[ "ap'authTokenCs" ':= PCurrencySymbol 100 | , "ap'certTokenCs" ':= PCurrencySymbol 101 | ] 102 | ) 103 | ) 104 | deriving stock (GHC.Generic, Typeable) 105 | deriving anyclass (Generic, PlutusType, PIsData, PEq, PTryFrom PData, PDataFields) 106 | 107 | instance DerivePlutusType PAuthParams where type DPTStrat _ = PlutusTypeData 108 | instance PUnsafeLiftDecl PAuthParams where type PLifted PAuthParams = AuthParams 109 | deriving via (DerivePConstantViaData AuthParams PAuthParams) instance (PConstantDecl AuthParams) 110 | instance PTryFrom PData (PAsData PAuthParams) 111 | 112 | newtype PCertDatum (s :: S) 113 | = PCertDatum 114 | ( Term 115 | s 116 | ( PDataRecord 117 | '[ "cert'id" ':= PByteString 118 | , "cert'validity" ':= PPOSIXTimeRange 119 | , "cert'redeemerAc" ':= PTuple PCurrencySymbol PTokenName 120 | ] 121 | ) 122 | ) 123 | deriving stock (GHC.Generic) 124 | deriving anyclass (Generic, PlutusType, PIsData, PEq, PTryFrom PData, PDataFields) 125 | 126 | instance DerivePlutusType PCertDatum where type DPTStrat _ = PlutusTypeData 127 | instance PUnsafeLiftDecl PCertDatum where type PLifted PCertDatum = CertDatum 128 | deriving via (DerivePConstantViaData CertDatum PCertDatum) instance (PConstantDecl CertDatum) 129 | instance PTryFrom PData (PAsData PCertDatum) 130 | 131 | newtype PAuthMpParams (s :: S) 132 | = PAuthMpParams 133 | ( Term 134 | s 135 | ( PDataRecord 136 | '[ "amp'authAuthorityAc" ':= PTuple PCurrencySymbol PTokenName 137 | , "amp'requiredAtLeastAaQ" ':= PInteger 138 | ] 139 | ) 140 | ) 141 | deriving stock (GHC.Generic) 142 | deriving anyclass (Generic, PlutusType, PIsData, PEq, PTryFrom PData, PDataFields) 143 | 144 | instance DerivePlutusType PAuthMpParams where type DPTStrat _ = PlutusTypeData 145 | instance PUnsafeLiftDecl PAuthMpParams where type PLifted PAuthMpParams = AuthMpParams 146 | deriving via (DerivePConstantViaData AuthMpParams PAuthMpParams) instance (PConstantDecl AuthMpParams) 147 | instance PTryFrom PData (PAsData PAuthMpParams) 148 | 149 | data PAuthMpRedeemer s 150 | = PAuthMpBurn (Term s (PDataRecord '[])) 151 | | PAuthMpMint (Term s (PDataRecord '[])) 152 | deriving stock (GHC.Generic, Typeable) 153 | deriving anyclass (Generic, PlutusType, PIsData, PEq) 154 | 155 | instance DerivePlutusType PAuthMpRedeemer where type DPTStrat _ = PlutusTypeData 156 | instance PUnsafeLiftDecl PAuthMpRedeemer where type PLifted PAuthMpRedeemer = AuthMpRedeemer 157 | deriving via (DerivePConstantViaData AuthMpRedeemer PAuthMpRedeemer) instance (PConstantDecl AuthMpRedeemer) 158 | instance PTryFrom PData (PAsData PAuthMpRedeemer) 159 | 160 | newtype PCertMpParams (s :: S) 161 | = PCertMpParams 162 | ( Term 163 | s 164 | ( PDataRecord 165 | '[ "cmp'authAuthorityAc" ':= PTuple PCurrencySymbol PTokenName 166 | , "cmp'requiredAtLeastAaQ" ':= PInteger 167 | , "cmp'certVAddress" ':= PAddress 168 | ] 169 | ) 170 | ) 171 | deriving stock (GHC.Generic) 172 | deriving anyclass (Generic, PlutusType, PIsData, PEq, PTryFrom PData, PDataFields) 173 | 174 | instance DerivePlutusType PCertMpParams where type DPTStrat _ = PlutusTypeData 175 | instance PUnsafeLiftDecl PCertMpParams where type PLifted PCertMpParams = CertMpParams 176 | deriving via (DerivePConstantViaData CertMpParams PCertMpParams) instance (PConstantDecl CertMpParams) 177 | instance PTryFrom PData (PAsData PCertMpParams) 178 | 179 | data PCertMpRedeemer s 180 | = PCertMpBurn (Term s (PDataRecord '[])) 181 | | PCertMpMint (Term s (PDataRecord '[])) 182 | deriving stock (GHC.Generic, Typeable) 183 | deriving anyclass (Generic, PlutusType, PIsData, PEq) 184 | 185 | instance DerivePlutusType PCertMpRedeemer where type DPTStrat _ = PlutusTypeData 186 | instance PUnsafeLiftDecl PCertMpRedeemer where type PLifted PCertMpRedeemer = CertMpRedeemer 187 | deriving via (DerivePConstantViaData CertMpRedeemer PCertMpRedeemer) instance (PConstantDecl CertMpRedeemer) 188 | instance PTryFrom PData (PAsData PCertMpRedeemer) 189 | 190 | -- FIXME: Purge this when Plutarch supports it 191 | instance PUnsafeLiftDecl (PTuple PCurrencySymbol PTokenName) where type PLifted (PTuple PCurrencySymbol PTokenName) = AssetClass 192 | deriving via (DerivePConstantViaData AssetClass (PTuple PCurrencySymbol PTokenName)) instance (PConstantDecl AssetClass) 193 | 194 | instance PTryFrom PData (PAsData PBool) 195 | instance PTryFrom PData (PExtended PPOSIXTime) 196 | instance PTryFrom PData (PUpperBound PPOSIXTime) 197 | instance PTryFrom PData (PLowerBound PPOSIXTime) 198 | instance PTryFrom PData (PInterval PPOSIXTime) 199 | 200 | instance PTryFrom PData (PAsData (PExtended PPOSIXTime)) 201 | instance PTryFrom PData (PAsData (PUpperBound PPOSIXTime)) 202 | instance PTryFrom PData (PAsData (PLowerBound PPOSIXTime)) 203 | instance PTryFrom PData (PAsData (PInterval PPOSIXTime)) 204 | -------------------------------------------------------------------------------- /coop-plutus/test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Test.Hspec (Spec, describe, hspec) 4 | 5 | import Coop.Plutus.Test (spec) 6 | 7 | main :: IO () 8 | main = do 9 | hspec tests 10 | 11 | tests :: Spec 12 | tests = do 13 | describe "COOP Plutus spec" spec 14 | -------------------------------------------------------------------------------- /coop-proto/.envrc: -------------------------------------------------------------------------------- 1 | use flake ..#dev-proto 2 | -------------------------------------------------------------------------------- /coop-proto/Makefile: -------------------------------------------------------------------------------- 1 | grpcui: 2 | grpcui -servername "127.0.0.1" -insecure -proto ./coop.proto localhost:5081 3 | 4 | protogen: 5 | protoc -I . --plugin=protoc-gen-haskell=`which proto-lens-protoc` \ 6 | --haskell_out proto_out \ 7 | fact-statement-store-service.proto cardano.proto tx-builder-service.proto publisher-service.proto 8 | -------------------------------------------------------------------------------- /coop-proto/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, shellHook }: 2 | pkgs.mkShell { 3 | packages = with pkgs; [ 4 | protobuf 5 | protoc-gen-grpc-web 6 | haskellPackages.proto-lens-protoc 7 | nodePackages.npm 8 | nodejs 9 | grpcui 10 | grpcurl 11 | ]; 12 | 13 | inherit shellHook; 14 | } 15 | -------------------------------------------------------------------------------- /coop-proto/cardano-proto-extras/.envrc: -------------------------------------------------------------------------------- 1 | use flake ../../#dev-cardano-proto-extras 2 | -------------------------------------------------------------------------------- /coop-proto/cardano-proto-extras/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for cardano-protobuf-extras 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /coop-proto/cardano-proto-extras/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, haskell-nix, compiler-nix-name, plutip, cardanoProtoHs, shellHook }: 2 | let 3 | proj = haskell-nix.cabalProject' { 4 | src = ./.; 5 | name = "cardano-proto-extras"; 6 | inherit compiler-nix-name; 7 | index-state = "2022-05-16T00:00:00Z"; 8 | inherit (plutip) cabalProjectLocal; 9 | modules = plutip.haskellModules ++ [ 10 | { 11 | packages = { 12 | # Enable strict builds 13 | cardano-protobuf-extras.configureFlags = [ "-f-dev" ]; 14 | 15 | # FIXME: This is annoying 16 | # Add proto compilation execs 17 | proto-lens-protobuf-types.components.library.build-tools = [ 18 | pkgs.protobuf 19 | pkgs.haskellPackages.proto-lens-protoc 20 | ]; 21 | 22 | }; 23 | } 24 | ]; 25 | 26 | extraSources = plutip.extraSources ++ [ 27 | { 28 | src = cardanoProtoHs; 29 | subdirs = [ "." ]; 30 | } 31 | 32 | ]; 33 | 34 | shell = { 35 | withHoogle = true; 36 | 37 | exactDeps = true; 38 | 39 | nativeBuildInputs = with pkgs; [ 40 | # Code quality 41 | ## Haskell/Cabal 42 | haskellPackages.apply-refact 43 | haskellPackages.fourmolu 44 | haskellPackages.cabal-fmt 45 | hlint 46 | ]; 47 | 48 | additional = ps: [ 49 | ps.coop-cardano-proto 50 | ps.plutus-tx 51 | ps.plutus-ledger-api 52 | ps.plutus-ledger 53 | ]; 54 | 55 | tools = { 56 | cabal = { }; 57 | haskell-language-server = { }; 58 | }; 59 | 60 | shellHook = '' 61 | export LC_CTYPE=C.UTF-8 62 | export LC_ALL=C.UTF-8 63 | export LANG=C.UTF-8 64 | ${shellHook} 65 | ''; 66 | 67 | }; 68 | }; 69 | in 70 | proj 71 | -------------------------------------------------------------------------------- /coop-proto/cardano-proto-extras/cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./. 2 | 3 | tests: true 4 | -------------------------------------------------------------------------------- /coop-proto/cardano-proto-extras/cardano-proto-extras.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: cardano-proto-extras 3 | version: 0.1.0.0 4 | license: MIT 5 | maintainer: info@mlabs.city 6 | author: mlabs-haskell 7 | description: Cardano Google Protobuf library with conversion utilities 8 | 9 | flag dev 10 | description: Enable non-strict compilation for development 11 | manual: True 12 | 13 | common common-language 14 | ghc-options: 15 | -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind 16 | -Wno-partial-type-signatures -Wmissing-export-lists 17 | -Wincomplete-record-updates -Wmissing-deriving-strategies 18 | -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls 19 | -fprint-explicit-kinds -fwarn-missing-import-lists -Wname-shadowing 20 | -Wunused-packages 21 | 22 | if !flag(dev) 23 | ghc-options: -Werror 24 | 25 | default-extensions: 26 | NoStarIsType 27 | BangPatterns 28 | BinaryLiterals 29 | ConstrainedClassMethods 30 | ConstraintKinds 31 | DataKinds 32 | DeriveAnyClass 33 | DeriveDataTypeable 34 | DeriveFoldable 35 | DeriveFunctor 36 | DeriveGeneric 37 | DeriveLift 38 | DeriveTraversable 39 | DerivingStrategies 40 | DerivingVia 41 | DoAndIfThenElse 42 | EmptyCase 43 | EmptyDataDecls 44 | EmptyDataDeriving 45 | ExistentialQuantification 46 | ExplicitForAll 47 | ExplicitNamespaces 48 | FlexibleContexts 49 | FlexibleInstances 50 | ForeignFunctionInterface 51 | GADTSyntax 52 | GeneralisedNewtypeDeriving 53 | HexFloatLiterals 54 | ImportQualifiedPost 55 | InstanceSigs 56 | KindSignatures 57 | LambdaCase 58 | MonomorphismRestriction 59 | MultiParamTypeClasses 60 | NamedFieldPuns 61 | NamedWildCards 62 | NumericUnderscores 63 | OverloadedStrings 64 | PartialTypeSignatures 65 | PatternGuards 66 | PolyKinds 67 | PostfixOperators 68 | RankNTypes 69 | RelaxedPolyRec 70 | ScopedTypeVariables 71 | StandaloneDeriving 72 | StandaloneKindSignatures 73 | TemplateHaskell 74 | TraditionalRecordSyntax 75 | TupleSections 76 | TypeApplications 77 | TypeFamilies 78 | TypeOperators 79 | TypeSynonymInstances 80 | ViewPatterns 81 | 82 | default-language: Haskell2010 83 | 84 | library 85 | import: common-language 86 | exposed-modules: Cardano.Proto.Aux 87 | hs-source-dirs: src 88 | build-depends: 89 | , base 90 | , bytestring 91 | , coop-cardano-proto 92 | , hex 93 | , lens 94 | , plutus-ledger 95 | , plutus-ledger-api 96 | , plutus-tx 97 | , proto-lens 98 | , text 99 | -------------------------------------------------------------------------------- /coop-proto/cardano-proto-extras/hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /coop-proto/cardano-proto-extras/src/Cardano/Proto/Aux.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | 3 | module Cardano.Proto.Aux (ProtoCardano (toCardano, fromCardano)) where 4 | 5 | import Control.Lens ((.~), (^.)) 6 | import Data.ByteString (ByteString) 7 | import Data.Function ((&)) 8 | import Data.Hex (Hex (hex, unhex)) 9 | import Data.ProtoLens (Message (defMessage)) 10 | import Data.Text (Text) 11 | import Data.Text qualified as Text 12 | import Data.Text.Encoding (decodeUtf8) 13 | import Data.Text.Encoding qualified as Text 14 | import Data.Traversable (for) 15 | import Ledger qualified 16 | import Plutus.V1.Ledger.Api (BuiltinData (BuiltinData), ToData (toBuiltinData), fromBuiltin, toBuiltin) 17 | import PlutusTx (FromData (fromBuiltinData), builtinDataToData, dataToBuiltinData) 18 | import PlutusTx qualified 19 | import Proto.Cardano qualified as Proto 20 | import Proto.Cardano_Fields (base16, elements, extended, fields, finiteLedgerTime, idx, index, key, kvs, maybe'plutusData, pdbytes, pdconstr, pdint, pdlist, pdmap, transactionHash, value) 21 | import Proto.Cardano_Fields qualified as PCardano 22 | 23 | class (MonadFail m) => ProtoCardano m proto cardano where 24 | toCardano :: proto -> m cardano 25 | fromCardano :: cardano -> m proto 26 | 27 | instance MonadFail (Either Text) where 28 | fail = Left . Text.pack 29 | 30 | -- | plutus-ledger-api types 31 | instance (MonadFail m) => ProtoCardano m Proto.PubKeyHash Ledger.PubKeyHash where 32 | toCardano ppkh = Ledger.PubKeyHash . toBuiltin <$> fromHex (ppkh ^. base16) 33 | 34 | fromCardano (Ledger.PubKeyHash bytes) = return $ defMessage & base16 .~ (toHex . fromBuiltin $ bytes) 35 | 36 | instance MonadFail m => ProtoCardano m Proto.ExtendedLedgerTime (Ledger.Extended Ledger.POSIXTime) where 37 | toCardano pext = case pext ^. extended of 38 | Proto.ExtendedLedgerTime'Extended'Unrecognized unrec -> fail (show unrec) 39 | Proto.ExtendedLedgerTime'NEG_INF -> return Ledger.NegInf 40 | Proto.ExtendedLedgerTime'POS_INF -> return Ledger.PosInf 41 | Proto.ExtendedLedgerTime'FINITE -> return (Ledger.Finite (Ledger.POSIXTime . toInteger $ pext ^. finiteLedgerTime)) 42 | 43 | fromCardano cext = case cext of 44 | Ledger.NegInf -> return $ defMessage & extended .~ Proto.ExtendedLedgerTime'NEG_INF 45 | Ledger.Finite (Ledger.POSIXTime i) -> 46 | return $ 47 | defMessage 48 | & extended .~ Proto.ExtendedLedgerTime'FINITE 49 | & finiteLedgerTime .~ fromInteger i 50 | Ledger.PosInf -> return $ defMessage & extended .~ Proto.ExtendedLedgerTime'POS_INF 51 | 52 | instance (MonadFail m) => ProtoCardano m Proto.TxOutRef Ledger.TxOutRef where 53 | toCardano ptxOutRef = do 54 | txId <- toCardano (ptxOutRef ^. PCardano.txId) 55 | return $ Ledger.TxOutRef txId (toInteger $ ptxOutRef ^. idx) 56 | 57 | fromCardano (Ledger.TxOutRef txId ix) = do 58 | txId' <- fromCardano txId 59 | return $ 60 | defMessage 61 | & PCardano.txId .~ txId' 62 | & idx .~ fromInteger ix 63 | 64 | instance (MonadFail m) => ProtoCardano m Proto.TxId Ledger.TxId where 65 | toCardano ptxId = return $ Ledger.TxId (toBuiltin $ ptxId ^. transactionHash) 66 | fromCardano (Ledger.TxId bs) = 67 | return $ 68 | defMessage & transactionHash .~ fromBuiltin bs 69 | 70 | -- | PlutusData encoding 71 | plDataToPrData :: PlutusTx.Data -> Maybe Proto.PlutusData 72 | plDataToPrData (PlutusTx.List xs) = do 73 | pxs <- for xs plDataToPrData 74 | return $ defMessage & pdlist . elements .~ pxs 75 | plDataToPrData (PlutusTx.Map plKvs) = do 76 | prKvs <- 77 | for 78 | plKvs 79 | ( \(k, v) -> do 80 | k' <- plDataToPrData k 81 | v' <- plDataToPrData v 82 | return $ 83 | defMessage 84 | & key .~ k' 85 | & value .~ v' 86 | ) 87 | return $ defMessage & pdmap . kvs .~ prKvs 88 | plDataToPrData (PlutusTx.Constr ix plFields) = do 89 | prFields <- for plFields plDataToPrData 90 | return $ 91 | defMessage 92 | & pdconstr . index .~ fromInteger ix 93 | & pdconstr . fields .~ prFields 94 | plDataToPrData (PlutusTx.I plInt) = return $ defMessage & pdint .~ fromInteger plInt 95 | plDataToPrData (PlutusTx.B plBs) = return $ defMessage & pdbytes .~ plBs 96 | 97 | plDataFromPrData :: Proto.PlutusData -> PlutusTx.Data 98 | plDataFromPrData prPlData = case prPlData ^. maybe'plutusData of 99 | Nothing -> PlutusTx.toData (0 :: Integer) 100 | Just pd' -> case pd' of 101 | Proto.PlutusData'Pdint i -> PlutusTx.I . toInteger $ i 102 | Proto.PlutusData'Pdbytes bs -> PlutusTx.B bs 103 | Proto.PlutusData'Pdlist pl -> PlutusTx.List [builtinDataToData . toBuiltinData $ el | el <- pl ^. elements] 104 | Proto.PlutusData'Pdmap pm -> 105 | PlutusTx.Map 106 | ( [ ( builtinDataToData . toBuiltinData $ kv ^. key 107 | , builtinDataToData . toBuiltinData $ kv ^. value 108 | ) 109 | | kv <- pm ^. kvs 110 | ] 111 | ) 112 | Proto.PlutusData'Pdconstr pc -> 113 | PlutusTx.Constr 114 | (toInteger $ pc ^. index) 115 | (builtinDataToData . toBuiltinData <$> pc ^. fields) 116 | 117 | instance ToData Proto.PlutusData where 118 | toBuiltinData = dataToBuiltinData . plDataFromPrData 119 | 120 | instance FromData Proto.PlutusData where 121 | fromBuiltinData (BuiltinData d) = plDataToPrData d 122 | 123 | -- | Helpers 124 | toHex :: ByteString -> Text 125 | toHex = decodeUtf8 . hex 126 | 127 | fromHex :: MonadFail m => Text -> m ByteString 128 | fromHex t = case unhex . Text.encodeUtf8 $ t of 129 | Left err -> fail err 130 | Right bytes -> return bytes 131 | -------------------------------------------------------------------------------- /coop-proto/cardano.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | package cardano; 4 | 5 | message Transaction { 6 | // CBOR+Base16 (hex) encoded transaction 7 | string cbor_base16 = 1; 8 | } 9 | 10 | // plutus-ledger-api Plutus.V1.Ledger.Tx.TxId 11 | message TxId { 12 | // Transaction hash is the transaction id 13 | bytes transaction_hash = 1; 14 | } 15 | 16 | message PubKeyHash { 17 | // Base16 (hex) encoded public key hash 18 | string base16 = 1; 19 | } 20 | 21 | // plutus-ledger-api Plutus.V1.Ledger.Tx.TxOutRef 22 | message TxOutRef { 23 | // Transaction ID 24 | TxId tx_id = 1; 25 | // The output index of the transaction denoted by the id 26 | uint64 idx = 2; 27 | } 28 | 29 | message ExtendedLedgerTime { 30 | enum Extended { 31 | // Negative infinity: elapses immediately 32 | NEG_INF = 0; 33 | // Finite time: elapses at `finite_ledger_time` 34 | FINITE = 1; 35 | // Positive infinity: never elapses. 36 | POS_INF = 2; 37 | } 38 | Extended extended = 1; 39 | // Unix timestamp in milliseconds (ms) 40 | uint64 finite_ledger_time = 2; 41 | } 42 | 43 | // https://github.com/input-output-hk/plutus/blob/6aa7ba8142a16ada1a7b73eaa7210c55b41ac382/plutus-core/plutus-core/src/PlutusCore/Data.hs#L40 44 | // data Data = 45 | // Constr Integer [Data] 46 | // | Map [(Data, Data)] 47 | // | List [Data] 48 | // | I Integer 49 | // | B BS.ByteString 50 | message PlutusData { 51 | oneof plutus_data { 52 | uint64 pdint = 1; 53 | bytes pdbytes = 2; 54 | PlutusList pdlist = 3; 55 | PlutusMap pdmap = 4; 56 | PlutusConstr pdconstr = 5; 57 | } 58 | } 59 | 60 | message PlutusList { 61 | repeated PlutusData elements = 1; 62 | } 63 | 64 | message PlutusMap { 65 | message KV { 66 | PlutusData key = 1; 67 | PlutusData value = 2; 68 | } 69 | repeated KV kvs = 1; 70 | } 71 | 72 | message PlutusConstr { 73 | uint64 index = 1; 74 | repeated PlutusData fields = 2; 75 | } 76 | -------------------------------------------------------------------------------- /coop-proto/fact-statement-store-service.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | import "cardano.proto"; 4 | 5 | package coop.fact_statement_store; 6 | 7 | service FactStatementStore { 8 | // Fetch a PlutusData encoded Fact Statement with a given ID 9 | rpc getFactStatement(GetFactStatementRequest) returns (GetFactStatementResponse) {} 10 | } 11 | 12 | message GetFactStatementRequest { 13 | repeated bytes fs_ids = 1; 14 | } 15 | 16 | message Success { 17 | message FsIdAndPlutus { 18 | bytes fs_id = 1; 19 | cardano.PlutusData plutus_data = 2; 20 | } 21 | repeated FsIdAndPlutus fs_ids_with_plutus = 1; 22 | } 23 | 24 | // Error associated with above response messages 25 | // TODO: Should catch and properly report classes of errors users would expect to trigger. 26 | // For example: 27 | // - Fact statement ID not found 28 | message Error { 29 | message OtherError { 30 | // Some other error message 31 | string msg = 1; 32 | } 33 | oneof someError { 34 | // Some other error 35 | OtherError other_err = 1; 36 | } 37 | } 38 | 39 | message GetFactStatementResponse { 40 | oneof factStatementsOrErr { 41 | // Error encountered when servicing the request 42 | Error error = 1; 43 | // Fetched Fact Statements in PlutusData form 44 | Success success = 2; 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /coop-proto/js/Makefile: -------------------------------------------------------------------------------- 1 | protoc: ../coop.proto 2 | mkdir generated-pb 3 | protoc -I .. coop.proto --js_out=import_style=commonjs:./generated-pb 4 | protoc -I .. coop.proto --grpc-web_out=import_style=commonjs,mode=grpcwebtext:./generated-pb 5 | 6 | bundle: client.js 7 | npm i 8 | npx webpack ./client.js 9 | 10 | serve: bundle 11 | npx webpack serve --entry ./dist/main.js --static ./ 12 | 13 | clean: 14 | rm -fR node_modules || true 15 | rm -fR dist || true 16 | rm -fR generated-pb || true 17 | 18 | all: clean protoc bundle serve 19 | -------------------------------------------------------------------------------- /coop-proto/js/client.js: -------------------------------------------------------------------------------- 1 | const coopTypes = require('./generated-pb/coop_pb.js'); 2 | const coopGrpc = require('./generated-pb/coop_grpc_web_pb.js'); 3 | var google_protobuf_empty_pb = require('google-protobuf/google/protobuf/empty_pb.js'); 4 | 5 | var coopPublisherClient = new coopGrpc.CoopPublisherClient('https://localhost:5081'); 6 | 7 | var metadata = {'custom-header-1': 'value1'}; 8 | 9 | coopPublisherClient.getCatalog(new google_protobuf_empty_pb.Empty(), metadata, function(err, response) { 10 | if (err) { 11 | console.log(err.code); 12 | console.log(err.message); 13 | } else { 14 | console.log(response.getMessage()); 15 | } 16 | }); 17 | -------------------------------------------------------------------------------- /coop-proto/js/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /coop-proto/js/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "coop-proto-web-commonjs", 3 | "dependencies": { 4 | "google-protobuf": "^3.6.1", 5 | "grpc-web": "^1.2.0" 6 | }, 7 | "devDependencies": { 8 | "@grpc/grpc-js": "^1.6.7", 9 | "@grpc/proto-loader": "^0.3.0", 10 | "google-protobuf": "^3.6.1", 11 | "grpc-web": "^1.2.0", 12 | "webpack": "^5.73.0", 13 | "webpack-cli": "^4.10.0", 14 | "webpack-dev-server": "^4.9.3" 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /coop-proto/publisher-service.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | import "cardano.proto"; 4 | import "tx-builder-service.proto"; 5 | import "fact-statement-store-service.proto"; 6 | 7 | package coop.publisher; 8 | 9 | service Publisher { 10 | // Create a Fact Statement minting transaction (mint-fact-statement-tx) 11 | rpc createMintFsTx(CreateMintFsTxRequest) returns (CreateMintFsTxResponse) {} 12 | // Create a Fact Statement garbage collection transaction (gc-fact-statement-tx) 13 | rpc createGcFsTx(CreateGcFsTxRequest) returns (CreateGcFsTxResponse) {} 14 | } 15 | 16 | message CreateMintFsTxRequest { 17 | message FactStatementInfo { 18 | // Fact Statement identifier known by the Oracle's Fact Store 19 | bytes fs_id = 1; 20 | // Extended ledger time after which the created Fact Statement UTxO at @FsV can be spent by the Submitter 21 | cardano.ExtendedLedgerTime gcAfter = 2; 22 | } 23 | 24 | // A list of Fact Statement information containing the ID and time-to-live 25 | repeated FactStatementInfo fs_infos = 1; 26 | // The PubKeyHash of the user that will submit the transaction 27 | cardano.PubKeyHash submitter = 2; 28 | } 29 | 30 | message CreateMintFsTxResponse { 31 | oneof transactionOrErr { 32 | // Error encountered when servicing the request 33 | Error error = 1; 34 | // Fact Statement Minting transaction (mint-fact-statement-tx) that must be signed by the Submitter and submitted 35 | cardano.Transaction mint_fs_tx = 2; 36 | } 37 | message Info { 38 | coop.tx_builder.MintFsInfo tx_builder_info = 1; 39 | } 40 | Info info = 3; 41 | } 42 | 43 | message CreateGcFsTxRequest { 44 | // Fact Statement IDs to garbage collect 45 | repeated bytes fs_ids = 1; 46 | // The PubKeyHash of the user that submitted the FSMintTx and will also submit the FSBurnTx 47 | cardano.PubKeyHash submitter = 2; 48 | } 49 | 50 | message CreateGcFsTxResponse { 51 | oneof transactionOrErr { 52 | // Fact Statement garbage collection transaction (gc-fact-statement-tx) to sign and submit 53 | cardano.Transaction gc_fs_tx = 1; 54 | // Error encountered when servicing the request 55 | Error error = 2; 56 | } 57 | message Info { 58 | coop.tx_builder.GcFsInfo tx_builder_info = 1; 59 | } 60 | Info info = 3; 61 | } 62 | 63 | message Error { 64 | message OtherError { 65 | // Some other error message 66 | string msg = 1; 67 | } 68 | oneof someError { 69 | coop.fact_statement_store.Error fs_store_err = 1; 70 | coop.tx_builder.Error tx_builder_err = 2; 71 | OtherError other_err = 3; 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /coop-proto/tx-builder-service.proto: -------------------------------------------------------------------------------- 1 | syntax = "proto3"; 2 | 3 | import "cardano.proto"; 4 | 5 | package coop.tx_builder; 6 | 7 | service TxBuilder { 8 | // Create a transaction that creates Fact Statement UTxOs (mint-fact-statement-tx) 9 | rpc createMintFsTx(CreateMintFsTxReq) returns (CreateMintFsTxResp) {} 10 | // Create a transaction that garbage collects obsolete Fact Statement UTxOs (gc-fact-statement-tx) 11 | rpc createGcFsTx(CreateGcFsTxReq) returns (CreateGcFsTxResp) {} 12 | } 13 | 14 | message CreateMintFsTxReq { 15 | repeated FactStatementInfo fact_statements = 1; 16 | // The PubKeyHash of the user wallet that will sign and submit the transaction (ie. Submitter) 17 | cardano.PubKeyHash submitter = 2; 18 | } 19 | 20 | message CreateMintFsTxResp { 21 | oneof succOrErr { 22 | // Error encountered when servicing the request 23 | Error error = 1; 24 | // Successful Fact Statement Minting message 25 | MintFsSuccess success = 2; 26 | } 27 | // Information about the processing of the request 28 | MintFsInfo info = 3; 29 | } 30 | 31 | // Success message associated with CreateMintFsTxResp 32 | message MintFsSuccess { 33 | // Fact Statement Minting transaction (abbr. mint-fact-statement-tx) signed by Authenticators 34 | cardano.Transaction mint_fs_tx = 1; 35 | } 36 | 37 | // Information message associated with CreateMintFsTxResp 38 | message MintFsInfo { 39 | message FsIdAndTxOutRef { 40 | bytes fs_id = 1; 41 | cardano.TxOutRef fs_utxo = 2; 42 | } 43 | // A list of already published Fact Statements (Map FactStatementId TxOutRef) 44 | repeated FsIdAndTxOutRef already_published = 1; 45 | // Fact Statements ID that will be published with the mint-fact-statement-tx 46 | repeated bytes published_fs_ids = 2; 47 | } 48 | 49 | message FactStatementInfo { 50 | // Fact Statement ID 51 | bytes fs_id = 1; 52 | // PlutusData encoding of a Fact Statement 53 | cardano.PlutusData fs = 2; 54 | // Extended ledger time after which the created Fact Statement UTxO can be garbage collected by the Submitter 55 | cardano.ExtendedLedgerTime gc_after = 3; 56 | } 57 | 58 | message CreateGcFsTxReq { 59 | // Fact Statement IDs to garbage collect 60 | repeated bytes fs_ids = 1; 61 | // The PubKeyHash of the user that submitted the mint-fact-statement-x and will also submit the gc-fact-statement-tx 62 | cardano.PubKeyHash submitter = 2; 63 | } 64 | 65 | message CreateGcFsTxResp { 66 | oneof transactionOrErr { 67 | // Error encountered when servicing the request 68 | Error error = 1; 69 | // Successfull Fact Statement garbage collection message 70 | GcFsSuccess success = 2; 71 | } 72 | // Request processing information 73 | GcFsInfo info = 3; 74 | } 75 | 76 | // Success message associated with the CreateGcFsTxResp 77 | message GcFsSuccess { 78 | // Fact Statement garbage collections transaction (abbr. gc-fact-statement-tx) to sign and submit 79 | cardano.Transaction gc_fs_tx = 1; 80 | } 81 | 82 | // Info message associated with the CreateGcFsTxResp 83 | message GcFsInfo { 84 | // Requested Fact Statement IDs that can be garbage collected with the above transaction 85 | repeated bytes obsolete_fs_ids = 1; 86 | // Requested Fact Statement IDs that couldn't be found belonging to the specified Submitter 87 | repeated bytes not_found_fs_ids = 2; 88 | // Requested Fact Statement IDs that can't be garbage collected (still valid) 89 | repeated bytes valid_fs_ids = 3; 90 | 91 | } 92 | 93 | // Error associated with above response messages 94 | // TODO: Should catch and properly report classes of errors users would expect to trigger. 95 | // For example: 96 | // - Collateral finding could fail 97 | // - $FEE determination could fail 98 | // - Transaction size due to too many Fact Statements 99 | message Error { 100 | message OtherError { 101 | // Some other error message 102 | string msg = 1; 103 | } 104 | oneof someError { 105 | // Some other error 106 | OtherError other_err = 1; 107 | } 108 | } 109 | -------------------------------------------------------------------------------- /coop-publisher/.envrc: -------------------------------------------------------------------------------- 1 | use flake ..#dev-service 2 | -------------------------------------------------------------------------------- /coop-publisher/app/Coop/Cli/PublisherGrpc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BlockArguments #-} 2 | 3 | module Coop.Cli.PublisherGrpc (publisherService, PublisherGrpcOpts (..)) where 4 | 5 | import Control.Lens (makeLenses, (&), (.~), (^.)) 6 | import Data.Map qualified as Map 7 | import Data.ProtoLens (Message (defMessage)) 8 | import Data.Text (Text) 9 | import Data.Text qualified as Text 10 | import GHC.Exts (fromString) 11 | import Network.GRPC.Client (RawReply) 12 | import Network.GRPC.Client.Helpers (GrpcClient, GrpcClientConfig (_grpcClientConfigCompression), grpcClientConfigSimple, rawUnary, setupGrpcClient) 13 | import Network.GRPC.HTTP2.Encoding as Encoding ( 14 | GRPCInput, 15 | GRPCOutput, 16 | gzip, 17 | uncompressed, 18 | ) 19 | import Network.GRPC.HTTP2.ProtoLens (RPC (RPC)) 20 | import Network.GRPC.HTTP2.Types (IsRPC (path)) 21 | import Network.GRPC.Server as Server ( 22 | ServiceHandler, 23 | UnaryHandler, 24 | runGrpc, 25 | unary, 26 | ) 27 | import Network.HTTP2.Client (ClientIO, HostName, PortNumber, TooMuchConcurrency, runClientIO) 28 | import Network.Wai.Handler.Warp qualified as Warp 29 | import Network.Wai.Handler.WarpTLS (tlsSettings) 30 | import Proto.FactStatementStoreService (FactStatementStore, GetFactStatementResponse) 31 | import Proto.FactStatementStoreService_Fields (fsIdsWithPlutus, plutusData, success) 32 | import Proto.PublisherService ( 33 | CreateGcFsTxRequest, 34 | CreateGcFsTxResponse, 35 | CreateMintFsTxRequest, 36 | CreateMintFsTxResponse, 37 | Publisher, 38 | ) 39 | import Proto.PublisherService qualified as PublisherService 40 | import Proto.PublisherService_Fields (fsId, fsIds, fsInfos, fsStoreErr, gcAfter, gcFsTx, info, maybe'error, mintFsTx, msg, otherErr, submitter, txBuilderErr, txBuilderInfo) 41 | import Proto.PublisherService_Fields qualified as PublisherService 42 | import Proto.TxBuilderService (FactStatementInfo, TxBuilder) 43 | import Proto.TxBuilderService qualified as TxBuilder 44 | import Proto.TxBuilderService_Fields (factStatements, fs) 45 | 46 | data PublisherGrpcOpts = PublisherGrpcOpts 47 | { _grpcAddress :: String 48 | , _grpcPort :: Int 49 | , _tlsCertFile :: FilePath 50 | , _tlsKeyFile :: FilePath 51 | , _fsStoreAddress :: String 52 | , _fsStorePort :: Int 53 | , _txBuilderAddress :: String 54 | , _txBuilderPort :: Int 55 | } 56 | deriving stock (Show, Eq) 57 | 58 | makeLenses ''PublisherGrpcOpts 59 | 60 | publisherService :: PublisherGrpcOpts -> IO () 61 | publisherService opts = do 62 | let handleCreateMintFsTx :: Server.UnaryHandler IO CreateMintFsTxRequest CreateMintFsTxResponse 63 | handleCreateMintFsTx _ req = do 64 | print ("Got from user: " <> show req) 65 | getFsRespOrErr <- 66 | call' 67 | (opts ^. fsStoreAddress) 68 | (fromInteger . toInteger $ opts ^. fsStorePort) 69 | (RPC :: RPC FactStatementStore "getFactStatement") 70 | (defMessage & fsIds .~ ((^. fsId) <$> req ^. fsInfos)) 71 | either 72 | (\err -> return $ defMessage & PublisherService.error .~ err) 73 | ( \(getFsResp :: GetFactStatementResponse) -> do 74 | print ("Got from FactStatementStore: " <> show getFsResp) 75 | case getFsResp ^. maybe'error of 76 | Nothing -> do 77 | let fsIdToGcAfter = Map.fromList [(fsI ^. fsId, fsI ^. gcAfter) | fsI <- req ^. fsInfos] 78 | fsInfos' = 79 | [ (defMessage :: FactStatementInfo) 80 | & fsId .~ fsI ^. fsId 81 | & fs .~ fsI ^. plutusData 82 | & gcAfter .~ gcAf 83 | | fsI <- getFsResp ^. success . fsIdsWithPlutus 84 | , gcAf <- maybe [] return $ Map.lookup (fsI ^. fsId) fsIdToGcAfter 85 | ] 86 | let crMintFsTxReq :: TxBuilder.CreateMintFsTxReq 87 | crMintFsTxReq = 88 | defMessage 89 | & factStatements .~ fsInfos' 90 | & submitter .~ req ^. submitter 91 | print ("Sending CreateMintFsTxReq to TxBuilder: " <> show crMintFsTxReq) 92 | createMintFsRespOrErr <- 93 | call' 94 | (opts ^. txBuilderAddress) 95 | (fromInteger . toInteger $ opts ^. txBuilderPort) 96 | (RPC :: RPC TxBuilder "createMintFsTx") 97 | crMintFsTxReq 98 | either 99 | (\err -> return $ defMessage & PublisherService.error .~ err) 100 | ( \(createMintFsResp :: TxBuilder.CreateMintFsTxResp) -> do 101 | print ("Got from TxBuilder: " <> show getFsResp) 102 | case createMintFsResp ^. maybe'error of 103 | Nothing -> 104 | return $ 105 | (defMessage :: CreateMintFsTxResponse) 106 | & mintFsTx .~ createMintFsResp ^. success . mintFsTx 107 | & info . txBuilderInfo .~ createMintFsResp ^. info 108 | Just er -> 109 | return $ 110 | (defMessage :: CreateMintFsTxResponse) 111 | & PublisherService.error . txBuilderErr .~ er 112 | & info . txBuilderInfo .~ createMintFsResp ^. info 113 | ) 114 | createMintFsRespOrErr 115 | Just er -> return $ (defMessage :: CreateMintFsTxResponse) & PublisherService.error . fsStoreErr .~ er 116 | ) 117 | getFsRespOrErr 118 | 119 | handleCreateGcFsTx :: Server.UnaryHandler IO CreateGcFsTxRequest CreateGcFsTxResponse 120 | handleCreateGcFsTx _ req = do 121 | print ("Got from user: " <> show req) 122 | let txBuilderReq :: TxBuilder.CreateGcFsTxReq 123 | txBuilderReq = 124 | defMessage 125 | & fsIds .~ req ^. fsIds 126 | & submitter .~ req ^. submitter 127 | print ("Sending CreateGcFsTxRequest to TxBuilder: " <> show txBuilderReq) 128 | createGcFsRespOrErr <- 129 | call' 130 | (opts ^. txBuilderAddress) 131 | (fromInteger . toInteger $ opts ^. txBuilderPort) 132 | (RPC :: RPC TxBuilder "createGcFsTx") 133 | txBuilderReq 134 | either 135 | (\err -> return $ defMessage & PublisherService.error .~ err) 136 | ( \(createGcFsResp :: TxBuilder.CreateGcFsTxResp) -> do 137 | print ("Got from TxBuilder: " <> show createGcFsResp) 138 | case createGcFsResp ^. maybe'error of 139 | Nothing -> 140 | return $ 141 | (defMessage :: CreateGcFsTxResponse) 142 | & gcFsTx .~ createGcFsResp ^. success . gcFsTx 143 | & info . txBuilderInfo .~ createGcFsResp ^. info 144 | Just er -> 145 | return $ 146 | (defMessage :: CreateGcFsTxResponse) 147 | & PublisherService.error . txBuilderErr .~ er 148 | & info . txBuilderInfo .~ createGcFsResp ^. info 149 | ) 150 | createGcFsRespOrErr 151 | 152 | routes :: [ServiceHandler] 153 | routes = 154 | [ Server.unary (RPC :: RPC Publisher "createMintFsTx") handleCreateMintFsTx 155 | , Server.unary (RPC :: RPC Publisher "createGcFsTx") handleCreateGcFsTx 156 | ] 157 | 158 | runServer 159 | routes 160 | (fromString $ opts ^. grpcAddress, opts ^. grpcPort) 161 | (opts ^. tlsCertFile, opts ^. tlsKeyFile) 162 | 163 | runServer :: [ServiceHandler] -> (Warp.HostPreference, Int) -> (FilePath, FilePath) -> IO () 164 | runServer routes (h, p) (certFile, keyFile) = do 165 | let warpSettings = 166 | Warp.defaultSettings 167 | & Warp.setPort p 168 | & Warp.setHost h 169 | Server.runGrpc 170 | (tlsSettings certFile keyFile) 171 | warpSettings 172 | routes 173 | [ Encoding.uncompressed 174 | , Encoding.gzip 175 | ] 176 | 177 | formatRpcError :: (IsRPC r, Show a) => r -> a -> Text 178 | formatRpcError r err = (Text.pack . show . path $ r) <> (Text.pack . show $ err) 179 | 180 | call :: (GRPCInput r i, GRPCOutput r a) => r -> GrpcClient -> i -> ClientIO (Either PublisherService.Error a) 181 | call r grpc req = parseRet <$> rawUnary r grpc req 182 | where 183 | parseRet :: Either TooMuchConcurrency (RawReply a) -> Either PublisherService.Error a 184 | parseRet = 185 | either 186 | (\err -> Left $ defMessage & otherErr . msg .~ formatRpcError r err) 187 | ( \(rawRep :: RawReply a) -> 188 | either 189 | (\err -> Left $ defMessage & otherErr . msg .~ formatRpcError r err) 190 | ( \(_, _, errOrResp) -> 191 | either 192 | ( \err -> 193 | Left $ defMessage & otherErr . msg .~ formatRpcError r err 194 | ) 195 | return 196 | errOrResp 197 | ) 198 | rawRep 199 | ) 200 | 201 | call' :: (GRPCOutput r b, GRPCInput r i) => HostName -> PortNumber -> r -> i -> IO (Either PublisherService.Error b) 202 | call' addr port r req = do 203 | ret <- runClientIO do 204 | cli <- mkClient addr port 205 | call r cli req 206 | return $ 207 | either 208 | (\err -> Left $ defMessage & otherErr . msg .~ formatRpcError r err) 209 | (either Left Right) 210 | ret 211 | 212 | mkClient :: HostName -> PortNumber -> ClientIO GrpcClient 213 | mkClient host port = 214 | setupGrpcClient ((grpcClientConfigSimple host port True) {_grpcClientConfigCompression = uncompressed}) 215 | -------------------------------------------------------------------------------- /coop-publisher/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Control.Applicative ((<**>)) 4 | import Coop.Cli.PublisherGrpc (PublisherGrpcOpts (PublisherGrpcOpts), publisherService) 5 | import Options.Applicative ( 6 | Parser, 7 | ParserInfo, 8 | auto, 9 | command, 10 | customExecParser, 11 | fullDesc, 12 | help, 13 | helper, 14 | info, 15 | long, 16 | metavar, 17 | option, 18 | prefs, 19 | progDesc, 20 | showDefault, 21 | showHelpOnEmpty, 22 | showHelpOnError, 23 | strOption, 24 | subparser, 25 | value, 26 | ) 27 | 28 | newtype Command 29 | = PublisherGrpc PublisherGrpcOpts 30 | 31 | publisherGrpcOpts :: Parser PublisherGrpcOpts 32 | publisherGrpcOpts = 33 | PublisherGrpcOpts 34 | <$> strOption 35 | ( long "address" 36 | <> metavar "ADDR" 37 | <> help "Local IP address or host name to bing the Publisher gRpc service to" 38 | <> value "localhost" 39 | <> showDefault 40 | ) 41 | <*> option 42 | auto 43 | ( long "port" 44 | <> metavar "PORT" 45 | <> help "TCP port to bind the Publisher gRpc service to" 46 | <> value 5080 47 | <> showDefault 48 | ) 49 | <*> strOption 50 | ( long "cert-file" 51 | <> metavar "CERT_FILE" 52 | <> help "Certificate file to use for TLS" 53 | <> value ".coop-publisher-cli/certificate.pem" 54 | <> showDefault 55 | ) 56 | <*> strOption 57 | ( long "key-file" 58 | <> metavar "KEY_FILE" 59 | <> help "Private key file to use for TLS" 60 | <> value ".coop-publisher-cli/key.pem" 61 | <> showDefault 62 | ) 63 | <*> strOption 64 | ( long "fact-statement-store-address" 65 | <> metavar "FS_STORE_ADDR" 66 | <> help "IP address or host name of the FactStatementStore gRpc service" 67 | <> value "localhost" 68 | <> showDefault 69 | ) 70 | <*> option 71 | auto 72 | ( long "fact-statement-store-port" 73 | <> metavar "FS_STORE_PORT" 74 | <> help "TCP port of the FactStatementStore gRpc service" 75 | <> value 5082 76 | <> showDefault 77 | ) 78 | <*> strOption 79 | ( long "tx-builder-address" 80 | <> metavar "TX_BUILDER_ADDR" 81 | <> help "IP address or host name of the TxBuilder gRpc service" 82 | <> value "localhost" 83 | <> showDefault 84 | ) 85 | <*> option 86 | auto 87 | ( long "tx-builder-port" 88 | <> metavar "TX_STORE_PORT" 89 | <> help "TCP port of the TxBuilder gRpc service" 90 | <> value 5081 91 | <> showDefault 92 | ) 93 | 94 | optionsP :: Parser Command 95 | optionsP = 96 | subparser $ 97 | command 98 | "publisher-grpc" 99 | (info (PublisherGrpc <$> publisherGrpcOpts <* helper) (progDesc "Run a Publisher gRpc service")) 100 | 101 | parserInfo :: ParserInfo Command 102 | parserInfo = info (optionsP <**> helper) (fullDesc <> progDesc "COOP Publisher cli tools") 103 | 104 | main :: IO () 105 | main = do 106 | cmd <- customExecParser (prefs (showHelpOnEmpty <> showHelpOnError)) parserInfo 107 | case cmd of 108 | PublisherGrpc opts -> publisherService opts 109 | -------------------------------------------------------------------------------- /coop-publisher/aux.bash: -------------------------------------------------------------------------------- 1 | function generate-keys { 2 | local WORKDIR=.coop-publisher-cli 3 | local RESOURCES=resources 4 | mkdir $WORKDIR 5 | openssl genrsa -out $WORKDIR/key.pem 2048 6 | openssl req -new -key $WORKDIR/key.pem -out $WORKDIR/certificate.csr 7 | openssl x509 -req -in $WORKDIR/certificate.csr -signkey $WORKDIR/key.pem -out $WORKDIR/certificate.pem -extfile $RESOURCES/ssl-extensions-x509.conf -extensions v3_ca 8 | openssl x509 -text -in $WORKDIR/certificate.pem 9 | } 10 | 11 | function coop-mint-fs { 12 | resp=$(grpcurl -insecure -import-path ../coop-proto -proto ../coop-proto/publisher-service.proto -d @ localhost:5080 coop.publisher.Publisher/createMintFsTx < .coop-publisher-cli/signed 46 | } 47 | 48 | function coop-gc-fs { 49 | resp=$(grpcurl -insecure -import-path ../coop-proto -proto ../coop-proto/publisher-service.proto -d @ localhost:5080 coop.publisher.Publisher/createGcFsTx < .coop-publisher-cli/signed 63 | } 64 | 65 | function run-grpcui { 66 | make-exports 67 | grpcui -insecure -import-path ../coop-proto -proto ../coop-proto/publisher-service.proto localhost:5080 68 | } 69 | -------------------------------------------------------------------------------- /coop-publisher/build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, haskell-nix, compiler-nix-name, http2-grpc-native, cardanoProtoHs, publisherProtoHs, txBuilderProtoHs, factStatementStoreProtoHs, shellHook }: 2 | haskell-nix.cabalProject' { 3 | src = ./.; 4 | name = "coop-publisher"; 5 | inherit compiler-nix-name; 6 | index-state = "2022-01-21T23:44:46Z"; 7 | extraSources = [ 8 | { 9 | src = http2-grpc-native; 10 | subdirs = [ 11 | "http2-client-grpc" 12 | "http2-grpc-proto-lens" 13 | "http2-grpc-types" 14 | "warp-grpc" 15 | ]; 16 | } 17 | { 18 | src = cardanoProtoHs; 19 | subdirs = [ "." ]; 20 | } 21 | { 22 | src = publisherProtoHs; 23 | subdirs = [ "." ]; 24 | } 25 | { 26 | src = txBuilderProtoHs; 27 | subdirs = [ "." ]; 28 | } 29 | { 30 | src = factStatementStoreProtoHs; 31 | subdirs = [ "." ]; 32 | } 33 | 34 | ]; 35 | modules = [ 36 | (_: { 37 | packages = { 38 | allComponent.doHoogle = true; 39 | allComponent.doHaddock = true; 40 | 41 | # FIXME: This is annoying 42 | # Add proto compilation execs 43 | proto-lens-protobuf-types.components.library.build-tools = [ 44 | pkgs.protobuf 45 | pkgs.haskellPackages.proto-lens-protoc 46 | ]; 47 | 48 | }; 49 | }) 50 | ]; 51 | shell = { 52 | 53 | withHoogle = true; 54 | 55 | exactDeps = true; 56 | 57 | # We use the ones from vanilla Nixpkgs, since they are cached reliably. 58 | nativeBuildInputs = with pkgs; [ 59 | # Code quality 60 | ## Haskell/Cabal 61 | haskellPackages.fourmolu 62 | haskellPackages.cabal-fmt 63 | hlint 64 | ## Nix 65 | nixpkgs-fmt 66 | grpcui 67 | grpcurl 68 | ]; 69 | 70 | additional = ps: [ 71 | ps.http2-client-grpc 72 | ps.http2-grpc-proto-lens 73 | ps.http2-grpc-types 74 | ps.warp-grpc 75 | ps.coop-cardano-proto 76 | ps.coop-publisher-service-proto 77 | ps.coop-tx-builder-service-proto 78 | ps.coop-fact-statement-store-service-proto 79 | ]; 80 | 81 | tools = { 82 | cabal = { }; 83 | hlint = { }; 84 | haskell-language-server = { }; 85 | }; 86 | 87 | shellHook = '' 88 | export LC_CTYPE=C.UTF-8 89 | export LC_ALL=C.UTF-8 90 | export LANG=C.UTF-8 91 | ${shellHook} 92 | ''; 93 | }; 94 | } 95 | -------------------------------------------------------------------------------- /coop-publisher/cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./. 2 | 3 | tests: true 4 | -------------------------------------------------------------------------------- /coop-publisher/coop-publisher.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: coop-publisher 3 | version: 0.1.0.0 4 | maintainer: info@mlabs.city 5 | author: mlabs-haskell 6 | synopsis: gRpc COOP Publisher service implementation 7 | build-type: Simple 8 | 9 | flag dev 10 | description: Enable non-strict compilation for development 11 | manual: True 12 | 13 | common common-language 14 | ghc-options: 15 | -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind 16 | -Wno-partial-type-signatures -Wmissing-export-lists 17 | -Wincomplete-record-updates -Wmissing-deriving-strategies 18 | -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls 19 | -fprint-explicit-kinds -fwarn-missing-import-lists -Wname-shadowing 20 | -Wunused-packages -fprint-potential-instances 21 | 22 | if !flag(dev) 23 | ghc-options: -Werror 24 | 25 | default-extensions: 26 | NoStarIsType 27 | BangPatterns 28 | BinaryLiterals 29 | ConstrainedClassMethods 30 | ConstraintKinds 31 | DataKinds 32 | DeriveAnyClass 33 | DeriveDataTypeable 34 | DeriveFoldable 35 | DeriveFunctor 36 | DeriveGeneric 37 | DeriveLift 38 | DeriveTraversable 39 | DerivingStrategies 40 | DerivingVia 41 | DoAndIfThenElse 42 | EmptyCase 43 | EmptyDataDecls 44 | EmptyDataDeriving 45 | ExistentialQuantification 46 | ExplicitForAll 47 | ExplicitNamespaces 48 | FlexibleContexts 49 | FlexibleInstances 50 | ForeignFunctionInterface 51 | GADTSyntax 52 | GeneralisedNewtypeDeriving 53 | HexFloatLiterals 54 | ImportQualifiedPost 55 | InstanceSigs 56 | KindSignatures 57 | LambdaCase 58 | MonomorphismRestriction 59 | MultiParamTypeClasses 60 | NamedFieldPuns 61 | NamedWildCards 62 | NumericUnderscores 63 | OverloadedStrings 64 | PartialTypeSignatures 65 | PatternGuards 66 | PolyKinds 67 | PostfixOperators 68 | RankNTypes 69 | RelaxedPolyRec 70 | ScopedTypeVariables 71 | StandaloneDeriving 72 | StandaloneKindSignatures 73 | TemplateHaskell 74 | TraditionalRecordSyntax 75 | TupleSections 76 | TypeApplications 77 | TypeFamilies 78 | TypeOperators 79 | TypeSynonymInstances 80 | ViewPatterns 81 | 82 | default-language: Haskell2010 83 | 84 | executable coop-publisher-cli 85 | import: common-language 86 | main-is: Main.hs 87 | hs-source-dirs: app 88 | other-modules: Coop.Cli.PublisherGrpc 89 | build-depends: 90 | , base 91 | , containers 92 | , coop-fact-statement-store-service-proto 93 | , coop-publisher-service-proto 94 | , coop-tx-builder-service-proto 95 | , http2-client 96 | , http2-client-grpc 97 | , http2-grpc-proto-lens 98 | , http2-grpc-types 99 | , lens 100 | , optparse-applicative 101 | , proto-lens 102 | , text 103 | , warp 104 | , warp-grpc 105 | , warp-tls 106 | -------------------------------------------------------------------------------- /coop-publisher/hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /coop-publisher/resources/ssl-extensions-x509.conf: -------------------------------------------------------------------------------- 1 | [v3_ca] 2 | basicConstraints = CA:FALSE 3 | keyUsage = digitalSignature, keyEncipherment 4 | subjectAltName = IP:127.0.0.1, DNS:localhost 5 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "cardano-open-oracle-protocol"; 3 | 4 | inputs = { 5 | # Plutip maintains a compatible Plutus/Cardano derivation set 6 | bot-plutus-interface.url = "github:mlabs-haskell/bot-plutus-interface"; 7 | 8 | plutip.url = "github:mlabs-haskell/plutip"; 9 | plutip.inputs.bot-plutus-interface.follows = "bot-plutus-interface"; 10 | plutip.inputs.haskell-nix.follows = "bot-plutus-interface/haskell-nix"; 11 | plutip.inputs.iohk-nix.follows = "bot-plutus-interface/iohk-nix"; 12 | plutip.inputs.nixpkgs.follows = "bot-plutus-interface/nixpkgs"; 13 | 14 | nixpkgs.follows = "plutip/nixpkgs"; 15 | haskell-nix.follows = "plutip/haskell-nix"; 16 | 17 | flake-utils.url = "github:numtide/flake-utils"; 18 | 19 | pre-commit-hooks.url = "github:cachix/pre-commit-hooks.nix"; 20 | 21 | # TODO: Merge with upstream and use that. 22 | http2-grpc-native = { 23 | url = "github:bladyjoker/http2-grpc-haskell"; 24 | flake = false; 25 | }; 26 | 27 | plutarch.url = "github:plutonomicon/plutarch-plutus/c32001b2ae3007572cb6d5256072a2529c1a3407"; 28 | plutarch.inputs.nixpkgs.follows = "nixpkgs"; 29 | 30 | iohk-nix.follows = "plutip/iohk-nix"; 31 | 32 | nixpkgs-fourmolu.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; 33 | }; 34 | outputs = 35 | { self 36 | , nixpkgs 37 | , flake-utils 38 | , haskell-nix 39 | , pre-commit-hooks 40 | , http2-grpc-native 41 | , plutarch 42 | , iohk-nix 43 | , plutip 44 | , nixpkgs-fourmolu 45 | , ... 46 | }: 47 | flake-utils.lib.eachSystem [ "x86_64-linux" "x86_64-darwin" ] 48 | (system: 49 | let 50 | inherit self; 51 | 52 | pkgs = import nixpkgs { 53 | inherit system; 54 | }; 55 | pkgsWithOverlay = import nixpkgs { 56 | inherit system; 57 | inherit (haskell-nix) config; 58 | overlays = [ 59 | haskell-nix.overlay 60 | (import "${iohk-nix}/overlays/crypto") 61 | ]; 62 | }; 63 | pkgsFourmolu = import nixpkgs-fourmolu { 64 | inherit system; 65 | }; 66 | fourmolu = pkgsFourmolu.haskell.packages.ghc924.fourmolu; 67 | pre-commit-check = pre-commit-hooks.lib.${system}.run (import ./pre-commit-check.nix { inherit fourmolu; }); 68 | pre-commit-devShell = pkgs.mkShell { 69 | inherit (pre-commit-check) shellHook; 70 | }; 71 | 72 | # Haskell shared types 73 | coopHsTypesProj = import ./coop-hs-types/build.nix { 74 | inherit pkgs plutip; 75 | inherit (pkgsWithOverlay) haskell-nix; 76 | inherit (pre-commit-check) shellHook; 77 | compiler-nix-name = "ghc8107"; 78 | }; 79 | coopHsTypesFlake = coopHsTypesProj.flake { }; 80 | 81 | # Plutus 82 | pkgsForPlutarch = import plutarch.inputs.nixpkgs { 83 | inherit system; 84 | inherit (plutarch.inputs.haskell-nix) config; 85 | overlays = [ 86 | plutarch.inputs.haskell-nix.overlay 87 | (import "${plutarch.inputs.iohk-nix}/overlays/crypto") 88 | ]; 89 | }; 90 | 91 | coopPlutusProj = import ./coop-plutus/build.nix { 92 | inherit plutarch; 93 | pkgs = pkgsForPlutarch; 94 | inherit (pkgsForPlutarch) haskell-nix; 95 | inherit (pre-commit-check) shellHook; 96 | coop-hs-types = ./coop-hs-types; 97 | compiler-nix-name = "ghc923"; 98 | }; 99 | coopPlutusFlake = coopPlutusProj.flake { }; 100 | coopPlutusCli = coopPlutusProj.getComponent "coop-plutus:exe:coop-plutus-cli"; 101 | 102 | # Publisher 103 | coopPublisherProj = import ./coop-publisher/build.nix { 104 | inherit pkgs http2-grpc-native; 105 | inherit (pkgsWithOverlay) haskell-nix; 106 | inherit (pre-commit-check) shellHook; 107 | inherit cardanoProtoHs txBuilderProtoHs factStatementStoreProtoHs publisherProtoHs; 108 | compiler-nix-name = "ghc8107"; 109 | }; 110 | coopPublisherFlake = coopPublisherProj.flake { }; 111 | coopPublisherCli = coopPublisherFlake.packages."coop-publisher:exe:coop-publisher-cli"; 112 | 113 | # Docs 114 | coopDocsDevShell = import ./coop-docs/build.nix { 115 | inherit pkgs; 116 | inherit (pre-commit-hooks.outputs.packages.${system}) markdownlint-cli; 117 | inherit (pre-commit-check) shellHook; 118 | }; 119 | 120 | # Protos 121 | coopProtoDevShell = import ./coop-proto/build.nix { 122 | inherit pkgs; 123 | inherit (pre-commit-check) shellHook; 124 | }; 125 | 126 | cardanoProtoHs = import ./nix/protobuf-hs.nix { 127 | inherit pkgs; 128 | src = ./coop-proto; 129 | proto = "cardano.proto"; 130 | cabalPackageName = "coop-cardano-proto"; 131 | }; 132 | 133 | txBuilderProtoHs = import ./nix/protobuf-hs.nix { 134 | inherit pkgs; 135 | src = ./coop-proto; 136 | proto = "tx-builder-service.proto"; 137 | buildDepends = [ "coop-cardano-proto" ]; 138 | cabalPackageName = "coop-tx-builder-service-proto"; 139 | }; 140 | 141 | factStatementStoreProtoHs = import ./nix/protobuf-hs.nix { 142 | inherit pkgs; 143 | src = ./coop-proto; 144 | proto = "fact-statement-store-service.proto"; 145 | buildDepends = [ "coop-cardano-proto" ]; 146 | cabalPackageName = "coop-fact-statement-store-service-proto"; 147 | }; 148 | 149 | publisherProtoHs = import ./nix/protobuf-hs.nix { 150 | inherit pkgs; 151 | src = ./coop-proto; 152 | proto = "publisher-service.proto"; 153 | buildDepends = [ "coop-cardano-proto" "coop-fact-statement-store-service-proto" "coop-tx-builder-service-proto" ]; 154 | cabalPackageName = "coop-publisher-service-proto"; 155 | }; 156 | 157 | # PAB 158 | coopPabProj = import ./coop-pab/build.nix { 159 | inherit pkgs plutip coopPlutusCli http2-grpc-native; 160 | inherit (pkgsWithOverlay) haskell-nix; 161 | inherit (pre-commit-check) shellHook; 162 | coop-hs-types = ./coop-hs-types; 163 | cardanoProtoExtras = ./coop-proto/cardano-proto-extras; 164 | inherit cardanoProtoHs txBuilderProtoHs; 165 | plutipLocalCluster = plutip.packages.${system}."plutip:exe:local-cluster"; 166 | compiler-nix-name = "ghc8107"; 167 | }; 168 | coopPabFlake = coopPabProj.flake { }; 169 | coopPabCli = coopPabFlake.packages."coop-pab:exe:coop-pab-cli"; 170 | 171 | # Extras 172 | plutusJson = import ./coop-extras/plutus-json/build.nix { 173 | inherit plutarch; 174 | pkgs = pkgsForPlutarch; 175 | inherit (pkgsForPlutarch) haskell-nix; 176 | inherit (pre-commit-check) shellHook; 177 | compiler-nix-name = "ghc923"; 178 | }; 179 | plutusJsonFlake = plutusJson.flake { }; 180 | plutusJsonCli = plutusJsonFlake.packages."plutus-json:exe:plutus-json-cli"; 181 | 182 | coopExtrasJsonFactStatementStore = import ./coop-extras/json-fact-statement-store/build.nix { 183 | inherit pkgs plutip http2-grpc-native; 184 | inherit (pkgsWithOverlay) haskell-nix; 185 | inherit (pre-commit-check) shellHook; 186 | inherit factStatementStoreProtoHs cardanoProtoHs; 187 | cardanoProtoExtras = ./coop-proto/cardano-proto-extras; 188 | plutusJson = ./coop-extras/plutus-json; 189 | compiler-nix-name = "ghc8107"; 190 | }; 191 | coopExtrasJsonFactStatementStoreFlake = coopExtrasJsonFactStatementStore.flake { }; 192 | jsFsStoreCli = coopExtrasJsonFactStatementStoreFlake.packages."json-fact-statement-store:exe:json-fs-store-cli"; 193 | 194 | cardanoProtoExtras = import ./coop-proto/cardano-proto-extras/build.nix { 195 | inherit pkgs plutip; 196 | inherit (pkgsWithOverlay) haskell-nix; 197 | inherit (pre-commit-check) shellHook; 198 | inherit cardanoProtoHs; 199 | compiler-nix-name = "ghc8107"; 200 | }; 201 | cardanoProtoExtrasFlake = cardanoProtoExtras.flake { }; 202 | 203 | coopClis = indexBy (drv: drv.exeName) [ 204 | coopPabCli 205 | coopPlutusCli 206 | coopPublisherCli 207 | jsFsStoreCli 208 | plutusJsonCli 209 | ]; 210 | 211 | coopEnvShell = import ./coop-extras/coop-env/build.nix { 212 | inherit pkgs; 213 | inherit coopClis; 214 | cardanoNode = coopPabProj.hsPkgs.cardano-node.components.exes.cardano-node; 215 | cardanoCli = coopPabProj.hsPkgs.cardano-cli.components.exes.cardano-cli; 216 | chainIndex = coopPabProj.hsPkgs.plutus-chain-index.components.exes.plutus-chain-index; 217 | plutipLocalCluster = plutip.packages.${system}."plutip:exe:local-cluster"; 218 | }; 219 | 220 | # Various helper functions 221 | renameAttrs = rnFn: pkgs.lib.attrsets.mapAttrs' (n: value: { name = rnFn n; inherit value; }); 222 | indexBy = keyFn: builtins.foldl' (indexed: x: indexed // { "${keyFn x}" = x; }) { }; 223 | fixNames = builtins.mapAttrs 224 | (_: drv: 225 | builtins.mapAttrs 226 | (name: value: 227 | if name == "name" 228 | then "${drv.exeName}-${drv.version}" 229 | else value 230 | ) 231 | drv 232 | ); 233 | in 234 | rec { 235 | # Useful for nix repl 236 | inherit pkgs pkgsWithOverlay pkgsForPlutarch; 237 | 238 | # Standard flake attributes 239 | packages = coopPlutusFlake.packages 240 | // coopPublisherFlake.packages 241 | // coopPabFlake.packages 242 | // coopHsTypesFlake.packages 243 | // plutusJsonFlake.packages 244 | // coopClis 245 | // { "default" = coopPabCli; }; 246 | 247 | devShells = rec { 248 | dev-proto = coopProtoDevShell; 249 | dev-pre-commit = pre-commit-devShell; 250 | dev-plutus = coopPlutusFlake.devShell; 251 | dev-service = coopPublisherFlake.devShell; 252 | dev-docs = coopDocsDevShell; 253 | dev-pab = coopPabFlake.devShell; 254 | dev-hs-types = coopHsTypesFlake.devShell; 255 | dev-extras-plutus-json = plutusJsonFlake.devShell; 256 | dev-extras-json-store = coopExtrasJsonFactStatementStoreFlake.devShell; 257 | coop-env = coopEnvShell; 258 | dev-cardano-proto-extras = cardanoProtoExtrasFlake.devShell; 259 | default = pre-commit-devShell; 260 | }; 261 | 262 | # nix flake check --impure --keep-going --allow-import-from-derivation 263 | checks = renameAttrs (n: "check-${n}") 264 | (coopPlutusFlake.checks // 265 | coopPublisherFlake.checks // 266 | coopPabFlake.checks // 267 | coopHsTypesFlake.checks // 268 | plutusJsonFlake.checks // 269 | coopExtrasJsonFactStatementStoreFlake.checks // 270 | cardanoProtoExtrasFlake.checks 271 | ) // 272 | { inherit pre-commit-check; } // devShells // packages; 273 | 274 | # FIXME(bladyjoker): Bundlers don't work without `fixNames` because they rely on `builtins.parseDrvName` on `name` rather than `exeName` attribute. 275 | bundlers = fixNames coopClis; 276 | }) 277 | // { 278 | # Instruction for the Hercules CI to build on x86_64-linux only, to avoid errors about systems without agents. 279 | herculesCI.ciSystems = [ "x86_64-linux" ]; 280 | }; 281 | } 282 | -------------------------------------------------------------------------------- /fourmolu.yaml: -------------------------------------------------------------------------------- 1 | indentation: 2 2 | comma-style: leading 3 | record-brace-space: true 4 | indent-wheres: true 5 | diff-friendly-import-export: true 6 | respectful: true 7 | haddock-style: multi-line 8 | newlines-between-decls: 1 9 | -------------------------------------------------------------------------------- /nix/protobuf-hs.nix: -------------------------------------------------------------------------------- 1 | { src, proto, cabalPackageName, buildDepends ? [ ], pkgs }: 2 | let 3 | cabalTemplate = pkgs.writeTextFile { 4 | name = "protobuf-hs-cabal-template"; 5 | text = '' 6 | cabal-version: 3.0 7 | name: ${cabalPackageName} 8 | version: 0.1.0.0 9 | synopsis: A Cabal project that contains protoc/proto-lens-protoc generated Haskell modules 10 | build-type: Simple 11 | 12 | library 13 | exposed-modules: EXPOSED_MODULES 14 | autogen-modules: EXPOSED_MODULES 15 | 16 | hs-source-dirs: src 17 | 18 | default-language: Haskell2010 19 | build-depends: 20 | base, 21 | proto-lens-runtime, 22 | proto-lens-protobuf-types, 23 | ${builtins.concatStringsSep "," buildDepends} 24 | ''; 25 | }; 26 | in 27 | pkgs.stdenv.mkDerivation { 28 | src = ./.; 29 | name = cabalPackageName; 30 | buildInputs = [ 31 | pkgs.protobuf 32 | pkgs.haskellPackages.proto-lens-protoc 33 | pkgs.cabal-install 34 | ]; 35 | buildPhase = '' 36 | set -vox 37 | mkdir src 38 | protoc --plugin=protoc-gen-haskell=${pkgs.haskellPackages.proto-lens-protoc}/bin/proto-lens-protoc \ 39 | --proto_path=${src} \ 40 | --haskell_out=src ${src}/${proto} 41 | 42 | EXPOSED_MODULES=$(find src -name "*.hs" | while read f; do grep -Eo 'module\s+\S+\s+' $f | sed -r 's/module\s+//' | sed -r 's/\s+//'; done | tr '\n' ' ') 43 | echo "Found generated modules $EXPOSED_MODULES" 44 | cat ${cabalTemplate} | sed -r "s/EXPOSED_MODULES/$EXPOSED_MODULES/" > ${cabalPackageName}.cabal 45 | ''; 46 | 47 | installPhase = '' 48 | cp -r . $out 49 | ''; 50 | } 51 | -------------------------------------------------------------------------------- /pre-commit-check.nix: -------------------------------------------------------------------------------- 1 | { fourmolu }: { 2 | src = ./.; 3 | settings = { 4 | # FIXME: https://github.com/cachix/pre-commit-hooks.nix/issues/155 5 | ormolu.defaultExtensions = [ 6 | "NoStarIsType" 7 | "BangPatterns" 8 | "BinaryLiterals" 9 | "ConstrainedClassMethods" 10 | "ConstraintKinds" 11 | "DataKinds" 12 | "DeriveAnyClass" 13 | "DeriveDataTypeable" 14 | "DeriveFoldable" 15 | "DeriveFunctor" 16 | "DeriveGeneric" 17 | "DeriveLift" 18 | "DeriveTraversable" 19 | "DerivingStrategies" 20 | "DerivingVia" 21 | "DoAndIfThenElse" 22 | "EmptyCase" 23 | "EmptyDataDecls" 24 | "EmptyDataDeriving" 25 | "ExistentialQuantification" 26 | "ExplicitForAll" 27 | "ExplicitNamespaces" 28 | "FlexibleContexts" 29 | "FlexibleInstances" 30 | "ForeignFunctionInterface" 31 | "GADTSyntax" 32 | "GeneralisedNewtypeDeriving" 33 | "HexFloatLiterals" 34 | "ImportQualifiedPost" 35 | "InstanceSigs" 36 | "KindSignatures" 37 | "LambdaCase" 38 | "MonomorphismRestriction" 39 | "MultiParamTypeClasses" 40 | "NamedFieldPuns" 41 | "NamedWildCards" 42 | "NumericUnderscores" 43 | "OverloadedRecordDot" 44 | "OverloadedStrings" 45 | "PartialTypeSignatures" 46 | "PatternGuards" 47 | "PolyKinds" 48 | "PostfixOperators" 49 | "RankNTypes" 50 | "RelaxedPolyRec" 51 | "ScopedTypeVariables" 52 | "StandaloneDeriving" 53 | "StandaloneKindSignatures" 54 | "TraditionalRecordSyntax" 55 | "TupleSections" 56 | "TypeApplications" 57 | "TypeFamilies" 58 | "TypeOperators" 59 | "TypeSynonymInstances" 60 | ]; 61 | }; 62 | 63 | hooks = { 64 | nixpkgs-fmt.enable = true; 65 | nix-linter.enable = true; 66 | cabal-fmt.enable = true; 67 | fourmolu.enable = true; 68 | shellcheck.enable = true; 69 | hlint.enable = true; 70 | #FIXME(https://github.com/mlabs-haskell/cardano-open-oracle-protocol/issues/11) hunspell.enable = true; 71 | markdownlint.enable = true; 72 | }; 73 | 74 | tools = { inherit fourmolu; }; 75 | } 76 | --------------------------------------------------------------------------------