From b38137eb06a45280bbd742980e6d62bc45b51e98 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Wed, 12 May 2021 15:37:55 +0200 Subject: [PATCH 01/21] Initial repo setup --- NodeFactory/stable-coin/.gitignore | 23 ++ NodeFactory/stable-coin/LICENSE | 201 ++++++++++++++++ NodeFactory/stable-coin/README.md | 33 +++ NodeFactory/stable-coin/cabal.project | 144 ++++++++++++ NodeFactory/stable-coin/hie.yaml | 2 + NodeFactory/stable-coin/pab/Main.hs | 90 ++++++++ NodeFactory/stable-coin/plutus-starter.cabal | 81 +++++++ NodeFactory/stable-coin/src/MyModule.hs | 7 + .../stable-coin/src/Plutus/Contracts/Game.hs | 162 +++++++++++++ NodeFactory/stable-coin/test/Spec.hs | 21 ++ NodeFactory/stable-coin/test/Spec/Game.hs | 60 +++++ NodeFactory/stable-coin/test/Spec/game.pir | 217 ++++++++++++++++++ 12 files changed, 1041 insertions(+) create mode 100644 NodeFactory/stable-coin/.gitignore create mode 100644 NodeFactory/stable-coin/LICENSE create mode 100644 NodeFactory/stable-coin/README.md create mode 100644 NodeFactory/stable-coin/cabal.project create mode 100644 NodeFactory/stable-coin/hie.yaml create mode 100644 NodeFactory/stable-coin/pab/Main.hs create mode 100644 NodeFactory/stable-coin/plutus-starter.cabal create mode 100644 NodeFactory/stable-coin/src/MyModule.hs create mode 100644 NodeFactory/stable-coin/src/Plutus/Contracts/Game.hs create mode 100644 NodeFactory/stable-coin/test/Spec.hs create mode 100644 NodeFactory/stable-coin/test/Spec/Game.hs create mode 100644 NodeFactory/stable-coin/test/Spec/game.pir diff --git a/NodeFactory/stable-coin/.gitignore b/NodeFactory/stable-coin/.gitignore new file mode 100644 index 000000000..db3002230 --- /dev/null +++ b/NodeFactory/stable-coin/.gitignore @@ -0,0 +1,23 @@ +dist +dist-* +cabal-dev +*.o +*.hi +*.hie +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* \ No newline at end of file diff --git a/NodeFactory/stable-coin/LICENSE b/NodeFactory/stable-coin/LICENSE new file mode 100644 index 000000000..261eeb9e9 --- /dev/null +++ b/NodeFactory/stable-coin/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/NodeFactory/stable-coin/README.md b/NodeFactory/stable-coin/README.md new file mode 100644 index 000000000..204550690 --- /dev/null +++ b/NodeFactory/stable-coin/README.md @@ -0,0 +1,33 @@ +# Plutus Platform starter project + +This project gives a simple starter project for using the Plutus Platform. + +## Setting up + +- Install [nix](https://nixos.org/download.html) +- Clone and setup [plutus repo](https://github.com/input-output-hk/plutus) following README instructions (pay attention on setting binary cache) + +## The Plutus Application Backend (PAB) example + +We have provided an example PAB application in `./pab`. With the PAB we can serve and interact +with contracts over a web API. You can read more about the PAB here: [PAB Architecture](https://github.com/input-output-hk/plutus/blob/master/plutus-pab/ARCHITECTURE.adoc). + +Here, the PAB is configured with sample contract, the `Game` contract from `./src/Plutus/Contracts/Game.hs`. + +1. Start `nix-shell` + +*Make sure that plutus is set up - and run nix-shell inside cloned Plutus repo* + +1. Build the PAB executable: + +``` +cabal build plutus-starter-pab +``` + +2. Run the PAB binary: + +``` +cabal run plutus-starter-pab +```` + +This will then start up the server on port 8080. The devcontainer process will then automatically expose this port so that you can connect to it from any terminal (it doesn't have to be a terminal running in the devcontainer). \ No newline at end of file diff --git a/NodeFactory/stable-coin/cabal.project b/NodeFactory/stable-coin/cabal.project new file mode 100644 index 000000000..f7e25adc5 --- /dev/null +++ b/NodeFactory/stable-coin/cabal.project @@ -0,0 +1,144 @@ +index-state: 2021-02-24T00:00:00Z + +packages: ./. + +-- You never, ever, want this. +write-ghc-environment-files: never + +-- Always build tests and benchmarks. +tests: true +benchmarks: true + +source-repository-package + type: git + location: https://github.com/input-output-hk/plutus.git + subdir: + freer-extras + playground-common + plutus-core + plutus-contract + plutus-ledger + plutus-ledger-api + plutus-tx + plutus-tx-plugin + plutus-pab + plutus-use-cases + prettyprinter-configurable + quickcheck-dynamic + tag: 03a95411238225db1d10288fbd3b405f5f53c78b + +-- The following sections are copied from the 'plutus' repository cabal.project at the revision +-- given above. +-- This is necessary because the 'plutus' libraries depend on a number of other libraries which are +-- not on Hackage, and so need to be pulled in as `source-repository-package`s themselves. Make sure to +-- re-update this section from the template when you do an upgrade. +package eventful-sql-common + ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances + +allow-newer: + -- Has a commit to allow newer aeson, not on Hackage yet + monoidal-containers:aeson + -- Pins to an old version of Template Haskell, unclear if/when it will be updated + , size-based:template-haskell + + -- The following two dependencies are needed by plutus. + , eventful-sql-common:persistent + , eventful-sql-common:persistent-template + +constraints: + -- aws-lambda-haskell-runtime-wai doesn't compile with newer versions + aws-lambda-haskell-runtime <= 3.0.3 + -- big breaking change here, inline-r doens't have an upper bound + , singletons < 3.0 + -- breaks eventful even more than it already was + , persistent-template < 2.12 + +extra-packages: ieee, filemanip + +-- Needs some patches, but upstream seems to be fairly dead (no activity in > 1 year) +source-repository-package + type: git + location: https://github.com/shmish111/purescript-bridge.git + tag: 6a92d7853ea514be8b70bab5e72077bf5a510596 + +source-repository-package + type: git + location: https://github.com/shmish111/servant-purescript.git + tag: a76104490499aa72d40c2790d10e9383e0dbde63 + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-crypto.git + tag: f73079303f663e028288f9f4a9e08bcca39a923e + +-- Needs a fix (https://github.com/wenkokke/unlit/pull/11) and a Hackage release +source-repository-package + type: git + location: https://github.com/michaelpj/unlit.git + tag: 9ca1112093c5ffd356fc99c7dafa080e686dd748 + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-base + tag: 4251c0bb6e4f443f00231d28f5f70d42876da055 + subdir: + binary + binary/test + slotting + cardano-crypto-class + cardano-crypto-praos + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-prelude + tag: ee4e7b547a991876e6b05ba542f4e62909f4a571 + subdir: + cardano-prelude + cardano-prelude-test + +source-repository-package + type: git + location: https://github.com/input-output-hk/ouroboros-network + tag: 6cb9052bde39472a0555d19ade8a42da63d3e904 + subdir: + typed-protocols + typed-protocols-examples + ouroboros-network + ouroboros-network-testing + ouroboros-network-framework + io-sim + io-sim-classes + network-mux + Win32-network + +source-repository-package + type: git + location: https://github.com/input-output-hk/iohk-monitoring-framework + tag: a89c38ed5825ba17ca79fddb85651007753d699d + subdir: + iohk-monitoring + tracer-transformers + contra-tracer + plugins/backend-ekg + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-ledger-specs + tag: 097890495cbb0e8b62106bcd090a5721c3f4b36f + subdir: + byron/chain/executable-spec + byron/crypto + byron/crypto/test + byron/ledger/executable-spec + byron/ledger/impl + byron/ledger/impl/test + semantics/executable-spec + semantics/small-steps-test + shelley/chain-and-ledger/dependencies/non-integer + shelley/chain-and-ledger/executable-spec + shelley-ma/impl + +source-repository-package + type: git + location: https://github.com/input-output-hk/goblins + tag: cde90a2b27f79187ca8310b6549331e59595e7ba diff --git a/NodeFactory/stable-coin/hie.yaml b/NodeFactory/stable-coin/hie.yaml new file mode 100644 index 000000000..04cd24395 --- /dev/null +++ b/NodeFactory/stable-coin/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: diff --git a/NodeFactory/stable-coin/pab/Main.hs b/NodeFactory/stable-coin/pab/Main.hs new file mode 100644 index 000000000..10822ec12 --- /dev/null +++ b/NodeFactory/stable-coin/pab/Main.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Main(main) where + +import Control.Monad (void) +import Control.Monad.Freer (Eff, Member, interpret, type (~>)) +import Control.Monad.Freer.Error (Error) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Aeson (FromJSON (..), ToJSON (..), genericToJSON, genericParseJSON + , defaultOptions, Options(..)) +import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) +import GHC.Generics (Generic) +import Plutus.Contract (BlockchainActions, ContractError) +import Plutus.PAB.Effects.Contract (ContractEffect (..)) +import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..), type (.\\)) +import qualified Plutus.PAB.Effects.Contract.Builtin as Builtin +import Plutus.PAB.Simulator (SimulatorEffectHandlers) +import qualified Plutus.PAB.Simulator as Simulator +import Plutus.PAB.Types (PABError (..)) +import qualified Plutus.PAB.Webserver.Server as PAB.Server +import Plutus.Contracts.Game as Game +import Wallet.Emulator.Types (Wallet (..)) + +main :: IO () +main = void $ Simulator.runSimulationWith handlers $ do + Simulator.logString @(Builtin StarterContracts) "Starting plutus-starter PAB webserver on port 8080. Press enter to exit." + shutdown <- PAB.Server.startServerDebug + -- Example of spinning up a game instance on startup + -- void $ Simulator.activateContract (Wallet 1) GameContract + -- You can add simulator actions here: + -- Simulator.observableState + -- etc. + -- That way, the simulation gets to a predefined state and you don't have to + -- use the HTTP API for setup. + + -- Pressing enter results in the balances being printed + void $ liftIO getLine + + Simulator.logString @(Builtin StarterContracts) "Balances at the end of the simulation" + b <- Simulator.currentBalances + Simulator.logBalances @(Builtin StarterContracts) b + + shutdown + +data StarterContracts = + GameContract + deriving (Eq, Ord, Show, Generic) + +-- NOTE: Because 'StarterContracts' only has one constructor, corresponding to +-- the demo 'Game' contract, we kindly ask aeson to still encode it as if it had +-- many; this way we get to see the label of the contract in the API output! +-- If you simple have more contracts, you can just use the anyclass deriving +-- statement on 'StarterContracts' instead: +-- +-- `... deriving anyclass (ToJSON, FromJSON)` +instance ToJSON StarterContracts where + toJSON = genericToJSON defaultOptions { + tagSingleConstructors = True } +instance FromJSON StarterContracts where + parseJSON = genericParseJSON defaultOptions { + tagSingleConstructors = True } + +instance Pretty StarterContracts where + pretty = viaShow + +handleStarterContract :: + ( Member (Error PABError) effs + ) + => ContractEffect (Builtin StarterContracts) + ~> Eff effs +handleStarterContract = Builtin.handleBuiltin getSchema getContract where + getSchema = \case + GameContract -> Builtin.endpointsToSchemas @(Game.GameSchema .\\ BlockchainActions) + getContract = \case + GameContract -> SomeBuiltin (Game.game @ContractError) + +handlers :: SimulatorEffectHandlers (Builtin StarterContracts) +handlers = + Simulator.mkSimulatorHandlers @(Builtin StarterContracts) [GameContract] + $ interpret handleStarterContract + diff --git a/NodeFactory/stable-coin/plutus-starter.cabal b/NodeFactory/stable-coin/plutus-starter.cabal new file mode 100644 index 000000000..8183a2ee1 --- /dev/null +++ b/NodeFactory/stable-coin/plutus-starter.cabal @@ -0,0 +1,81 @@ +cabal-version: 2.4 +name: plutus-starter +version: 0.1.0.0 + +-- A short (one-line) description of the package. +-- synopsis: + +-- A longer description of the package. +-- description: + +-- A URL where users can report bugs. +-- bug-reports: + +license: Apache-2.0 +license-files: LICENSE +author: NodeFactory +maintainer: mak@nodefactory.io + +-- A copyright notice. +-- copyright: +-- category: +-- extra-source-files: CHANGELOG.md + +library + exposed-modules: + MyModule + Plutus.Contracts.Game + build-depends: + base >= 4.9 && < 5, + aeson, + bytestring, + playground-common, + plutus-contract, + plutus-tx-plugin, + plutus-tx, + plutus-ledger + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: + -- See Plutus Tx readme + -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas + +test-suite plutus-example-projects-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + other-modules: + Spec.Game + default-language: Haskell2010 + ghc-options: -Wall -Wnoncanonical-monad-instances + -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints -Widentities -rtsopts + -- See Plutus Tx readme + -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas + build-depends: + plutus-tx -any, + plutus-tx-plugin, + plutus-contract -any, + plutus-ledger -any, + plutus-starter -any + build-depends: + base >=4.9 && <5, + tasty -any, + tasty-hunit -any, + tasty-hedgehog >=0.2.0.0 + +executable plutus-starter-pab + main-is: Main.hs + hs-source-dirs: pab + ghc-options: + -threaded + build-depends: + base >= 4.9 && < 5, + plutus-contract -any, + plutus-pab -any, + plutus-starter -any, + aeson -any, + freer-simple -any, + prettyprinter -any, + freer-extras -any, + plutus-ledger -any diff --git a/NodeFactory/stable-coin/src/MyModule.hs b/NodeFactory/stable-coin/src/MyModule.hs new file mode 100644 index 000000000..2a1505371 --- /dev/null +++ b/NodeFactory/stable-coin/src/MyModule.hs @@ -0,0 +1,7 @@ +module MyModule where + +hello :: String +hello = "hello" + +main :: IO () +main = putStrLn hello \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/Plutus/Contracts/Game.hs b/NodeFactory/stable-coin/src/Plutus/Contracts/Game.hs new file mode 100644 index 000000000..4f7dfe0be --- /dev/null +++ b/NodeFactory/stable-coin/src/Plutus/Contracts/Game.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} + +-- | A guessing game +module Plutus.Contracts.Game + ( lock + , guess + , game + , GameSchema + , GuessParams(..) + , LockParams(..) + -- * Scripts + , gameValidator + , hashString + , clearString + -- * Address + , gameAddress + , validateGuess + -- * Traces + , guessTrace + , guessWrongTrace + , lockTrace + ) where + +import Control.Monad (void) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) +import Ledger (Address, Validator, ValidatorCtx, Value) +import qualified Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Plutus.Contract +import Plutus.Contract.Schema () +import Plutus.Trace.Emulator (EmulatorTrace) +import qualified Plutus.Trace.Emulator as Trace +import qualified PlutusTx +import PlutusTx.Prelude +import Schema (ToArgument, ToSchema) +import Wallet.Emulator (Wallet (..)) + +import qualified Ledger +import qualified Ledger.Ada as Ada + +import qualified Data.ByteString.Char8 as C +import qualified Prelude + +newtype HashedString = HashedString ByteString deriving newtype PlutusTx.IsData + +PlutusTx.makeLift ''HashedString + +newtype ClearString = ClearString ByteString deriving newtype PlutusTx.IsData + +PlutusTx.makeLift ''ClearString + +type GameSchema = + BlockchainActions + .\/ Endpoint "lock" LockParams + .\/ Endpoint "guess" GuessParams + +-- | The validation function (DataValue -> RedeemerValue -> ValidatorCtx -> Bool) +validateGuess :: HashedString -> ClearString -> ValidatorCtx -> Bool +validateGuess (HashedString actual) (ClearString guess') _ = actual == sha2_256 guess' + +-- | The validator script of the game. +gameValidator :: Validator +gameValidator = Scripts.validatorScript gameInstance + +data Game +instance Scripts.ScriptType Game where + type instance RedeemerType Game = ClearString + type instance DatumType Game = HashedString + +gameInstance :: Scripts.ScriptInstance Game +gameInstance = Scripts.validator @Game + $$(PlutusTx.compile [|| validateGuess ||]) + $$(PlutusTx.compile [|| wrap ||]) where + wrap = Scripts.wrapValidator @HashedString @ClearString + +-- create a data script for the guessing game by hashing the string +-- and lifting the hash to its on-chain representation +hashString :: String -> HashedString +hashString = HashedString . sha2_256 . C.pack + +-- create a redeemer script for the guessing game by lifting the +-- string to its on-chain representation +clearString :: String -> ClearString +clearString = ClearString . C.pack + +-- | The address of the game (the hash of its validator script) +gameAddress :: Address +gameAddress = Ledger.scriptAddress gameValidator + +-- | Parameters for the "lock" endpoint +data LockParams = LockParams + { secretWord :: String + , amount :: Value + } + deriving stock (Prelude.Eq, Prelude.Show, Generic) + deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument) + +-- | Parameters for the "guess" endpoint +newtype GuessParams = GuessParams + { guessWord :: String + } + deriving stock (Prelude.Eq, Prelude.Show, Generic) + deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument) + +lock :: AsContractError e => Contract () GameSchema e () +lock = do + LockParams secret amt <- endpoint @"lock" @LockParams + let tx = Constraints.mustPayToTheScript (hashString secret) amt + void (submitTxConstraints gameInstance tx) + +guess :: AsContractError e => Contract () GameSchema e () +guess = do + GuessParams theGuess <- endpoint @"guess" @GuessParams + unspentOutputs <- utxoAt gameAddress + let redeemer = clearString theGuess + tx = collectFromScript unspentOutputs redeemer + void (submitTxConstraintsSpending gameInstance unspentOutputs tx) + +game :: AsContractError e => Contract () GameSchema e () +game = lock `select` guess + +lockTrace :: EmulatorTrace () +lockTrace = do + let w1 = Wallet 1 + hdl <- Trace.activateContractWallet w1 (game @ContractError) + Trace.callEndpoint @"lock" hdl (LockParams "secret" (Ada.lovelaceValueOf 10)) + void $ Trace.waitNSlots 1 + +guessTrace :: EmulatorTrace () +guessTrace = do + lockTrace + let w2 = Wallet 2 + hdl <- Trace.activateContractWallet w2 (game @ContractError) + Trace.callEndpoint @"guess" hdl (GuessParams "secret") + +guessWrongTrace :: EmulatorTrace () +guessWrongTrace = do + lockTrace + let w2 = Wallet 2 + hdl <- Trace.activateContractWallet w2 (game @ContractError) + Trace.callEndpoint @"guess" hdl (GuessParams "SECRET") diff --git a/NodeFactory/stable-coin/test/Spec.hs b/NodeFactory/stable-coin/test/Spec.hs new file mode 100644 index 000000000..60001de7b --- /dev/null +++ b/NodeFactory/stable-coin/test/Spec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main(main) where + +import qualified Spec.Game +import Test.Tasty +import Test.Tasty.Hedgehog (HedgehogTestLimit (..)) + +main :: IO () +main = defaultMain tests + +-- | Number of successful tests for each hedgehog property. +-- The default is 100 but we use a smaller number here in order to speed up +-- the test suite. +-- +limit :: HedgehogTestLimit +limit = HedgehogTestLimit (Just 5) + +tests :: TestTree +tests = localOption limit $ testGroup "use cases" [ + Spec.Game.tests + ] diff --git a/NodeFactory/stable-coin/test/Spec/Game.hs b/NodeFactory/stable-coin/test/Spec/Game.hs new file mode 100644 index 000000000..e479d43ad --- /dev/null +++ b/NodeFactory/stable-coin/test/Spec/Game.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Spec.Game + ( tests + ) where + +import Control.Monad (void) +import Ledger.Ada (adaValueOf) +import Plutus.Contract (Contract, ContractError) +import Plutus.Contract.Test +import Plutus.Contracts.Game +import Plutus.Trace.Emulator (ContractInstanceTag) +import qualified Plutus.Trace.Emulator as Trace +import qualified PlutusTx +import qualified PlutusTx.Prelude as PlutusTx +import Test.Tasty +import qualified Test.Tasty.HUnit as HUnit + +w1, w2 :: Wallet +w1 = Wallet 1 +w2 = Wallet 2 + +t1, t2 :: ContractInstanceTag +t1 = Trace.walletInstanceTag w1 +t2 = Trace.walletInstanceTag w2 + +theContract :: Contract () GameSchema ContractError () +theContract = game + +tests :: TestTree +tests = testGroup "game" + [ checkPredicate "Expose 'lock' and 'guess' endpoints" + (endpointAvailable @"lock" theContract (Trace.walletInstanceTag w1) + .&&. endpointAvailable @"guess" theContract (Trace.walletInstanceTag w1)) + $ void (Trace.activateContractWallet w1 theContract) + + , checkPredicate "'lock' endpoint submits a transaction" + (anyTx theContract (Trace.walletInstanceTag w1)) + $ do + hdl <- Trace.activateContractWallet w1 theContract + Trace.callEndpoint @"lock" hdl (LockParams "secret" (adaValueOf 10)) + + , checkPredicate "'guess' endpoint is available after locking funds" + (endpointAvailable @"guess" theContract (Trace.walletInstanceTag w2)) + lockTrace + + , checkPredicate "guess right (unlock funds)" + (walletFundsChange w2 (1 `timesFeeAdjust` 10) + .&&. walletFundsChange w1 (1 `timesFeeAdjust` (-10))) + guessTrace + + , checkPredicate "guess wrong" + (walletFundsChange w2 PlutusTx.zero + .&&. walletFundsChange w1 (1 `timesFeeAdjust` (-10))) + guessWrongTrace + , goldenPir "examples/test/Spec/game.pir" $$(PlutusTx.compile [|| validateGuess ||]) + , HUnit.testCase "script size is reasonable" (reasonable gameValidator 20000) + ] diff --git a/NodeFactory/stable-coin/test/Spec/game.pir b/NodeFactory/stable-coin/test/Spec/game.pir new file mode 100644 index 000000000..dcea0aeab --- /dev/null +++ b/NodeFactory/stable-coin/test/Spec/game.pir @@ -0,0 +1,217 @@ +(program + (let + (nonrec) + (datatypebind + (datatype + (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) + (tyvardecl a (type)) (tyvardecl b (type)) + Tuple2_match + (vardecl Tuple2 (fun a (fun b [[Tuple2 a] b]))) + ) + ) + (let + (rec) + (datatypebind + (datatype + (tyvardecl List (fun (type) (type))) + (tyvardecl a (type)) + Nil_match + (vardecl Nil [List a]) (vardecl Cons (fun a (fun [List a] [List a]))) + ) + ) + (let + (rec) + (datatypebind + (datatype + (tyvardecl Data (type)) + + Data_match + (vardecl B (fun (con bytestring) Data)) + (vardecl Constr (fun (con integer) (fun [List Data] Data))) + (vardecl I (fun (con integer) Data)) + (vardecl List (fun [List Data] Data)) + (vardecl Map (fun [List [[Tuple2 Data] Data]] Data)) + ) + ) + (let + (nonrec) + (datatypebind + (datatype + (tyvardecl Extended (fun (type) (type))) + (tyvardecl a (type)) + Extended_match + (vardecl Finite (fun a [Extended a])) + (vardecl NegInf [Extended a]) + (vardecl PosInf [Extended a]) + ) + ) + (datatypebind + (datatype + (tyvardecl Bool (type)) + + Bool_match + (vardecl True Bool) (vardecl False Bool) + ) + ) + (datatypebind + (datatype + (tyvardecl LowerBound (fun (type) (type))) + (tyvardecl a (type)) + LowerBound_match + (vardecl LowerBound (fun [Extended a] (fun Bool [LowerBound a]))) + ) + ) + (datatypebind + (datatype + (tyvardecl UpperBound (fun (type) (type))) + (tyvardecl a (type)) + UpperBound_match + (vardecl UpperBound (fun [Extended a] (fun Bool [UpperBound a]))) + ) + ) + (datatypebind + (datatype + (tyvardecl Interval (fun (type) (type))) + (tyvardecl a (type)) + Interval_match + (vardecl + Interval (fun [LowerBound a] (fun [UpperBound a] [Interval a])) + ) + ) + ) + (datatypebind + (datatype + (tyvardecl Tuple3 (fun (type) (fun (type) (fun (type) (type))))) + (tyvardecl a (type)) (tyvardecl b (type)) (tyvardecl c (type)) + Tuple3_match + (vardecl Tuple3 (fun a (fun b (fun c [[[Tuple3 a] b] c])))) + ) + ) + (datatypebind + (datatype + (tyvardecl Maybe (fun (type) (type))) + (tyvardecl a (type)) + Maybe_match + (vardecl Just (fun a [Maybe a])) (vardecl Nothing [Maybe a]) + ) + ) + (datatypebind + (datatype + (tyvardecl TxOutRef (type)) + + TxOutRef_match + (vardecl + TxOutRef (fun (con bytestring) (fun (con integer) TxOutRef)) + ) + ) + ) + (datatypebind + (datatype + (tyvardecl TxInInfo (type)) + + TxInInfo_match + (vardecl + TxInInfo + (fun TxOutRef (fun [Maybe [[[Tuple3 (con bytestring)] (con bytestring)] (con bytestring)]] (fun [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] (con integer)]] TxInInfo))) + ) + ) + ) + (datatypebind + (datatype + (tyvardecl Address (type)) + + Address_match + (vardecl PubKeyAddress (fun (con bytestring) Address)) + (vardecl ScriptAddress (fun (con bytestring) Address)) + ) + ) + (datatypebind + (datatype + (tyvardecl TxOutType (type)) + + TxOutType_match + (vardecl PayToPubKey TxOutType) + (vardecl PayToScript (fun (con bytestring) TxOutType)) + ) + ) + (datatypebind + (datatype + (tyvardecl TxOut (type)) + + TxOut_match + (vardecl + TxOut + (fun Address (fun [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] (con integer)]] (fun TxOutType TxOut))) + ) + ) + ) + (datatypebind + (datatype + (tyvardecl TxInfo (type)) + + TxInfo_match + (vardecl + TxInfo + (fun [List TxInInfo] (fun [List TxOut] (fun [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] (con integer)]] (fun [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] (con integer)]] (fun [Interval (con integer)] (fun [List (con bytestring)] (fun [List (con bytestring)] (fun [List [[Tuple2 (con bytestring)] Data]] (fun (con bytestring) TxInfo))))))))) + ) + ) + ) + (datatypebind + (datatype + (tyvardecl ValidatorCtx (type)) + + ValidatorCtx_match + (vardecl + ValidatorCtx (fun TxInfo (fun (con integer) ValidatorCtx)) + ) + ) + ) + (termbind + (strict) + (vardecl + equalsByteString + (fun (con bytestring) (fun (con bytestring) Bool)) + ) + (lam + arg + (con bytestring) + (lam + arg + (con bytestring) + [ + (lam + b + (con bool) + [ [ [ { (builtin ifThenElse) Bool } b ] True ] False ] + ) + [ [ (builtin equalsByteString) arg ] arg ] + ] + ) + ) + ) + (termbind + (strict) + (vardecl + validateGuess + (fun (con bytestring) (fun (con bytestring) (fun ValidatorCtx Bool))) + ) + (lam + ds + (con bytestring) + (lam + ds + (con bytestring) + (lam + ds + ValidatorCtx + [ [ equalsByteString ds ] [ (builtin sha2_256) ds ] ] + ) + ) + ) + ) + validateGuess + ) + ) + ) + ) +) \ No newline at end of file From 69d300463000ecc1d2e1e24c9827e89b82ea0e6b Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Tue, 1 Jun 2021 11:37:59 +0200 Subject: [PATCH 02/21] Add oracle code and simple mint contract --- NodeFactory/stable-coin/app/oracle-client.hs | 59 +++++ NodeFactory/stable-coin/app/oracle-pab.hs | 123 ++++++++++ NodeFactory/stable-coin/app/swap-client.hs | 122 ++++++++++ NodeFactory/stable-coin/cabal.project | 2 +- NodeFactory/stable-coin/pab/Main.hs | 90 ------- .../stable-coin/plutus-stable-coin.cabal | 86 +++++++ NodeFactory/stable-coin/plutus-starter.cabal | 81 ------ NodeFactory/stable-coin/src/MyModule.hs | 7 - .../Plutus/Contracts/Oracle/Core.hs | 207 ++++++++++++++++ .../Plutus/Contracts/Oracle/Funds.hs | 41 ++++ .../Plutus/Contracts/Oracle/PAB.hs | 19 ++ .../Plutus/Contracts/Oracle/Swap.hs | 230 ++++++++++++++++++ .../Plutus/Contracts/StableCoin.hs | 74 ++++++ .../stable-coin/src/Plutus/Contracts/Game.hs | 162 ------------ NodeFactory/stable-coin/test/Spec.hs | 21 -- NodeFactory/stable-coin/test/Spec/Game.hs | 60 ----- NodeFactory/stable-coin/test/Spec/game.pir | 217 ----------------- 17 files changed, 962 insertions(+), 639 deletions(-) create mode 100644 NodeFactory/stable-coin/app/oracle-client.hs create mode 100644 NodeFactory/stable-coin/app/oracle-pab.hs create mode 100644 NodeFactory/stable-coin/app/swap-client.hs delete mode 100644 NodeFactory/stable-coin/pab/Main.hs create mode 100644 NodeFactory/stable-coin/plutus-stable-coin.cabal delete mode 100644 NodeFactory/stable-coin/plutus-starter.cabal delete mode 100644 NodeFactory/stable-coin/src/MyModule.hs create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Funds.hs create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/PAB.hs create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Swap.hs create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs delete mode 100644 NodeFactory/stable-coin/src/Plutus/Contracts/Game.hs delete mode 100644 NodeFactory/stable-coin/test/Spec.hs delete mode 100644 NodeFactory/stable-coin/test/Spec/Game.hs delete mode 100644 NodeFactory/stable-coin/test/Spec/game.pir diff --git a/NodeFactory/stable-coin/app/oracle-client.hs b/NodeFactory/stable-coin/app/oracle-client.hs new file mode 100644 index 000000000..06c07e23b --- /dev/null +++ b/NodeFactory/stable-coin/app/oracle-client.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main + ( main + ) where + +import Control.Concurrent +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 (unpack) +import Data.Proxy (Proxy (..)) +import Data.Text (pack) +import Data.UUID +import Network.HTTP.Req +import Text.Regex.TDFA + +main :: IO () +main = do + uuid <- read <$> readFile "oracle.cid" + putStrLn $ "oracle contract instance id: " ++ show uuid + go uuid Nothing + where + go :: UUID -> Maybe Integer -> IO a + go uuid m = do + x <- getExchangeRate + let y = Just x + when (m /= y) $ + updateOracle uuid x + threadDelay 5_000_000 + go uuid y + +updateOracle :: UUID -> Integer -> IO () +updateOracle uuid x = runReq defaultHttpConfig $ do + v <- req + POST + (http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "update") + (ReqBodyJson x) + (Proxy :: Proxy (JsonResponse ())) + (port 8080) + liftIO $ putStrLn $ if responseStatusCode v == 200 + then "updated oracle to " ++ show x + else "error updating oracle" + +getExchangeRate :: IO Integer +getExchangeRate = runReq defaultHttpConfig $ do + v <- req + GET + (https "coinmarketcap.com" /: "currencies" /: "cardano") + NoReqBody + bsResponse + mempty + let priceRegex = "priceValue___11gHJ\">\\$([\\.0-9]*)" :: ByteString + (_, _, _, [bs]) = responseBody v =~ priceRegex :: (ByteString, ByteString, ByteString, [ByteString]) + d = read $ unpack bs :: Double + x = round $ 1_000_000 * d + liftIO $ putStrLn $ "queried exchange rate: " ++ show d + return x \ No newline at end of file diff --git a/NodeFactory/stable-coin/app/oracle-pab.hs b/NodeFactory/stable-coin/app/oracle-pab.hs new file mode 100644 index 000000000..6858e68aa --- /dev/null +++ b/NodeFactory/stable-coin/app/oracle-pab.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Main + ( main + ) where + +import Control.Monad (forM_, void, when) +import Control.Monad.Freer (Eff, Member, interpret, type (~>)) +import Control.Monad.Freer.Error (Error) +import Control.Monad.Freer.Extras.Log (LogMsg) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Aeson (FromJSON, Result (..), fromJSON) +import Data.Monoid (Last (..)) +import Data.Text (Text, pack) +import Ledger +import Ledger.Constraints +import qualified Ledger.Value as Value +import Plutus.Contract hiding (when) +import Plutus.PAB.Effects.Contract (ContractEffect (..)) +import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..), type (.\\), endpointsToSchemas, handleBuiltin) +import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg) +import Plutus.PAB.Simulator (SimulatorEffectHandlers) +import qualified Plutus.PAB.Simulator as Simulator +import Plutus.PAB.Types (PABError (..)) +import qualified Plutus.PAB.Webserver.Server as PAB.Server +import qualified Plutus.Contracts.Currency as Currency + +import Wallet.Emulator.Types (Wallet (..), walletPubKey) +import Wallet.Types (ContractInstanceId (..)) + +import qualified NodeFactory.Plutus.Contracts.Oracle.Core as Oracle +import NodeFactory.Plutus.Contracts.Oracle.PAB (OracleContracts (..)) +import qualified NodeFactory.Plutus.Contracts.Oracle.Swap as Oracle + +main :: IO () +main = void $ Simulator.runSimulationWith handlers $ do + Simulator.logString @(Builtin OracleContracts) "Starting Oracle PAB webserver. Press enter to exit." + shutdown <- PAB.Server.startServerDebug + + cidInit <- Simulator.activateContract (Wallet 1) Init + cs <- waitForLast cidInit + _ <- Simulator.waitUntilFinished cidInit + + cidOracle <- Simulator.activateContract (Wallet 1) $ Oracle cs + liftIO $ writeFile "oracle.cid" $ show $ unContractInstanceId cidOracle + oracle <- waitForLast cidOracle + + forM_ wallets $ \w -> + when (w /= Wallet 1) $ do + cid <- Simulator.activateContract w $ Swap oracle + liftIO $ writeFile ('W' : show (getWallet w) ++ ".cid") $ show $ unContractInstanceId cid + + void $ liftIO getLine + shutdown + +waitForLast :: FromJSON a => ContractInstanceId -> Simulator.Simulation t a +waitForLast cid = + flip Simulator.waitForState cid $ \json -> case fromJSON json of + Success (Last (Just x)) -> Just x + _ -> Nothing + +wallets :: [Wallet] +wallets = [Wallet i | i <- [1 .. 5]] + +usdt :: TokenName +usdt = "USDT" + +oracleParams :: CurrencySymbol -> Oracle.OracleParams +oracleParams cs = Oracle.OracleParams + { Oracle.opFees = 1_000_000 + , Oracle.opSymbol = cs + , Oracle.opToken = usdt + } + +handleOracleContracts :: + ( Member (Error PABError) effs + , Member (LogMsg (PABMultiAgentMsg (Builtin OracleContracts))) effs + ) + => ContractEffect (Builtin OracleContracts) + ~> Eff effs +handleOracleContracts = handleBuiltin getSchema getContract where + getSchema = \case + Init -> endpointsToSchemas @Empty + Oracle _ -> endpointsToSchemas @(Oracle.OracleSchema .\\ BlockchainActions) + Swap _ -> endpointsToSchemas @(Oracle.SwapSchema .\\ BlockchainActions) + getContract = \case + Init -> SomeBuiltin initContract + Oracle cs -> SomeBuiltin $ Oracle.runOracle $ oracleParams cs + Swap oracle -> SomeBuiltin $ Oracle.swap oracle + +handlers :: SimulatorEffectHandlers (Builtin OracleContracts) +handlers = + Simulator.mkSimulatorHandlers @(Builtin OracleContracts) [] + $ interpret handleOracleContracts + +initContract :: Contract (Last CurrencySymbol) BlockchainActions Text () +initContract = do + ownPK <- pubKeyHash <$> ownPubKey + cur <- + mapError (pack . show) + (Currency.forgeContract ownPK [(usdt, fromIntegral (length wallets) * amount)] + :: Contract (Last CurrencySymbol) BlockchainActions Currency.CurrencyError Currency.OneShotCurrency) + let cs = Currency.currencySymbol cur + v = Value.singleton cs usdt amount + forM_ wallets $ \w -> do + let pkh = pubKeyHash $ walletPubKey w + when (pkh /= ownPK) $ do + tx <- submitTx $ mustPayToPubKey pkh v + awaitTxConfirmed $ txId tx + tell $ Last $ Just cs + where + amount :: Integer + amount = 100_000_000 \ No newline at end of file diff --git a/NodeFactory/stable-coin/app/swap-client.hs b/NodeFactory/stable-coin/app/swap-client.hs new file mode 100644 index 000000000..dabb1a813 --- /dev/null +++ b/NodeFactory/stable-coin/app/swap-client.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Main + ( main + ) where + +import Control.Concurrent +import Control.Exception +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Aeson (Result (..), fromJSON) +import Data.Monoid (Last (..)) +import Data.Proxy (Proxy (..)) +import Data.Text (pack) +import Data.UUID +import Ledger.Value (flattenValue) +import Network.HTTP.Req +import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..)) +import Plutus.PAB.Webserver.Types +import System.Environment (getArgs) +import System.IO +import Text.Read (readMaybe) + +import NodeFactory.Plutus.Contracts.Oracle.PAB (OracleContracts) + +main :: IO () +main = do + [i :: Int] <- map read <$> getArgs + uuid <- read <$> readFile ('W' : show i ++ ".cid") + hSetBuffering stdout NoBuffering + putStrLn $ "swap contract instance id for Wallet " ++ show i ++ ": " ++ show uuid + go uuid + where + go :: UUID -> IO a + go uuid = do + cmd <- readCommand + case cmd of + Offer amt -> offer uuid amt + Retrieve -> retrieve uuid + Use -> use uuid + Funds -> getFunds uuid + go uuid + + readCommand :: IO Command + readCommand = do + putStr "enter command (Offer amt, Retrieve, Use or Funds): " + s <- getLine + maybe readCommand return $ readMaybe s + +data Command = Offer Integer | Retrieve | Use | Funds + deriving (Show, Read, Eq, Ord) + +getFunds :: UUID -> IO () +getFunds uuid = handle h $ runReq defaultHttpConfig $ do + v <- req + POST + (http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "funds") + (ReqBodyJson ()) + (Proxy :: Proxy (JsonResponse ())) + (port 8080) + if responseStatusCode v /= 200 + then liftIO $ putStrLn "error getting funds" + else do + w <- req + GET + (http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "status") + NoReqBody + (Proxy :: Proxy (JsonResponse (ContractInstanceClientState OracleContracts))) + (port 8080) + liftIO $ putStrLn $ case fromJSON $ observableState $ cicCurrentState $ responseBody w of + Success (Last (Just f)) -> "funds: " ++ show (flattenValue f) + _ -> "error decoding state" + where + h :: HttpException -> IO () + h _ = threadDelay 1_000_000 >> getFunds uuid + +offer :: UUID -> Integer -> IO () +offer uuid amt = handle h $ runReq defaultHttpConfig $ do + v <- req + POST + (http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "offer") + (ReqBodyJson amt) + (Proxy :: Proxy (JsonResponse ())) + (port 8080) + liftIO $ putStrLn $ if responseStatusCode v == 200 + then "offered swap of " ++ show amt ++ " lovelace" + else "error offering swap" + where + h :: HttpException -> IO () + h _ = threadDelay 1_000_000 >> offer uuid amt + +retrieve :: UUID -> IO () +retrieve uuid = handle h $ runReq defaultHttpConfig $ do + v <- req + POST + (http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "retrieve") + (ReqBodyJson ()) + (Proxy :: Proxy (JsonResponse ())) + (port 8080) + liftIO $ putStrLn $ if responseStatusCode v == 200 + then "retrieved swaps" + else "error retrieving swaps" + where + h :: HttpException -> IO () + h _ = threadDelay 1_000_000 >> retrieve uuid + +use :: UUID -> IO () +use uuid = handle h $ runReq defaultHttpConfig $ do + v <- req + POST + (http "127.0.0.1" /: "api" /: "new" /: "contract" /: "instance" /: pack (show uuid) /: "endpoint" /: "use") + (ReqBodyJson ()) + (Proxy :: Proxy (JsonResponse ())) + (port 8080) + liftIO $ putStrLn $ if responseStatusCode v == 200 + then "used swap" + else "error using swap" + where + h :: HttpException -> IO () + h _ = threadDelay 1_000_000 >> use uuid + diff --git a/NodeFactory/stable-coin/cabal.project b/NodeFactory/stable-coin/cabal.project index f7e25adc5..ea81b0202 100644 --- a/NodeFactory/stable-coin/cabal.project +++ b/NodeFactory/stable-coin/cabal.project @@ -25,7 +25,7 @@ source-repository-package plutus-use-cases prettyprinter-configurable quickcheck-dynamic - tag: 03a95411238225db1d10288fbd3b405f5f53c78b + tag: 476409eaee94141e2fe076a7821fc2fcdec5dfcb -- The following sections are copied from the 'plutus' repository cabal.project at the revision -- given above. diff --git a/NodeFactory/stable-coin/pab/Main.hs b/NodeFactory/stable-coin/pab/Main.hs deleted file mode 100644 index 10822ec12..000000000 --- a/NodeFactory/stable-coin/pab/Main.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Main(main) where - -import Control.Monad (void) -import Control.Monad.Freer (Eff, Member, interpret, type (~>)) -import Control.Monad.Freer.Error (Error) -import Control.Monad.IO.Class (MonadIO (..)) -import Data.Aeson (FromJSON (..), ToJSON (..), genericToJSON, genericParseJSON - , defaultOptions, Options(..)) -import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) -import GHC.Generics (Generic) -import Plutus.Contract (BlockchainActions, ContractError) -import Plutus.PAB.Effects.Contract (ContractEffect (..)) -import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..), type (.\\)) -import qualified Plutus.PAB.Effects.Contract.Builtin as Builtin -import Plutus.PAB.Simulator (SimulatorEffectHandlers) -import qualified Plutus.PAB.Simulator as Simulator -import Plutus.PAB.Types (PABError (..)) -import qualified Plutus.PAB.Webserver.Server as PAB.Server -import Plutus.Contracts.Game as Game -import Wallet.Emulator.Types (Wallet (..)) - -main :: IO () -main = void $ Simulator.runSimulationWith handlers $ do - Simulator.logString @(Builtin StarterContracts) "Starting plutus-starter PAB webserver on port 8080. Press enter to exit." - shutdown <- PAB.Server.startServerDebug - -- Example of spinning up a game instance on startup - -- void $ Simulator.activateContract (Wallet 1) GameContract - -- You can add simulator actions here: - -- Simulator.observableState - -- etc. - -- That way, the simulation gets to a predefined state and you don't have to - -- use the HTTP API for setup. - - -- Pressing enter results in the balances being printed - void $ liftIO getLine - - Simulator.logString @(Builtin StarterContracts) "Balances at the end of the simulation" - b <- Simulator.currentBalances - Simulator.logBalances @(Builtin StarterContracts) b - - shutdown - -data StarterContracts = - GameContract - deriving (Eq, Ord, Show, Generic) - --- NOTE: Because 'StarterContracts' only has one constructor, corresponding to --- the demo 'Game' contract, we kindly ask aeson to still encode it as if it had --- many; this way we get to see the label of the contract in the API output! --- If you simple have more contracts, you can just use the anyclass deriving --- statement on 'StarterContracts' instead: --- --- `... deriving anyclass (ToJSON, FromJSON)` -instance ToJSON StarterContracts where - toJSON = genericToJSON defaultOptions { - tagSingleConstructors = True } -instance FromJSON StarterContracts where - parseJSON = genericParseJSON defaultOptions { - tagSingleConstructors = True } - -instance Pretty StarterContracts where - pretty = viaShow - -handleStarterContract :: - ( Member (Error PABError) effs - ) - => ContractEffect (Builtin StarterContracts) - ~> Eff effs -handleStarterContract = Builtin.handleBuiltin getSchema getContract where - getSchema = \case - GameContract -> Builtin.endpointsToSchemas @(Game.GameSchema .\\ BlockchainActions) - getContract = \case - GameContract -> SomeBuiltin (Game.game @ContractError) - -handlers :: SimulatorEffectHandlers (Builtin StarterContracts) -handlers = - Simulator.mkSimulatorHandlers @(Builtin StarterContracts) [GameContract] - $ interpret handleStarterContract - diff --git a/NodeFactory/stable-coin/plutus-stable-coin.cabal b/NodeFactory/stable-coin/plutus-stable-coin.cabal new file mode 100644 index 000000000..b7f982524 --- /dev/null +++ b/NodeFactory/stable-coin/plutus-stable-coin.cabal @@ -0,0 +1,86 @@ +cabal-version: 2.4 +name: plutus-stable-coin +version: 0.1.0.0 + +-- A short (one-line) description of the package. +-- synopsis: + +-- A longer description of the package. +-- description: + +-- A URL where users can report bugs. +-- bug-reports: + +license: Apache-2.0 +license-files: LICENSE +author: NodeFactory +maintainer: mak@nodefactory.io + +-- A copyright notice. +-- copyright: +-- category: +-- extra-source-files: CHANGELOG.md + +library + hs-source-dirs: src + exposed-modules: + NodeFactory.Plutus.Contracts.Oracle.Core + NodeFactory.Plutus.Contracts.Oracle.Funds + NodeFactory.Plutus.Contracts.Oracle.PAB + NodeFactory.Plutus.Contracts.Oracle.Swap + NodeFactory.Plutus.Contracts.StableCoin + build-depends: aeson + , base ^>=4.14.1.0 + , containers + , data-default + , freer-extras + , playground-common + , plutus-contract + , plutus-ledger + , plutus-ledger-api + , plutus-tx-plugin + , plutus-tx + , plutus-use-cases + , prettyprinter + , text + default-language: Haskell2010 + ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr -fno-specialise + +executable oracle-pab + main-is: oracle-pab.hs + hs-source-dirs: app + ghc-options: -Wall -threaded + build-depends: aeson + , base ^>= 4.14.1.0 + , freer-extras + , freer-simple + , plutus-contract + , plutus-ledger + , plutus-pab + , plutus-stable-coin + , plutus-use-cases + , text + +executable oracle-client + main-is: oracle-client.hs + hs-source-dirs: app + ghc-options: -Wall + build-depends: base ^>= 4.14.1.0 + , bytestring + , regex-tdfa ^>= 1.3.1.0 + , req ^>= 3.9.0 + , text + , uuid + +executable swap-client + main-is: swap-client.hs + hs-source-dirs: app + ghc-options: -Wall + build-depends: aeson + , base ^>= 4.14.1.0 + , plutus-ledger + , plutus-pab + , plutus-stable-coin + , req ^>= 3.9.0 + , text + , uuid diff --git a/NodeFactory/stable-coin/plutus-starter.cabal b/NodeFactory/stable-coin/plutus-starter.cabal deleted file mode 100644 index 8183a2ee1..000000000 --- a/NodeFactory/stable-coin/plutus-starter.cabal +++ /dev/null @@ -1,81 +0,0 @@ -cabal-version: 2.4 -name: plutus-starter -version: 0.1.0.0 - --- A short (one-line) description of the package. --- synopsis: - --- A longer description of the package. --- description: - --- A URL where users can report bugs. --- bug-reports: - -license: Apache-2.0 -license-files: LICENSE -author: NodeFactory -maintainer: mak@nodefactory.io - --- A copyright notice. --- copyright: --- category: --- extra-source-files: CHANGELOG.md - -library - exposed-modules: - MyModule - Plutus.Contracts.Game - build-depends: - base >= 4.9 && < 5, - aeson, - bytestring, - playground-common, - plutus-contract, - plutus-tx-plugin, - plutus-tx, - plutus-ledger - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: - -- See Plutus Tx readme - -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas - -test-suite plutus-example-projects-test - type: exitcode-stdio-1.0 - main-is: Spec.hs - hs-source-dirs: test - other-modules: - Spec.Game - default-language: Haskell2010 - ghc-options: -Wall -Wnoncanonical-monad-instances - -Wincomplete-uni-patterns -Wincomplete-record-updates - -Wredundant-constraints -Widentities -rtsopts - -- See Plutus Tx readme - -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas - build-depends: - plutus-tx -any, - plutus-tx-plugin, - plutus-contract -any, - plutus-ledger -any, - plutus-starter -any - build-depends: - base >=4.9 && <5, - tasty -any, - tasty-hunit -any, - tasty-hedgehog >=0.2.0.0 - -executable plutus-starter-pab - main-is: Main.hs - hs-source-dirs: pab - ghc-options: - -threaded - build-depends: - base >= 4.9 && < 5, - plutus-contract -any, - plutus-pab -any, - plutus-starter -any, - aeson -any, - freer-simple -any, - prettyprinter -any, - freer-extras -any, - plutus-ledger -any diff --git a/NodeFactory/stable-coin/src/MyModule.hs b/NodeFactory/stable-coin/src/MyModule.hs deleted file mode 100644 index 2a1505371..000000000 --- a/NodeFactory/stable-coin/src/MyModule.hs +++ /dev/null @@ -1,7 +0,0 @@ -module MyModule where - -hello :: String -hello = "hello" - -main :: IO () -main = putStrLn hello \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs new file mode 100644 index 000000000..fa65d59fc --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs @@ -0,0 +1,207 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module NodeFactory.Plutus.Contracts.Oracle.Core + ( Oracle (..) + , OracleRedeemer (..) + , oracleTokenName + , oracleValue + , oracleAsset + , oracleInst + , oracleValidator + , oracleAddress + , OracleSchema + , OracleParams (..) + , runOracle + , findOracle + ) where + +import Control.Monad hiding (fmap) +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Map as Map +import Data.Monoid (Last (..)) +import Data.Text (Text, pack) +import GHC.Generics (Generic) +import Plutus.Contract as Contract hiding (when) +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Ledger.Ada as Ada +import Plutus.Contracts.Currency as Currency +import Prelude (Semigroup (..)) +import qualified Prelude as Prelude + +-- contract param structure +data Oracle = Oracle + { oSymbol :: !CurrencySymbol -- currency symbol of NFT + , oOperator :: !PubKeyHash -- owner of the oracle + , oFee :: !Integer -- fees in lovelace + , oAsset :: !AssetClass -- target of the oracle (US dollar) + } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord) + +PlutusTx.makeLift ''Oracle + +data OracleRedeemer = Update | Use -- two availabe operations + deriving Show + +PlutusTx.unstableMakeIsData ''OracleRedeemer + +-- HELPER FUNCTIONS + +{-# INLINABLE oracleTokenName #-} -- use empty string for token name +oracleTokenName :: TokenName +oracleTokenName = TokenName emptyByteString + +{-# INLINABLE oracleAsset #-} +oracleAsset :: Oracle -> AssetClass -- identify asset class if oracle provided +oracleAsset oracle = AssetClass (oSymbol oracle, oracleTokenName) + +{-# INLINABLE oracleValue #-} -- convert transaction output datum to integer +oracleValue :: TxOut -> (DatumHash -> Maybe Datum) -> Maybe Integer +oracleValue o f = do + dh <- txOutDatum o + Datum d <- f dh + PlutusTx.fromData d + +{-# INLINABLE mkOracleValidator #-} -- validator functions +mkOracleValidator :: Oracle -> Integer -> OracleRedeemer -> ScriptContext -> Bool +mkOracleValidator oracle x r ctx = + traceIfFalse "token missing from input" inputHasToken && + traceIfFalse "token missing from output" outputHasToken && + case r of + Update -> traceIfFalse "operator signature missing" (txSignedBy info $ oOperator oracle) && + traceIfFalse "invalid output datum" validOutputDatum + Use -> traceIfFalse "oracle value changed" (outputDatum == Just x) && + traceIfFalse "fees not paid" feesPaid + where + info :: TxInfo -- extract transaction info from context + info = scriptContextTxInfo ctx + + ownInput :: TxOut -- get oracle input + ownInput = case findOwnInput ctx of + Nothing -> traceError "oracle input missing" + Just i -> txInInfoResolved i + + inputHasToken :: Bool -- check if input contains nft token + inputHasToken = assetClassValueOf (txOutValue ownInput) (oracleAsset oracle) == 1 + + ownOutput :: TxOut -- get oracle output + ownOutput = case getContinuingOutputs ctx of + [o] -> o + _ -> traceError "expected exactly one oracle output" + + outputHasToken :: Bool -- check if output contains nft token + outputHasToken = assetClassValueOf (txOutValue ownOutput) (oracleAsset oracle) == 1 + + outputDatum :: Maybe Integer -- get data from output datum + outputDatum = oracleValue ownOutput (`findDatum` info) + + validOutputDatum :: Bool -- check if type of data in output datum valid + validOutputDatum = isJust outputDatum + + feesPaid :: Bool -- check if user paid fees + feesPaid = + let + inVal = txOutValue ownInput + outVal = txOutValue ownOutput + in + outVal `geq` (inVal <> Ada.lovelaceValueOf (oFee oracle)) + +data Oracling +instance Scripts.ScriptType Oracling where + type instance DatumType Oracling = Integer + type instance RedeemerType Oracling = OracleRedeemer + +oracleInst :: Oracle -> Scripts.ScriptInstance Oracling +oracleInst oracle = Scripts.validator @Oracling + ($$(PlutusTx.compile [|| mkOracleValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode oracle) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator @Integer @OracleRedeemer + +oracleValidator :: Oracle -> Validator +oracleValidator = Scripts.validatorScript . oracleInst + +oracleAddress :: Oracle -> Ledger.Address +oracleAddress = scriptAddress . oracleValidator + +data OracleParams = OracleParams -- parans fir starting oracle + { opFees :: !Integer + , opSymbol :: !CurrencySymbol + , opToken :: !TokenName + } deriving (Show, Generic, FromJSON, ToJSON) + +startOracle :: forall w s. HasBlockchainActions s => OracleParams -> Contract w s Text Oracle +startOracle op = do + pkh <- pubKeyHash <$> Contract.ownPubKey + -- mint NFT using forgeContract function (provide owner pkh and array of nft-s that are going to be minted) + -- use mapError to convert String error to Text error + osc <- mapError (pack . show) (forgeContract pkh [(oracleTokenName, 1)] :: Contract w s CurrencyError OneShotCurrency) + let cs = Currency.currencySymbol osc + oracle = Oracle + { oSymbol = cs + , oOperator = pkh + , oFee = opFees op + , oAsset = AssetClass (opSymbol op, opToken op) + } + logInfo @String $ "started oracle " ++ show oracle + return oracle + +updateOracle :: forall w s. HasBlockchainActions s => Oracle -> Integer -> Contract w s Text () +updateOracle oracle x = do + m <- findOracle oracle -- check if oracle exists + let c = Constraints.mustPayToTheScript x $ assetClassValue (oracleAsset oracle) 1 + case m of + Nothing -> do -- oracle nft not created + ledgerTx <- submitTxConstraints (oracleInst oracle) c + awaitTxConfirmed $ txId ledgerTx + logInfo @String $ "set initial oracle value to " ++ show x + Just (oref, o, _) -> do -- update existing oracle nft value + let lookups = Constraints.unspentOutputs (Map.singleton oref o) <> + Constraints.scriptInstanceLookups (oracleInst oracle) <> + Constraints.otherScript (oracleValidator oracle) + tx = c <> Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData Update) + -- fees auto send because of inbalance + ledgerTx <- submitTxConstraintsWith @Oracling lookups tx + awaitTxConfirmed $ txId ledgerTx + logInfo @String $ "updated oracle value to " ++ show x + +-- +findOracle :: forall w s. HasBlockchainActions s => Oracle -> Contract w s Text (Maybe (TxOutRef, TxOutTx, Integer)) +findOracle oracle = do + utxos <- Map.filter f <$> utxoAt (oracleAddress oracle) + return $ case Map.toList utxos of + [(oref, o)] -> do + x <- oracleValue (txOutTxOut o) $ \dh -> Map.lookup dh $ txData $ txOutTxTx o + return (oref, o, x) + _ -> Nothing + where + f :: TxOutTx -> Bool + f o = assetClassValueOf (txOutValue $ txOutTxOut o) (oracleAsset oracle) == 1 + +type OracleSchema = BlockchainActions .\/ Endpoint "update" Integer + +runOracle :: OracleParams -> Contract (Last Oracle) OracleSchema Text () +runOracle op = do + oracle <- startOracle op + tell $ Last $ Just oracle + go oracle + where + go :: Oracle -> Contract (Last Oracle) OracleSchema Text a + go oracle = do + x <- endpoint @"update" + updateOracle oracle x + go oracle \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Funds.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Funds.hs new file mode 100644 index 000000000..a659c6d33 --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Funds.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module NodeFactory.Plutus.Contracts.Oracle.Funds + ( ownFunds + , ownFunds' + ) where + +import Control.Monad hiding (fmap) +import qualified Data.Map as Map +import Data.Monoid (Last (..)) +import Data.Text (Text) +import Plutus.Contract as Contract hiding (when) +import PlutusTx.Prelude hiding ((<$>)) +import Prelude ((<$>)) +import Ledger hiding (singleton) +import Ledger.Value as Value + +ownFunds :: HasBlockchainActions s => Contract w s Text Value +ownFunds = do + pk <- ownPubKey + utxos <- utxoAt $ pubKeyAddress pk + let v = mconcat $ Map.elems $ txOutValue . txOutTxOut <$> utxos + logInfo @String $ "own funds: " ++ show (Value.flattenValue v) + return v + +ownFunds' :: Contract (Last Value) BlockchainActions Text () +ownFunds' = do + handleError logError $ ownFunds >>= tell . Last . Just + void $ Contract.waitNSlots 1 + ownFunds' \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/PAB.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/PAB.hs new file mode 100644 index 000000000..d721a3a6d --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/PAB.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module NodeFactory.Plutus.Contracts.Oracle.PAB + ( OracleContracts (..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) +import GHC.Generics (Generic) +import Ledger + +import qualified NodeFactory.Plutus.Contracts.Oracle.Core as Oracle + +data OracleContracts = Init | Oracle CurrencySymbol | Swap Oracle.Oracle + deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON) + +instance Pretty OracleContracts where + pretty = viaShow \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Swap.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Swap.hs new file mode 100644 index 000000000..8c1be0ec8 --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Swap.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module NodeFactory.Plutus.Contracts.Oracle.Swap + ( SwapSchema + , swap + ) where + +import Control.Monad hiding (fmap) +import Data.List (find) +import qualified Data.Map as Map +import Data.Maybe (mapMaybe) +import Data.Monoid (Last (..)) +import Data.Text (Text) +import Plutus.Contract as Contract hiding (when) +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup(..), (<$>), unless, mapMaybe, find) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Ada as Ada hiding (divide) +import Ledger.Value as Value +import Prelude (Semigroup (..), (<$>)) + +import NodeFactory.Plutus.Contracts.Oracle.Core +import NodeFactory.Plutus.Contracts.Oracle.Funds + +{-# INLINABLE price #-} +price :: Integer -> Integer -> Integer +price lovelace exchangeRate = (lovelace * exchangeRate) `divide` 1000000 + +{-# INLINABLE lovelaces #-} +lovelaces :: Value -> Integer +lovelaces = Ada.getLovelace . Ada.fromValue + +{-# INLINABLE mkSwapValidator #-} +mkSwapValidator :: Oracle -> Address -> PubKeyHash -> () -> ScriptContext -> Bool +mkSwapValidator oracle addr pkh () ctx = + txSignedBy info pkh || + (traceIfFalse "expected exactly two script inputs" hasTwoScriptInputs && + traceIfFalse "price not paid" sellerPaid) + + where + info :: TxInfo + info = scriptContextTxInfo ctx + + oracleInput :: TxOut + oracleInput = + let + -- all inputs that sit at addr + ins = [ o + | i <- txInfoInputs info + , let o = txInInfoResolved i + , txOutAddress o == addr + ] + in + case ins of + [o] -> o + _ -> traceError "expected exactly one oracle input" + + oracleValue' = case oracleValue oracleInput (`findDatum` info) of + Nothing -> traceError "oracle value not found" + Just x -> x + + hasTwoScriptInputs :: Bool + hasTwoScriptInputs = + let + xs = filter (isJust . toValidatorHash . txOutAddress . txInInfoResolved) $ txInfoInputs info + in + length xs == 2 + + minPrice :: Integer + minPrice = + let + lovelaceIn = case findOwnInput ctx of + Nothing -> traceError "own input not found" + Just i -> lovelaces $ txOutValue $ txInInfoResolved i + in + price lovelaceIn oracleValue' + + sellerPaid :: Bool + sellerPaid = + let + pricePaid :: Integer + pricePaid = assetClassValueOf (valuePaidTo info pkh) (oAsset oracle) + in + pricePaid >= minPrice + +data Swapping +instance Scripts.ScriptType Swapping where + type instance DatumType Swapping = PubKeyHash + type instance RedeemerType Swapping = () + +swapInst :: Oracle -> Scripts.ScriptInstance Swapping +swapInst oracle = Scripts.validator @Swapping + ($$(PlutusTx.compile [|| mkSwapValidator ||]) + `PlutusTx.applyCode` PlutusTx.liftCode oracle + `PlutusTx.applyCode` PlutusTx.liftCode (oracleAddress oracle)) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator @PubKeyHash @() + +swapValidator :: Oracle -> Validator +swapValidator = Scripts.validatorScript . swapInst + +swapAddress :: Oracle -> Ledger.Address +swapAddress = scriptAddress . swapValidator + +-- OFFCHAIN + +offerSwap :: forall w s. HasBlockchainActions s => Oracle -> Integer -> Contract w s Text () +offerSwap oracle amt = do + pkh <- pubKeyHash <$> Contract.ownPubKey + let tx = Constraints.mustPayToTheScript pkh $ Ada.lovelaceValueOf amt + ledgerTx <- submitTxConstraints (swapInst oracle) tx + awaitTxConfirmed $ txId ledgerTx + logInfo @String $ "offered " ++ show amt ++ " lovelace for swap" + +findSwaps :: HasBlockchainActions s => Oracle -> (PubKeyHash -> Bool) -> Contract w s Text [(TxOutRef, TxOutTx, PubKeyHash)] +findSwaps oracle p = do + utxos <- utxoAt $ swapAddress oracle + return $ mapMaybe g $ Map.toList utxos + where + f :: TxOutTx -> Maybe PubKeyHash + f o = do + dh <- txOutDatumHash $ txOutTxOut o + (Datum d) <- Map.lookup dh $ txData $ txOutTxTx o + PlutusTx.fromData d + + g :: (TxOutRef, TxOutTx) -> Maybe (TxOutRef, TxOutTx, PubKeyHash) + g (oref, o) = do + pkh <- f o + guard $ p pkh + return (oref, o, pkh) + +retrieveSwaps :: HasBlockchainActions s => Oracle -> Contract w s Text () +retrieveSwaps oracle = do + pkh <- pubKeyHash <$> ownPubKey + xs <- findSwaps oracle (== pkh) + case xs of + [] -> logInfo @String "no swaps found" + _ -> do + let lookups = Constraints.unspentOutputs (Map.fromList [(oref, o) | (oref, o, _) <- xs]) <> + Constraints.otherScript (swapValidator oracle) + tx = mconcat [Constraints.mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData () | (oref, _, _) <- xs] + ledgerTx <- submitTxConstraintsWith @Swapping lookups tx + awaitTxConfirmed $ txId ledgerTx + logInfo @String $ "retrieved " ++ show (length xs) ++ " swap(s)" + +useSwap :: forall w s. HasBlockchainActions s => Oracle -> Contract w s Text () +useSwap oracle = do + funds <- ownFunds + let amt = assetClassValueOf funds $ oAsset oracle + logInfo @String $ "available assets: " ++ show amt + + m <- findOracle oracle + case m of + Nothing -> logInfo @String "oracle not found" + Just (oref, o, x) -> do + logInfo @String $ "found oracle, exchange rate " ++ show x + pkh <- pubKeyHash <$> Contract.ownPubKey + swaps <- findSwaps oracle (/= pkh) + case find (f amt x) swaps of + Nothing -> logInfo @String "no suitable swap found" + Just (oref', o', pkh') -> do + let v = txOutValue (txOutTxOut o) <> lovelaceValueOf (oFee oracle) + p = assetClassValue (oAsset oracle) $ price (lovelaces $ txOutValue $ txOutTxOut o') x + lookups = Constraints.otherScript (swapValidator oracle) <> + Constraints.otherScript (oracleValidator oracle) <> + Constraints.unspentOutputs (Map.fromList [(oref, o), (oref', o')]) + tx = Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData Use) <> + Constraints.mustSpendScriptOutput oref' (Redeemer $ PlutusTx.toData ()) <> + Constraints.mustPayToOtherScript + (validatorHash $ oracleValidator oracle) + (Datum $ PlutusTx.toData x) + v <> + Constraints.mustPayToPubKey pkh' p + ledgerTx <- submitTxConstraintsWith @Swapping lookups tx + awaitTxConfirmed $ txId ledgerTx + logInfo @String $ "made swap with price " ++ show (Value.flattenValue p) + where + getPrice :: Integer -> TxOutTx -> Integer + getPrice x o = price (lovelaces $ txOutValue $ txOutTxOut o) x + + f :: Integer -> Integer -> (TxOutRef, TxOutTx, PubKeyHash) -> Bool + f amt x (_, o, _) = getPrice x o <= amt + +type SwapSchema = + BlockchainActions + .\/ Endpoint "offer" Integer + .\/ Endpoint "retrieve" () + .\/ Endpoint "use" () + .\/ Endpoint "funds" () + +swap :: Oracle -> Contract (Last Value) SwapSchema Text () +swap oracle = (offer `select` retrieve `select` use `select` funds) >> swap oracle + where + offer :: Contract (Last Value) SwapSchema Text () + offer = h $ do + amt <- endpoint @"offer" + offerSwap oracle amt + + retrieve :: Contract (Last Value) SwapSchema Text () + retrieve = h $ do + endpoint @"retrieve" + retrieveSwaps oracle + + use :: Contract (Last Value) SwapSchema Text () + use = h $ do + endpoint @"use" + useSwap oracle + + funds :: Contract (Last Value) SwapSchema Text () + funds = h $ do + endpoint @"funds" + v <- ownFunds + tell $ Last $ Just v + + h :: Contract (Last Value) SwapSchema Text () -> Contract (Last Value) SwapSchema Text () + h = handleError logError \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs new file mode 100644 index 000000000..56f47276f --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module NodeFactory.Plutus.Contracts.StableCoin where + +import Control.Monad hiding (fmap) +import Control.Monad.Freer.Extras as Extras +import Data.Aeson (ToJSON, FromJSON) +import Data.Text (Text) +import Data.Void (Void) +import GHC.Generics (Generic) +import Plutus.Contract as Contract hiding (when) +import Plutus.Trace.Emulator as Emulator +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) +import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) +import Playground.Types (KnownCurrency (..)) +import Text.Printf (printf) +import Wallet.Emulator.Wallet + +{-# INLINABLE mkPolicy #-} +mkPolicy :: PubKeyHash -> ScriptContext -> Bool +mkPolicy pkh ctx = txSignedBy (scriptContextTxInfo ctx) pkh + +policy :: PubKeyHash -> Scripts.MonetaryPolicy +policy pkh = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy . mkPolicy ||]) + `PlutusTx.applyCode` + PlutusTx.liftCode pkh + +curSymbol :: PubKeyHash -> CurrencySymbol +curSymbol = scriptCurrencySymbol . policy + +data MintParams = MintParams + { mpTokenName :: !TokenName + , mpAmount :: !Integer + } deriving (Generic, ToJSON, FromJSON, ToSchema) + +type StableCoinSchema = + BlockchainActions + .\/ Endpoint "mint" MintParams + +mint :: MintParams -> Contract w StableCoinSchema Text () +mint mp = do + pkh <- pubKeyHash <$> Contract.ownPubKey + let val = Value.singleton (curSymbol pkh) (mpTokenName mp) (mpAmount mp) + lookups = Constraints.monetaryPolicy $ policy pkh + tx = Constraints.mustForgeValue val + ledgerTx <- submitTxConstraintsWith @Void lookups tx + void $ awaitTxConfirmed $ txId ledgerTx + Contract.logInfo @String $ printf "forged %s" (show val) + +endpoints :: Contract () StableCoinSchema Text () +endpoints = mint' >> endpoints + where + mint' = endpoint @"mint" >>= mint + +mkSchemaDefinitions ''StableCoinSchema + +mkKnownCurrencies [] \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/Plutus/Contracts/Game.hs b/NodeFactory/stable-coin/src/Plutus/Contracts/Game.hs deleted file mode 100644 index 4f7dfe0be..000000000 --- a/NodeFactory/stable-coin/src/Plutus/Contracts/Game.hs +++ /dev/null @@ -1,162 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE ViewPatterns #-} - --- | A guessing game -module Plutus.Contracts.Game - ( lock - , guess - , game - , GameSchema - , GuessParams(..) - , LockParams(..) - -- * Scripts - , gameValidator - , hashString - , clearString - -- * Address - , gameAddress - , validateGuess - -- * Traces - , guessTrace - , guessWrongTrace - , lockTrace - ) where - -import Control.Monad (void) -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) -import Ledger (Address, Validator, ValidatorCtx, Value) -import qualified Ledger.Constraints as Constraints -import qualified Ledger.Typed.Scripts as Scripts -import Plutus.Contract -import Plutus.Contract.Schema () -import Plutus.Trace.Emulator (EmulatorTrace) -import qualified Plutus.Trace.Emulator as Trace -import qualified PlutusTx -import PlutusTx.Prelude -import Schema (ToArgument, ToSchema) -import Wallet.Emulator (Wallet (..)) - -import qualified Ledger -import qualified Ledger.Ada as Ada - -import qualified Data.ByteString.Char8 as C -import qualified Prelude - -newtype HashedString = HashedString ByteString deriving newtype PlutusTx.IsData - -PlutusTx.makeLift ''HashedString - -newtype ClearString = ClearString ByteString deriving newtype PlutusTx.IsData - -PlutusTx.makeLift ''ClearString - -type GameSchema = - BlockchainActions - .\/ Endpoint "lock" LockParams - .\/ Endpoint "guess" GuessParams - --- | The validation function (DataValue -> RedeemerValue -> ValidatorCtx -> Bool) -validateGuess :: HashedString -> ClearString -> ValidatorCtx -> Bool -validateGuess (HashedString actual) (ClearString guess') _ = actual == sha2_256 guess' - --- | The validator script of the game. -gameValidator :: Validator -gameValidator = Scripts.validatorScript gameInstance - -data Game -instance Scripts.ScriptType Game where - type instance RedeemerType Game = ClearString - type instance DatumType Game = HashedString - -gameInstance :: Scripts.ScriptInstance Game -gameInstance = Scripts.validator @Game - $$(PlutusTx.compile [|| validateGuess ||]) - $$(PlutusTx.compile [|| wrap ||]) where - wrap = Scripts.wrapValidator @HashedString @ClearString - --- create a data script for the guessing game by hashing the string --- and lifting the hash to its on-chain representation -hashString :: String -> HashedString -hashString = HashedString . sha2_256 . C.pack - --- create a redeemer script for the guessing game by lifting the --- string to its on-chain representation -clearString :: String -> ClearString -clearString = ClearString . C.pack - --- | The address of the game (the hash of its validator script) -gameAddress :: Address -gameAddress = Ledger.scriptAddress gameValidator - --- | Parameters for the "lock" endpoint -data LockParams = LockParams - { secretWord :: String - , amount :: Value - } - deriving stock (Prelude.Eq, Prelude.Show, Generic) - deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument) - --- | Parameters for the "guess" endpoint -newtype GuessParams = GuessParams - { guessWord :: String - } - deriving stock (Prelude.Eq, Prelude.Show, Generic) - deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument) - -lock :: AsContractError e => Contract () GameSchema e () -lock = do - LockParams secret amt <- endpoint @"lock" @LockParams - let tx = Constraints.mustPayToTheScript (hashString secret) amt - void (submitTxConstraints gameInstance tx) - -guess :: AsContractError e => Contract () GameSchema e () -guess = do - GuessParams theGuess <- endpoint @"guess" @GuessParams - unspentOutputs <- utxoAt gameAddress - let redeemer = clearString theGuess - tx = collectFromScript unspentOutputs redeemer - void (submitTxConstraintsSpending gameInstance unspentOutputs tx) - -game :: AsContractError e => Contract () GameSchema e () -game = lock `select` guess - -lockTrace :: EmulatorTrace () -lockTrace = do - let w1 = Wallet 1 - hdl <- Trace.activateContractWallet w1 (game @ContractError) - Trace.callEndpoint @"lock" hdl (LockParams "secret" (Ada.lovelaceValueOf 10)) - void $ Trace.waitNSlots 1 - -guessTrace :: EmulatorTrace () -guessTrace = do - lockTrace - let w2 = Wallet 2 - hdl <- Trace.activateContractWallet w2 (game @ContractError) - Trace.callEndpoint @"guess" hdl (GuessParams "secret") - -guessWrongTrace :: EmulatorTrace () -guessWrongTrace = do - lockTrace - let w2 = Wallet 2 - hdl <- Trace.activateContractWallet w2 (game @ContractError) - Trace.callEndpoint @"guess" hdl (GuessParams "SECRET") diff --git a/NodeFactory/stable-coin/test/Spec.hs b/NodeFactory/stable-coin/test/Spec.hs deleted file mode 100644 index 60001de7b..000000000 --- a/NodeFactory/stable-coin/test/Spec.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main(main) where - -import qualified Spec.Game -import Test.Tasty -import Test.Tasty.Hedgehog (HedgehogTestLimit (..)) - -main :: IO () -main = defaultMain tests - --- | Number of successful tests for each hedgehog property. --- The default is 100 but we use a smaller number here in order to speed up --- the test suite. --- -limit :: HedgehogTestLimit -limit = HedgehogTestLimit (Just 5) - -tests :: TestTree -tests = localOption limit $ testGroup "use cases" [ - Spec.Game.tests - ] diff --git a/NodeFactory/stable-coin/test/Spec/Game.hs b/NodeFactory/stable-coin/test/Spec/Game.hs deleted file mode 100644 index e479d43ad..000000000 --- a/NodeFactory/stable-coin/test/Spec/Game.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} - -module Spec.Game - ( tests - ) where - -import Control.Monad (void) -import Ledger.Ada (adaValueOf) -import Plutus.Contract (Contract, ContractError) -import Plutus.Contract.Test -import Plutus.Contracts.Game -import Plutus.Trace.Emulator (ContractInstanceTag) -import qualified Plutus.Trace.Emulator as Trace -import qualified PlutusTx -import qualified PlutusTx.Prelude as PlutusTx -import Test.Tasty -import qualified Test.Tasty.HUnit as HUnit - -w1, w2 :: Wallet -w1 = Wallet 1 -w2 = Wallet 2 - -t1, t2 :: ContractInstanceTag -t1 = Trace.walletInstanceTag w1 -t2 = Trace.walletInstanceTag w2 - -theContract :: Contract () GameSchema ContractError () -theContract = game - -tests :: TestTree -tests = testGroup "game" - [ checkPredicate "Expose 'lock' and 'guess' endpoints" - (endpointAvailable @"lock" theContract (Trace.walletInstanceTag w1) - .&&. endpointAvailable @"guess" theContract (Trace.walletInstanceTag w1)) - $ void (Trace.activateContractWallet w1 theContract) - - , checkPredicate "'lock' endpoint submits a transaction" - (anyTx theContract (Trace.walletInstanceTag w1)) - $ do - hdl <- Trace.activateContractWallet w1 theContract - Trace.callEndpoint @"lock" hdl (LockParams "secret" (adaValueOf 10)) - - , checkPredicate "'guess' endpoint is available after locking funds" - (endpointAvailable @"guess" theContract (Trace.walletInstanceTag w2)) - lockTrace - - , checkPredicate "guess right (unlock funds)" - (walletFundsChange w2 (1 `timesFeeAdjust` 10) - .&&. walletFundsChange w1 (1 `timesFeeAdjust` (-10))) - guessTrace - - , checkPredicate "guess wrong" - (walletFundsChange w2 PlutusTx.zero - .&&. walletFundsChange w1 (1 `timesFeeAdjust` (-10))) - guessWrongTrace - , goldenPir "examples/test/Spec/game.pir" $$(PlutusTx.compile [|| validateGuess ||]) - , HUnit.testCase "script size is reasonable" (reasonable gameValidator 20000) - ] diff --git a/NodeFactory/stable-coin/test/Spec/game.pir b/NodeFactory/stable-coin/test/Spec/game.pir deleted file mode 100644 index dcea0aeab..000000000 --- a/NodeFactory/stable-coin/test/Spec/game.pir +++ /dev/null @@ -1,217 +0,0 @@ -(program - (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [[Tuple2 a] b]))) - ) - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - Nil_match - (vardecl Nil [List a]) (vardecl Cons (fun a (fun [List a] [List a]))) - ) - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl Data (type)) - - Data_match - (vardecl B (fun (con bytestring) Data)) - (vardecl Constr (fun (con integer) (fun [List Data] Data))) - (vardecl I (fun (con integer) Data)) - (vardecl List (fun [List Data] Data)) - (vardecl Map (fun [List [[Tuple2 Data] Data]] Data)) - ) - ) - (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Extended (fun (type) (type))) - (tyvardecl a (type)) - Extended_match - (vardecl Finite (fun a [Extended a])) - (vardecl NegInf [Extended a]) - (vardecl PosInf [Extended a]) - ) - ) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (datatypebind - (datatype - (tyvardecl LowerBound (fun (type) (type))) - (tyvardecl a (type)) - LowerBound_match - (vardecl LowerBound (fun [Extended a] (fun Bool [LowerBound a]))) - ) - ) - (datatypebind - (datatype - (tyvardecl UpperBound (fun (type) (type))) - (tyvardecl a (type)) - UpperBound_match - (vardecl UpperBound (fun [Extended a] (fun Bool [UpperBound a]))) - ) - ) - (datatypebind - (datatype - (tyvardecl Interval (fun (type) (type))) - (tyvardecl a (type)) - Interval_match - (vardecl - Interval (fun [LowerBound a] (fun [UpperBound a] [Interval a])) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Tuple3 (fun (type) (fun (type) (fun (type) (type))))) - (tyvardecl a (type)) (tyvardecl b (type)) (tyvardecl c (type)) - Tuple3_match - (vardecl Tuple3 (fun a (fun b (fun c [[[Tuple3 a] b] c])))) - ) - ) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [Maybe a])) (vardecl Nothing [Maybe a]) - ) - ) - (datatypebind - (datatype - (tyvardecl TxOutRef (type)) - - TxOutRef_match - (vardecl - TxOutRef (fun (con bytestring) (fun (con integer) TxOutRef)) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl TxInInfo (type)) - - TxInInfo_match - (vardecl - TxInInfo - (fun TxOutRef (fun [Maybe [[[Tuple3 (con bytestring)] (con bytestring)] (con bytestring)]] (fun [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] (con integer)]] TxInInfo))) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Address (type)) - - Address_match - (vardecl PubKeyAddress (fun (con bytestring) Address)) - (vardecl ScriptAddress (fun (con bytestring) Address)) - ) - ) - (datatypebind - (datatype - (tyvardecl TxOutType (type)) - - TxOutType_match - (vardecl PayToPubKey TxOutType) - (vardecl PayToScript (fun (con bytestring) TxOutType)) - ) - ) - (datatypebind - (datatype - (tyvardecl TxOut (type)) - - TxOut_match - (vardecl - TxOut - (fun Address (fun [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] (con integer)]] (fun TxOutType TxOut))) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl TxInfo (type)) - - TxInfo_match - (vardecl - TxInfo - (fun [List TxInInfo] (fun [List TxOut] (fun [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] (con integer)]] (fun [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] [[(lam k (type) (lam v (type) [List [[Tuple2 k] v]])) (con bytestring)] (con integer)]] (fun [Interval (con integer)] (fun [List (con bytestring)] (fun [List (con bytestring)] (fun [List [[Tuple2 (con bytestring)] Data]] (fun (con bytestring) TxInfo))))))))) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl ValidatorCtx (type)) - - ValidatorCtx_match - (vardecl - ValidatorCtx (fun TxInfo (fun (con integer) ValidatorCtx)) - ) - ) - ) - (termbind - (strict) - (vardecl - equalsByteString - (fun (con bytestring) (fun (con bytestring) Bool)) - ) - (lam - arg - (con bytestring) - (lam - arg - (con bytestring) - [ - (lam - b - (con bool) - [ [ [ { (builtin ifThenElse) Bool } b ] True ] False ] - ) - [ [ (builtin equalsByteString) arg ] arg ] - ] - ) - ) - ) - (termbind - (strict) - (vardecl - validateGuess - (fun (con bytestring) (fun (con bytestring) (fun ValidatorCtx Bool))) - ) - (lam - ds - (con bytestring) - (lam - ds - (con bytestring) - (lam - ds - ValidatorCtx - [ [ equalsByteString ds ] [ (builtin sha2_256) ds ] ] - ) - ) - ) - ) - validateGuess - ) - ) - ) - ) -) \ No newline at end of file From 7e09c391dcd36b26e6b55fcc7f4b1d8a3e1f28ad Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Tue, 1 Jun 2021 12:47:00 +0200 Subject: [PATCH 03/21] Add vault definition --- .../src/NodeFactory/Plutus/Contracts/Vault.hs | 66 +++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs new file mode 100644 index 000000000..9994da101 --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module NodeFactory.Plutus.Contracts.Vault + () where + +import Control.Monad hiding (fmap) +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Map as Map +import Data.Monoid (Last (..)) +import Data.Text (Text, pack) +import GHC.Generics (Generic) +import Plutus.Contract as Contract hiding (when) +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Ledger.Ada as Ada +import Plutus.Contracts.Currency as Currency +import Prelude (Semigroup (..)) +import qualified Prelude as Prelude + +-- contract param structure +data Vault = Vault + { owner :: !PubKeyHash -- owner of the of the vault + , amount :: !Integer -- amount of ADA in vault + } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord) + +PlutusTx.makeLift ''Vault + +data VaultRedeemer = Create | Close -- TODO - add liquidation + deriving Show + +PlutusTx.unstableMakeIsData ''VaultRedeemer + +-- + +data Vaulting +instance Scripts.ScriptType Vaulting where + type instance DatumType Vaulting = Integer + type instance RedeemerType Vaulting = VaultRedeemer + +vaultInst :: Vault -> Scripts.ScriptInstance Vaulting +vaultInst oracle = Scripts.validator @Oracling + ($$(PlutusTx.compile [|| mkOracleValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode oracle) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator @Integer @VaultRedeemer + +vaultValidator :: Vault -> Validator +vaultValidator = Scripts.validatorScript . vaultInst + +vaultAddress :: Vault -> Ledger.Address +vaultAddress = scriptAddress . vaultValidator From 03d85efc271235c7f4cd4b993ad1ff7e2575d9ba Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Tue, 1 Jun 2021 12:49:09 +0200 Subject: [PATCH 04/21] Change datum type --- .../stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs index 9994da101..e9ac3de32 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs @@ -49,7 +49,7 @@ PlutusTx.unstableMakeIsData ''VaultRedeemer data Vaulting instance Scripts.ScriptType Vaulting where - type instance DatumType Vaulting = Integer + type instance DatumType Vaulting = Vault type instance RedeemerType Vaulting = VaultRedeemer vaultInst :: Vault -> Scripts.ScriptInstance Vaulting @@ -57,7 +57,7 @@ vaultInst oracle = Scripts.validator @Oracling ($$(PlutusTx.compile [|| mkOracleValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode oracle) $$(PlutusTx.compile [|| wrap ||]) where - wrap = Scripts.wrapValidator @Integer @VaultRedeemer + wrap = Scripts.wrapValidator @Vault @VaultRedeemer vaultValidator :: Vault -> Validator vaultValidator = Scripts.validatorScript . vaultInst From 122196ca05790e37308f826e10368552a674ae35 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Tue, 1 Jun 2021 13:17:21 +0200 Subject: [PATCH 05/21] Fix build error --- NodeFactory/stable-coin/plutus-stable-coin.cabal | 1 + .../NodeFactory/Plutus/Contracts/StableCoin.hs | 12 ++++++++++++ .../src/NodeFactory/Plutus/Contracts/Vault.hs | 16 +++++++++++----- 3 files changed, 24 insertions(+), 5 deletions(-) diff --git a/NodeFactory/stable-coin/plutus-stable-coin.cabal b/NodeFactory/stable-coin/plutus-stable-coin.cabal index b7f982524..eedd6f568 100644 --- a/NodeFactory/stable-coin/plutus-stable-coin.cabal +++ b/NodeFactory/stable-coin/plutus-stable-coin.cabal @@ -29,6 +29,7 @@ library NodeFactory.Plutus.Contracts.Oracle.PAB NodeFactory.Plutus.Contracts.Oracle.Swap NodeFactory.Plutus.Contracts.StableCoin + NodeFactory.Plutus.Contracts.Vault build-depends: aeson , base ^>=4.14.1.0 , containers diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs index 56f47276f..60c2889d7 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs @@ -36,6 +36,18 @@ import Wallet.Emulator.Wallet mkPolicy :: PubKeyHash -> ScriptContext -> Bool mkPolicy pkh ctx = txSignedBy (scriptContextTxInfo ctx) pkh +-- TODO +-- policy should read value from nft in inputs and determine +-- amount of minted stable coins +{- +stableCoinPolicy :: ScriptContext -> Bool +stableCoinPolicy ctx = + let txinfo = scriptContextTxInfo ctx + forged = txInfoForge txinfo + in .... +-} + + policy :: PubKeyHash -> Scripts.MonetaryPolicy policy pkh = mkMonetaryPolicyScript $ $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy . mkPolicy ||]) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs index e9ac3de32..480c39d12 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs @@ -32,7 +32,6 @@ import Plutus.Contracts.Currency as Currency import Prelude (Semigroup (..)) import qualified Prelude as Prelude --- contract param structure data Vault = Vault { owner :: !PubKeyHash -- owner of the of the vault , amount :: !Integer -- amount of ADA in vault @@ -47,17 +46,24 @@ PlutusTx.unstableMakeIsData ''VaultRedeemer -- +{-# INLINABLE mkVaultValidator #-} -- validator functions +mkVaultValidator :: Vault -> () -> VaultRedeemer -> ScriptContext -> Bool +mkVaultValidator oracle x r ctx = + traceIfFalse "check vault constraints" True -- TODO - add validation logic + +-- + data Vaulting instance Scripts.ScriptType Vaulting where - type instance DatumType Vaulting = Vault + type instance DatumType Vaulting = () type instance RedeemerType Vaulting = VaultRedeemer vaultInst :: Vault -> Scripts.ScriptInstance Vaulting -vaultInst oracle = Scripts.validator @Oracling - ($$(PlutusTx.compile [|| mkOracleValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode oracle) +vaultInst oracle = Scripts.validator @Vaulting + ($$(PlutusTx.compile [|| mkVaultValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode oracle) $$(PlutusTx.compile [|| wrap ||]) where - wrap = Scripts.wrapValidator @Vault @VaultRedeemer + wrap = Scripts.wrapValidator @() @VaultRedeemer vaultValidator :: Vault -> Validator vaultValidator = Scripts.validatorScript . vaultInst From 8a2d1161cf4db2217091228d8ecdf30d9642cc37 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Mon, 7 Jun 2021 21:54:17 +0200 Subject: [PATCH 06/21] Add basic on chain functions --- .../stable-coin/plutus-stable-coin.cabal | 2 +- .../src/NodeFactory/Plutus/Contracts/Coin.hs | 105 ++++++ .../Plutus/Contracts/StableCoin.hs | 318 +++++++++++++----- .../src/NodeFactory/Plutus/Contracts/Vault.hs | 72 ---- 4 files changed, 343 insertions(+), 154 deletions(-) create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Coin.hs delete mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs diff --git a/NodeFactory/stable-coin/plutus-stable-coin.cabal b/NodeFactory/stable-coin/plutus-stable-coin.cabal index eedd6f568..20fff1fd6 100644 --- a/NodeFactory/stable-coin/plutus-stable-coin.cabal +++ b/NodeFactory/stable-coin/plutus-stable-coin.cabal @@ -29,7 +29,7 @@ library NodeFactory.Plutus.Contracts.Oracle.PAB NodeFactory.Plutus.Contracts.Oracle.Swap NodeFactory.Plutus.Contracts.StableCoin - NodeFactory.Plutus.Contracts.Vault + NodeFactory.Plutus.Contracts.Coin build-depends: aeson , base ^>=4.14.1.0 , containers diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Coin.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Coin.hs new file mode 100644 index 000000000..ba394deee --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Coin.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module NodeFactory.Plutus.Contracts.Coin + ( + Coin (..), + coin, + coinValueOf, + hashCoin, + coinAssetClass + ) where + +import Control.Monad hiding (fmap) +import qualified Data.Map as Map +import Data.Monoid (Last (..)) +import Data.Proxy (Proxy (..)) +import Data.Text (Text, pack) +import Data.Void (Void) +import Ledger hiding (singleton) +import Ledger.Contexts +import Ledger.Constraints as Constraints +import Ledger.Constraints.OnChain as Constraints +import Ledger.Constraints.TxConstraints as Constraints +import qualified Ledger.Scripts as Scripts +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Playground.Contract +import Plutus.Contract hiding (when) +import qualified Plutus.Contracts.Currency as Currency +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup (..), unless) +import Prelude (Semigroup (..)) +import qualified Prelude +import Text.Printf (printf) + + +-- | A pair consisting of a 'CurrencySymbol' and a 'TokenName'. +-- Coins are the entities that can be swapped in the exchange. +data Coin = Coin + { cCurrency :: CurrencySymbol + , cToken :: TokenName + } deriving (Show, Generic, ToJSON, FromJSON) + +PlutusTx.unstableMakeIsData ''Coin +PlutusTx.makeLift ''Coin + +instance Eq Coin where + {-# INLINABLE (==) #-} + c == d = cCurrency c == cCurrency d && cToken c == cToken d + +instance Prelude.Eq Coin where + (==) = (==) + +{-# INLINABLE compareCoins #-} +compareCoins :: Coin -> Coin -> Ordering +compareCoins c d = case compare (cCurrency c) (cCurrency d) of + LT -> LT + GT -> GT + EQ -> compare (cToken c) (cToken d) + +instance Prelude.Ord Coin where + compare = compareCoins + +{-# INLINABLE coinLT #-} +coinLT :: Coin -> Coin -> Bool +coinLT c d = case compareCoins c d of + LT -> True + _ -> False + +{-# INLINABLE coin #-} +-- | @'coin' c n@ denotes the value given by @n@ units of @'Coin'@ @c@. +coin :: Coin -- ^ The 'Coin'. + -> Integer -- ^ The desired number coins. + -> Value -- ^ The 'Value' consisting of the given number of units of the given 'Coin'. +coin Coin{..} = Value.singleton cCurrency cToken + +{-# INLINABLE coinValueOf #-} +-- | Calculates how many units of the specified 'Coin' are contained in the +-- given 'Value'. +coinValueOf :: Value -- ^ The 'Value' to inspect. + -> Coin -- ^ The 'Coin' to look for. + -> Integer -- ^ The number of units of the given 'Coin' contained in the given 'Value'. +coinValueOf v Coin{..} = valueOf v cCurrency cToken + +{-# INLINABLE hashCoin #-} +hashCoin :: Coin -> ByteString +hashCoin Coin{..} = sha2_256 $ concatenate (unCurrencySymbol cCurrency) (unTokenName cToken) + +{-# INLINABLE coinAssetClass #-} +coinAssetClass :: Coin -> AssetClass +coinAssetClass Coin{..} = AssetClass (cCurrency, cToken) \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs index 60c2889d7..aca147225 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs @@ -1,86 +1,242 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module NodeFactory.Plutus.Contracts.StableCoin where - -import Control.Monad hiding (fmap) -import Control.Monad.Freer.Extras as Extras -import Data.Aeson (ToJSON, FromJSON) -import Data.Text (Text) -import Data.Void (Void) -import GHC.Generics (Generic) -import Plutus.Contract as Contract hiding (when) -import Plutus.Trace.Emulator as Emulator +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module NodeFactory.Plutus.Contracts.StableCoin + ( + StableCoin (..), stablecoin, + vaultStateCoinFromStableCoinCurrency + ) where + +import Control.Monad hiding (fmap) +import qualified Data.Map as Map +import Data.Monoid (Last (..)) +import Data.Proxy (Proxy (..)) +import Data.Text (Text, pack) +import Data.Void (Void) +import Ledger hiding (singleton) +import Ledger.Contexts +import Ledger.Constraints as Constraints +import Ledger.Constraints.OnChain as Constraints +import Ledger.Constraints.TxConstraints as Constraints +import qualified Ledger.Scripts as Scripts +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Playground.Contract +import Plutus.Contract hiding (when) +import qualified Plutus.Contracts.Currency as Currency import qualified PlutusTx -import PlutusTx.Prelude hiding (Semigroup(..), unless) -import Ledger hiding (singleton) -import Ledger.Constraints as Constraints -import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value as Value -import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) -import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) -import Playground.Types (KnownCurrency (..)) -import Text.Printf (printf) -import Wallet.Emulator.Wallet - -{-# INLINABLE mkPolicy #-} -mkPolicy :: PubKeyHash -> ScriptContext -> Bool -mkPolicy pkh ctx = txSignedBy (scriptContextTxInfo ctx) pkh - --- TODO --- policy should read value from nft in inputs and determine --- amount of minted stable coins -{- -stableCoinPolicy :: ScriptContext -> Bool -stableCoinPolicy ctx = - let txinfo = scriptContextTxInfo ctx - forged = txInfoForge txinfo - in .... --} - - -policy :: PubKeyHash -> Scripts.MonetaryPolicy -policy pkh = mkMonetaryPolicyScript $ - $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy . mkPolicy ||]) - `PlutusTx.applyCode` - PlutusTx.liftCode pkh - -curSymbol :: PubKeyHash -> CurrencySymbol -curSymbol = scriptCurrencySymbol . policy - -data MintParams = MintParams - { mpTokenName :: !TokenName - , mpAmount :: !Integer - } deriving (Generic, ToJSON, FromJSON, ToSchema) - -type StableCoinSchema = - BlockchainActions - .\/ Endpoint "mint" MintParams - -mint :: MintParams -> Contract w StableCoinSchema Text () -mint mp = do - pkh <- pubKeyHash <$> Contract.ownPubKey - let val = Value.singleton (curSymbol pkh) (mpTokenName mp) (mpAmount mp) - lookups = Constraints.monetaryPolicy $ policy pkh - tx = Constraints.mustForgeValue val - ledgerTx <- submitTxConstraintsWith @Void lookups tx - void $ awaitTxConfirmed $ txId ledgerTx - Contract.logInfo @String $ printf "forged %s" (show val) +import PlutusTx.Prelude hiding (Semigroup (..), unless) +import Prelude (Semigroup (..)) +import qualified Prelude +import Text.Printf (printf) + +import NodeFactory.Plutus.Contracts.Coin + +stableCoinTokenName, vaultStateTokenName :: TokenName +stableCoinTokenName = "Stable Coin Token" +vaultStateTokenName = "Vault State Token" + +-- DEFINING STRUCTURES + +data StableCoinVault = StableCoinVault + { owner :: !PubKeyHash -- owner of the of the vault + , amount :: !Integer -- amount of ADA locked in vault + } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord) + +PlutusTx.unstableMakeIsData ''StableCoinVault +PlutusTx.makeLift ''StableCoinVault + +data StableCoin = StableCoin + { sCoin :: Coin +-- scOracle :: PubKeyHash -- oracle identificator + } deriving stock (Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +PlutusTx.unstableMakeIsData ''StableCoin +PlutusTx.makeLift ''StableCoin + +instance Prelude.Eq StableCoin where + u == v = sCoin u Prelude.== sCoin v -endpoints :: Contract () StableCoinSchema Text () -endpoints = mint' >> endpoints +instance Prelude.Ord StableCoin where + compare u v = Prelude.compare (sCoin u) (sCoin v) + +data StableCoinAction = Create StableCoinVault | Close + deriving Show + +PlutusTx.unstableMakeIsData ''StableCoinAction +PlutusTx.makeLift ''StableCoinAction + +data StableCoinDatum = + Factory [StableCoinVault] + | Vault StableCoinVault + deriving stock (Show) + +PlutusTx.unstableMakeIsData ''StableCoinDatum +PlutusTx.makeLift ''StableCoinDatum + +-- + +data StableCoining +instance Scripts.ScriptType StableCoining where + type instance DatumType StableCoining = StableCoinDatum + type instance RedeemerType StableCoining = StableCoinAction + +{-# INLINABLE validateCreate #-} +validateCreate :: StableCoin + -> Coin + -> [StableCoinVault] + -> StableCoinVault + -> ScriptContext + -> Bool +validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = + traceIfFalse "StableCoin coin not present" inputHasSCToken && + Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Factory $ v : vs) $ coin sCoin 1) + -- Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Vault v) $ coin c 1) TODO - fix checking vault coin + -- TODO - Add constraint checking output amount of stable coin appropriate + -- TODO - Add constraint checking input amount of ADA where - mint' = endpoint @"mint" >>= mint + amount :: Integer + amount = 10 + + ownInput :: TxOut -- get stable coind input + ownInput = case findOwnInput ctx of + Nothing -> traceError "stable coin input missing" + Just i -> txInInfoResolved i + + inputHasSCToken :: Bool -- check if input contains nft token + inputHasSCToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ c) == 1 + +{-# INLINABLE validateCloseFactory #-} +validateCloseFactory :: StableCoin -> Coin -> [StableCoinVault] -> ScriptContext -> Bool +validateCloseFactory sc c vs ctx = + traceIfFalse "StableCoin coin not present" inputHasToken + where + usC :: Coin + usC = sCoin sc + + ownInput :: TxOut -- get stable coind input + ownInput = case findOwnInput ctx of + Nothing -> traceError "stable coin input missing" + Just i -> txInInfoResolved i + + inputHasToken :: Bool -- check if input contains nft token + inputHasToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ usC) == 1 + +{-# INLINABLE validateClosePool #-} +validateClosePool :: StableCoin -> ScriptContext -> Bool +validateClosePool sc ctx = hasFactoryInput + where + info :: TxInfo + info = scriptContextTxInfo ctx + + hasFactoryInput :: Bool + hasFactoryInput = + traceIfFalse "Stable coin factory input expected" $ coinValueOf (valueSpent info) (sCoin sc) == 1 + + +mkStableCoinValidator :: StableCoin + -> Coin + -> StableCoinDatum + -> StableCoinAction + -> ScriptContext + -> Bool +mkStableCoinValidator sc c (Factory vs) (Create v) ctx = validateCreate sc c vs v ctx +mkStableCoinValidator sc c (Factory vs) Close ctx = validateCloseFactory sc c vs ctx +mkStableCoinValidator sc _ (Vault _) Close ctx = validateClosePool sc ctx +mkStableCoinValidator _ _ _ _ _ = False + +stableCoinInstance :: StableCoin -> Scripts.ScriptInstance StableCoining +stableCoinInstance sc = Scripts.validator @StableCoining + ($$(PlutusTx.compile [|| mkStableCoinValidator ||]) + `PlutusTx.applyCode` PlutusTx.liftCode sc + `PlutusTx.applyCode` PlutusTx.liftCode c) + $$(PlutusTx.compile [|| wrap ||]) + where + c :: Coin + c = vaultStateCoin sc + + wrap = Scripts.wrapValidator @StableCoinDatum @StableCoinAction + +-- validateLiquidityForging :: StableCoin -> TokenName -> ScriptContext -> Bool +-- validateLiquidityForging us tn ctx = case [ i +-- | i <- txInfoInputs $ policyCtxTxInfo ctx +-- , let v = (txOutValue . txInInfoResolved) i +-- , (coinValueOf v usC == 1) || +-- (coinValueOf v lpC == 1) +-- ] of +-- [_] -> True +-- [_, _] -> True +-- _ -> traceError "pool state forging without StableCoin input" +-- where +-- usC, lpC :: Coin +-- usC = sCoin us +-- lpC = Coin (ownCurrencySymbol ctx) tn + +validateLiquidityForging :: StableCoin -> TokenName -> ScriptContext -> Bool +validateLiquidityForging us tn ctx = True -- TODO replace with real forging validation + +stableCoinValidator :: StableCoin -> Validator +stableCoinValidator = Scripts.validatorScript . stableCoinInstance + +stableCoinAddress :: StableCoin -> Ledger.Address +stableCoinAddress = scriptAddress . stableCoinValidator + +stablecoin :: CurrencySymbol -> StableCoin +stablecoin cs = StableCoin $ Coin cs stableCoinTokenName + + +liquidityPolicy :: StableCoin -> MonetaryPolicy +liquidityPolicy us = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateLiquidityForging u t) ||]) + `PlutusTx.applyCode` PlutusTx.liftCode us + `PlutusTx.applyCode` PlutusTx.liftCode vaultStateTokenName + +liquidityCurrency :: StableCoin -> CurrencySymbol +liquidityCurrency = scriptCurrencySymbol . liquidityPolicy + +vaultStateCoin :: StableCoin -> Coin +vaultStateCoin = flip Coin vaultStateTokenName . liquidityCurrency + +-- | Gets the 'Coin' used to identity vaults. +vaultStateCoinFromStableCoinCurrency :: CurrencySymbol -> Coin +vaultStateCoinFromStableCoinCurrency = vaultStateCoin . stablecoin + +---- + +start :: HasBlockchainActions s => Contract w s Text StableCoin +start = do + pkh <- pubKeyHash <$> ownPubKey + cs <- fmap Currency.currencySymbol $ + mapError (pack . show @Currency.CurrencyError) $ + Currency.forgeContract pkh [(stableCoinTokenName, 1)] + let c = Coin cs stableCoinTokenName + us = stablecoin cs + inst = stableCoinInstance us + tx = mustPayToTheScript (Factory []) $ coin c 1 + ledgerTx <- submitTxConstraints inst tx + void $ awaitTxConfirmed $ txId ledgerTx -mkSchemaDefinitions ''StableCoinSchema + logInfo @String $ printf "started StableCoin %s at address %s" (show us) (show $ stableCoinAddress us) + return us -mkKnownCurrencies [] \ No newline at end of file +ownerEndpoint :: Contract (Last (Either Text StableCoin)) BlockchainActions Void () +ownerEndpoint = do + e <- runError start + tell $ Last $ Just $ case e of + Left err -> Left err + Right us -> Right us \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs deleted file mode 100644 index 480c39d12..000000000 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Vault.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module NodeFactory.Plutus.Contracts.Vault - () where - -import Control.Monad hiding (fmap) -import Data.Aeson (FromJSON, ToJSON) -import qualified Data.Map as Map -import Data.Monoid (Last (..)) -import Data.Text (Text, pack) -import GHC.Generics (Generic) -import Plutus.Contract as Contract hiding (when) -import qualified PlutusTx -import PlutusTx.Prelude hiding (Semigroup(..), unless) -import Ledger hiding (singleton) -import Ledger.Constraints as Constraints -import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value as Value -import Ledger.Ada as Ada -import Plutus.Contracts.Currency as Currency -import Prelude (Semigroup (..)) -import qualified Prelude as Prelude - -data Vault = Vault - { owner :: !PubKeyHash -- owner of the of the vault - , amount :: !Integer -- amount of ADA in vault - } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord) - -PlutusTx.makeLift ''Vault - -data VaultRedeemer = Create | Close -- TODO - add liquidation - deriving Show - -PlutusTx.unstableMakeIsData ''VaultRedeemer - --- - -{-# INLINABLE mkVaultValidator #-} -- validator functions -mkVaultValidator :: Vault -> () -> VaultRedeemer -> ScriptContext -> Bool -mkVaultValidator oracle x r ctx = - traceIfFalse "check vault constraints" True -- TODO - add validation logic - --- - -data Vaulting -instance Scripts.ScriptType Vaulting where - type instance DatumType Vaulting = () - type instance RedeemerType Vaulting = VaultRedeemer - -vaultInst :: Vault -> Scripts.ScriptInstance Vaulting -vaultInst oracle = Scripts.validator @Vaulting - ($$(PlutusTx.compile [|| mkVaultValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode oracle) - $$(PlutusTx.compile [|| wrap ||]) - where - wrap = Scripts.wrapValidator @() @VaultRedeemer - -vaultValidator :: Vault -> Validator -vaultValidator = Scripts.validatorScript . vaultInst - -vaultAddress :: Vault -> Ledger.Address -vaultAddress = scriptAddress . vaultValidator From 22cc5db16ac11f98dc9754954a38d32333401d1a Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Tue, 8 Jun 2021 08:13:24 +0200 Subject: [PATCH 07/21] Code formating --- .../Plutus/Contracts/StableCoin.hs | 58 +++++++------------ 1 file changed, 22 insertions(+), 36 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs index aca147225..27a62c714 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs @@ -22,17 +22,13 @@ module NodeFactory.Plutus.Contracts.StableCoin ) where import Control.Monad hiding (fmap) -import qualified Data.Map as Map import Data.Monoid (Last (..)) -import Data.Proxy (Proxy (..)) import Data.Text (Text, pack) import Data.Void (Void) import Ledger hiding (singleton) -import Ledger.Contexts import Ledger.Constraints as Constraints import Ledger.Constraints.OnChain as Constraints import Ledger.Constraints.TxConstraints as Constraints -import qualified Ledger.Scripts as Scripts import qualified Ledger.Typed.Scripts as Scripts import Ledger.Value as Value import Playground.Contract @@ -50,7 +46,7 @@ stableCoinTokenName, vaultStateTokenName :: TokenName stableCoinTokenName = "Stable Coin Token" vaultStateTokenName = "Vault State Token" --- DEFINING STRUCTURES +-- Structs data StableCoinVault = StableCoinVault { owner :: !PubKeyHash -- owner of the of the vault @@ -89,13 +85,13 @@ data StableCoinDatum = PlutusTx.unstableMakeIsData ''StableCoinDatum PlutusTx.makeLift ''StableCoinDatum --- - data StableCoining instance Scripts.ScriptType StableCoining where type instance DatumType StableCoining = StableCoinDatum type instance RedeemerType StableCoining = StableCoinAction +-- Validators + {-# INLINABLE validateCreate #-} validateCreate :: StableCoin -> Coin @@ -104,41 +100,44 @@ validateCreate :: StableCoin -> ScriptContext -> Bool validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = - traceIfFalse "StableCoin coin not present" inputHasSCToken && + traceIfFalse "StableCoin coin not present" inputHasVaultToken && Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Factory $ v : vs) $ coin sCoin 1) -- Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Vault v) $ coin c 1) TODO - fix checking vault coin -- TODO - Add constraint checking output amount of stable coin appropriate -- TODO - Add constraint checking input amount of ADA where - amount :: Integer - amount = 10 - - ownInput :: TxOut -- get stable coind input + ownInput :: TxOut ownInput = case findOwnInput ctx of Nothing -> traceError "stable coin input missing" Just i -> txInInfoResolved i - inputHasSCToken :: Bool -- check if input contains nft token - inputHasSCToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ c) == 1 + inputHasVaultToken :: Bool -- check if input contains nft token + inputHasVaultToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ c) == 1 {-# INLINABLE validateCloseFactory #-} -validateCloseFactory :: StableCoin -> Coin -> [StableCoinVault] -> ScriptContext -> Bool +validateCloseFactory :: StableCoin + -> Coin + -> [StableCoinVault] + -> ScriptContext + -> Bool validateCloseFactory sc c vs ctx = - traceIfFalse "StableCoin coin not present" inputHasToken + traceIfFalse "StableCoin coin not present" inputHasStableCoinToken where usC :: Coin usC = sCoin sc - ownInput :: TxOut -- get stable coind input + ownInput :: TxOut ownInput = case findOwnInput ctx of Nothing -> traceError "stable coin input missing" Just i -> txInInfoResolved i - inputHasToken :: Bool -- check if input contains nft token - inputHasToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ usC) == 1 + inputHasStableCoinToken :: Bool -- check if input contains nft token + inputHasStableCoinToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ usC) == 1 {-# INLINABLE validateClosePool #-} -validateClosePool :: StableCoin -> ScriptContext -> Bool +validateClosePool :: StableCoin + -> ScriptContext + -> Bool validateClosePool sc ctx = hasFactoryInput where info :: TxInfo @@ -172,23 +171,12 @@ stableCoinInstance sc = Scripts.validator @StableCoining wrap = Scripts.wrapValidator @StableCoinDatum @StableCoinAction +-- TODO implement forging validation -- validateLiquidityForging :: StableCoin -> TokenName -> ScriptContext -> Bool --- validateLiquidityForging us tn ctx = case [ i --- | i <- txInfoInputs $ policyCtxTxInfo ctx --- , let v = (txOutValue . txInInfoResolved) i --- , (coinValueOf v usC == 1) || --- (coinValueOf v lpC == 1) --- ] of --- [_] -> True --- [_, _] -> True --- _ -> traceError "pool state forging without StableCoin input" --- where --- usC, lpC :: Coin --- usC = sCoin us --- lpC = Coin (ownCurrencySymbol ctx) tn +-- validateLiquidityForging us tn ctx = validateLiquidityForging :: StableCoin -> TokenName -> ScriptContext -> Bool -validateLiquidityForging us tn ctx = True -- TODO replace with real forging validation +validateLiquidityForging sc tn ctx = True -- TODO replace with real forging validation stableCoinValidator :: StableCoin -> Validator stableCoinValidator = Scripts.validatorScript . stableCoinInstance @@ -199,7 +187,6 @@ stableCoinAddress = scriptAddress . stableCoinValidator stablecoin :: CurrencySymbol -> StableCoin stablecoin cs = StableCoin $ Coin cs stableCoinTokenName - liquidityPolicy :: StableCoin -> MonetaryPolicy liquidityPolicy us = mkMonetaryPolicyScript $ $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateLiquidityForging u t) ||]) @@ -212,7 +199,6 @@ liquidityCurrency = scriptCurrencySymbol . liquidityPolicy vaultStateCoin :: StableCoin -> Coin vaultStateCoin = flip Coin vaultStateTokenName . liquidityCurrency --- | Gets the 'Coin' used to identity vaults. vaultStateCoinFromStableCoinCurrency :: CurrencySymbol -> Coin vaultStateCoinFromStableCoinCurrency = vaultStateCoin . stablecoin From 66a066c4a64058cec983e1b8f1707e1e5218e927 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Tue, 8 Jun 2021 08:43:49 +0200 Subject: [PATCH 08/21] Fix naming --- .../Plutus/Contracts/StableCoin.hs | 98 ++++++++++++++----- 1 file changed, 76 insertions(+), 22 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs index 27a62c714..1ebf953a5 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs @@ -123,8 +123,8 @@ validateCloseFactory :: StableCoin validateCloseFactory sc c vs ctx = traceIfFalse "StableCoin coin not present" inputHasStableCoinToken where - usC :: Coin - usC = sCoin sc + scC :: Coin + scC = sCoin sc ownInput :: TxOut ownInput = case findOwnInput ctx of @@ -132,20 +132,23 @@ validateCloseFactory sc c vs ctx = Just i -> txInInfoResolved i inputHasStableCoinToken :: Bool -- check if input contains nft token - inputHasStableCoinToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ usC) == 1 + inputHasStableCoinToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ scC) == 1 -{-# INLINABLE validateClosePool #-} -validateClosePool :: StableCoin +{-# INLINABLE validateCloseVault #-} +validateCloseVault :: StableCoin -> ScriptContext -> Bool -validateClosePool sc ctx = hasFactoryInput - where - info :: TxInfo - info = scriptContextTxInfo ctx +validateCloseVault sc ctx = + hasFactoryInput + -- TODO - Add constraint checking input amount of stable coin appropriate + -- TODO - Add constraint check if owner of vault + where + info :: TxInfo + info = scriptContextTxInfo ctx - hasFactoryInput :: Bool - hasFactoryInput = - traceIfFalse "Stable coin factory input expected" $ coinValueOf (valueSpent info) (sCoin sc) == 1 + hasFactoryInput :: Bool + hasFactoryInput = + traceIfFalse "Stable coin factory input expected" $ coinValueOf (valueSpent info) (sCoin sc) == 1 mkStableCoinValidator :: StableCoin @@ -156,7 +159,7 @@ mkStableCoinValidator :: StableCoin -> Bool mkStableCoinValidator sc c (Factory vs) (Create v) ctx = validateCreate sc c vs v ctx mkStableCoinValidator sc c (Factory vs) Close ctx = validateCloseFactory sc c vs ctx -mkStableCoinValidator sc _ (Vault _) Close ctx = validateClosePool sc ctx +mkStableCoinValidator sc _ (Vault _) Close ctx = validateCloseVault sc ctx mkStableCoinValidator _ _ _ _ _ = False stableCoinInstance :: StableCoin -> Scripts.ScriptInstance StableCoining @@ -173,7 +176,7 @@ stableCoinInstance sc = Scripts.validator @StableCoining -- TODO implement forging validation -- validateLiquidityForging :: StableCoin -> TokenName -> ScriptContext -> Bool --- validateLiquidityForging us tn ctx = +-- validateLiquidityForging sc tn ctx = validateLiquidityForging :: StableCoin -> TokenName -> ScriptContext -> Bool validateLiquidityForging sc tn ctx = True -- TODO replace with real forging validation @@ -188,9 +191,9 @@ stablecoin :: CurrencySymbol -> StableCoin stablecoin cs = StableCoin $ Coin cs stableCoinTokenName liquidityPolicy :: StableCoin -> MonetaryPolicy -liquidityPolicy us = mkMonetaryPolicyScript $ +liquidityPolicy sc = mkMonetaryPolicyScript $ $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateLiquidityForging u t) ||]) - `PlutusTx.applyCode` PlutusTx.liftCode us + `PlutusTx.applyCode` PlutusTx.liftCode sc `PlutusTx.applyCode` PlutusTx.liftCode vaultStateTokenName liquidityCurrency :: StableCoin -> CurrencySymbol @@ -202,7 +205,7 @@ vaultStateCoin = flip Coin vaultStateTokenName . liquidityCurrency vaultStateCoinFromStableCoinCurrency :: CurrencySymbol -> Coin vaultStateCoinFromStableCoinCurrency = vaultStateCoin . stablecoin ----- +---- ENDPOINTS start :: HasBlockchainActions s => Contract w s Text StableCoin start = do @@ -211,18 +214,69 @@ start = do mapError (pack . show @Currency.CurrencyError) $ Currency.forgeContract pkh [(stableCoinTokenName, 1)] let c = Coin cs stableCoinTokenName - us = stablecoin cs - inst = stableCoinInstance us + sc = stablecoin cs + inst = stableCoinInstance sc tx = mustPayToTheScript (Factory []) $ coin c 1 ledgerTx <- submitTxConstraints inst tx void $ awaitTxConfirmed $ txId ledgerTx - logInfo @String $ printf "started StableCoin %s at address %s" (show us) (show $ stableCoinAddress us) - return us + logInfo @String $ printf "started StableCoin %s at address %s" (show sc) (show $ stableCoinAddress sc) + return sc ownerEndpoint :: Contract (Last (Either Text StableCoin)) BlockchainActions Void () ownerEndpoint = do e <- runError start tell $ Last $ Just $ case e of Left err -> Left err - Right us -> Right us \ No newline at end of file + Right sc -> Right sc + +---- TODO general user endpoints + +-- data CreateParams = CreateParams +-- {} deriving (Show, Generic, ToJSON, FromJSON, ToSchema) + +-- data CloseParams = CloseParams +-- {} deriving (Show, Generic, ToJSON, FromJSON, ToSchema) + +-- create :: HasBlockchainActions s => StableCoin -> CreateParams -> Contract w s Text () +-- create sc CreateParams{..} = do + +-- close :: HasBlockchainActions s => StableCoin -> CloseParams -> Contract w s Text () +-- close sc CreateParams{..} = do + +-- type StableCoinUserSchema = +-- BlockchainActions +-- .\/ Endpoint "create" CreateParams +-- .\/ Endpoint "close" CloseParams +-- -- TODO add liquidation + +-- data UserContractState = Created | Closed +-- deriving (Show, Generic, FromJSON, ToJSON) + +-- userEndpoints :: StableCoin -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () +-- userEndpoints sc = +-- stop +-- `select` +-- ((f (Proxy @"create") (const Created) create `select` +-- f (Proxy @"close") (const Closed) close `select` +-- where +-- f :: forall l a p. +-- HasEndpoint l p StableCoinUserSchema +-- => Proxy l +-- -> (a -> UserContractState) +-- -> (StableCoin -> p -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Text a) +-- -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () +-- f _ g c = do +-- e <- runError $ do +-- p <- endpoint @l +-- c sc p +-- tell $ Last $ Just $ case e of +-- Left err -> Left err +-- Right a -> Right $ g a + +-- stop :: Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () +-- stop = do +-- e <- runError $ endpoint @"stop" +-- tell $ Last $ Just $ case e of +-- Left err -> Left err +-- Right () -> Right Stopped \ No newline at end of file From 1a0e0ee2c31419544e09bc04a8e124afad5a4293 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Wed, 16 Jun 2021 08:54:35 +0200 Subject: [PATCH 09/21] Restructure code --- NodeFactory/stable-coin/cabal.project | 43 +-- .../stable-coin/plutus-stable-coin.cabal | 48 +-- .../src/NodeFactory/Plutus/Contracts/Coin.hs | 105 ------- .../Plutus/Contracts/Oracle/Core.hs | 8 +- .../Plutus/Contracts/Oracle/Funds.hs | 2 +- .../Plutus/Contracts/Oracle/Swap.hs | 2 +- .../Plutus/Contracts/StableCoin.hs | 282 ------------------ .../Plutus/Contracts/StableCoin/OffChain.hs | 275 +++++++++++++++++ .../Plutus/Contracts/StableCoin/OnChain.hs | 130 ++++++++ .../Plutus/Contracts/StableCoin/Types.hs | 118 ++++++++ 10 files changed, 585 insertions(+), 428 deletions(-) delete mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Coin.hs delete mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs diff --git a/NodeFactory/stable-coin/cabal.project b/NodeFactory/stable-coin/cabal.project index ea81b0202..937af2a2c 100644 --- a/NodeFactory/stable-coin/cabal.project +++ b/NodeFactory/stable-coin/cabal.project @@ -1,4 +1,4 @@ -index-state: 2021-02-24T00:00:00Z +index-state: 2021-04-13T00:00:00Z packages: ./. @@ -12,26 +12,31 @@ benchmarks: true source-repository-package type: git location: https://github.com/input-output-hk/plutus.git - subdir: + subdir: freer-extras playground-common - plutus-core - plutus-contract - plutus-ledger - plutus-ledger-api - plutus-tx - plutus-tx-plugin + plutus-core + plutus-contract + plutus-ledger + plutus-ledger-api plutus-pab + plutus-tx + plutus-tx-plugin plutus-use-cases prettyprinter-configurable quickcheck-dynamic - tag: 476409eaee94141e2fe076a7821fc2fcdec5dfcb + word-array + tag: 26449c6e6e1c14d335683e5a4f40e2662b9b7e7 -- The following sections are copied from the 'plutus' repository cabal.project at the revision --- given above. --- This is necessary because the 'plutus' libraries depend on a number of other libraries which are +-- given above. +-- This is necessary because the 'plutus' libraries depend on a number of other libraries which are -- not on Hackage, and so need to be pulled in as `source-repository-package`s themselves. Make sure to -- re-update this section from the template when you do an upgrade. + +-- This is also needed so evenful-sql-common will build with a +-- newer version of persistent. See stack.yaml for the mirrored +-- configuration. package eventful-sql-common ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances @@ -53,8 +58,16 @@ constraints: -- breaks eventful even more than it already was , persistent-template < 2.12 +-- See the note on nix/pkgs/default.nix:agdaPackages for why this is here. +-- (NOTE this will change to ieee754 in newer versions of nixpkgs). extra-packages: ieee, filemanip +-- Drops an instance breaking our code. Should be released to Hackage eventually. +source-repository-package + type: git + location: https://github.com/Quid2/flat.git + tag: 95e5d7488451e43062ca84d5376b3adcc465f1cd + -- Needs some patches, but upstream seems to be fairly dead (no activity in > 1 year) source-repository-package type: git @@ -71,12 +84,6 @@ source-repository-package location: https://github.com/input-output-hk/cardano-crypto.git tag: f73079303f663e028288f9f4a9e08bcca39a923e --- Needs a fix (https://github.com/wenkokke/unlit/pull/11) and a Hackage release -source-repository-package - type: git - location: https://github.com/michaelpj/unlit.git - tag: 9ca1112093c5ffd356fc99c7dafa080e686dd748 - source-repository-package type: git location: https://github.com/input-output-hk/cardano-base @@ -141,4 +148,4 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/goblins - tag: cde90a2b27f79187ca8310b6549331e59595e7ba + tag: cde90a2b27f79187ca8310b6549331e59595e7ba \ No newline at end of file diff --git a/NodeFactory/stable-coin/plutus-stable-coin.cabal b/NodeFactory/stable-coin/plutus-stable-coin.cabal index 20fff1fd6..a6873ef75 100644 --- a/NodeFactory/stable-coin/plutus-stable-coin.cabal +++ b/NodeFactory/stable-coin/plutus-stable-coin.cabal @@ -1,25 +1,30 @@ cabal-version: 2.4 name: plutus-stable-coin version: 0.1.0.0 - --- A short (one-line) description of the package. --- synopsis: - --- A longer description of the package. --- description: - --- A URL where users can report bugs. --- bug-reports: - license: Apache-2.0 license-files: LICENSE author: NodeFactory maintainer: mak@nodefactory.io --- A copyright notice. --- copyright: --- category: --- extra-source-files: CHANGELOG.md +flag defer-plugin-errors + description: + Defer errors from the plugin, useful for things like Haddock that can't handle it. + default: False + manual: True + +common lang + default-language: Haskell2010 + default-extensions: ExplicitForAll ScopedTypeVariables + DeriveGeneric StandaloneDeriving DeriveLift + GeneralizedNewtypeDeriving DeriveFunctor DeriveFoldable + DeriveTraversable + ghc-options: -Wall -Wnoncanonical-monad-instances + -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints -Widentities + -- See Plutus Tx readme + -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas + if flag(defer-plugin-errors) + ghc-options: -fplugin-opt PlutusTx.Plugin:defer-errors library hs-source-dirs: src @@ -28,8 +33,9 @@ library NodeFactory.Plutus.Contracts.Oracle.Funds NodeFactory.Plutus.Contracts.Oracle.PAB NodeFactory.Plutus.Contracts.Oracle.Swap - NodeFactory.Plutus.Contracts.StableCoin - NodeFactory.Plutus.Contracts.Coin + NodeFactory.Plutus.Contracts.StableCoin.Types + NodeFactory.Plutus.Contracts.StableCoin.OnChain + NodeFactory.Plutus.Contracts.StableCoin.OffChain build-depends: aeson , base ^>=4.14.1.0 , containers @@ -45,7 +51,15 @@ library , prettyprinter , text default-language: Haskell2010 - ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr -fno-specialise + default-extensions: ExplicitForAll ScopedTypeVariables + DeriveGeneric StandaloneDeriving DeriveLift + GeneralizedNewtypeDeriving DeriveFunctor DeriveFoldable + DeriveTraversable + ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas + -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr + -fno-specialise -Wnoncanonical-monad-instances + -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints -Widentities executable oracle-pab main-is: oracle-pab.hs diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Coin.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Coin.hs deleted file mode 100644 index ba394deee..000000000 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Coin.hs +++ /dev/null @@ -1,105 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module NodeFactory.Plutus.Contracts.Coin - ( - Coin (..), - coin, - coinValueOf, - hashCoin, - coinAssetClass - ) where - -import Control.Monad hiding (fmap) -import qualified Data.Map as Map -import Data.Monoid (Last (..)) -import Data.Proxy (Proxy (..)) -import Data.Text (Text, pack) -import Data.Void (Void) -import Ledger hiding (singleton) -import Ledger.Contexts -import Ledger.Constraints as Constraints -import Ledger.Constraints.OnChain as Constraints -import Ledger.Constraints.TxConstraints as Constraints -import qualified Ledger.Scripts as Scripts -import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value as Value -import Playground.Contract -import Plutus.Contract hiding (when) -import qualified Plutus.Contracts.Currency as Currency -import qualified PlutusTx -import PlutusTx.Prelude hiding (Semigroup (..), unless) -import Prelude (Semigroup (..)) -import qualified Prelude -import Text.Printf (printf) - - --- | A pair consisting of a 'CurrencySymbol' and a 'TokenName'. --- Coins are the entities that can be swapped in the exchange. -data Coin = Coin - { cCurrency :: CurrencySymbol - , cToken :: TokenName - } deriving (Show, Generic, ToJSON, FromJSON) - -PlutusTx.unstableMakeIsData ''Coin -PlutusTx.makeLift ''Coin - -instance Eq Coin where - {-# INLINABLE (==) #-} - c == d = cCurrency c == cCurrency d && cToken c == cToken d - -instance Prelude.Eq Coin where - (==) = (==) - -{-# INLINABLE compareCoins #-} -compareCoins :: Coin -> Coin -> Ordering -compareCoins c d = case compare (cCurrency c) (cCurrency d) of - LT -> LT - GT -> GT - EQ -> compare (cToken c) (cToken d) - -instance Prelude.Ord Coin where - compare = compareCoins - -{-# INLINABLE coinLT #-} -coinLT :: Coin -> Coin -> Bool -coinLT c d = case compareCoins c d of - LT -> True - _ -> False - -{-# INLINABLE coin #-} --- | @'coin' c n@ denotes the value given by @n@ units of @'Coin'@ @c@. -coin :: Coin -- ^ The 'Coin'. - -> Integer -- ^ The desired number coins. - -> Value -- ^ The 'Value' consisting of the given number of units of the given 'Coin'. -coin Coin{..} = Value.singleton cCurrency cToken - -{-# INLINABLE coinValueOf #-} --- | Calculates how many units of the specified 'Coin' are contained in the --- given 'Value'. -coinValueOf :: Value -- ^ The 'Value' to inspect. - -> Coin -- ^ The 'Coin' to look for. - -> Integer -- ^ The number of units of the given 'Coin' contained in the given 'Value'. -coinValueOf v Coin{..} = valueOf v cCurrency cToken - -{-# INLINABLE hashCoin #-} -hashCoin :: Coin -> ByteString -hashCoin Coin{..} = sha2_256 $ concatenate (unCurrencySymbol cCurrency) (unTokenName cToken) - -{-# INLINABLE coinAssetClass #-} -coinAssetClass :: Coin -> AssetClass -coinAssetClass Coin{..} = AssetClass (cCurrency, cToken) \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs index fa65d59fc..682fe39fd 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs @@ -41,7 +41,7 @@ import qualified Ledger.Typed.Scripts as Scripts import Ledger.Value as Value import Ledger.Ada as Ada import Plutus.Contracts.Currency as Currency -import Prelude (Semigroup (..)) +import Prelude (Semigroup (..), String, show) import qualified Prelude as Prelude -- contract param structure @@ -50,12 +50,12 @@ data Oracle = Oracle , oOperator :: !PubKeyHash -- owner of the oracle , oFee :: !Integer -- fees in lovelace , oAsset :: !AssetClass -- target of the oracle (US dollar) - } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord) + } deriving (Prelude.Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord) PlutusTx.makeLift ''Oracle data OracleRedeemer = Update | Use -- two availabe operations - deriving Show + deriving Prelude.Show PlutusTx.unstableMakeIsData ''OracleRedeemer @@ -142,7 +142,7 @@ data OracleParams = OracleParams -- parans fir starting oracle { opFees :: !Integer , opSymbol :: !CurrencySymbol , opToken :: !TokenName - } deriving (Show, Generic, FromJSON, ToJSON) + } deriving (Prelude.Show, Generic, FromJSON, ToJSON) startOracle :: forall w s. HasBlockchainActions s => OracleParams -> Contract w s Text Oracle startOracle op = do diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Funds.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Funds.hs index a659c6d33..88d62359f 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Funds.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Funds.hs @@ -31,7 +31,7 @@ ownFunds = do pk <- ownPubKey utxos <- utxoAt $ pubKeyAddress pk let v = mconcat $ Map.elems $ txOutValue . txOutTxOut <$> utxos - logInfo @String $ "own funds: " ++ show (Value.flattenValue v) + -- logInfo @String $ "own funds: " ++ show (Value.flattenValue v) return v ownFunds' :: Contract (Last Value) BlockchainActions Text () diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Swap.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Swap.hs index 8c1be0ec8..12d65e649 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Swap.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Swap.hs @@ -30,7 +30,7 @@ import Ledger.Constraints as Constraints import qualified Ledger.Typed.Scripts as Scripts import Ledger.Ada as Ada hiding (divide) import Ledger.Value as Value -import Prelude (Semigroup (..), (<$>)) +import Prelude (Semigroup (..), String, show, (<$>)) import NodeFactory.Plutus.Contracts.Oracle.Core import NodeFactory.Plutus.Contracts.Oracle.Funds diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs deleted file mode 100644 index 1ebf953a5..000000000 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin.hs +++ /dev/null @@ -1,282 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module NodeFactory.Plutus.Contracts.StableCoin - ( - StableCoin (..), stablecoin, - vaultStateCoinFromStableCoinCurrency - ) where - -import Control.Monad hiding (fmap) -import Data.Monoid (Last (..)) -import Data.Text (Text, pack) -import Data.Void (Void) -import Ledger hiding (singleton) -import Ledger.Constraints as Constraints -import Ledger.Constraints.OnChain as Constraints -import Ledger.Constraints.TxConstraints as Constraints -import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value as Value -import Playground.Contract -import Plutus.Contract hiding (when) -import qualified Plutus.Contracts.Currency as Currency -import qualified PlutusTx -import PlutusTx.Prelude hiding (Semigroup (..), unless) -import Prelude (Semigroup (..)) -import qualified Prelude -import Text.Printf (printf) - -import NodeFactory.Plutus.Contracts.Coin - -stableCoinTokenName, vaultStateTokenName :: TokenName -stableCoinTokenName = "Stable Coin Token" -vaultStateTokenName = "Vault State Token" - --- Structs - -data StableCoinVault = StableCoinVault - { owner :: !PubKeyHash -- owner of the of the vault - , amount :: !Integer -- amount of ADA locked in vault - } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord) - -PlutusTx.unstableMakeIsData ''StableCoinVault -PlutusTx.makeLift ''StableCoinVault - -data StableCoin = StableCoin - { sCoin :: Coin --- scOracle :: PubKeyHash -- oracle identificator - } deriving stock (Show, Generic) - deriving anyclass (ToJSON, FromJSON) - -PlutusTx.unstableMakeIsData ''StableCoin -PlutusTx.makeLift ''StableCoin - -instance Prelude.Eq StableCoin where - u == v = sCoin u Prelude.== sCoin v - -instance Prelude.Ord StableCoin where - compare u v = Prelude.compare (sCoin u) (sCoin v) - -data StableCoinAction = Create StableCoinVault | Close - deriving Show - -PlutusTx.unstableMakeIsData ''StableCoinAction -PlutusTx.makeLift ''StableCoinAction - -data StableCoinDatum = - Factory [StableCoinVault] - | Vault StableCoinVault - deriving stock (Show) - -PlutusTx.unstableMakeIsData ''StableCoinDatum -PlutusTx.makeLift ''StableCoinDatum - -data StableCoining -instance Scripts.ScriptType StableCoining where - type instance DatumType StableCoining = StableCoinDatum - type instance RedeemerType StableCoining = StableCoinAction - --- Validators - -{-# INLINABLE validateCreate #-} -validateCreate :: StableCoin - -> Coin - -> [StableCoinVault] - -> StableCoinVault - -> ScriptContext - -> Bool -validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = - traceIfFalse "StableCoin coin not present" inputHasVaultToken && - Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Factory $ v : vs) $ coin sCoin 1) - -- Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Vault v) $ coin c 1) TODO - fix checking vault coin - -- TODO - Add constraint checking output amount of stable coin appropriate - -- TODO - Add constraint checking input amount of ADA - where - ownInput :: TxOut - ownInput = case findOwnInput ctx of - Nothing -> traceError "stable coin input missing" - Just i -> txInInfoResolved i - - inputHasVaultToken :: Bool -- check if input contains nft token - inputHasVaultToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ c) == 1 - -{-# INLINABLE validateCloseFactory #-} -validateCloseFactory :: StableCoin - -> Coin - -> [StableCoinVault] - -> ScriptContext - -> Bool -validateCloseFactory sc c vs ctx = - traceIfFalse "StableCoin coin not present" inputHasStableCoinToken - where - scC :: Coin - scC = sCoin sc - - ownInput :: TxOut - ownInput = case findOwnInput ctx of - Nothing -> traceError "stable coin input missing" - Just i -> txInInfoResolved i - - inputHasStableCoinToken :: Bool -- check if input contains nft token - inputHasStableCoinToken = assetClassValueOf (txOutValue ownInput) (coinAssetClass $ scC) == 1 - -{-# INLINABLE validateCloseVault #-} -validateCloseVault :: StableCoin - -> ScriptContext - -> Bool -validateCloseVault sc ctx = - hasFactoryInput - -- TODO - Add constraint checking input amount of stable coin appropriate - -- TODO - Add constraint check if owner of vault - where - info :: TxInfo - info = scriptContextTxInfo ctx - - hasFactoryInput :: Bool - hasFactoryInput = - traceIfFalse "Stable coin factory input expected" $ coinValueOf (valueSpent info) (sCoin sc) == 1 - - -mkStableCoinValidator :: StableCoin - -> Coin - -> StableCoinDatum - -> StableCoinAction - -> ScriptContext - -> Bool -mkStableCoinValidator sc c (Factory vs) (Create v) ctx = validateCreate sc c vs v ctx -mkStableCoinValidator sc c (Factory vs) Close ctx = validateCloseFactory sc c vs ctx -mkStableCoinValidator sc _ (Vault _) Close ctx = validateCloseVault sc ctx -mkStableCoinValidator _ _ _ _ _ = False - -stableCoinInstance :: StableCoin -> Scripts.ScriptInstance StableCoining -stableCoinInstance sc = Scripts.validator @StableCoining - ($$(PlutusTx.compile [|| mkStableCoinValidator ||]) - `PlutusTx.applyCode` PlutusTx.liftCode sc - `PlutusTx.applyCode` PlutusTx.liftCode c) - $$(PlutusTx.compile [|| wrap ||]) - where - c :: Coin - c = vaultStateCoin sc - - wrap = Scripts.wrapValidator @StableCoinDatum @StableCoinAction - --- TODO implement forging validation --- validateLiquidityForging :: StableCoin -> TokenName -> ScriptContext -> Bool --- validateLiquidityForging sc tn ctx = - -validateLiquidityForging :: StableCoin -> TokenName -> ScriptContext -> Bool -validateLiquidityForging sc tn ctx = True -- TODO replace with real forging validation - -stableCoinValidator :: StableCoin -> Validator -stableCoinValidator = Scripts.validatorScript . stableCoinInstance - -stableCoinAddress :: StableCoin -> Ledger.Address -stableCoinAddress = scriptAddress . stableCoinValidator - -stablecoin :: CurrencySymbol -> StableCoin -stablecoin cs = StableCoin $ Coin cs stableCoinTokenName - -liquidityPolicy :: StableCoin -> MonetaryPolicy -liquidityPolicy sc = mkMonetaryPolicyScript $ - $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateLiquidityForging u t) ||]) - `PlutusTx.applyCode` PlutusTx.liftCode sc - `PlutusTx.applyCode` PlutusTx.liftCode vaultStateTokenName - -liquidityCurrency :: StableCoin -> CurrencySymbol -liquidityCurrency = scriptCurrencySymbol . liquidityPolicy - -vaultStateCoin :: StableCoin -> Coin -vaultStateCoin = flip Coin vaultStateTokenName . liquidityCurrency - -vaultStateCoinFromStableCoinCurrency :: CurrencySymbol -> Coin -vaultStateCoinFromStableCoinCurrency = vaultStateCoin . stablecoin - ----- ENDPOINTS - -start :: HasBlockchainActions s => Contract w s Text StableCoin -start = do - pkh <- pubKeyHash <$> ownPubKey - cs <- fmap Currency.currencySymbol $ - mapError (pack . show @Currency.CurrencyError) $ - Currency.forgeContract pkh [(stableCoinTokenName, 1)] - let c = Coin cs stableCoinTokenName - sc = stablecoin cs - inst = stableCoinInstance sc - tx = mustPayToTheScript (Factory []) $ coin c 1 - ledgerTx <- submitTxConstraints inst tx - void $ awaitTxConfirmed $ txId ledgerTx - - logInfo @String $ printf "started StableCoin %s at address %s" (show sc) (show $ stableCoinAddress sc) - return sc - -ownerEndpoint :: Contract (Last (Either Text StableCoin)) BlockchainActions Void () -ownerEndpoint = do - e <- runError start - tell $ Last $ Just $ case e of - Left err -> Left err - Right sc -> Right sc - ----- TODO general user endpoints - --- data CreateParams = CreateParams --- {} deriving (Show, Generic, ToJSON, FromJSON, ToSchema) - --- data CloseParams = CloseParams --- {} deriving (Show, Generic, ToJSON, FromJSON, ToSchema) - --- create :: HasBlockchainActions s => StableCoin -> CreateParams -> Contract w s Text () --- create sc CreateParams{..} = do - --- close :: HasBlockchainActions s => StableCoin -> CloseParams -> Contract w s Text () --- close sc CreateParams{..} = do - --- type StableCoinUserSchema = --- BlockchainActions --- .\/ Endpoint "create" CreateParams --- .\/ Endpoint "close" CloseParams --- -- TODO add liquidation - --- data UserContractState = Created | Closed --- deriving (Show, Generic, FromJSON, ToJSON) - --- userEndpoints :: StableCoin -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () --- userEndpoints sc = --- stop --- `select` --- ((f (Proxy @"create") (const Created) create `select` --- f (Proxy @"close") (const Closed) close `select` --- where --- f :: forall l a p. --- HasEndpoint l p StableCoinUserSchema --- => Proxy l --- -> (a -> UserContractState) --- -> (StableCoin -> p -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Text a) --- -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () --- f _ g c = do --- e <- runError $ do --- p <- endpoint @l --- c sc p --- tell $ Last $ Just $ case e of --- Left err -> Left err --- Right a -> Right $ g a - --- stop :: Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () --- stop = do --- e <- runError $ endpoint @"stop" --- tell $ Last $ Just $ case e of --- Left err -> Left err --- Right () -> Right Stopped \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs new file mode 100644 index 000000000..5cca30063 --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs @@ -0,0 +1,275 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module NodeFactory.Plutus.Contracts.StableCoin.OffChain + ( poolStateCoinFromUniswapCurrency + , CreateParams (..) + , CloseParams (..) + , StableCoinUserSchema, UserContractState (..) + , StableCoinOwnerSchema + , start, create, close, pools + , ownerEndpoint, userEndpoints + ) where + +import Control.Monad hiding (fmap) +import qualified Data.Map as Map +import Data.Monoid (Last (..)) +import Data.Proxy (Proxy (..)) +import Data.Text (Text, pack) +import Data.Void (Void, absurd) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Playground.Contract +import Plutus.Contract +import qualified Plutus.Contracts.Currency as Currency +import NodeFactory.Plutus.Contracts.StableCoin.OnChain (mkStableCoinValidator, validateStableCoinForging) +import NodeFactory.Plutus.Contracts.StableCoin.Types +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup (..), dropWhile, flip, unless) +import Prelude as Haskell (Int, Semigroup (..), String, div, dropWhile, flip, show, + (^)) +import Text.Printf (printf) + +data StableCoining +instance Scripts.ValidatorTypes StableCoining where + type instance RedeemerType StableCoining = StableCoinAction + type instance DatumType StableCoining = StableCoinDatum + +type StableCoinOwnerSchema = Endpoint "start" () + +-- | Schema for the endpoints for users of stable coin. +type StableCoinUserSchema = + Endpoint "create" CreateParams + .\/ Endpoint "close" CloseParams + .\/ Endpoint "funds" () + .\/ Endpoint "stop" () + +-- | Type of the StableCoin user contract state. +data UserContractState = + Funds Value + | Created + | Closed + | Stopped + deriving (Show, Generic, FromJSON, ToJSON) + + +scTokenName, vaultStateTokenName :: TokenName +scTokenName = "StableCoin" +vaultStateTokenName = "Vault State" + +scInstance :: StableCoin -> Scripts.TypedValidator StableCoining +scInstance sc = Scripts.mkTypedValidator @StableCoining + ($$(PlutusTx.compile [|| mkStableCoinValidator ||]) + `PlutusTx.applyCode` PlutusTx.liftCode sc + `PlutusTx.applyCode` PlutusTx.liftCode c) + $$(PlutusTx.compile [|| wrap ||]) + where + c :: Coin VaultState + c = vaultStateCoin sc + + wrap = Scripts.wrapValidator @StableCoinDatum @StableCoinAction + +scScript :: StableCoin -> Validator +scScript = Scripts.validatorScript . scInstance + +scAddress :: StableCoin -> Ledger.Address +scAddress = Ledger.scriptAddress . scScript + +stablecoin :: CurrencySymbol -> StableCoin +stablecoin cs = StableCoin $ mkCoin cs scTokenName + +stableCoinPolicy :: StableCoin -> MonetaryPolicy +stableCoinPolicy sc = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateStableCoinForging u t) ||]) + `PlutusTx.applyCode` PlutusTx.liftCode sc + `PlutusTx.applyCode` PlutusTx.liftCode vaultStateTokenName + +stableCoinCurrency :: StableCoin -> CurrencySymbol +stableCoinCurrency = scriptCurrencySymbol . stableCoinPolicy + +vaultStateCoin :: StableCoin -> Coin VaultState +vaultStateCoin = flip mkCoin vaultStateTokenName . stableCoinCurrency + +poolStateCoinFromUniswapCurrency :: CurrencySymbol -- ^ The currency identifying the StableCoin instance. + -> Coin VaultState +poolStateCoinFromUniswapCurrency = vaultStateCoin . stablecoin + +-- | Parameters for the @create@-endpoint, which creates a new vault. +data CreateParams = CreateParams + { crAmount :: Amount + , crOwner :: PubKeyHash + } deriving (Show, Generic, ToJSON, FromJSON, ToSchema) + +-- | Parameters for the @close@-endpoint, which closes a vault. +data CloseParams = CloseParams + { clOwner :: PubKeyHash + , clAmount :: Amount + } deriving (Show, Generic, ToJSON, FromJSON, ToSchema) + +start :: forall w s. Contract w s Text StableCoin +start = do + pkh <- pubKeyHash <$> ownPubKey + cs <- fmap Currency.currencySymbol $ + mapError (pack . show @Currency.CurrencyError) $ + Currency.forgeContract pkh [(scTokenName, 1)] + let c = mkCoin cs scTokenName + sc = stablecoin cs + inst = scInstance sc + tx = mustPayToTheScript (Factory []) $ unitValue c + ledgerTx <- submitTxConstraints inst tx + void $ awaitTxConfirmed $ txId ledgerTx + + logInfo @String $ printf "started StableCoin %s at address %s" (show sc) (show $ scAddress sc) + return sc + +-- | Creates a liquidity pool for a pair of coins. The creator provides liquidity for both coins and gets liquidity tokens in return. +create :: forall w s. StableCoin -> CreateParams -> Contract w s Text () +create sc CreateParams{..} = do + Plutus.Contract.when (scAmount <= 0) $ throwError "Amount of stable coin must be positive" + (oref, o, vs) <- findStableCoinFactory sc + let v = Vault {clOwner = r, clAmount = r} + let scInst = scInstance sc + scScript = scScript sc + scDat1 = Factory $ v : vs + scDat2 = Vault v liquidity + vsC = vaultStateCoin sc + lC = mkCoin (stableCoinCurrency sc) $ lpTicker v + scVal = unitValue $ usCoin sc + vVal = valueOf unitValue vsC + + lookups = Constraints.typedValidatorLookups scInst <> + Constraints.otherScript scScript <> + Constraints.monetaryPolicy (stableCoinPolicy sc) <> + Constraints.unspentOutputs (Map.singleton oref o) + + tx = Constraints.mustPayToTheScript scDat1 scVal <> + Constraints.mustPayToTheScript scDat2 vVal <> + Constraints.mustForgeValue (unitValue vsC <> valueOf lC liquidity) <> + Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData $ Create v) + + ledgerTx <- submitTxConstraintsWith lookups tx + void $ awaitTxConfirmed $ txId ledgerTx + + logInfo $ "created liquidity pool: " ++ show v + +-- | Closes a liquidity pool by burning all remaining liquidity tokens in exchange for all liquidity remaining in the pool. +close :: forall w s. StableCoin -> CloseParams -> Contract w s Text () +close sc CloseParams{..} = do + pkh <- pubKeyHash <$> ownPubKey + let scInst = scInstance sc + scScript = scScript sc + usDat = Factory $ filter (/= v) vs + usC = usCoin sc + vsC = vaultStateCoin sc + lC = mkCoin (stableCoinCurrency sc) $ lpTicker v + scVal = unitValue usC + psVal = unitValue vsC + lVal = valueOf lC liquidity + redeemer = Redeemer $ PlutusTx.toData Close + + lookups = Constraints.typedValidatorLookups scInst <> + Constraints.otherScript scScript <> + Constraints.monetaryPolicy (stableCoinPolicy sc) <> + Constraints.ownPubKeyHash pkh + + tx = Constraints.mustPayToTheScript usDat scVal <> + Constraints.mustForgeValue (negate $ psVal <> lVal) <> + Constraints.mustIncludeDatum (Datum $ PlutusTx.toData $ Vault v liquidity) + + ledgerTx <- submitTxConstraintsWith lookups tx + void $ awaitTxConfirmed $ txId ledgerTx + + logInfo $ "closed liquidity pool: " ++ show v + +-- | Gets the caller's funds. +funds :: forall w s. Contract w s Text Value +funds = do + pkh <- pubKeyHash <$> ownPubKey + os <- map snd . Map.toList <$> utxoAt (pubKeyHashAddress pkh) + return $ mconcat [txOutValue $ txOutTxOut o | o <- os] + +getStableCoinDatum :: TxOutTx -> Contract w s Text StableCoinDatum +getStableCoinDatum o = case txOutDatumHash $ txOutTxOut o of + Nothing -> throwError "datumHash not found" + Just h -> case Map.lookup h $ txData $ txOutTxTx o of + Nothing -> throwError "datum not found" + Just (Datum e) -> case PlutusTx.fromData e of + Nothing -> throwError "datum has wrong type" + Just d -> return d + +findStableCoinInstance :: forall a b w s. StableCoin -> Coin b -> (StableCoinDatum -> Maybe a) -> Contract w s Text (TxOutRef, TxOutTx, a) +findStableCoinInstance sc c f = do + let addr = scAddress sc + logInfo @String $ printf "looking for StableCoin instance at address %s containing coin %s " (show addr) (show c) + utxos <- utxoAt addr + go [x | x@(_, o) <- Map.toList utxos, isUnity (txOutValue $ txOutTxOut o) c] + where + go [] = throwError "StableCoin instance not found" + go ((oref, o) : xs) = do + d <- getStableCoinDatum o + case f d of + Nothing -> go xs + Just a -> do + logInfo @String $ printf "found StableCoin instance with datum: %s" (show d) + return (oref, o, a) + +findStableCoinFactory :: forall w s. StableCoin -> Contract w s Text (TxOutRef, TxOutTx, [StableCoinVault]) +findStableCoinFactory sc@StableCoin{..} = findStableCoinInstance sc usCoin $ \case + Factory vs -> Just vs + Vault _ _ -> Nothing + +findStableCoinPool :: forall w s. StableCoin -> StableCoinVault -> Contract w s Text (TxOutRef, TxOutTx) +findStableCoinPool sc v = findStableCoinInstance sc (vaultStateCoin sc) $ \case + Vault v' l + | v == v' -> Just l + _ -> Nothing + +ownerEndpoint :: Contract (Last (Either Text StableCoin)) EmptySchema ContractError () +ownerEndpoint = do + e <- mapError absurd $ runError start + tell $ Last $ Just e + void $ waitNSlots 10 + +userEndpoints :: StableCoin -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () +userEndpoints sc = + stop + `select` + ((f (Proxy @"create") (const Created) create `select` + f (Proxy @"close") (const Closed) close `select` + f (Proxy @"funds") Funds (\_us () -> funds)) >> userEndpoints sc) + where + f :: forall l a p. + (HasEndpoint l p StableCoinUserSchema, FromJSON p) + => Proxy l + -> (a -> UserContractState) + -> (StableCoin -> p -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Text a) + -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () + f _ g c = do + e <- runError $ do + p <- endpoint @l + c sc p + tell $ Last $ Just $ case e of + Left err -> Left err + Right a -> Right $ g a + + stop :: Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () + stop = do + e <- runError $ endpoint @"stop" + tell $ Last $ Just $ case e of + Left err -> Left err + Right () -> Right Stopped \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs new file mode 100644 index 000000000..145a2c9b7 --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# options_ghc -fno-strictness #-} +{-# options_ghc -fno-specialise #-} + +module NodeFactory.Plutus.Contracts.StableCoin.OnChain + ( mkStableCoinValidator + , validateStableCoinForging + ) where + +import Ledger +import Ledger.Ada (Ada) +import qualified Ledger.Ada as Ada +import Ledger.Constraints.OnChain as Constraints +import Ledger.Constraints.TxConstraints as Constraints +import Ledger.Value (AssetClass (..), symbols) +import NodeFactory.Plutus.Contracts.StableCoin.Types +import qualified PlutusTx +import PlutusTx.Prelude + +{-# INLINABLE findOwnInput' #-} +findOwnInput' :: ScriptContext -> TxInInfo +findOwnInput' ctx = fromMaybe (error ()) (findOwnInput ctx) + +{-# INLINABLE valueWithin #-} +valueWithin :: TxInInfo -> Value +valueWithin = txOutValue . txInInfoResolved + +{-# INLINABLE validateCreate #-} +-- | Validates the creation of the stable coin vault. Conditions: +-- +-- 1,2. Check that stable coin factory utxo is in input and output +-- 3. Check that we are creating new vault +-- 4. Check that one vault state coin has been forged +-- 5. Check that more than minimum amount of lovelace has been sent +-- 6. Check if vault UTXO contains appropriate: amount of lovelace, owner, minted amount +-- 7. Check if stablecoin in output +validateCreate :: StableCoin + -> Coin VaultState + -> [StableCoinVault] + -> StableCoinVault + -> ScriptContext + -> Bool +validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = + traceIfFalse "StableCoin coin not present" (isUnity (valueWithin $ findOwnInput' ctx) sCoin) && -- 1 + Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Factory $ v : vs) $ unitValue sCoin) && -- 2 + all (/= v) vs && -- 3 + isUnity forged c && -- 4 + traceIfFalse "Less than minimum" (amountOfAdaInInput > minimumLovelaceAmount) -- 5 + -- 6 TODO - check if vault UTXO contains appropriate: amount of lovelace, owner, minted amount + -- Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Vault v) $ valueOf ) + -- 7 TODO - check if stablecoin in ouptu + where + forged :: Value + forged = txInfoForge $ scriptContextTxInfo ctx + + adaValueIn :: Value -> Integer + adaValueIn v = Ada.getLovelace (Ada.fromValue v) + + minimumLovelaceAmount = 10 + + amountOfAdaInInput = adaValueIn (valueWithin $ findOwnInput' ctx) + +{-# INLINABLE validateCloseVault #-} +-- | Validates the creation of the stable coin vault. Conditions: +-- +-- 1. +-- 2. +-- 3. +validateCloseVault :: StableCoin + -> ScriptContext + -> Bool +validateCloseVault sc ctx = hasFactoryInput + where + info :: TxInfo + info = scriptContextTxInfo ctx + + hasFactoryInput :: Bool + hasFactoryInput = + traceIfFalse "Stable coin factory input expected" $ + isUnity (valueSpent info) (sCoin sc) + +-- TODO +-- {-# INLINABLE validateLiquidateVault #-} +-- validateLiquidateVault :: StableCoin... + +-- TODO +-- {-# INLINABLE validateCloseFactory #-} +-- validateCloseFactory :: StableCoin... + +mkStableCoinValidator :: StableCoin + -> Coin VaultState + -> StableCoinDatum + -> StableCoinAction + -> ScriptContext + -> Bool +mkStableCoinValidator sc c (Factory vs) (Create v) ctx = validateCreate sc c vs v ctx -- case: create vault +mkStableCoinValidator sc _ (Vault _) Close ctx = validateCloseVault sc ctx -- case: close vault +mkStableCoinValidator _ _ _ _ _ = False -- case: default +-- TODO case: liquidate vault +-- TODO case: close factory + +{-# INLINABLE validateStableCoinForging #-} +validateStableCoinForging :: StableCoin -> TokenName -> ScriptContext -> Bool +validateStableCoinForging StableCoin{..} tn ctx + = case [ i + | i <- txInfoInputs $ scriptContextTxInfo ctx + , let v = valueWithin i + , isUnity v sCoin || isUnity v lpC + ] of + [_] -> True + [_, _] -> True + _ -> traceError "pool state forging without StableCoin input" + where + lpC :: Coin sUSD + lpC = mkCoin (ownCurrencySymbol ctx) tn \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs new file mode 100644 index 000000000..85528a5fa --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs @@ -0,0 +1,118 @@ + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# options_ghc -Wno-redundant-constraints #-} +{-# options_ghc -fno-strictness #-} +{-# options_ghc -fno-specialise #-} + + +module NodeFactory.Plutus.Contracts.StableCoin.Types + where + +import Ledger +import Ledger.Value (AssetClass (..), assetClass, assetClassValue, assetClassValueOf) +import Playground.Contract (FromJSON, Generic, ToJSON, ToSchema) +import qualified PlutusTx +import PlutusTx.Prelude +import qualified Prelude as Haskell +import Text.Printf (PrintfArg) + +-- | SC-state coin token +data SC = SC +PlutusTx.makeIsDataIndexed ''SC [('SC, 0)] +PlutusTx.makeLift ''SC + +-- | Vault-state coin token +data VaultState = VaultState +PlutusTx.makeIsDataIndexed ''VaultState [('VaultState, 0)] +PlutusTx.makeLift ''VaultState + +-- | USDc coin token +data USDc = USDc +PlutusTx.makeIsDataIndexed ''USDc [('USDc, 0)] +PlutusTx.makeLift ''USDc + +-- | A single 'AssetClass'. +newtype Coin a = Coin { unCoin :: AssetClass } + deriving stock (Haskell.Show, Generic) + deriving newtype (ToJSON, FromJSON, ToSchema, Eq, Haskell.Eq, Haskell.Ord) +PlutusTx.makeIsDataIndexed ''Coin [('Coin, 0)] +PlutusTx.makeLift ''Coin + +-- | Likewise for 'Integer'. +newtype Amount a = Amount { unAmount :: Integer } + deriving stock (Haskell.Show, Generic) + deriving newtype (ToJSON, FromJSON, ToSchema, Eq, Ord, PrintfArg) + deriving newtype (Haskell.Eq, Haskell.Ord, Haskell.Num) + deriving newtype (AdditiveGroup, AdditiveMonoid, AdditiveSemigroup, MultiplicativeSemigroup) +PlutusTx.makeIsDataIndexed ''Amount [('Amount, 0)] +PlutusTx.makeLift ''Amount + +{-# INLINABLE valueOf #-} +valueOf :: Coin a -> Amount a -> Value +valueOf c a = assetClassValue (unCoin c) (unAmount a) + +{-# INLINABLE unitValue #-} +unitValue :: Coin a -> Value +unitValue c = valueOf c 1 + +{-# INLINABLE isUnity #-} +isUnity :: Value -> Coin a -> Bool +isUnity v c = amountOf v c == 1 + +{-# INLINABLE amountOf #-} +amountOf :: Value -> Coin a -> Amount a +amountOf v = Amount . assetClassValueOf v . unCoin + +{-# INLINABLE mkCoin #-} +mkCoin:: CurrencySymbol -> TokenName -> Coin a +mkCoin c = Coin . assetClass c + +newtype StableCoin = StableCoin + { sCoin :: Coin SC + } deriving stock (Haskell.Show, Generic) + deriving anyclass (ToJSON, FromJSON, ToSchema) + deriving newtype (Haskell.Eq, Haskell.Ord) +PlutusTx.makeIsDataIndexed ''StableCoin [('StableCoin, 0)] +PlutusTx.makeLift ''StableCoin + +data StableCoinVault = StableCoinVault + { owner :: !PubKeyHash -- owner of the of the vault + , amount :: !Integer -- amount of ADA locked in vault + } deriving (Haskell.Show, Generic, ToJSON, FromJSON, ToSchema) +PlutusTx.makeIsDataIndexed ''StableCoinVault [('StableCoinVault, 0)] +PlutusTx.makeLift ''StableCoinVault + +instance Eq StableCoinVault where + {-# INLINABLE (==) #-} + x == y = (owner x == owner y && amount x == amount y) + +-- Actions that can be executed on vault +data StableCoinAction = Create StableCoinVault | Close | Liquidate + deriving Haskell.Show +PlutusTx.makeIsDataIndexed ''StableCoinAction [ ('Create, 0) + , ('Close, 1) + , ('Liquidate, 2) + ] +PlutusTx.makeLift ''StableCoinAction + +data StableCoinDatum = + Factory [StableCoinVault] + | Vault StableCoinVault + deriving stock (Haskell.Show) + +PlutusTx.unstableMakeIsData ''StableCoinDatum --[ ('Factory, 0) + --, ('Vault, 1) + --] +PlutusTx.makeLift ''StableCoinDatum From f25bbc532a5abf61cd83125a0b865c2f796263e5 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Wed, 16 Jun 2021 09:17:09 +0200 Subject: [PATCH 10/21] Fix typo in val comments --- .../Plutus/Contracts/StableCoin/OnChain.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs index 145a2c9b7..5c3402575 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -63,7 +63,7 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = traceIfFalse "Less than minimum" (amountOfAdaInInput > minimumLovelaceAmount) -- 5 -- 6 TODO - check if vault UTXO contains appropriate: amount of lovelace, owner, minted amount -- Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Vault v) $ valueOf ) - -- 7 TODO - check if stablecoin in ouptu + -- 7 TODO - check if stablecoin in ouptut where forged :: Value forged = txInfoForge $ scriptContextTxInfo ctx @@ -76,11 +76,12 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = amountOfAdaInInput = adaValueIn (valueWithin $ findOwnInput' ctx) {-# INLINABLE validateCloseVault #-} --- | Validates the creation of the stable coin vault. Conditions: +-- | Validates the closing of the stable coin vault. Conditions: -- --- 1. --- 2. --- 3. +-- 1. Check that vault token in output +-- 2. Check that vault token burned +-- 3. Check that proper amount of stable coin sent +-- 4. Check that collateral in output validateCloseVault :: StableCoin -> ScriptContext -> Bool From 9188ac131bef1ad9801bc2c0d25688865ea15791 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Thu, 24 Jun 2021 10:55:29 +0200 Subject: [PATCH 11/21] Changes on create vault --- .../Plutus/Contracts/StableCoin/OffChain.hs | 14 +++++++------- .../Plutus/Contracts/StableCoin/OnChain.hs | 14 ++++++++------ 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs index 5cca30063..450b29c40 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs @@ -33,7 +33,7 @@ import Data.Text (Text, pack) import Data.Void (Void, absurd) import Ledger hiding (singleton) import Ledger.Constraints as Constraints -import qualified Ledger.Typed.Scripts as Scripts +import qualified Ledger.Typed.Scripts.Validators as Scripts import Playground.Contract import Plutus.Contract import qualified Plutus.Contracts.Currency as Currency @@ -137,19 +137,19 @@ start = do logInfo @String $ printf "started StableCoin %s at address %s" (show sc) (show $ scAddress sc) return sc --- | Creates a liquidity pool for a pair of coins. The creator provides liquidity for both coins and gets liquidity tokens in return. +-- | Creates stable coin vault create :: forall w s. StableCoin -> CreateParams -> Contract w s Text () create sc CreateParams{..} = do - Plutus.Contract.when (scAmount <= 0) $ throwError "Amount of stable coin must be positive" + Plutus.Contract.when (crAmount <= 0) $ throwError "Amount of stable coin must be positive" (oref, o, vs) <- findStableCoinFactory sc - let v = Vault {clOwner = r, clAmount = r} + let v = Vault {owner = crOwner, amount = crAmount} let scInst = scInstance sc scScript = scScript sc scDat1 = Factory $ v : vs - scDat2 = Vault v liquidity + scDat2 = Vault v vsC = vaultStateCoin sc lC = mkCoin (stableCoinCurrency sc) $ lpTicker v - scVal = unitValue $ usCoin sc + scVal = unitValue $ sCoin sc vVal = valueOf unitValue vsC lookups = Constraints.typedValidatorLookups scInst <> @@ -167,7 +167,7 @@ create sc CreateParams{..} = do logInfo $ "created liquidity pool: " ++ show v --- | Closes a liquidity pool by burning all remaining liquidity tokens in exchange for all liquidity remaining in the pool. +-- | Closes a stable coin vault close :: forall w s. StableCoin -> CloseParams -> Contract w s Text () close sc CloseParams{..} = do pkh <- pubKeyHash <$> ownPubKey diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs index 5c3402575..cb033f417 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -47,8 +47,9 @@ valueWithin = txOutValue . txInInfoResolved -- 3. Check that we are creating new vault -- 4. Check that one vault state coin has been forged -- 5. Check that more than minimum amount of lovelace has been sent --- 6. Check if vault UTXO contains appropriate: amount of lovelace, owner, minted amount --- 7. Check if stablecoin in output +-- 6. Check that at least same amount of lovelace is sent that is defined in vault +-- 7. Check if vault UTXO contains appropriate: amount of lovelace, owner, minted amount +-- 8. Check if stablecoin in output validateCreate :: StableCoin -> Coin VaultState -> [StableCoinVault] @@ -60,10 +61,9 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Factory $ v : vs) $ unitValue sCoin) && -- 2 all (/= v) vs && -- 3 isUnity forged c && -- 4 - traceIfFalse "Less than minimum" (amountOfAdaInInput > minimumLovelaceAmount) -- 5 - -- 6 TODO - check if vault UTXO contains appropriate: amount of lovelace, owner, minted amount - -- Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Vault v) $ valueOf ) - -- 7 TODO - check if stablecoin in ouptut + traceIfFalse "Less than minimum" (amountOfAdaInInput > minimumLovelaceAmount) && -- 5 + traceIfFalse "Not enough ada sent" (amount <= amountOfAdaInInput) && -- 6 + -- 8 TODO - check if appropriate amount of stablecoin in ouptut where forged :: Value forged = txInfoForge $ scriptContextTxInfo ctx @@ -74,6 +74,7 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = minimumLovelaceAmount = 10 amountOfAdaInInput = adaValueIn (valueWithin $ findOwnInput' ctx) + {-# INLINABLE validateCloseVault #-} -- | Validates the closing of the stable coin vault. Conditions: @@ -114,6 +115,7 @@ mkStableCoinValidator sc _ (Vault _) Close ctx = validateCloseVault sc mkStableCoinValidator _ _ _ _ _ = False -- case: default -- TODO case: liquidate vault -- TODO case: close factory +-- TODO case: {-# INLINABLE validateStableCoinForging #-} validateStableCoinForging :: StableCoin -> TokenName -> ScriptContext -> Bool From 158c1369544a4433df6ad3980a5efe9e7181f61a Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Thu, 24 Jun 2021 11:37:48 +0200 Subject: [PATCH 12/21] Add stable coin token name as param --- .../Plutus/Contracts/StableCoin/OnChain.hs | 15 +++++++++++---- .../Plutus/Contracts/StableCoin/Types.hs | 1 + 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs index cb033f417..c5b0f7303 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -47,9 +47,9 @@ valueWithin = txOutValue . txInInfoResolved -- 3. Check that we are creating new vault -- 4. Check that one vault state coin has been forged -- 5. Check that more than minimum amount of lovelace has been sent --- 6. Check that at least same amount of lovelace is sent that is defined in vault --- 7. Check if vault UTXO contains appropriate: amount of lovelace, owner, minted amount --- 8. Check if stablecoin in output +-- 6. Check that enough lovelace has been sent to mint stablecoin +-- 7. Check if appropriate amount of stablecoin has been minted +-- 8. Check if vault in output validateCreate :: StableCoin -> Coin VaultState -> [StableCoinVault] @@ -62,7 +62,8 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = all (/= v) vs && -- 3 isUnity forged c && -- 4 traceIfFalse "Less than minimum" (amountOfAdaInInput > minimumLovelaceAmount) && -- 5 - traceIfFalse "Not enough ada sent" (amount <= amountOfAdaInInput) && -- 6 + traceIfFalse "Not enough ada sent" (requiredAmountOfAda <= amountOfAdaInInput) && -- 6 + (amountOf forged stableCoin' == amount) -- 7 -- 8 TODO - check if appropriate amount of stablecoin in ouptut where forged :: Value @@ -74,6 +75,12 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = minimumLovelaceAmount = 10 amountOfAdaInInput = adaValueIn (valueWithin $ findOwnInput' ctx) + + requiredAmountOfAda :: Integer -> Integer + requiredAmountOfAda a = a * 0.5 -- TODO use value from oracle + + stableCoin' :: Coin USDc + stableCoin' = let AssetClass (cs, _) = unCoin c in mkCoin cs $ scStablecoinTokenName {-# INLINABLE validateCloseVault #-} diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs index 85528a5fa..9c6d6b332 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs @@ -81,6 +81,7 @@ mkCoin c = Coin . assetClass c newtype StableCoin = StableCoin { sCoin :: Coin SC + , scStablecoinTokenName :: TokenName } deriving stock (Haskell.Show, Generic) deriving anyclass (ToJSON, FromJSON, ToSchema) deriving newtype (Haskell.Eq, Haskell.Ord) From 6c71faf36b99c54be1a18b0a39769ddac2a7eec8 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Thu, 24 Jun 2021 12:29:21 +0200 Subject: [PATCH 13/21] Fix amount of stablecoin check --- .../src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs | 6 +++--- .../src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs | 7 +++++-- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs index c5b0f7303..93cefdd75 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -62,8 +62,8 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = all (/= v) vs && -- 3 isUnity forged c && -- 4 traceIfFalse "Less than minimum" (amountOfAdaInInput > minimumLovelaceAmount) && -- 5 - traceIfFalse "Not enough ada sent" (requiredAmountOfAda <= amountOfAdaInInput) && -- 6 - (amountOf forged stableCoin' == amount) -- 7 + traceIfFalse "Not enough ada sent" (requiredAmountOfAda amount <= amountOfAdaInInput) && -- 6 + (unAmount (amountOf forged stableCoin') == amount) -- 7 -- 8 TODO - check if appropriate amount of stablecoin in ouptut where forged :: Value @@ -77,7 +77,7 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = amountOfAdaInInput = adaValueIn (valueWithin $ findOwnInput' ctx) requiredAmountOfAda :: Integer -> Integer - requiredAmountOfAda a = a * 0.5 -- TODO use value from oracle + requiredAmountOfAda a = a * 1 -- TODO use value from oracle stableCoin' :: Coin USDc stableCoin' = let AssetClass (cs, _) = unCoin c in mkCoin cs $ scStablecoinTokenName diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs index 9c6d6b332..5e57bced2 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs @@ -79,15 +79,18 @@ amountOf v = Amount . assetClassValueOf v . unCoin mkCoin:: CurrencySymbol -> TokenName -> Coin a mkCoin c = Coin . assetClass c -newtype StableCoin = StableCoin +data StableCoin = StableCoin { sCoin :: Coin SC , scStablecoinTokenName :: TokenName } deriving stock (Haskell.Show, Generic) deriving anyclass (ToJSON, FromJSON, ToSchema) - deriving newtype (Haskell.Eq, Haskell.Ord) PlutusTx.makeIsDataIndexed ''StableCoin [('StableCoin, 0)] PlutusTx.makeLift ''StableCoin +instance Eq StableCoin where + {-# INLINABLE (==) #-} + x == y = (sCoin x == sCoin y && scStablecoinTokenName x == scStablecoinTokenName y) + data StableCoinVault = StableCoinVault { owner :: !PubKeyHash -- owner of the of the vault , amount :: !Integer -- amount of ADA locked in vault From 2a7ca9f6acc0e0464b2036d5763d9473fac88b53 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Thu, 24 Jun 2021 13:49:19 +0200 Subject: [PATCH 14/21] Minor changes --- NodeFactory/stable-coin/cabal.project | 2 +- .../stable-coin/plutus-stable-coin.cabal | 2 +- .../Plutus/Contracts/Oracle/Core.hs | 8 ++++---- .../Plutus/Contracts/StableCoin/OffChain.hs | 18 +++++++++--------- .../Plutus/Contracts/StableCoin/OnChain.hs | 2 +- 5 files changed, 16 insertions(+), 16 deletions(-) diff --git a/NodeFactory/stable-coin/cabal.project b/NodeFactory/stable-coin/cabal.project index 937af2a2c..9c60c35d0 100644 --- a/NodeFactory/stable-coin/cabal.project +++ b/NodeFactory/stable-coin/cabal.project @@ -26,7 +26,7 @@ source-repository-package prettyprinter-configurable quickcheck-dynamic word-array - tag: 26449c6e6e1c14d335683e5a4f40e2662b9b7e7 + tag: 5cdd2c3d708bf4c33514681dee096da6463273b7 -- The following sections are copied from the 'plutus' repository cabal.project at the revision -- given above. diff --git a/NodeFactory/stable-coin/plutus-stable-coin.cabal b/NodeFactory/stable-coin/plutus-stable-coin.cabal index a6873ef75..dd8edba74 100644 --- a/NodeFactory/stable-coin/plutus-stable-coin.cabal +++ b/NodeFactory/stable-coin/plutus-stable-coin.cabal @@ -32,7 +32,7 @@ library NodeFactory.Plutus.Contracts.Oracle.Core NodeFactory.Plutus.Contracts.Oracle.Funds NodeFactory.Plutus.Contracts.Oracle.PAB - NodeFactory.Plutus.Contracts.Oracle.Swap + -- NodeFactory.Plutus.Contracts.Oracle.Swap NodeFactory.Plutus.Contracts.StableCoin.Types NodeFactory.Plutus.Contracts.StableCoin.OnChain NodeFactory.Plutus.Contracts.StableCoin.OffChain diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs index 682fe39fd..88ff4322e 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Oracle/Core.hs @@ -121,12 +121,12 @@ mkOracleValidator oracle x r ctx = outVal `geq` (inVal <> Ada.lovelaceValueOf (oFee oracle)) data Oracling -instance Scripts.ScriptType Oracling where +instance Scripts.ValidatorTypes Oracling where type instance DatumType Oracling = Integer type instance RedeemerType Oracling = OracleRedeemer -oracleInst :: Oracle -> Scripts.ScriptInstance Oracling -oracleInst oracle = Scripts.validator @Oracling +oracleInst :: Oracle -> Scripts.TypedValidator Oracling +oracleInst oracle = Scripts.mkTypedValidator @Oracling ($$(PlutusTx.compile [|| mkOracleValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode oracle) $$(PlutusTx.compile [|| wrap ||]) where @@ -171,7 +171,7 @@ updateOracle oracle x = do logInfo @String $ "set initial oracle value to " ++ show x Just (oref, o, _) -> do -- update existing oracle nft value let lookups = Constraints.unspentOutputs (Map.singleton oref o) <> - Constraints.scriptInstanceLookups (oracleInst oracle) <> + -- Constraints.scriptInstanceLookups (oracleInst oracle) <> TODO FIX THIS Constraints.otherScript (oracleValidator oracle) tx = c <> Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData Update) -- fees auto send because of inbalance diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs index 450b29c40..726439f6b 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs @@ -16,7 +16,7 @@ {-# LANGUAGE TypeOperators #-} module NodeFactory.Plutus.Contracts.StableCoin.OffChain - ( poolStateCoinFromUniswapCurrency + ( vaultStateCoinFromUniswapCurrency , CreateParams (..) , CloseParams (..) , StableCoinUserSchema, UserContractState (..) @@ -33,7 +33,7 @@ import Data.Text (Text, pack) import Data.Void (Void, absurd) import Ledger hiding (singleton) import Ledger.Constraints as Constraints -import qualified Ledger.Typed.Scripts.Validators as Scripts +import qualified Ledger.Typed.Scripts as Scripts import Playground.Contract import Plutus.Contract import qualified Plutus.Contracts.Currency as Currency @@ -105,20 +105,20 @@ stableCoinCurrency = scriptCurrencySymbol . stableCoinPolicy vaultStateCoin :: StableCoin -> Coin VaultState vaultStateCoin = flip mkCoin vaultStateTokenName . stableCoinCurrency -poolStateCoinFromUniswapCurrency :: CurrencySymbol -- ^ The currency identifying the StableCoin instance. +vaultStateCoinFromUniswapCurrency :: CurrencySymbol -- ^ The currency identifying the StableCoin instance. -> Coin VaultState -poolStateCoinFromUniswapCurrency = vaultStateCoin . stablecoin +vaultStateCoinFromUniswapCurrency = vaultStateCoin . stablecoin -- | Parameters for the @create@-endpoint, which creates a new vault. data CreateParams = CreateParams - { crAmount :: Amount + { crAmount :: Integer , crOwner :: PubKeyHash } deriving (Show, Generic, ToJSON, FromJSON, ToSchema) -- | Parameters for the @close@-endpoint, which closes a vault. data CloseParams = CloseParams { clOwner :: PubKeyHash - , clAmount :: Amount + , clAmount :: Integer } deriving (Show, Generic, ToJSON, FromJSON, ToSchema) start :: forall w s. Contract w s Text StableCoin @@ -165,7 +165,7 @@ create sc CreateParams{..} = do ledgerTx <- submitTxConstraintsWith lookups tx void $ awaitTxConfirmed $ txId ledgerTx - logInfo $ "created liquidity pool: " ++ show v + logInfo $ "created stable coin vault: " ++ show v -- | Closes a stable coin vault close :: forall w s. StableCoin -> CloseParams -> Contract w s Text () @@ -194,7 +194,7 @@ close sc CloseParams{..} = do ledgerTx <- submitTxConstraintsWith lookups tx void $ awaitTxConfirmed $ txId ledgerTx - logInfo $ "closed liquidity pool: " ++ show v + logInfo $ "closed stable coin vault: " ++ show v -- | Gets the caller's funds. funds :: forall w s. Contract w s Text Value @@ -239,7 +239,7 @@ findStableCoinPool sc v = findStableCoinInstance sc (vaultStateCoin sc) $ \case | v == v' -> Just l _ -> Nothing -ownerEndpoint :: Contract (Last (Either Text StableCoin)) EmptySchema ContractError () +ownerEndpoint :: Contract (Last (Either Text StableCoin)) Plutus.Contract.Empty ContractError () ownerEndpoint = do e <- mapError absurd $ runError start tell $ Last $ Just e diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs index 93cefdd75..df0984512 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -63,7 +63,7 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = isUnity forged c && -- 4 traceIfFalse "Less than minimum" (amountOfAdaInInput > minimumLovelaceAmount) && -- 5 traceIfFalse "Not enough ada sent" (requiredAmountOfAda amount <= amountOfAdaInInput) && -- 6 - (unAmount (amountOf forged stableCoin') == amount) -- 7 + (unAmount (amountOf forged stableCoin') == amount) -- 7 -- 8 TODO - check if appropriate amount of stablecoin in ouptut where forged :: Value From e88abdbc48c899df61d8fc02fa848cdafb1e28a4 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Thu, 24 Jun 2021 14:07:51 +0200 Subject: [PATCH 15/21] Fix vault type in off chain code --- .../Plutus/Contracts/StableCoin/OffChain.hs | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs index 726439f6b..6bfc8fd92 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs @@ -142,7 +142,7 @@ create :: forall w s. StableCoin -> CreateParams -> Contract w s Text () create sc CreateParams{..} = do Plutus.Contract.when (crAmount <= 0) $ throwError "Amount of stable coin must be positive" (oref, o, vs) <- findStableCoinFactory sc - let v = Vault {owner = crOwner, amount = crAmount} + let v = StableCoinVault {owner = crOwner, amount = crAmount} let scInst = scInstance sc scScript = scScript sc scDat1 = Factory $ v : vs @@ -231,13 +231,7 @@ findStableCoinInstance sc c f = do findStableCoinFactory :: forall w s. StableCoin -> Contract w s Text (TxOutRef, TxOutTx, [StableCoinVault]) findStableCoinFactory sc@StableCoin{..} = findStableCoinInstance sc usCoin $ \case Factory vs -> Just vs - Vault _ _ -> Nothing - -findStableCoinPool :: forall w s. StableCoin -> StableCoinVault -> Contract w s Text (TxOutRef, TxOutTx) -findStableCoinPool sc v = findStableCoinInstance sc (vaultStateCoin sc) $ \case - Vault v' l - | v == v' -> Just l - _ -> Nothing + Vault _ -> Nothing ownerEndpoint :: Contract (Last (Either Text StableCoin)) Plutus.Contract.Empty ContractError () ownerEndpoint = do From 7fc5839439586b7bacb0a41dcb1362cd97912cfd Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Thu, 24 Jun 2021 14:12:49 +0200 Subject: [PATCH 16/21] Comment out close function --- .../Plutus/Contracts/StableCoin/OffChain.hs | 64 +++++++++---------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs index 6bfc8fd92..a7330cc75 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs @@ -21,7 +21,7 @@ module NodeFactory.Plutus.Contracts.StableCoin.OffChain , CloseParams (..) , StableCoinUserSchema, UserContractState (..) , StableCoinOwnerSchema - , start, create, close, pools + , start, create, pools , ownerEndpoint, userEndpoints ) where @@ -55,7 +55,7 @@ type StableCoinOwnerSchema = Endpoint "start" () -- | Schema for the endpoints for users of stable coin. type StableCoinUserSchema = Endpoint "create" CreateParams - .\/ Endpoint "close" CloseParams + -- .\/ Endpoint "close" CloseParams .\/ Endpoint "funds" () .\/ Endpoint "stop" () @@ -63,7 +63,7 @@ type StableCoinUserSchema = data UserContractState = Funds Value | Created - | Closed + -- | Closed | Stopped deriving (Show, Generic, FromJSON, ToJSON) @@ -148,7 +148,7 @@ create sc CreateParams{..} = do scDat1 = Factory $ v : vs scDat2 = Vault v vsC = vaultStateCoin sc - lC = mkCoin (stableCoinCurrency sc) $ lpTicker v + lC = mkCoin (stableCoinCurrency sc) $ scStablecoinTokenName sc scVal = unitValue $ sCoin sc vVal = valueOf unitValue vsC @@ -168,33 +168,33 @@ create sc CreateParams{..} = do logInfo $ "created stable coin vault: " ++ show v -- | Closes a stable coin vault -close :: forall w s. StableCoin -> CloseParams -> Contract w s Text () -close sc CloseParams{..} = do - pkh <- pubKeyHash <$> ownPubKey - let scInst = scInstance sc - scScript = scScript sc - usDat = Factory $ filter (/= v) vs - usC = usCoin sc - vsC = vaultStateCoin sc - lC = mkCoin (stableCoinCurrency sc) $ lpTicker v - scVal = unitValue usC - psVal = unitValue vsC - lVal = valueOf lC liquidity - redeemer = Redeemer $ PlutusTx.toData Close - - lookups = Constraints.typedValidatorLookups scInst <> - Constraints.otherScript scScript <> - Constraints.monetaryPolicy (stableCoinPolicy sc) <> - Constraints.ownPubKeyHash pkh - - tx = Constraints.mustPayToTheScript usDat scVal <> - Constraints.mustForgeValue (negate $ psVal <> lVal) <> - Constraints.mustIncludeDatum (Datum $ PlutusTx.toData $ Vault v liquidity) - - ledgerTx <- submitTxConstraintsWith lookups tx - void $ awaitTxConfirmed $ txId ledgerTx - - logInfo $ "closed stable coin vault: " ++ show v +-- close :: forall w s. StableCoin -> CloseParams -> Contract w s Text () +-- close sc CloseParams{..} = do +-- pkh <- pubKeyHash <$> ownPubKey +-- let scInst = scInstance sc +-- scScript = scScript sc +-- usDat = Factory $ filter (/= v) vs +-- usC = usCoin sc +-- vsC = vaultStateCoin sc +-- lC = mkCoin (stableCoinCurrency sc) $ lpTicker v +-- scVal = unitValue usC +-- psVal = unitValue vsC +-- lVal = valueOf lC liquidity +-- redeemer = Redeemer $ PlutusTx.toData Close + +-- lookups = Constraints.typedValidatorLookups scInst <> +-- Constraints.otherScript scScript <> +-- Constraints.monetaryPolicy (stableCoinPolicy sc) <> +-- Constraints.ownPubKeyHash pkh + +-- tx = Constraints.mustPayToTheScript usDat scVal <> +-- Constraints.mustForgeValue (negate $ psVal <> lVal) <> +-- Constraints.mustIncludeDatum (Datum $ PlutusTx.toData $ Vault v liquidity) + +-- ledgerTx <- submitTxConstraintsWith lookups tx +-- void $ awaitTxConfirmed $ txId ledgerTx + +-- logInfo $ "closed stable coin vault: " ++ show v -- | Gets the caller's funds. funds :: forall w s. Contract w s Text Value @@ -244,7 +244,7 @@ userEndpoints sc = stop `select` ((f (Proxy @"create") (const Created) create `select` - f (Proxy @"close") (const Closed) close `select` + -- f (Proxy @"close") (const Closed) close `select` f (Proxy @"funds") Funds (\_us () -> funds)) >> userEndpoints sc) where f :: forall l a p. From 5d8cd49e6b67d868bd38c8c7ba8eec66004ecf7e Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Fri, 25 Jun 2021 12:35:19 +0200 Subject: [PATCH 17/21] Add documentation to README file --- NodeFactory/stable-coin/README.md | 39 ++++++++++++++---- .../stable-coin/static/close_vault.png | Bin 0 -> 20938 bytes .../stable-coin/static/liquidate_vault.png | Bin 0 -> 30039 bytes NodeFactory/stable-coin/static/open_vault.png | Bin 0 -> 20186 bytes 4 files changed, 30 insertions(+), 9 deletions(-) create mode 100644 NodeFactory/stable-coin/static/close_vault.png create mode 100644 NodeFactory/stable-coin/static/liquidate_vault.png create mode 100644 NodeFactory/stable-coin/static/open_vault.png diff --git a/NodeFactory/stable-coin/README.md b/NodeFactory/stable-coin/README.md index 204550690..a26a83bb2 100644 --- a/NodeFactory/stable-coin/README.md +++ b/NodeFactory/stable-coin/README.md @@ -1,18 +1,15 @@ -# Plutus Platform starter project -This project gives a simple starter project for using the Plutus Platform. +# Node Factory - Crypto backed stable coin on Cardano +### Introduction + +The idea of this use case is to create a stable coin pegged to the US dollar within the Plutus partnership program. In this case, the stable coin is backed by the over-collateralization of ADA. For example, if a user wants to mint 100$ worth of stable coin he/she will need to lock at least 150% of the issued value as ADA (the price of ADA is provided from the oracle at the moment of minting the stable coin). ## Setting up - Install [nix](https://nixos.org/download.html) - Clone and setup [plutus repo](https://github.com/input-output-hk/plutus) following README instructions (pay attention on setting binary cache) -## The Plutus Application Backend (PAB) example - -We have provided an example PAB application in `./pab`. With the PAB we can serve and interact -with contracts over a web API. You can read more about the PAB here: [PAB Architecture](https://github.com/input-output-hk/plutus/blob/master/plutus-pab/ARCHITECTURE.adoc). - -Here, the PAB is configured with sample contract, the `Game` contract from `./src/Plutus/Contracts/Game.hs`. +## Starting example 1. Start `nix-shell` @@ -30,4 +27,28 @@ cabal build plutus-starter-pab cabal run plutus-starter-pab ```` -This will then start up the server on port 8080. The devcontainer process will then automatically expose this port so that you can connect to it from any terminal (it doesn't have to be a terminal running in the devcontainer). \ No newline at end of file +This will then start up the server on port 8080. The devcontainer process will then automatically expose this port so that you can connect to it from any terminal (it doesn't have to be a terminal running in the devcontainer). + +## Documentation + +### Opening a vault (minting stable coin) + +If a user wants to mint new stable coins, he/she needs to open a new “vault”. This vault will hold ADA collateral that must be at least 150% of minted stable coin value at the moment of minting. In practical use cases, users will always want to lock more than 150% of value in collateral as this is the threshold for liquidation (if the collateral value falls under 150% of the value it is eligible for liquidation). The current value of ADA on the market will be provided through an oracle. + +Based on the price of ADA (PADA) and the amount of stable coins that the user wants to mint (ASC), the user will need to send at least a minimal amount of ADA (Amin) to open the vault. + +Collateral will be sent to the created vault’s script address, which will also record information on the sender and the size of the collateral. This will be used as input on closing or liquidating the vault. + +Let’s say that Alice wants to mint 100 stable coins (SC) and she has decided to lock 200% of the minted value as collateral. As the current price of 1 ADA is 2$, she will send 100 ADA when opening the vault and receive 100 SC. This process is represented in the following schema. + +### Closing a vault (burning the stable coin) + +When Alice wants to close her opened vault and return the collateral, closing action must be invoked. Here Alice sends the same amount of stable coin that was originally minted together with the vault UTXO - vault is closed and the user receives original collateral back. It is important to note that this action is possible only if the liquidation criteria haven’t been met. This process is represented in the following schema. + +### Vault liquidation + +Liquidation is an action that can be executed only if the current value of vault collateral has fallen below the defined 150% value of the minted stable coin. In this case, anybody is eligible to execute the liquidation process if he/she has enough stable coins to close the vault. + +We will continue with our example where Alice minted 100 SC for 100 ADA when the price of 1 ADA was 2$, and the collateral value was 200% of the minted stable coin value. + +Currently, the price of one ADA is 1.4$, and the value of the collateral is 140% of the minted stable coin value. This makes Alice’s vault eligible for liquidation. Bob decides that he has some spare stable coin and wants to liquidate Alice’s vault as he is incentivized by the reward for doing that. He will send the same amount of stable coin that Alice originally minted to close the vault. Locked ADA collateral is firstly used to pay out Bob for providing stable coins needed to close the vault. As an incentive for executing liquidation Bob will get 8% (an arbitrary parameter defined by the protocol) more value back. In the example below, as Bob provided 100 SC having a value of 100$, he will get 77.14 ADA back that at the moment of liquidation has a value of 108$. In total, Bob has earned 8$ in total for providing 100$ worth of stable coins (8%). The rest of the collateral that’s remaining will be returned to Alice. diff --git a/NodeFactory/stable-coin/static/close_vault.png b/NodeFactory/stable-coin/static/close_vault.png new file mode 100644 index 0000000000000000000000000000000000000000..1be5c6e15efbca16d5f6fa4cf0b087202033dbc7 GIT binary patch literal 20938 zcmZ^~cRW?`A3rXUt5VlW*)w}wm+PW%aj$W&YwzqmE-u&1D3O&d*(;QWO14sVN@mC| zgls9Z_`Pp^KA-RR`^WF`@VL%B=Y8JuwVuz{>&EHfHRw*Wo~EFnpwrS+H=v+6(F?Ap zA*aA+wZ@l13JThjB(xcc5ajIU=|mv_SNnG*AT8zU?MD)Ts|!d=+xhrNIJ()n_}UTt zB)ptR;1+mJ@OE@_c5`z4*G5`O8YV6!D=v*Rf=LU&Q7{?sAtfatBagKB*WS*>$?HEI z%1TIq4us5LFafwKxWc)4`3HgjK}duRLPi)|p?rKiolKqVv2I{Aj4WJE0*)ZRg4HzA z!3jvKfoo4U4=3;8GIuaB$zy&e_h_?f>e9Jox}8 zUq3f*uYYrg$wxjkAMb47s}|(%?5^!4C;zVvDcHy9UmF*1 zZx>H6CRi~V?A?Dh33TK3pKURcMwz%7p^8V>_aBe81lfRdRv>j1ETGhlvo?ziBZ{Y2VRd>}fmhp8C@Wsnw&}wK+jEB92oSmPO zKf=RD7wv%st>t8cjT~fT?d))_=H!KHXi7T=n;N(o26?OMl5j?b!CI)`K(NCYBred- zTwex-GIjCva59iF*7DTCdVwx5NHuktL6Fou@$wky5C^omPN1WXhY>o&2NvS$hLpk)17R{gpp8_Bo3u#?NgWsLqJbfx z?R>S6!Dd=c1_6dJEf1U-#?_bLi32BV;-Y70hz&HBb1_DQ$dNQ0rR7c0vW75%oobLC zOp|~O@sM^hkn=N_LfE5a&FqYg(9SxJYA*7QvLQOIMi>t{G(wH!<%tX+*lTMBYWl0= zvBuICvT6Y?a3eKsi(t5?Bg43s;?`nhxD*8bwbLc1p+ z>!I!e|rJWnsVACgepPa%p?Hg-O;XoP6(KG2-?HYFThO`OgKQFVBl*3R74f-;biaT zZKUH$^s>iz$|AjW^gVGzRg|NlaUdeVK2X{##K{gX;{wxyJ9;?!_!!EW`{A5bgTbr1 zj;i)Bw6qS8DTK6z9ZFME$J|6O5OlAr;}?jx*GC|9-9bA)m8h=wmoR(r9oC#DS0!vL!dg$J3!A&R#iqCZia<9xk@3t43Stre-Esag}<7U zx1F9mAq2dm2}9VaX}b{gO#EDfyaT1pObs;EjC6Hj#&{=HKRjq*9u%xC?_}?!i#5ed z1?oE)I-r9MRpp2}rp6(dKrI7bRX-13th6is9+rw z%A64BF6E7vRyPXpRFy^O7-(p?A`xJJFb;Zp@>ncM7OUe7Bj~&7t4ra)DZ8M+sbf%n zzCQLoChF22o*_XFAyO8>en^6TNU)Bcwqp=lUsG4t-CffJZ4dKAVI*yLDRpl*JsGn6n97i3-Q9>mav>%@4k%|d0cVN^w-NGim<-Ys;f41> zBFtpXja-O^LH3TuU?{AUml`U>$(JDSEaxeQ^KiEygviO`;O?qkE>c92x_h95uc5hx zISP(+HZXGb1eO?s_k`(5X%P|XE+|c`hqQ^CmM%ie!c9LAVQ23h7@#E|WUL29CF+uA zWa??);p^g$R&yolX##_X@x{8>`K$T(!~C$peqP41{+fPR4G)bVtcjhTjI_L?9!AsI z)!ffl7w+g!kh0U4H_$VcHpfVtp)~aje8F}byBlF#orws77ST;6fP}(H8@QQyYan&y z&82mv9I?S#FkL@jk_^rCjd3OuTtiwWSSv8l(b(M2!$d|+J3vi8 zSj|YsOxGSm#E}SrsyL*xPmo852g+2MD6Qp>^|N!=(;&Gxz+6qe5YEPG0W#(|l$o;& z!7tc8n0$sL83ZE4-3@Ig_JvKUtcLNXKlQm3)~s!rDtveW{dSg zy1UxRfh$xX*;$kSK-hr!uaExgu)+8L#5-{GEipqE3JPutEp?Ppko8(V?dQ8g2c7p| zyit0zW$HZH+D5$D$;D?c!TEXEwL~0+w3Bem47|lcs(ESJm!vt=ic`+gvFoRf%^V+G zU3_);YG!B6dm}K}VA$3e!#HS19E%TBW_B?C&$s8#g5- zZ!g65yWW2v^WvZW=S?UjJrqjBP+((D|Mw2jo$kN=#@@IQ3#T+wFd|P!?;Irb*RW|N z_MXIg!(xG-+U>K%d)6UtcZa+_Jxo2^n@gU$Yij+y^7YR6=NEEQr1X{H$M^mm=Xg|p zcOQQA?VQ3Aci@!&Xv13VL}jaNQ^49X=!SE&(cfctHbK&vW8rYUsc-$mWR9%I!fiUX zg&aBWb*1Cqet{$AE)AyE!5x3Ly12ahuI`d{r>{SAz{jb#XaDNDf9CJR<5_MBU^DBd z0wz8Zn)eshZ=F}t)XqCT7=1Ij-n6lP?#iZ0UC@@jqF~AmWS`QZ=V%e?4Vm(O%YA?>B#HCmfQmPBtH|ubh*g zhX&3i%8mcJv=S#+uynNF7txp?(fCf>?D<=re1&1cn?F12!=^UOMCUcyB~|iq-ekah zN!L|^>G*BD-mO*cmg!XrJE*7O40@Z$p*XVk=J;s+_3pHv;>N3&JWSBVmwieeQPD*o zi@#d=v{0|_OnBGzaZ5DEMDf(M+@hJ-?T$M9m?yt28G{O6o2W|;JNmud*QCK2-2Q8A zVifYbG#y`ceEjX6&7{)d>fDG;M3@|DNl)(jjwj!C#PQ)w<@Me5b04duQ#-R)yO*w$ zJ-w-fZs&$S|-a6^Zk9S!Jw&SV5nJ}03<}v5ou|L;;E`43EpF1~N zORyZRCpzRx&OO#v&vV+l)t?c40|#!in4KN)LA*{TU3h$DZ)@)3gB*gN_^wrRXoKRo!SlW}yTJk-Hn>+977r z((?tnOxL>I{I)Vg$NaD6p1o-lo6gM|>B+4}WpD*79p}g2SSvmIYP(nQW5heys7=Ic z#qA#W)LgRiI%mjI@#mDiO6QL`S|4jF4v-Olewl9PhyNVVSkNU5ltfP@2wA+#*0kUy zY!MmOuJ^#Y>gD|wvXbkh>4}#uuO3+cRZk40sDs|;rO#K@(WXG}z;U++*#RR}PT0C% zBbHq$kXYuI3mq&r?1$`;2SA*3{LW|$uRm`)x6s!9B*E>%@hmue&ttEl^2F=2af0@v zOQX*U*<@Vx4E)4}`Lk^1qF*pHutCOGqFJn6!+W?j<2JYnp^wyu0#-&o;=0sN&3U8e zCLPmtz_C{E$Qu6@DGNwX7OV|u(7NQJ{dD{JOOR4+3mV7IrCRBq7e}x8B{m%_KTfUrqndRg*a zU@hM<-9#r`$nLIHi#ewyDKLvWoqF!SHg{8*Npf%`W zs$#^^?~BAVZ*AuLz4?lkQ4P%wAWhsRh@%Fw_QkcS#7xG1pvLZmEcu(cA$y4^= zTvIFmyE^gXH9x;aU5qoJ8&5=~{hU+pN6dt7>+n5Lr#@wX7Sit(Mqktvr#(Z3Z=oK< zzZ0jE>3vWbKJJV7UZmQGf4@EzvhsBO;r*m4gv(v9o?*e#Ik4MMN~b85s zoOYJHD9sH{KzvoXx#L;%w389m4Nw_%h0^vjP82-N@A)4(GeHH%VaACMZH-=s_&@ff z`f4h`+k5Sbj+NnGF`tL<^Wn>B_KOH5`(OL60hjVoIkpqSVevc4)mNrr2R$2?PSh#5 zGUh%Ke(?PPqUX=fM4wI`@`dVH^X48pulb5jqT1grpa+(~Me3SnddU*isn?sWXGT7S zbi^~8V3IG7J}3xr_jGoB=<)1zfQhrV3zPdw=b3!{rIfVz&Pz(SXV(?istuo{A|xru zOBGGlWuYe@UB(5QB!)y0lWDKgKz_WI!5i;-Hd|`WZ}Cht-?LL zE;LlG1AlY*s71o6vEF~gyel??qS*YUvpJijj81Iq&NX)I7bq2Vc1gCg2noZZDQqot zS@(;9+0u*dLa?Uy)wTz*3@EI{+3#@D&0@vV7K={ztejI@Us1#Y-O>K1J9@KZ*`~hO znat(ApIl0^ZT6h3e}R6&8S#7THiNUdfe|K|bFF!A_RNR5)lU`aY*My2CTwrf{fOt^ zFLmwOQVkcLPcqNUwEuac%;7^UJs-nD&U>TWQH=+=v_OZbqHa8cE8|(|3@Xs3VZUu*Z=(8&zz{Ay-$;NpQi$OiFN5CSOP{>0?whFJWH&p5tDlto7 zYfg`^k?nS+_3IGk=KH@HYqyuQ7^yPm4SS&@O1&lF)+ zT(7^+d=*m=ym0C9Tm8tcrN`u8ynd`ZYw0x-zDy=M!{@P8d> zX(WgVnKKyJ)vVNdN`Qe#q&GDy*DYMfBfnDZ{u;G0)y~VZgv|_w3oaQ4P7=H1A$4Jg zJ3C`Vs9TfP*Vmk=a1Tfdk7%qQvoRSxMxu%ETQpA%|3(2kJG$aiV@!&9XvMvehdt-81$jE7A6n4o1lIL z=#uZB*|ayCAbKsMcX1}-`1N(Lv!b%YwQfV5f7ZMsUKV&mKH9i> z3{^RO`0SsguqP5aYSZT4aB_Y?ocf;QQ@nAjV+FCExt6qUW*T&k5|Fpa02qpV1^kk1zSn>W-^9tZbadd(l0{_0Mz6A)xo#(I51}pu4 zFbCOI#2R}1^S%F5{r9`Yh2qxpCQlA}Bd;T#H8ebajh+fUkNW36AvclWhzrEy%%Ao7 zFg{RPn9e!8{kS>YziwTDWVAo@=jV1`lKNef>(v2WBxLW}V12d=->A=D@%VQ0M(j}f z;_q%3t_HRZ&ZW$-m+b^Shm((Wu!+tGeb`KnbuTIZ2b;~) zfL#ptsr(@!*^HR7BKmooKEM-1zut=%vuf=5v$e9}rCB&JwKHL4eOvPG%F=(pTI_A0 zPpsDF$_Kv!7wZd7O8U^%dVfKTyWZCveK6a9{;^4u{;ke>al~UYQMtir((`}#u=Eai z&FNuP#23joN2?0?5v3E3Ly1-&b7Y4aTL#OpQ<<_JO^TJA*(3W3TK_C(3E1~Lw@pDL zJlA45*)#f}Vcfs={ZeCL#7?y0Mrp#en2{J~5=Xw+zjNuPhY~M$2?=Wa-Z}KHY;$}1 z^l^9NaBQBA4dkN5Tyo9i5>Ikz1bx2wiJKrEXME-|m_=4(Tde>6!u8C@5)Iy2H0|hA!&rTJL#vpdiriYOY?7lI0zm4ivG)vT!A3Sm39C0PGP!#HE&@F z@^RpMmfx_kX~WLigeA{WDxZdhn%@!KrGVAX1M!Eut7Ai*eq9`aW^YUsHcD9?%VU6t zQy~Gd9Dsdze@ShFW7RrrqwI~$Tm0@U_JX9pRkCs)$K-+Xcq)Gw)pW#h7@u5h`~{*z zS5i&FukS-$u?f@Vka5m&!Ek4pSL%z=8dU(qX5AhG{^2ky!p}P99LJJKX*_rjxGm9FLKiw-h;Dyt8ff}CH_c~X<*SNku zF+7viEy32h@cMY2rlD7(ASdy|-8EUMdnI(W00H-u(6Ia5$W;ui{EAXGs_q$iYT30} zoVpK=fDo0l^hzqL#(mfqSV>q3+LEqPKH?~p>ZbQ$KXz+Itvx>WKEP$$=LqY37!V2` z`FeY?$K*4s8sW=Uaw8%D5cq_mUieoyDi(BBl`hTS+xxU`?}9t zc9eHC9veS4x$vcJE6c-8g>w%N&e45b_^9_39cw+nh*uFxmD|gYpEYKRTQ)X_9X7Jc zx@T#b13Rj+4vgl)xe1YHp}TEuQyHcOacEa(g*zQKVgW4q(;sTanykw2iA-$A8C+d? z^70PFE#H{M!iZ)M04Lk{Cmx$h#$e)Atf?r!p8WIX`0!2CqMZUA73FW>gzk9GQ8P*` zm{;pj-r{yEae#fhpGbzN7tTgiTr6C8S~u-}?;^}T>iT@D20MQ^0600FT0ftv13jE1 z>mf(2v2}Jl>f~*kZ?#kF&zc`SRO5a6bt-V$KOKYjXB+*DT>h?b^ak>!k6)E}4F;tQ zkm^8qPfwysEWKaXl%;O&zP)*Js^I#%TX?_vA}|g*FFgF$#)l0oHQ}^pqO_z8KFbAf zb+9xY{90)uvo7>{B*3XO<_C;-lg}KJM2?Zu1X_1MoCS;Q$iSsQ3uy)cCWg~sft7#9 z2?DZJyG#4p8vcr(2__zfAKrXW7kX`aedy`b$3N@u=A{)(|5;1}vM^F=HYm(*Epqxh z6td>)O9(o*CSM3$J!OOVv^L_ndyUR`^dCCBc?=XvY|~(Ah)ciylYV{nDdie7f+Gm|?>Zj$bXT$gZ z2-b})BhQ)(n9o0GJ$sqweG@86`FQW;;ZY3Nq`Y9kq5`L{>if}= zn`MbA6@>ZbzOLP^yF2cZzgN}sq9aZ*V>Z{`drxJs2sT}MrsJ2;Y_`;F^XIjtU!v?( zCmUfl!1eik#pmBp>-_;5<1P$5P;NbUwuX)Et+3Dor}+!OcY19N4@aw5LxpM*C;u+< zl~|*6b6o7pJ6z4>)(Vh}am@N*XegJ>_a~mpF1)ipw;NoIRJj=_%W6{(mAGcQSlqUj zzPy9PBKg$H8KZ7Q{O^sz2+`_l4F9ay)5VIh4B`L1U|Ozx>y?h;V!M_%s!?GT&^eVh zZ^B>1f#}C$9ne96x>vT^Z7ySXAt9#+D=3Taw?DUQoBa8G=&7k)zJmV~w@pC*xz6}q zbNYB)_|Zo$n{R*y@VP~EKH$s+F`t!ZZ<^`Sty6BDqVok^H%$OAd2OoE-=Xb6)*fKT z7G2HGo?}<@);ygw#Gz);{J-hi>>n}wfN$q9F4hz0JkukVD;`V&!pouiPX&WujhWkH zsu#ciY(xb9S|0Y>UikR(@|%dmiJ8f4mjbtTTKS>ik}RsfOw-e=%vNFm4oh5&gQRXR z(aGDsyps;X7PX$)9$*FfjDm!s_2xq_kK1>4E{-74c?bFB@&A*GvPLh`wGhaB z29ibMn(NgwWIw;qak%kDdE|zi@$9Sph1@AXv~C>iZWQ|5?s!5RlnMsG*q1AOulTS_ z`G{v0=go2NkNJPk)pSQWmi=Uk;p{8G9rtL&T)JCDBt48#A9!LQ00MSdj}g+CzXVK30-Qs2;$)@CXCM#b1tnswq&?olB5ausv=S03tGk zyPz&GD>go3ggRyYU;Uvrk8&an<6r=WSBrVh(P<|hE+s!d=TE%cRpAfz?i*tv2RnJRFaU#%n zv_ys;zjr(_S()|V*i7rMo{*wyt9BoLpC33K9I=Hhv9r&lTO=L<($%XymVSMIu`p27 zmMs$Gwv;H4myu_dhd-B@8b; zBmsY2o{-neNXhwshTs(cn8qG&+O9S517P^J)D0~TixRg{a~F<;o+$t$t$X**ROT78*tD&XSiBCU}x_Lmhv!=aoqC
    $gY^mTH#J?g>y0ZW+r;wD*zdn7`JTHEi+G$ZUnSKXXH+>@-+(w-ArbFp%NDGDK;+HDHq6jyxgE@;jd$rpVmZC=@FpVjH1~&9CxPJJGpPkR(4><#SH!giigSjg%jpcIg}pIO!{lGdL5vFw0}+@Uni zK0~3y^pRm^ftVy35Aqw+;tChu@PyM_+V`*tvob(p5+!6RCM z7e;uL8~0Qb#;b{*57TDVxuqu5e419P66kqVZTk}Crd`pJDIolwsvcmm2_1;NTYWj| z3-^2J-dwpp`qWF1(FqWgIvgjvLE%!y52vqhT>YC}1O1&YDvleZ%C{}PMq9e-_sO+# zA%EFFEZO2$SZKxUles~)BJTEJvegH4lZ&`}YHT-PdrUt|4c$_6VP-ucgN^+GP-jhX zC?F;){Z~fT0Us(`!m~#+BdGL)oZL(V46#g~Xk~pXJw(Q}zvwfQ)V69l5cH~d9`k?_ zB++n%KIf}qWB4}Nw9!0KZPY8Mb2>s~zM=ba?)=$vgjdFDD~e>l?{Y>i@eJe7(H9OH zkI#)hvw8EGIo264Tq_(cC0nfp&0w&Gm%R!fnt4s^K0mi}4xSAW(yF(@U)fSWESL+T zPr6rW)ueFbXn9&S&!O`UOq_xn&Wup0j5#GLY)$phxF^{OIIARXp74t)U+6X1zi#TM z#a97Vu3>$usVf`@cj=XZO9-D$5gmBGRUwq+*dU=l85)Do{+bxJJ2mCRz5uN*!Dd$_EqGPa`-E>9v_H_P@yh`VYO|Nc%16%kY7Dj z?FG88TFK$ib;@~MsJc=qcYAkf@CS-095o~74bHHi1KHNvi)U`W0(gaqxIlQpyoY&^ zACN=6P5(~gZe7vk;79FR;nIJDpVe>j&{wH;*SZsP+B=2ud(R0o>z* zKW5!0_$(Oo+QOeyOFm?bRw)4JEFQUC{poZ_ZuA+JaZVi_-`UfyODGWoro{A%7bYd@ z=NPocpo`$RzJSE9^^n5QFM%y7RvFinyQ-(Dt*jb@$No+(v#msMuGnj;(HSFvxykOi zLtx4`k_A!EywRLNMLhC_qXD;oSk~=^h}tsl@^M>+bV1$PqVt}g0P?mgZMX`|!a6W^ zq|#c=D3up~ySy-wlc-=Fnoc$KLign~eaTFp@^NS&FcA-Mc`1@tv*UDxt|!7NC}LpV zoUh`jQj?9Za`(L4)1ZaWyJ4)}D@?PHDO5(mf!^QK!d@r5_8K1YqB8{Cu9ouC_e9G} z{-#VaPkGw{;O6wv7t1r0hV_cfWuMg^+D3g*uuqQwiF5m$Gt8y2>+>7Wm-YpY1?aQ! zNizD&H+u?|XHtz}fJDiN^V?Y+yYNNh3KluM3P^^U&{b~R=kvF2&GNVur=4vEfuP0F zHK*6|aUuM7Z)j>8FjVO;BKGf((yMaIL0sn&@p(3(ThV3DQC{^yAO{YgKpFyfnYM7^ zrtKQssK zqo4~uTe>6E+Ewa1gW#zAw+zEobp93FSjIZ~V`qo*){I#A>zOm-%5-e~48leX7an0! z4*-cFDw=y~DAD(#o@k-@>IZeM%xI)m`h7Qwh<9A=KLog34pv?n^)V4Mm(zz|y~6zM;3St|83SxA)lAom zyG6D7o|?LO?E_j!l0<>&mmtwPx7<{g-Y9_bo=^ z1*(9l>Pd3grkmH2{YeDlz|YI2lh%4H!*_ljl#0}<@Ve7?F$#7;B~jhASjpF)@U)DA zH-!NA=|@gvu8cg*Eph+whlWiqg8spUD5wy{zYP(>_B>4COx-Dck;2G!R4h*9b}=0%NO$av0d4Yh7~j*J{C#IVB9NZAz($YmW|cjh*BexFkv*#0nW*s_YZM1>BgI7=7XL-&iR2>GNzt?qMu-MgSP=()XWQ4L*l zD)pHQW`EQlIa~|-HLUfl6=rO_s~d8HL(c$c6f-gNQzYI`I;&+%ppe*kDf1p1TBt%Z zo&hcPL!7sl3Ho3;9K@JU+mIYx6Ez--IS7KgymfSK%>$`W$#X3;>O~kcAup5+zp=7V zunC?Q7~agGkY}Ei8MsonD+7Js1EhEevCAr}-TO@RE)3ORVib07Z=6_9!%B27z7(#w z{`%)2HX{4HByZ`ND|=sVIhXJdims`*3(tz(t0{0T`1y@L)?+4YSBEXWBZ0-zmL;(Y zupk9H{v`!Mvri~tGCBxSNMpsr&`)K|YkMGaQC!CV*fBq6u->lq+CXH7>Tc+4VK7tZ zyM}gN;NRsMp1nD0R3#W8J{7CQSbSU|XVdLYmiQ{~&oc%BfM)rewz-NNpRR#o9bw7W zLUY*t5&@EJ)gtyqm~|GYu*u(gGFDjk+5U{^=R!$(qRCB}g|=G4g!WKRn>+v6{7)y? zk3ldJz`1Vr*)rp>6Pt5_`9{djs#__GZjt^bPg#^b#4H+6e;4?A-G<7u*=~GcWL4X= zzx_CR5@*0F)Y8>Su640w<|&aSa+UJxciwydOM5NLv2S-kgR3T9mxhC+*J-%eKz~hr zm*I_u4MGYSammT=~Ls)G)xCi^Bh{9IZnFSsM6HEi~oA_Nt$!jLKYTU z&T5dsQuHOO>K{D3y;MTmJFRT6^J-~aRBv-W-brF9lNb-mAHD~2R^Ds+hLQ+ekvbOh z(JxUDUwtWu{UwTzf0)bX?Fp~Rdg6}!ALPlFJ0AkAngVp(zJK2rh^ctAh^#O^a&kd9-@vAEDll#-s%1=TMogS7RH$Jv|0-lz8-aBYBz<3K);J2=9%G zjQN20moD0QRQY;3OQ7=QWiGU%0fg_3f~;1@=)l5)&8dNKaBSlqfw5$Z>q!g6dr9 z=;g$UEe~GTEUFYJu5}SG8+KLoOGoKS73sWX`KS?CeZJ!GL`g3(0)5 z^;G}W)z9_9Tb+RwnZ)#p+GX^;)&1GID+^f;Rn8W7lZS5U+@Q;g9MsoAbDn*@6mw(Y z#8KKHhTHs;lR`U_E}3~iykQx3+stM_V-uu!3B(qt`G?yHr{ce7T0E@4kRHIB2g6I4 zUC7%%7tmpwCy;A?6!U>*l4=^VH@kuVVe(m)C)vP za;G)Hc4x--gSdE%Uw;v5M|z|T%d%bUw+77QWPZqU#X5+$pF=FiQ=_j3UvA?Y-V$iS zSA-X??yCl5^vrb#81iVdVwt@PLbdRqr0RTH!uQYkDk67O0VAhU$WK>|O*(r2EKN;i zh-qR=aG$-4eoS=q%yT=n>o4Dys%q@|bI6*!QQ(p=pgUHM^ZJ zYuR!h^MEy~I=l}v%y$7%Djs3w-JBfXBzJODr7Hf$#>(5>EvH|0^Go(j_df&B-B+t7dRt+=em`^_M)924M=!wMrJUM;k;UFXKiq-5{-7L=Q z*B*e>bj6p=dk!T>Qk1h%?;fiB0Dy74EvkAi@QdhcfT!6b9tO0w7N3xu8A8Ntonu4v zSc?U%{#VtTgrM*Krbuh1Ga0FTthfQ1)R>v+^7~chI@HKa;6PnlKoD;{KMj3 zhGVqo8@4?pD(VuDju2j)Dfdf$-`h<~^yLdZ^@{Gw=G&7m4jF#X6{FZ89l^v;=K(tP zeJF&y!2~DHN`40wARp(*H4U3P5l7pFFiR!%)29Gjm450s^28h#8aWpyf@aj{f0Rxy z`0@IHL<{paBYh;5k`IC2r8Zoo5wAqQnV$uCU8O?f%e$@Tb*}m_JratZej!w1t4IF` z`m_U3amaDNmR#;P4gMr@Vva(0Mr4Uu9;AOyRJY3A| z4I4Y&G9>5lKrq1jUBD-h{%q6-QB7Ix5QEI~?=BIg@eC=#*U^q_IReh_RN5L>t3F%< z>@M!Us%7g4UEFNHBy-|6AjV!8*w#%2(9<$i13EUE_9=61` zHKupV!;d+l_D3we8$iZ?a8{#)>095d-kO2DKrcu_HqtU)HWRpbS}eUzO$h0ZPw{!H0qYUAKrr8e2 zfNEGxs<+d^K)FUutr?}^sgA{pkSb8nb|xbdIj}h()4+KXwTC1&CLmw_Ngw$2r+q(waS4W(#M& z{%{tRP~>CHTm9+Ek zX-dzjX11z&H|*Nz=bC13o$y!G_OhAmw@uYMQHw{e9XWk?YYRgm$0u3?`aO#E_u z=EYKt{s=lANUTMEmRp-DzXY4|37ITp#f)Z#2udb}3MHM<9T^%X&}*wynr-`1W5w|m zsG+Vv50nVZ_G5xlZF^lae*1{>;gi~aYrm(Z`rzMk{+g!rImX3@`uEQck!yDsbeV|< zKMjY>O1PnSvx4M1#G}d?AZ(IT278Ici9aTaCiLsS!X!)DFWJ&3{AZ>k5mdhTJXFr9 zh&eyY7xvL*=C)Psr57)>rVU8ZmZNU9Mzsd-schX#3wSYvR~!?DE{Z;TWl*ds_4*h0 zMgEy`i(@W-;vGFU1LBnj*OH}|750t}H^>C($5yp-@`q~mU4jza1~WpW6uLMCP%UOS zx=C|0kMV)BVIqRzk5tLmyHD>&U$0FOTVE-CdG2}jrmv2JyO?2VJ^j<Mp%!O z+0uIVs)#mLZDjOBTW~Auag{!+=rT=m~yp8O4ExEPEnBufhYAm6~U}m(P88 z&rM2={D*2iw~PZE2%6SclOpLZFDr0Uq%L2ZPojxTaJfZ?c)k=mds3(`E*VfIIWHXE zWna#c5PF}s9CbfQa(HFAeimf6^DFRxm@r0_wEcW5+rIG}(K81L74x0=QmX#N;ir4`LF!9WnDN>1bY1!!6 zMG22^)1;?e&l(N3&Q}bqbz!W8adz_R6Z~dvh1Rs|n4^B{R!Ik4ich}Za!2>ANG5<1 z=i)#{#rhAvh9~$J@-!lgG;*TcJU$xQ(0f_i;xrq)VFsf0Q@z;GHaacCsGxWck{e>A z%?vM^*>Sk7+&cSck>9BpWiKS%nkgH`IP zs#4Wh`szRaq}ZenaFQZWL299gz3R=L+*yvW+@YSF4Oi`(MM7Kh0$OurkH#0`Vj2Bb zL1j0)N1bN3=@a@p^wMQ)EY$vk^pdfRY{;*(4?i(cK73Rx*1_~}Lz~2|bk_ZXv!&3- z4oijwb};M>DcH7NyuQKozlA^3dn{Oh{Qj}008d@5vMIXJxKde8wZ%av0u3Dq?LA_X zG#*Cis^>99YP6I%BO^Pt>m-)H430CbIA!(Uw>9yZ<$pw{A7c83yxyQH1R)HLE_&37T!+jWdV}mVwIP zc0!j!wypZVQZdYJ2PMMI3ES%J@}YY^+fK6wD2M2bwz9(@R7`(c>gS4CFsgdfDySQp ze~7rODR&pZ6bove>C06DpBIB;U8~c6^WNafr7rBX@7>V!ue62}LRNSy2;`n-6@$CL>)N z_MGl(qv9BUvBiknmWh&Vi%&_=TZ}RMehhMq39_ZVBmVyR^APCQSi{15!dmv`G!L@%`P6Le=i5i$Ob*Ly55u9^;8HNHT_O|4&(r%`<7T^2WA z&h0NB_#ts2ohbp_Ssuaq8o;hIYEd^u(hK4(mb(p>u1vivw~chor#hRemQg_wFj{FP zUTvNhLG^BqcP8Q0mH*8k^jY4U<3AeVLTB!&9r2x?MlvO2EUv*z&i7ZWcETz%lmIhTD6dF#8C|A%iSeWQ7#f5S=6{^ zdM3`X4e`Z&e)Y??Pw-)!Qa)7 zc;jl}GHdC~9nP!cJrJ20fp>BJu88y-pIX~#Uqp)%r6k#BzxEM*=g!!&r^uEv9wYi( zP%E+vxp$Dlx6ty^np`Efkr+Ff8aZ@i#zw_S58!4O|4I(N1cp;f(G{iQr^jI~#V*XdRu)p{M=zwY=t9dL^xE z_;1^87FCCF@Z*RlVk{OH#_beZ8<@Nxqspa0GW-<6_DvB>#W6i6lEe!e;3n^N^2ZP#LCb zMFc69QJi*LG{@R3_6x6j`e|9$(BCQ*UN;SMw_|(l4U6HZNLq`R@{(^@|u5j~`$+s#}nC{`Ie{|q9 zxpj<+^B7qLP;gI33SMtG_8!%dPPYnz8rPKNI1rF3MJyrOD-?j=fP}Gdu~T{NNw!7B zYh5hq=%M`{6P9PxtHKuDezIj$>mEf3TN_G=|D>N6ls!r^o;BHZ$@N00#!_IY4|Ei5 zc`lGQHlC{s&M6X7%2sr@_o_esh@Lx>LKJd=MU!z`Eb3D1M!DWh*S%xGoH35LLT;z% zy=3nG6cKwN{wHUc=${0yT0$C*OB=tm+V$B>wkdQRRRaj+mzz3M7{_ZoeCISK&+}cD z!{&V_5znfusw(5}G|GZ4^3V)^Pzc7SbhI}&1vsnx8MYO#U^NOZS=7x8<96{#W?xzCG?8N{@%(OiH;^6%fdbMhLZy^`BC zuYN$NS_SG<^ts4NHLE>KZ;|zbMdj{#B!l2G;z)Y>!XPu{wawQ~2DOq$(^}35z6mF$PY`<%kBfm-Cr7 zq-VFdZsnw@TY}=R6MxMt^V~8|NCA>AQtW$CBqmNZ>KP;Iekdqqcp8L--cnUytjy;& zp?V|V+)GYdy+AcytKAYp5~X>jxi3OQf*yUWfITP~Ojl))n9QZSQGL_pWXIAdWZ57s zLR8rMACg{NSw?x31`y2pIbZzvx>5eaLa+VQC|fp#YZ4WX;Yw6;dY?QE4>vuU=B08? z-&g8bmO=CiKb;iIEHzOYCbGC4fHGooV~+de`Hq1N;mrdT=UHoj_E2PJY<}p-(*BcE zdNNf``)B35@!;riJ1n%L+IUGpQ09>{J#a^507rirwsMRJZx3gf*#qs4rO4yGWsMWhwj!@AtF%;TdOJG!O`P3 zLcbPpdX)ua{-vGnj)!a#lmPLntFC;fRm}LS^~K4srpJGu?eAQ{60Y##=^vPSSg@s; zCf~QcwH3wzstF^n)=M`KP2w17B=7PF*>kRQY1K>78-%_AIbidjV&c(I1`9WTw60QK z!@TolcUerZfPt=1*9D1Z8s6F^k0SFpcq@D^8hXW1F54BibDeYH^=%V>J6l)>5ZpdB znHF51unM!GX-@8|TQql{>t-c318UHOJwN0ooA)as^=#=$nqXO`rRe%4lvbq3*VfVk zJ+u7AyXvO;!sJ4>$4viUE9V{#RsP3uG}&=CX54Q>e>B0&+qrw@7eR$dCob{dA{d- zzUO;Bm-p)v(wAS9?5?aSm{+0!;*`D6%KjDSd*(EThEHa~+|Y=E!XtVP(v+h|l?^@_ ziZ+Z=F8D=lF4wfx?t0lf|7=~qX)Q1vt?_;IYNh)_!qa+ykMp;}Bfyy^-hFBp-uR{8 z?tfV7>L?xT_|VQmN4;WyDfEJe9=iFxTuH6%m;)_u0K3s2XJzcH#V0m{+uI^=h*jd5QF z^Fp%tyOYzMY`5==5nfA^v?|OjvC7HarZ7LCU&N-trV?TO8rcIbp#MT!aVsd>>V!X} zTI2z0go^}1?h2z0>5amiy;fipGO1oCy0q*XCAge_L&^tJnP6?!Vbw6Vn_Q*X_`Cy= zF{UbQdAi^3vsP_tLS`9vm4sRLbe#4R@m}-Qu3(wqdke8!`=fOWew>T_tolW9Q!=?q zEq`qBNel5qbc5RJer&(_k}bC$M@7#?XE0D+`|+W~ZX3dhtq<4?rq!;`Cwj&nCMG(tnYAiq-EoK| zy4Rn>t%owz=HzY9E4Cw?_T8?cLjB3P?b0Hf>t#I#puxCUdA1gL#64*k3LBwJnF(`d zm_nqK?PiltxDNQ|1~G$X_&HUd=$;JK2!zyHhPvg8+wpS+?=_QMl!@7FwZ@Nl?L~Ic zo0}ioc+#so9|-3HryIp7gzB`pn79ovlInhuxep~Y^46moHUtE~;rzY;D2QF!&?}U) z_Z7bpW(RVY?Zm`W9&1bnG7rF9k8j{FVvRlQ%&L)R4uWroW`!vJ6lv72F+Hq^D9VADjM~dM~Amr3t_WZ zY5BT=cqod8Mmk~8U}a=6*2K?xiw;vS@35MfVx8Fg{uULz7O569fUF4_Dw4~` z;VasUADuPyqtE&)JLcbcgEGOn{P`SNQ{XSI@CP0|?n z43`68r+5`u-33yY&rlx{?XJnVgAPIhDaok8SZYp z+ef@ke3)`jm6eh!8P1H$_`15ixVjo)3n*2~9W;DQh@vfwApfH7UwdpF!oe1H+kv}6-TxhEz+_#e#rkLwU=M=q3_}GSqe4A#(rEa68YKTq;oX||jBG3utpu7@4mTiht zuI5|ZMEwV7GpXd=G#MLHYN~UjDakBvh3w%rL+Y6i9FZv8VylaD(JiJ3ag8Gl((1Z5 z^?E&mEdm>Q%k1?Wj{#MLN_M6fTGu_TSWaDiMlMSwU}jc>`ksQ;xY(C%rBnv!%f{LP zK{rS;Nh3MUOEE`(uVv^&2g>ZqhMJEw30@g!F$e?{$3E*%>U)1*9wT(m@J^14gT))b zbt0Ir6_+jxW2BB&3$xRo=FhjE089E8rWHq&Cefc<8FJcyre3|UwmoV*q6_A=Ndn1! zSoK*#EU4bLkQKSSsrbx@|Jxh6rb2Dd9KN{yNzT^OYv_F)3W*Uwq&a%nZ1eTX4{`95;KYBNhWOf| zsUe@P0)YUNsH$nJ652N03f~1J2faq?{`M^XxkwMnM~YE|3Byen>o`MD-*?P*OGqb; zYug^@&%H>TeUK1sc_ES-10<#M>M@fdlWN`4z>E*MrORBhi-XVSV1&Uf8D*`Yv!07U zV-}dGN)}OS?I2Lc=F4)!N)^gN4?{hGLg_*R_U-9rbKgsEtAFFAT;A~ti5H5PCTfw? zhRBy~d7TO~WLM41ZRe`B!)BF$GAJ*`u1kv|X7FIc^{xjwK9h)#)(i_v8N>Kn%+Bnl~~zVn3c;omq0mweK=U%pFP}ktUrJ@#9D4qOD(Eseh@X3m5bO%I2`tEq4vN zLK0#VeAt{s7awiCz610TZGbx$h=W@Rhv|_sec2w?SHjKm{UDDR@Df1{wvmtzM5lZ3PKdo2 zl9(2nn{U5%Rx>mgru;Hy=wN`VO{I~;9|qy~G-2f4@s_A*%#V4r$VJg|1*KDNZJF-_ zX;bia2buB&QO=bJk@>lwTC4al9oz`S1%l1=(HaS{o5J0X_bNE6KI4Or<1pWfLH(P1 zPCA0se(&v{FC^=PD0VyK6PC$UfEzd<`%xgo@%5~G9n-^NG_Zb*F z3TJxB7wa-7seLK{3a5;YDuJlj422!fljw*Pg~U8CIX#*G-a+sKuSW0a^L?Qnx6{{P z&rm|wtj7ry^!z?W)1<} zhYu1S7rZ~tdlagpy#u`ihRG5G*Ic;iZMPa z&L2(^n2&l~W@2~XVc-ZA-6Xt&aRU1|Afc})sIRK`Z9G6f92B1>-7)yT(hui!r75ULk)lWuk){ZOu8X)2Q)F@a{!I*1ODKByy-0dBN)G676V){M#I!$>PRF4rjAB{ z>o#O6Ihgi8TH$v-%qN&lV=@2fI~=Kw;`fOEg-;0C_n)g_Y%7!pCcsh6o*0PX5Y+I# zhM;x+Jt5pcpMUQ0WwCq%{#-@iz})?3lE5vr|4a+hi)ZM;Bbx`|hz@8At58Q2oX&3q zfkWAcczL5)NMlPRoJX*-^uh47Kqq~D=?EV!3kK81#yKPeZA_#YhUl2loUMtzRPZ(2 zJcMNx!bKXI`2~5|(peO9YjBmqJD_RgXiH*Kf_T=fFro>^Dnv^QZHg!1e25lAA`cZD zXl3Q+?L;sJca!k;UUr72h8VWF1t-XaWp8BegACK5S=m|{Q>-0K?8t#Io}s^ygBQn+ zW=*m&BjV_Gnlw|pU^9nM7|hH*fI?vfFz7gEBm+YVvkOMxop@HEL0FWg4QSpUZ|;mB zX<0BaSQf*<$Qe)J(3v(Qt6=j`x;f8_>F+@E!&@7Zy>QOf&b~Zb@Q8T;-jd=6J{g6C zI`OQ{+5S#gC#;FDkq_RUWESRRk0RUqY1`8SoUE)-UeyE|J9uGjYI^EUd$wthjb`QyVyg&4RPg zEMo>jlj&>1CRq^e%xUHXb915>oNi~qHna=#vo+HS4x)wGpz%mH8#JS1>gUD6a7}Hr z{jpxQ_HeGhksS`E#d0R&nL0GOIm2Ar%$$sMVp?dK`cjQUZ2Y)^CS0Bt!VeQ}YyvtC z+Aw1?!h`Xq0Sfe$!~+{Yh)9HoID_NlOyto`%;6L~ z+n%LGGp5oRBr_fGgfYh4$Jm_9@*^5~v#iWa{euWbcyJvJr<>DpcFy3~8JiPG2%3#G zl|(bN3$_WN7}IP>7EBv1n@c5;P3*8Xp@uZ3DbAS<^C5@9DKH+-j>&N_H*vPnX4{6C zn}u*X{j`JlC^6k<5fisGnc?Bs|>1_Z$E z*r7-#ZC`5(Z+r7_f6xniM`Lq3m4I@_1`_f1Izhgcwq);MCfS08pqgmwpkO#hZ-k+b z9h^+ou_pN11n4j=SqM@nhpugC5=^jjLO7!lHgvCWGi^gG+t4R~;_t{tGT2C5m^}*X zi!dS>_^AjGs2BnJUou7WdZZ25iky54V^3qnxdrc=c+f37& zOdwJ0;dlarOQ9n|7#KsYy%*Xp$cbed%r#-b&^Gj7mJfks$m3YD>>UU?IwZ6?A(X)b zyTH!a){w-Y1anNdXn&R+&YR~%bEcqpT!xJa-j^M!#bz36A%d)|ytzTVpa9_m^)F&20?r z$xq^$Uq(}935#?M?7CcQj==!;Atb4!+<-vkk#RaBPT$C7S}bVp)<=_^^;rdN>De zY7K0-5!@0CFbn}>6WGoSV1i5PRH1BB@O99Svdah^E`x zg(01Ny@=k1#$F639g{#V%*(>d7-oVp_X>qs^4nnHP&PJ>*52MmJc60Iu`fwGi0rGw z3D-neYf*HJxt4I>Fz~BLmZ7CD5j@}>hBIV&!vhU?LQrgNeGSpJSUA!V7akfG>P&|lhiaRIg7aWw!S*GS zyu2I{G*c2*hh=Hy3oJ7t$k507kAZ`kTCzfrCSMvaz?a$HFPpAn>mjlcVEhhXRXdjAc9encJh$&R&SXApX|Sw)J5l;dHj9Bga43 z5nP~zvMilQ;U?6OpfDRtbSVEGgca6KC!FJ}#SNkv+4=-In}vsZYqB|h_C%(pkpt78 z8EQjt=HN6*R&+x@yq&gHDBRS@9;Iyudc(KX;041|tSD5XIW3S5CmT{MjcmLP%~&MU zU_22E_tNp#^asW+JQQijw6qQ5f(PJ4KMEZDbujdE3JAxCfR+dh4idq|hgiZjX@NxG z2aL?Z?ZEX=62exKN~19B+2Ia440Zq!#iU!96G<>1g1LP#&c`^^Lerj((&ADOfj&;w zR2Bn?C)hbqoXz1RtTvT{K{{|bY)+_-DNU0>MKQf?&4TfMmKbB0Zx|^I<3zRygPYFoll&QYxHp@>J{CA_N4z1^fn&uWnTLm1TG$yoQ|yRvoTZZ!Gk|TQ!-gZgEYaRp z+yE__Eraasge4gx&2%i-)Nm^z!=B`fCQ%vqP@ENls;%XRM%de6wSk{9B9lXC2un0M z7)D|vn9deRlsCegVTJZ1bN%TKEGG&XG!>#MCw$4QdovcmGtcvbnlXl!Pa?3B0Pp}-nZg=0_wiI_$S%PMFS2};Kd%1jV ztbggu{Bky0irh4`KR@J+O z4^M3ugo^)pDbpZP%YB2%SWiyOF5Y<^6H7 zDP<4+VcEw`2+oY>e2;H#`d)orTDM2khn3l;ebm9@KecY)&uYs=9J(M(z?lptoe+-y z^NJyQetvl=FX&SvbuzzHd$W`};UHw~_jFXIqD4lUHlsIfyNdn$&@42RGn($3Q4uSI35|1iB-qtf%p+6vp|Y1mYaBZWs`kG4Mc z`d&I1X&zsr?pBd@J2$e|HSqcR(Hm!vXcki2G=F?~i(pmG8ovxO6UxKhT#q#n`sY=v z_=xgCVp6a_YVG$_u5C_Di~7@6y~UwZ)Y=%4(W|GnYEDmW2qZrp&{gY2{Njs?HudXdD+cvJc^CoWn*nzpahc|vLp#yl{gFr1?_%^=7JG|)fjpSJP{kir|CzgZ z1B!6v(r6~N`uBqQK}h(APzQEB6z^ylhnoIc*g=emxsYIheYe9UfE?E2BQ?3JUOblb z=E&mEx~^-OjVcd2MMOxsM?MUFp6`3yv^R4`lUHp%mS%irx6iMi)2z|7m{I%X0mR4zuU*dmp3Y4dY^ZSoget4ae;iXT3Ow^J->XF6(?k&C}^;eWR}*w~C_rJ==9YZ9(|F+=hr;S*%Z8+^XSv zFEy|N9nGw}o03p_F?{fNxIQxZaq#DtCGwoy;|q_`(Zcl$Q+?8jCe7Ion)gF&+!(*y z|FavhvLO&ow{i)8pS7M4Tt_Hne%OKzYs*BTbiY2rcpW2JLM0kbjV9NoOg~$0=e?|a z`~2xtNoL!ULI`2;%CQ>%xA%IYO8wuy)LVG(oxn(qLs6PjFUpa7i;sbmGzs^9U@NP8 ze>{!annqqfQN8*@!=~8ZZoZ3jwCC+&=BIDH#rJpV1YQ+gw%*=<-$6sVF;5~x&sZpAZ5aKpbgGF4L0=-S48$7XnaoW`NiC3l<`dFxKlo9{! zd%Et~-EWPRa`$t2#!*SEURzz(L`U21{Q0$~YtzwS$csJLJM!CX()FV63Qt7*-JgQc zcpX8#t1+jl20Cmpm;b*eDBhr6MAfb0&FNUNqboB-_(RY%?L%tHe^*)-(tt6Lf5d6O zm4f}d6b3?_in9N|wEYvquT1Hi!m98Fa63 zr+SM^tT`X+6GoFXo;|X-MA8`+(pA`qU~cR6BOZTw@OIkSqpR<=@8wPJGxqjRxe%t& zDni%}YubL%RA>Xvx)1u-|1?Vrj()sF(>%T~{=*?h_@ZR z;}5<&y1Mv@u~tQG%jmhR5npiE=60_(yhCrEFpwhGbDD;)eu3yOIbncDU-N~k~-{BLf_;xa41^djmeK~YCnYaF-FTir4)MU2wxE1a`JkK+~0+= z6o=f+b9AZV6=xqlbN3_f`#3pvA0kS&2v)!COiudNZ{Xmxx1`PXTjU-&Ud2FM+9R)? zUhYK560WDe2vBTweKL`k*}Ka^yudI6>zRryR{OhsqAMj#4nTU)Mw>Kb_oC<4(mbvl zJFG`*-Ar)bvsb$^+6rDROmQXY&BmblW*>MM|G1^IQ7d(XOzr&EH|+9c4|$jr&)MPc z{<(Tps1q8^G!U*qvq#@wPaVsR8X%;>p2Mbg+dS6?9%l3n;0KcTbPS)CX6|f${J^EO z9j5VUP~uaDz)9S*s(JvP2amLLxkPV7DXuYWKUz9|vi zy1DgO?TC=I?8&xl-R>RHsXy`14eO=0#SDq|d!7>gs=03CR-{cH;c=`~%mwyiLNMe* zv{)lg zzBk(W5#IXt+3y7xOmyPlJ%<8jl6_@~=W|G1?k)t?aeDv2kweimJB+z>3cKft&jyy~ z+Ujpc1Hw!Df8PeF4v^2>ZgGxVMaaRzY5ZPpy}ei$b^W!%UiP(T>-K#X{@tlf z{rdhfb!qN%3CR-#FKt85Pg%UZXE)E2Sv}KLAYO25aNHx_^1%0}UJaWH-`cyR-$*(9 zvOl!jE&7M%MPb$PyYJfn9X?hT0dad8R(ulX2liyfof4(Ldr}r6C{YFi7Dg!hl_GQ} z62$9&_ke+rmw|yiY=e?1X4~HrEFOJT#6)O=g>9eYe=qG6PZdsnZrUl1`x}^GW&I#v z1ti}t{Esed03oG!;CUqW@2(Yu3TK?adcMLI>;Lysyr5u0&Caa-qE`Ry$4Owz{$JPr ziQ&Qf|C_b{JNFv9e;|1m;!j{Uz#ZFTbIWWyyGC$h+GIiX0Fv4Np1H(#GjaPO%kH|C z2YZo<{oiW(<{mF8|N5lm<<}~Jn5f^!Uyp(iSWEX?nRohh4(Fo?d#bp*cUt>Hh)q{T zC>;^-9#%N{@M*?i)Y^xDqSwZJ14E756Q*3aclqeoM|G_mqyrueoO_Z(_hBwS2y=EQbi0Ab*KJHI_z_*p}el#=o4K*V%92yQ!* zWzd~6;r&4i^T4gwAp_pO%8L9oF^tSJhDV#x2Tn-fskV$@!4=)T;K8I zAS9#Cx1kCwg?|0qCl|9j@n46L0XowqWEbD?rMrNo{%p}pWv=oa2=?ad#EzyVNGd6A zk5=s~raN?9HC%@X95Q(N1+>dlB;^EDCE{g*V$zRBMS5M}Y$xgeuzjjg03z|1GVE4( z9sm^*(Xl$iy>WkWp9!#i*u??20>{U-r`@ZUMx|A1D;H`vYotk%^j;tP@z%i zR4=JWfB{_b_&Px&^C0H8#>tnTLj<;~p--^XoYPkk0i zZpPgp{{t`M4Yq<2u}?^i+yl{QblWl?GrsFnmFw02+23`VA+qsPj{+qrANbcd51hJq z0uc*eX-D}n1PwqL(OnK8P63;yvGVsq-)M^NHyDW0)3-;(WT1K|7am}*9#uMbM%-O- z%~J8N#TOR?rWuMR@nKsJHIvZ_;?*s&dm~9h{79;LeoRPWL4R#!zO6QPvt)z($Ob-A z5;=z_%EsOUFtQ4NMP}IB@WyJQy9*E(As6T@J^F#QRUGnRd_?ThpH-1>8Zx_-p zb?ImI8l$d}(N|KO?^gmS0c@^8l!gIs^LcMa_uQH*?z|U8ey`;{{EFQEI>l%KzRwl5 z$&~o7&n@Ho+?MoCo&Vu;4Zvgw*1pO6A3j$dY_3nic}U{lwt)9Y1wQu#>_+8XAC=1) z(^0OB&AKH6{&bs&%&8lCu4gR%J@_5q;rT5(t!>qM(>Mg<-Hp+yC02&T{Q&<%EZd%) z^H-L9rkpYJY3njekW*sQl!e~oxv;pq$N$Tn@Z$%e@uh*!=Y95Nl7G6h?2i|A+J30K zm#vZ(hH$^JQ7)enxwwii92{tCJ>kBtjheX{e&}%ezsG%6GF4dh30p7X+h*#}j3D*t zlz$&>yz{ZfGe@7*#UJ79E}!r;p6-EMGxh8#zyHGhMgH`3l$)VDxzlZMDUYa!cU=k| z_IM?!S*uUGok%y1{59)~@NdRYGk5!pski%KoE`ri_YN>_@1P88vEUB{bc?1VO&MzU z9T0rb|7H7m)!7Cqk2GhOx7y+EY!CZM`hmYw8~vXjy%%^hJmu-zO5`-!CgLfBefWCE zWi?b4=~<1;z+7`y$&E|@uGw`9FhRXzO8KvUFD$c0XP9bj-=0o053vaA0~d@RHxI79 zuSu?=c`Zo4&X|NcKA|MgUR{k|>aJe(NjdyQdHFXWml#_QkIU+MAR4n;F{ih{0eNWg zAU8mNx-m{{A9L(j-r^WAwweIcXx%VAqX}>g{Ox@Q(n##;>hg5n@#TflyiDek`+Ru% zt-$6sakNFF8u@$qCki}OvGk+cW9ryj1$;`;yk#l9yS?4J>b0@-fv||rmmD&>h`JWO zPJgCNc9cJ7k&s=h^93E63VSOW0;;`XRcl9F%bJsS9Ucg%o=U+PDD935{Brm9AA&3^ zq|pXRz4dAu%B30fyYsRA$IdwJf#iUU@XvV?r3@*I5TyJm0u5KNz{(Rz&M+bPauLH~I=Arlsaw1OtaK7a+)#->BM$ zz$$Eb%mM4yH`~u0%cgd_g=-a5Ejah$j9*{PxBAB*-vn41w#N+WF?#tmrcHXf+TZ`} zro5}(pA$7&ow6e`6`WVQy$`gUsX4iR^8-sv$eBI5@A$}wIrF4Ny-@xu;I&HDnl{Hd zr1lf^SfBI9_OuCZl=0M$5|!32+BeU7r@Jy!*9MHccOEf2!*Qi@zP&J~7EqrqR;3`4 zM}&-9+LQ6rDCE)Dx&rF{OGp)dN)|9p#oNR{={$4pFDzbqb zpNd(~ug&Uz=pvq}GQqIDZ{Nn7*m`8qQ<|qgl8R|vS(;b7@F_*Noww#(5|Hj$)a@RT zo{sQ!4ssmexnI?yze57!UUVI*alLQ!IxeXd7+oJGARV9ToGb{Pd^h?+DHoZ^thoC_ zLUSv27|e4k5g4`s?k~PQ1FR=?0FaR9kHq~$D=XUrTZ9Xwc08L4DO@sz`#ZPDRoASe^dZ`ngx2S*sDPeE6hI+Vu=~sY5nRUe@yS)O|zITyOfOSlfBk0lJsk$6YQ94`AUrqM+*Z54|9Bw0T z3*VgUAJ1Yjg(4MPkAEv4%K#KHdiE_Ci)$l&r@Gse+dp$E1$tZlDyg~RNQ9dFu4>qE+u`oQ*pn2EIe82&(U&o<4s+69*x+6xUYH3)@OTamxpEA%qo7N-bf&l@~>Id(_%;zfZ!j%^zs z^j=FC3yShMzIm}LRZ841u;!W5 z&)gVax_jETNY4yzvT~yFz3JDbE5gVyA|o-yk5mkhe_v0i>skxI1nu_uHVy3ronu#2 zf2P|TpVga-*XI_QQ~+9n;T=N#crBctk?@bWYklH#{*#}%j6b`3C7Ue*C(_`L%8r>uc`y`{4uJ+mEC!EGR;DNu&z5iaWaQsHU$> zjb3Zo3+sD3FkssgBFSfSb?*!9g)$T4tBcp1=^$y< zuYJevCK=r8k=F93_!eF}F7aC>z2Mi29HliKdl5K0)1>YB%u|k>+-rWz~ z+5q9|*;H?vY&+2P?ZvL;vhnLlUl*Vywx3$CviHE|y1}DDc6Ns!J?5K}{yT;n^o>oO zm?O1j|V?4gqlh0h&mA6D5Z9a9jIQIp%2FhQAVp(WeZF?5R!z_7X696o} zmo+??1IOkqmOB%DMQ@-+`JNrb$_}IZ;nG{X_5(l|^>p_P>SU@@P@2TK$SlB|yS$WK z26i*^#Ra8IX=a%my!g7y3l+!*-|t;|qiNn>-<*lJ-C`J@+E2M)(fYNgFki|>5n^=! z?Ao`88$k&MCSU-YH$QuWyPCTIxbFbvu$9Hx$!uXBQ&Uu7K(9cqM0iPlMR>b{aymY9 zsp8;8?@WN?;(oM4-AA8N8t1BbKQ!a^^6t>O^3Lqiq{R2Is(*jI4)Q6vh#wyT9t&8G z_-Kj^kf+eZNgC~EkNj%pDf!5Y8b3#ARGfQ)}u!=2Ow)r%M-VAwE>-8;>83b zQ(?<*5Zz5V>RW-Gn_GET=u48GyH$>Ed+(GYgQ2!Ox8Y3Oy3(6(fos5ZHyVezc^SqrMmhr=1QjHm^JXo&!6H~R-|S?I1!DBqD$s}s)&x+AOS2EU?4 zU*wg=$Qac=YArj(Sp?>bHfF07*AYvfojcbTmpZe%Pxi{$AMk~wtNY)W9|^_f)PPCt zNevxq&(0SQ>B91ZwRadDVB%}tZJ|BV*Ft0Z0PG8RosxN6*$rwk?VML$e<}j_(_W)J z!RqBi@owL&pwj@4TTn^oeSo2Wv8m1&p+vszA(INQLs9on%?b=x&HqH>URmiG?UnUX zO@|H~uuVpZ-*^;LUUo&*$&1f&4)7+`bQ$u-X+MD%@zB^$u-e4-L$L<*9&au&KPN0V zPLU4;5N@@J{nOiE5 z7v=Td@$q3Fvwm>p96?Z^CUIW4b?P2?JCplvNAz_CkdJhns=b>zsEjv&faQvjLpDU{2eWTnJSlzOH0vdP`CCqL+jh)7bYGPfwX z$L10kO$h%t%9#pFHS5G2&t)eF%N#jY=2S>MlRu;00Wka1dtNFK^lVwITZdwQ{a8)} z^LpYI)qdMWsD^V<^E2Gn;%@gmkiSeoy=Ef+Y5@+x2aFf1BcATRmR73&^4F)!&E{JD zudZPj5>M#IYx-0Y+A7bS@8_d=rH4C=w)G!d3i|lach^7~m;QOm+`i(^X8UIDCKP;j zH1eBKY|4?7$up|!<=q8MCZ+0S(B$u5Ff+rkpWNH^bA4<1U}9Nl&Q*3>e^o?yrcFtk zc3&EZ;%NFBvP&lc2UO+OL?1jhe*xyI`%$#wYOUBX4pkEr;$eI2Sag%=J zM@qZ_(=*0E{BfFtkbG*3WcUNT@G0p_gg;{zy;vcvs>+zk7Z>6vO6J@qm&`xt{Ic;{ zB*;JARD(dz^ZAV9mmT&)07dZINo^CfdHAWjHQ;$J_V6b28Mk&==>N8J8j%v;Jv2>W zDcH)*j+$`fh^K{b>I=$=9UABKofl5-+LheycmSMdb#SO#Tq0VI3I=P^GCv)<-=hFU zAF4bkVAd_U_)?|dy{lEQu^U;e?-z(eMLT%Ckb^Q=eM_pFpz({>4kh2yd^u0sZFWn1 zz+i3VcG<`Tgk)5(W<=4S)AqAE@e>Aqwtn5q5aW@jmfMw}J8vU)WB8kGh@SUBp;=vWivEHlCTHJWlZm4E=Qm6apeD?a!-^;ItBPLdVR|?;h+DHe9Fq(N zRK<^Q1YZn)sx_!Qm-=$Okrc054de_j&ngHkVbU%x9eCj+TM!dzJR&#al+~JG@Js$& zOlzhjW4kMH2pAU@+a>EpfSRjlTmotL{M|&9*1y8%Xd-cBI;)ccz^bS zLCx`n9^aC);tA#3PRNA4CzpH>AX^m-i|l{X5*|sC<(?|LXDZuxW2X{ZKDAVlXFuB% zTg6SXCVFPIQ_H+Bf%T6{sHvTMHvkxpRs2{VTv0Zn01o5!)4Y5or{kdBnME;S;I zpBx%^M&XK7Hpl>ExR8G;j_lg10@;PIYah|JmOB95d8KgY86c+Ev7qd4=}oUHI3O2Hc@>|(B*wO5XWnmDHKC9PcRecz{X=!?`D4WHe#XB6DZtq9#Go)8-d& zC6BC&a=*knuV%co%}ZCPuDq^&AQlao!U>&J5_f^_)Z4@Wc@_bFLseUWP5WfA4=p3$ zjv0qb1!^idWHdGi>vd91#JrApJRr(UZj*==oNJ==NLK3(A@|JN8^7^O_nD9<2;Sp86mu zxnn4{L7}Cx#&*4AwgTmB_hpm4g$>Oo`B920iD4n+MdHT@w=Kb2rRlmaZ|`5p)|9-l zQ(VxbeP8UU_GYpDsMO2e1e>wkcMl)kP#>s*+ej^?-(2|a8f6I2gXM>+u4DCc~p3N@AwprX!Q{>NZ{@N2&W& z^t}pRQ?M+Ow_I9Z(TbDR1xwiz)DotaP!sUtR`uQn+1pvciK6I_qLsiyeJ#4a?fB3S zwlQABsD>i|l|I%K;?rtyU~`IqoaeoK5s5xl0KfC@8^QX1&TbzV&o|5MA=jP0RakcUMQRNoXMHhq6EP=R`o81$9j5?!6a^3n zjaz;`Y^V}SG!r^hZ6H-DJVKOZ%Fn!WVQICdTV$T4>`jMxvNbxiF_!^ow* zfi;4Y3~3Gc_7U5R0=K8{0*c?-mu!Sf+UrDoOi=pTN-5eczx^5@GZt>09JpxpTL8ySG*qq+6XJy=f$SOK4{5>4XrsmmvUTU`k2r71<^*6=kn-AYA-qqTqy>snuYA76qEwKmp>i=v zkIbo&P|kaDTspfQt@K(Ve)LV8OmKX<9{0)bEOcJB+}vVHh-AUJlPA*-{4#LAQChJC za$b+PZ(DWUZWFT!Vz-A{n%sqU9IC!L#y(h$u236@MO0DMN1CH zg?*v1>*_`7&5_J9lu_xo`vuSZZ)XBa3Yg-KGh@IwYx5O(ZZXD1t)!QtCwzc&+LyWZ zG2ftdsb;QHkQa7N@{^QOq}-(!YxBjb%I_C)qgKmvUMa+2HYWg1(b!!`-u6S*823n3 zZ>4aI*$@bUiw26XJ`AtldCehsT^BT(&pbgKqr^Cgeetpqj6JrIyVyV2Hm zwMojf640Q9v++RAyUfc|fTl=QF^c#rVe7 zt;si7gU=T7_HHD}UfbVzP%_#}2?p|NF0f&-L25+*%~L~<@4J*To#n+lKJ4<%BF_uJ zK~QjeA9n=0j7CSa`^mNg-+nb5-#-?#6*jqL(nj{A^36R~ZxRj83no?xtAY()B6a88 z=D3=UqiX?G9L{Gy+zFGq3>1s0@?1P_=h5KvQMtS?2c@m|R}0le;5p}hWWUbb^w@BH z`us}ybQyH!)Y#N3-RcAGhp=`RC8F!l3QK(|V;7z=v(~k$tY+Ow=INx-Z-TIM>C{cN zBm=DQmfgta#FDGm6|hvm1$+tixV|#%c^%U~`Jw7KP&sL9)(>)K?!W^Zs4?87l)R7a ztMj>Q?`hv=j_^Eq>A|UHo}*c#OGd*h$!fV9Y1NrM` zwg#)Urz4cw&e0xU6;6$}D3)89U0G_deZ&5?a~~HwC$u3H=cj9>I0MM-o_nsH#9*z? z=kNFCG|aVXKs>mgxA*B}Ie9L&S&0&quOyP^)*t*O+bz~1`%_YnH&7&d-B=ILCu%*8 zl&>B8HE}x+@Zn+708&1-lH2X1uqC_c_4eE$ZU~NEzBfvI5*)D{5U(Yqx{4dj2tW_* z&r(iO5*%pEnk_NCwA0Sz;_UnmldW-uQzd=v6>B2X=Ubw$)^S`EdUTwm*XhM@R+`si z1BY-jMM=H5E`WkH)@9;4RJGU8rxn1l#iB{RVkY~94~cg zz3Uc0mnPYYgkMxo(@BoiJG$j@f{5hCF2^N$Md5V=p`W@ZQxvmDzMmUUipa^a z90~LUlGgL0+q>+Au9?^sRO@dcdz2(C=T6T^Xo?)p(Mg6O`wX^8*pFIBK@&@1xr$In z_y?VM19#08ME1yh#_JNCYygCCzi~7Au1vc7auNHQ!Ko0K6H~|w*t>HcsnTBgYLF!m z11dw)22}_yQqe2ovZWc%j)l;a3p#ScJ7P|}P#W=ZgTT_*pwGe^K1&I);eIN!d`dP7 zYO;LoD%CQ6%=}yiz$kuQE2RA|QtehND z7iJuc1VP~e$fxkP{`K;fmj%%Mob`8K-4au=tG+p4`KW2L1a5!6bFnqlq(+Kp6>pHH zTrE4Kg2_x01yRvrl0mS;1WHjd+FHrL{E9~PN+FIWI>zw-LNks7NMVw z;GI2p1ADtxi0LW06{qF!{&vl+9O{515{RG~zBp~LYnHIzp_-#i{`2m;{ti1Ga&_> z&!184f1Q=NPd+u>eO$kBaN_i-^n;BS^NmT0+!)Sp*KsMR$>hD$qSC!bHJ&YA&*!LW zCL6(r@0|*@P3q*f@Y$LfT`Em|PTfXt?25@Bw2?O*ucgR&? z1LbMykW_c-i0G3_l+p~S6F`Cd(=*ZK3NNSwUvWbq9-(21 zg>|U=J-^&La{N~sh$b`P-i`0Mw`W&}4`u;%0}XI<*3iXXdO?rVmLsc+-hJJCD7>dZ ziBGl;j{?yGKg|?(2O}Q66EO41!=_!SxEgalVF)$JH3&E*stp4nbFq5`G5c^&M{~!G z;+DnPPx+n-w^^^Q8irLIQcYJ%?Eng3PG8t406?xJp*ejcNilCt=ps-q^{&Qh@-yVh z`$3CN`~5v9MI8n8nqnUP-mbH(=Ry>|rynf3kbps6o!9X#Bo zPl&%Qn%N184ETI_fXZ2Gc!EJfjdl6E&@7NUdJZOe%Vpnkm%4TFIv`HR2dIcRtqRM4 zEI8ooQ{dmjRMxA6LOGz=B%`qXaEooev)07KsNzpht8y#!;Ly1`nt#tq zP#8#+X7Ce>sny|p(oXReXZkXrZb5Pu*%y#OeFX+ujUGC&uCsUFX84f|dliXPZB4#- zTwEM1$O(hI-Ys%3LFGity0lHU0)y4_?Ybq|O+X>+Eb(IDmOA9V?Om^e-NF8|k60x= zRG){}30PT%yPwRN(nz326@f1Hvpafh*YP&l7r1|TMoDcqoUR6yH@oxBNy9u(q@&q+ z+4?}&e8lwW=OnDBz)>E6NgvGI zgg$12ST9sPaRfBF(m)o{bNMfjdCCZAOx{HWfQj09(=-q00;oXp zlOVN~x_emH{Z}Wv5#Qy%dKsL}cmp|bdUl*x;8zmuBcl2PF@g(uZUzGH^wL-r6M5G+ zS_8IOvh`RsCsC=X-W0&M6A*oK}*?))n0$+M82G#oONSJ@(XFK)I` zZ)xO0Y!5j;0>maqoN;>#DCnSx$i{22RRLV|@o#KB+N#f;ol0t+KsAO=ssYyay%Ux% z`H0B7qUJ(f7>HoagYDnj0TKk6Wf0=g-yzF;2AV@uB}qPq`?@swNy=2dqX{wn{HP!3 z!u&>C)4j*!E^R+8AT|LM@)@z4rFKx` zTdsl1kIU=jRh3CYfJbNY%SAFb#t$#)&NVAAu1V!a0ij-kiU3P)(C4EFp)~M7eGB2~ z4sh6w!1}J&xtkgAB!S^^{Yy2ZW_8UCCh7ppuw?Dkz=(G_n=FPv%|t0~7iS&3V37?$ z*qr+;wlNpv3AIPQW|Wh%bY9yF&WD2nfmTrR*MhOaF)9qlxdBY8Tf6{Uhz z-79P&G%9#6{6aib@qWj5xr<}uOZB6(!p}YI`-S+bM+{v`X%$G^>_<-&LY*R^eDXHU zhKO!x&C%~0-Dxe#FBNft6EZe#ueDYBv}?Z}zaZ?kTY660V&Zc0mvP|6HsJsVC2%wJ zf`-7z{-@$U1Iwg%1>4rddAAG{({DxW5ho7tgH%OujC?%?VAh*KC5uml(AHg=_0Jqb zrUyQZW<8k#mc2EL_vP*=0PRJWYC*LC+*bHDeIiBU!xRn8H<2b+3`TIWBCAL*w`a$= z>9kA2zh6Be0~Pq`+Rca7iPXK4sMmE7O6cn^D>sZdlezft={NrkTV?#}wD~H~3E)t@ zpab70L{D4M#e4KLm)#-7Kh^_Xe#JO=)HkpBD^|6hn3KMyC7#` z0(L{#Rv&<7r{qBMIx#&@4WzoPsta`db4A@&-S<;Skd9L6Pahb`7RFwL&(}z^D#@{` zkmRVR{k8nW_Dr1R&O)h~PeaSa^zPo-6cB7BQtCBv2RZ822?mvWIELa;BL-*o>i4c% z@~P~Eng{LA>^Ef^Vt~7G7f1T0JQdzweTOe~(n;H$ly#e55vT)CR*rcN+^pZ= z1NX?K&qDi3_1-?_n7}Ku?_!7e9=TiWVNBVbkde5?lFuToD;x8)YL&$QuxqhV8?;V( z$qsFgmJy?E=LquQv@U|QyfDQ;ZoM|Hg&pLpLK<>Cgr3N>Z#}&Km59M*bhKlB*8O$bUEz^4Nhqz_NnxYNtV){bZlsAkY<}>{yLf@-edkmjCo^YZ5g-%kR+l znZ;|X*<<&k)>iXC{oK2*SgE8HK_R&p{XttdM(9U_QnQEI?TKMKi|*Ix9_GuRfy$~c z^7N;s;uOFz3uzWU2ZHHrq*7|?9B|)^x(QIGc;$2JMaS>BOl?L++tZ6mu=#yy?}T#= z-r(%tG)b-QdLx_|Eg+xjdeo@;A$>#p`g&=bdzxKae~0`o37N3&DrftufTRmgqFpxU z$I-Qw!fQ^eAQwnKdI7Azw)_lGy%c7zr3;>X(HFFbZ8d9b*e?CetK0Q*mX2!^=aFOF zD@DX1j_A2lzGu?)&Tl`>xgx5f^hyOH!bZFUvaPmJk&l9IPbjA8-o2ngPjr6U6(tCi zyW$9{O6RfLM}nI6_(nN;9Gi_*J8vlTk=wAYc|m#8FdqLn9_u-J6qXM?5*>iufyRF; zt%ZICb*I|XX_fn1V{nv)mT7A#N_7sQVwZc|E>mFE|BaF69gAI~E={($*eBqhs`--mc;!Yv&ZoKnoDVBfs11uDmilzS2fQK%4kql6c5^ddUoo{ z5y_U2W9b1dEr|xU!oVBtlB(VpNy5%Ie;O;VL-f#ZhC`=5-cofU4rOT3Tc2;-7odDc zwZOvGb|*GS28^|)E@I62a>S4#B| zlCWPX7qR zT<|baxyYAgJv=FV?DvoE7FUDsdyG`cv0FDb4c8{r?femVrq1c*+D=5())`f#|C?ss zz=YMy-_chzd~c?|N=b~Q8an2E+U%7J3d4Xns+1(V+!$@RKj}JAX}~1BR?yH)Vym>? z9QIx_w`t`#WJ0Q$oi%uK@_^&`r^Mw|FM!!MxuBK;+q25z>h%4=`8Zs&u02UUM_7JC zQMSA)&NljyhI`2Bz8D|GGuegvj6Xt8tf$~Z!4D&w1<)_l>-A;6S@qE$b_WUwXMYu$LbPP!ehaWt%(;(pOiNk9gbfSK|h4u~`K;rWTs8ry`TwCm|pN0z^OOTI}znZW~ z;PSuP`^vYb+y8ICA)_~Hl(3+?q#QlE5ebDMC7>Xw3YmXFcB#gk&=?mA*JG1 zBt&2XL@y*&K*amA%lr2|?!VxE^gE6{*ujI1ou4z_?^m5e3ph%8%L4(E+>1{(0!*fw zQ@?+mX-%J#790KVx~J8TMEy5u`VwWg0j*8oOQt6&0e1~6?E&9%kS#J;Q_`aV%n5!{ z>T_4TS9nZ~KQB-H?{@yY`MJoMSOl{Yf_};Z+g&J<4^xs*SSm_)Cat&1xiA>ZG6Wc! z-w^esL?Ej@;0c*kxo$pSqs0|zz3L4W*u`$5(^;!A30YzKN!1`7e~gT55Q9C;)n3#i zz(Ys-$PiK%D|F{7(4aqBNZ$dHvuLE^rI z2H?$byQoIG((V4_n0y!j$hty&{@k&&QXFCvaU(bOL-mi9p<2_-uPloH?(oiY&Y2my z4?sAD3_#o)2rwu#Iq{40z4?CQg2VeEJbtA>9hdTs7?bgwr^Ve7ne_!-ML;PRAD2XI zrbv?N&;RE&LxOp2qM8hQk$YT^FEB(Ak-$OpEjrwu?8N9NPnkgZKUPd9jv z^tL=^uQZLbuwE;p4(S6Tl)wM|+pe$(>LF6;#uvv+HM5nL1+|fVJmFiNdl{wITxiT8 zB;Jurxkr)PLA4-6AxR_4D;xOo)kcAr3WuzIr8n|}6l7)5^wDkEdWN4gTsOG>Qf?MM zU%kopGm0Y>@vg4q&PR@l7kns+B+pL{ZJ%xdWKsRU#piW5Nm9aao@1jZA9nH$aa4;}7+il3oIw;x`O;4uQtadlEQ~-8i0>edW9RZ!*CI zz*O>>k@Jw*G!Y$eeym3zKcj{R_h4Au!wL5+UJ{*FIkmVJuzzo#n-O6(iL2)#{QwFE zoekYb|31QmQnO8|A0XY|`{$*2(p;Vul=p8V zlg)+H16`bo4Tu?lO~}a_A=O?F4h~b+1#B!WM@0$w04+9$#eFb_x%=$Nw!t|ym*NJy z50zE;*rt4dbBD|O%WPA%eCs;U;V#bK<~XI`RW&R#MFUcPp{nUd#MhD0QQ^BS^UKTQ zLZb4~G}`yBb{9!g0;IA|{9c%IjpnI+NijVex-wYXcIdn^^06({I~>?lPB-cViA93| zSV2g3pZQlfg;wE@v8jAP%6_4wEegyK%B_~hRi~PHdzwui+2!&DE+m%Pv-R(#_!-u< z+}ykvPIDnZQ6?2#(t{!w$lr?e6_;rSGIHq*Bu&mT)6?&tVA{bbGSHM!Zd;YP-%|VV zbez^Ov>>z|n4CZ}(DI*Ffar>aj{}3`Pm@5acuAMC@0ldv22{0t$dIqQlf$^NCC?u; zn$22$c2IqSI)Y~{Zsodf`ylL62Io|``f?;0<5^n?)n$HXRSy^S487%F*SGj$ROJw5NVj7uriGu7p4IJ!r zAgCc-K#QZc%)B3c{6T%%8)^~xV7ir=bX;HZ^YtAzYQ%P;M0G-i8%Q?2O_nQO)o)S_ z7r5WWtgBR=k84-%9=|fwHy5FR*Y<_@j@Atlj-+<^Q1H3>7t4~Tpt4=r2z!*Qiex8Ai zc+FLTZyKZ>^g8bL&atuFZs1_kXcN&-@K0tFK;2WTGL@FM;A~S+ti~WS60*gMz@kI2 zk5UW2oL}T%G;K{GzV26}=>O z@W6=EgXE3&h-zT%m-+&P$RtjTT8 z!xZqd-7p5`={GV=nL=1S%(;;rK+pN1^=S+~QGh!kp8@K+!v%j4SD$6S>@k-W$VvN#rw>)I?xrV45L@JQ)$^1IK3jOt8Qj=to$u%;q7?oi{*jCA9Ym&8A5Fs{8+eW2s2 z-WbClvKlR!oFq95ul!hJvXtVb|2n}O19)?53m^txhzt6!_N6O-^5GT$;p0trXa0U6 z?z&s(YFyYsMytvlPw@Ou+9>B)m^a!=s30iRM&Z}{j=QMd8<I8EE0%oTqG-_jG8x>5F63RvkbD>W~b*~(3 z3qBhni$75DO$FS_v4N?~-jbZ8b(x zK#7fS7sn34Jn3MuD%;xvb&G-NE2qQ$6IK*G*%NHoN<-WxC#sutsvNMHttvUUnW3*N z3jS{?+Tom$f%X7N4SUbEx*1mSc&v=3<<7`^pu=aczai+um)?tKs}=|J6E*-p&joAj zB|DQTu~##XJMwrl=!VqPK$U|YPII(^P34TJmh<8(OC&$euszvRtTLB^`P1kao`3#= zwZRz?-WG#*3FT_hijD3pQ@9lQEs~jLHxPrPzS>`GXq2OK*j=~Deb~j5l`UtxbAQH+ zf-p^cGPY|-xPAzLT<@K3Hp)LaHh;Cg_$AuVWWyp-)n4pchixB-a;0NBf_=DT%4Z&B zo4zh$!xrWpwFcR(IK^N>(pc0GM22HWLmy3p)(IsV!cq}2QWfnd(akDj?;zPU3!;uh zB(dna(b%5?8okLu5M^c>Vi*5-6=B%2{~yXkg3!e*31u#^iT&0gDpifMvgc84GqaCO zBa5}{%+8zYOr+F_L~9B@GOW;lI@~o9ijFN+11M`Np(V$%wV-I3>tX+wd{WY1?Rfvq*Znd)BN0|Sc?CW=2 z25mdWqBGCVe{W;zLlv1ZJAjZ!8!tz+j4tOEn~d>XS%q(F-WPMG8L`3J37N@O}(L2`j>%5rDa5FO6aXkNgsy@ z*hkxWsone6ez-Ay<$J{Z2sgQKyEE(zJn4{wz8iqj<{1;buK_;y&4{?_cU#PuvL-f> zOMW46nIxusbze-yF-aF)kFoT>XZ7&(8H6V1s=&y=?|Yk!0bqyDXyJ2v90lvMl)1J0 zt5F=MWN!Jkb4yu3!FLN{79KR9LvE|lovPoRtc zicTkrD&zgVT<2mCF&|*_#tRa%BKmeqXS@Z5<7=pGm%q4kKD1m1XK-ioB0=;cDw>>- zA|9>RUTpENjvLivOhGCVgM7;uJ21U;24=<3i>a^Q5{@<3tkw%5uW%cXcf_Krj(E9s z*7YP05ON8!B+TS_`Nvk!;COgOzWC#?b^i^+rwzO4*h8-P65FKy-5oGT68T=6ME=Ab>}92Yjo*Rd<&q1~T(BGRoEjZEk2cc8ylg)pb8FjBESK z5>I0T0!K^_cs!K>ebIND2pK4WDGMex_XTctjD&E0>Wtd6+FI-is`G4=?k1nXRKV3| z`8b0?2t|+86#YS7k+WBx^?l&<#CFDj=`qBar)wO10ksD6&}w!=$AW$Mn%#r0FQD;N6uj# z!x;`eZve3n*yheyO-eZ>C}|5=jDEk2D9Q0VEf}O6`&M*x`>w1e(*$z)&~Bt+_m3b zHEnTDrS|?!{%^`L;6>#)S>$~)J_bVg>KUP_79Zs6TY>lpXdXcwBW5U+8T6z(M$YJs zebipd`ZTwT+|T=(BBoSyeA`ge{PILI%?ol}x3hA`o64{*&t9O#Jc8#V|3-Pl3FZIV z+2Jc5XDJ#VKLN&NWG5l@ZQ+oPg&(T30rOj%d?kh;RQ1siAM#-Tk}(nz%)9LD-2M`9 zjSJ~gyT^3+o~OxX-J&5^q!K-6w$S+X(XXDARpD%Wjf^cQhm(LSf2i;?)FEQKMvG!B zqC6r8!J%Wfc46j6>-Z;~1PF`N)YsSP3N;}zNoIEIgb7J!rul86)D3G>47xK1iE>}2hh zwwfh0^v?2v5f`I$qtorQX5uW9bHHp{BD`xPlqAFGPA~hUHC;jHty8PdngK$)g==E< z+%{z;$pp(9T>0%ve`dl|=wrzyLkU$&P*P-+-(CoNaPwSvH~8lxZIo~V5Mi7 z^;UPKe(EIYrwZ3}R?sE96X-VTw2N6ei%y}|9TrDWULet%EN9yucoSqmoIiaq$oVx= zI^Et)AGny+=LkTI>bpA!zO}dVKu*|-z*S8j{&pqQ`xlQueK0!iF$TVDOVS`%;YGgo zy?QA!V%wbZSWDpCh^?-~g;{YIIxKW_$DS^cAUOju zQd60UiJE@?io5XnImfp7^b&A{Chq+ARQ=mAJfXNfBvO9GE}c|sHI zES%)Gc;l&_%TP>+JubnIDB#-3`?Bsgmx$(_G>$xsjL4XW0 zjY&K;8QL5AEec&F3L8F&&E-w1XVVG=J9IE)1)J&$BV6&8z)pz6lp*dx{V-X_U;Fwm zFomPRD(HuGcaSSQnSvsAAgQ%YZZmQr#n-*RktccE%1Djdu=?nJxCvG~0k()wfWE-( zL5AHV1E(J}nKqy(Bmm!HpW?nKaUss|Oo8c0yO%(!qMJSB!l*)N>W;(b{-|Z`>^zS6 z4+Q-u`3DWVr~e^p@GXWEwq|a%jb6sn9h8W^_ynvoIVk@(PU+(0Yi+3ai+cueV0_+< z6l8|yY^XzRsZW<@ch_03bjWY*;uE10cV)Q7eQOWh3WPBwGCaOyi!}W}47@!7uhJQu zfjhxbmWO*I#lCsrSPvJrnB^i=nlP8!^dxlL23AG$x=ep-6OInb!$fwnvQef-ws!f} z(`#iv&QxyNS(l8D@mDHel{-X0grJ1t9sn|Aj?~j6i$63hEN1YfQcEuHN34Xq?O|mj zRKn|!S(LsTwrzA29QiB!;fMA^X8Wwp3DN%b>nGkhd7g%KtXlba7jRmeNeTWmSQ(;S z##P+v3EO=L<6h>OGs{x5aY<0()@e3d_#x=Y^}}G1B{+M*(KXq;E9%xd1I2AS_>bS> z6a9XOV+6N)xgyV9UFzG{`}Y=j!wi^xp|`!XcKsZRMCu-c^M-%g_izB9ZjGDxf)SWG zJQ#jQ9>{)EQ=fXf>UO%%ah?F9J%jojioti@(Py|nV0si9q7mU)ZNU#UU{vM}T9E5> z`s}mj27ta+Irm4uB4+RlPz-!e=WSaa$q}s7jWSIh^qLcTt@Q4DV);5xyFB3&U~@&X z#~ZtxF#>g1sI0YOh`S$wO5_i^BP|3R`b2KPI`4En!TO*nh^wmo_3?x3G%8Wp z=E^DkdL*(m5*Dl&6c6bsoM%eedThlx5l|6dVez;<|5N%{@w{;U z^Qy}id|AX=M*l!BH*>)C#EK-9grH`k@&K-wY6I$+>I`>p49Y0ZXQuvElE5gWJ9Sw* zskZB?tdanJEii_*`GRl7RNUQeT*KbqS3X>m(O@xAcgj~EAid{19!M-J9WuGtKX)Mi|Gu+aB5+(55vdME2 z_szPZeY@N$mF=fA(n_gMN}+<6V?%wTq7482DO^1H7rK2L$l>aZ-UB6{RoK)x`j@84 zQ0W@wKE0Ooc`Z63-G(_2nc*+go1VHYv#2Uqzk;aHzON48aQzT_ym!EvxO&uaY5}LB zEJN0fQAM9(HQk{Bg3=>#dXmYw5QmL3sF6KG;7u|NLRtIrhb>eiwa*k96UvI z&dvBOEXygNA{eFqB~9%& zhd*UCbZ+O^3>JRg8;MQf)8gmmQqq<2J1_9Fa`(z(ix<}=K1t4Ja>p-h zwa-xa&CWW9Nc?)&I0UE~>*?0jr;B60zJIp)&SJq0aN~}q7}aR?CCy|km@PV#f~oAn z4^5$r!$gLK&uxfsZ;9H;^n9!XK6Zo2gfJU4{c#_6E|R;m`W16UinK8TC$OWQGcdxQ zdo>8nsHR)lC%yKEs1fTYCUJhr$VT#E!1V=T*1HH|?oN~Z^~Htl&ae5AEUK&6I7@?< z;D77n`VrFxUR4Wt=i9Tlb8)8+g(#$WFjZV34=nbjx1)0~>_Mnv>TT%f;r=lM@ca>z zudW?ziR!g4kH@C5sg+2!_MlCg=|q6OGM)T$%I8$O`@hsKQl>NMZ75UKzt3~swh&Q@AKaH#HlzD zm3UuVbBFw{a&fZVKlsOk=*S#x9|(oWv$oEVv*t30di!V#^a z4q@AlyT}RM52rmtv8fxk(VubqF3w_>k0JkB z;+2mlzzSyBAT#=1fpq2xpF%>s&k>yOfP0qobT^e~x#z4Qsr}ufuq6npomIrKGiZ!P z4BolpnUU$p#`1c5i4t3Vfm@oNfI?f15{neK9hTkqF3CU-0RN9mFzoJSeuU*)XE!XO z{O#Suk1Z+qtZFk&n60}p`=2g~feT{JWlDf_Hlu)WY6S*0=Du3aA*_cC0XkzR>dG=| zB@S*x&dxEsUN!@^ZVpaYnh86ldfuFXGe95{S zzKtgT{b}|>q6n)&wy3b%C@b^(%nvQ`m#dJFzC=jGUJvE>0A)C4U^R*XYJ)##&TY`# z=;3hD4Z$j3<8QwTt2{Z(1I!;U3EPiW^RKBURcAX2hS3Y0D&>cyQdy9b+xyCSf{bD( z0%sw9IKdqWFR)f;LLHOLPtmH;M~@i2a$+zbiRsqmE^n)tj3u8l=tO*_^4n-lC&T5F z-}UT+9o$hkz9NPHr0DN9KwH6AiolMTGJj*ZhU~)6&Y+zu8)p~U+8=KxCA}nx$_M)` z__P6igXuZJU5$g#w-H6Y?ti+h6r^Ra%r_wSvv~9AG%kqn0SF1?Z1$?25b#LtkO`CL zlI65U_k~s$KWm^pVIDCJyk|#ik+$%l4lv{S$CfTIqloM@ax9;shl(xSID{Aqh)&h- zS>`?8>ug{*9J4}vd8W1&zMBUPC7_7vUQ}H!lN-ZbMJv$fGr4~B=&wK5!xLA#B4us0{iX22PVJ&0P!|K2mDi_Uik~A=m$JQ zb{k(YWsw{{(Tgf3t)gMDWm%}p+|Q1{jBa2Y4tc1p+xcq%E39FD8y7PvgwTNJB(%3@ znHq$i`WCs^NETRT=d>pmBZBK^`MvO0wP%jt#X9QJ%mji&T~(VMVKw%I0lH>As1@$?&K1Du$*yXdFW2A>QUMC%1_aVw>ccZzv%+mD zV<9ZioC+`7v8+gaS^8P>WLYnK_#7%S6p+$d;}hGTQxHaR_HrZP^av9~+MX3s9qOo% zjz{vbY>`_Zt?(h7vcZFo%ta7WeEl8GWd_?T4JbB_QyIKFW(x435S-zT`mVq+^d*iy z%BC+a_Gn0ADAZAXT96o`l>piK#?FMg3?->RYY6)PVBmUO=olTuB(Kcd36ILX2WVq?BTJ0_Sie-d zHG?h3z^#C?Ik|o$*_nMgG5I=8)0bC6?e*kwfbZ-r>br|6AD`Juf(+}AodAD4P(OEt2AhmmPH#UTq^p)I;_H}M!>2~Jzu1@b zMdIc)-vbPy_kelW(2_?bv`ml-jet2|0A;aYrO zbM$JsGacRJ>haabCa%@5>X{K4*m&b);RF@NRkro@e?qp_?moy@+!vQ)L>1&R@Lo7w z&_6r*o8McKf%)m%ZE+(x5Cp9XqRPWs;c2A;7?3_)O0R5x1E1kM5YZw z65}7+HCm!63rSvca!Np2*ni^;wc^Wp;tfgz`+KN+jK1RnDQ#l=R>_fbZ^$Z=`ruD` z4sz!aq%1D+97{>aA-6Z1t5{L`-L%%9J8}r`xnk zH-|k1SOCvmlj}w2*PrbFjV;Td+bk#iu%nuW!t(paGETCLEPJ!6;eml6|e z#2^r*Oz-wC%s4jybp+dv)!Turx*zv;r%|b{R&O`1jiir$l2slYcwI+RGr@B}H7pW3 z`0i*7EkyKpw9krWPDXQs}QK6E?K0&fY&PsyfdxMJ4vdxlbN9~y8>`dCI#rGyizi!3l~Bi6W%ZJ zirIELR9YbA7>sFQ{QfqT9Dl>-du`*cb2c-2licNi?*!|Hoh~vGK~XKIbgFzFHJy4k zSeTzKQ1Ncfa>hlOmJC(Z^w^u0IU3J}=;e7ZzWMd+QQ{FGVG2;^vBHX)*u1!t5C`1A zFyDUr7jOqg0YYqCw5sHhKW98yt%9IGmpO_la{)B*d}BrLLjOLd>X$_?v5pE4RGD;sIIK#H6_bU=;?s zPZv2qhmpS#_z>WVgLoWMCJ;{C+xm<>RsRDp$^*Km=6e1o?=udJ{~H-PSNZ?^i58Oi zk80WP|K^GkfIUQv!6>fIJ@tQPE8%}X?0?6MHsAk0ObsqzI>!6|`EL*)@aC@g_8ry_ XgnsdVPXHkdlY%L)Gnalva6 literal 0 HcmV?d00001 diff --git a/NodeFactory/stable-coin/static/open_vault.png b/NodeFactory/stable-coin/static/open_vault.png new file mode 100644 index 0000000000000000000000000000000000000000..71d7d0b867d79864d501ff1a139a35e8df9ed691 GIT binary patch literal 20186 zcmdSAXH=706eg^I7(^g6QBZoX2?Pj&Kte(fy@Mb%^cK1lX%c$xAWBnEP^3v0M2hq# z(gf+fih!Wb8}Gf}`exRewdTkCnY9F7-*U=6XYc*&y`K}UrJ+P|jq%#0OP45Alu>QkJFL8+}{By-63bA*?d2xxMxI{%Q-Q9(4 z94xV(mM%D9S6eUO7VzA~&Bnpb!Pe%VcSIqgP$7u8kSJUaD#|5>fQSRX#6*Q5P$`pt z-nYcsy8hdsxG)50fY%5L3Lb$s-+Zx(hsW||>DT<3p z3X4e)K2cNF!>DtKDgf8c4ome_yps{0}h{7vkv-K@pzOmsBu(Jtyh zbA)%i{M~K;c?av}hIIz|1ZIo|WcRO-fL9#;6^l34-&sM!-&xn&Tgu7PPRrNE#p$2d zB@LY2t+_;z7#Afi7!!mAwKS9hJp3?7g)7-3-0Fj1;wT1~4l-J0nGZ z9f%6X9_=lzsAnQ!r>Tc9v2{{Gx!USWIcaKWdBJrwR2^^-sGbAb-%0@|rG%5j;55Zl zq->ml`KvqH8z3BQ{ng+~mL^J0&Ik`Ntco2@S-}JC?5>5w+3R_^tKjsFA(sBy_WIt| z;$lcuRRd=Q1(c);1Zr&TZ;3PX*KzZ}y4g5mo%P(I{{GG`5I0LvC$uNfydTs>0wOAf z@lkNJbkVhfs%k0f8d+MYVhoiXaSkR*a0z{5w7)0R#~5aBZ0~3QOj$!$%g7Gu>*5fA z(N+!6^wvgV?R>|q?U>S+{Z;9<^;#MxB;Ch*z2mAz@;!K zV-qVC4KZDHLxhCCxUZv=fgRcq=OTf`xmsaFu?{|JIsuw!cYAw#Ungzx052Dug8|kK zjrGt{7l$D=Fj!wlV^x@fzmqsl*VO@GAca*k(N=|OU~LUuJgseU5-!>>A1?(Lv;$O0 z*~UlRUC|MxkG52HLnv$O`?#P~ZO{f#j0D2c$J#^!Ypd&R=ig!8a5)^T@2Y6Ds!s_39;ryk%AObl);<_@(Hv%;Zp;+k&Gc3#egQrcKo4`nG) zZFe12n6Eob7w2Y;a92kAs$g{;>_v_2#3l9IA^s2>M{RdiJrjr;5+@$ut?2@^2KgFlrn}v)qN~& zVF9*2S{g8*0VPRYEpKsmn5v}&R2)z;MI>Qo!qt=|Y`ox-2&^|wOi@b1M8eR|#m2)( z$;#1CiZCIJD@4%;sp6t0E~)4&s-q+2f^#vjHkQEY*+^oQA&MTZP;r=)kC8soSi#=d z00uX5k}&XdMmVS$7{HYcp?bGYs<@H669ld2 zZVbHYqU5Y;pw%l$6Abe0-(+6%{-s&@g*Z!Z0l@A+CmsVn}OMbt||JAR$|rvX6ro z+}q8-+uG1i*)YJ?*TqfD$HU&r2PWy|?dsv^gK*Qcfm#6{+h}V7zpacsG(C~Jni}3n zNl$wxaT6&Obtz*tEEM7BDd{X>r46(yC1&8OhjdfGDWI+OJnS576uoesc6v}>XDr5B zLf04NVPdWBWvAz7W2dRB;0G9WMU=0y4HRh%*Rz#?1?W3@ICux>tB6U8it1a!HLN@& z^>txd>TqRM8+|Dy6H$bNlf5d;1gWFq8lb2O)$>A%1?VVP`)j*+82CD16^zAHoxL@6 zwSe&g|J2|(q@kvvq=~DpqY^=ZED=shj-J{MD%zSR3K9Vbq>i_a2G$ZKp=qRu)$}v= za5T1q89S;Wbv(VjEqxqB-JLaI0Vb9TesI7|D#COzE)tSDc1{xBUP?f7ey+AIc5rpT zwEz$Q^Dci~4es z`E24O1k&v+!?6E*kM#}-DsSUyvGsr7UQk`8eqI;$UqfIJ9gAFZ0@A6RAH}2n%la=?SPc~n^Zj=rB`Oc}b zp|oShb^Jy0`OmG_bMca2*8{$-3?0F(+85iyJpheu{?u6c4nGLDHz`+%KiRAap&%M*YEugRQFo~j<<*Z zT&&4e`s_^m%pELsH%Z}E-`(}zT)y5}ru)3H<;Qeit^G*Ho#4}NmA-plC1i2;etjRC zTOTQ!OE)y%XuUX8ll0j(ntWraAnCD)qQ(vy$P<%Y21G{__g->7&^l*T_I%qqgntbF zy5)z-$#SY@x={tT4p}VP?vK~#_Z)4e(qjBRev=xm&)3+JTyA$rr1)a=c3lL_3 zRAdUSz#!l53D8zbT6RRp-61`zbr>sMJ_1BMKygd7^S_1(H)q5l0&ZHeeZOKysv~_J@5DUOqA=petu3t~vEN|~BPqUWsi&0j$!Ye>Tl*IAkAWzd)>K{8g`Xwj@dq z8k9m31xbv2%=0|Y7>5MZWCl9#*ZGO$AGYq<;Pai`i=!dmA-O-zOfr7%y=kYeu|jn( z#?5jo6OT^jLnP-n3@w6ee~$x8KUs;U6Ixd16iTi;g-8Fm_bq~U_I$6+P4??sRHyOO z?#Rhs39=(E2_-zrb!+?e*?VVtA|E#>RhlpE^tpfHwM82VndYl3acS>Oy+bLITE7FU zvDq-~TIt<)MQ0G`mQ~Kjws&W%xif91bG4!jd z%asf@lLD3RIxezgm817qT>{HdV?OJ{?dshq(j_sdom~JUriLn7TUn=jGK8 zNX)Op|qMZBXd48E(Xt@4xBCV%|^tV}CNIHH_w*9u{$3wcoXotK?(PHS{`-hfBsj{*}UrBJ12PFCEJlV8`6{&y}3>N}Z#tb=v47gVL02 z&cq{9zAvGMC7!EiTP^FEhlYAl^NXydv0pFFAh|;He1XV;XE`Gv9@mMd&Zt(oN*~~( z);-Hwjxge8#gr+yI! zZ@AZU)rEF|Dr6OKI&QxaFp16KMIKaYQLnciXF5E4vL~6N!fq$-mY8!6pe$`nvVneO zZ-d&;V&O$^b8?~xZjluUDptq~ZcO4vkC0st_;oy4QFffdrS>Y08B;j~80r*h1qFgd z#d$vWQhZkDT0VR$l9F%3KCj)Hceiy+LpmKcx_afQAhpM;%^3{;w@qV^o?_nkvyxyT zS&guWB$ZTdV^(mmI*|vck&PErfy?*)TxIS0?i=aWW8^+X=~rjYxWq9F9{r`_id%O~ zA5-3OM9&ulZ1Nqse6BE^glSV_B?O9bf6WT|5n*3+#WP`pF&E)G)3vy*iuxzie3y}K zEyo$P2gtDqy#3I}DiTVBRuW&1Lmd)J7nY_IX>~{9y>7UbjClsSkv-)-6xOgsXdm{0xJfR{5ishDdqoM*-M-DSvNzU2htj0~&qmrJbs z!l`79Tr11eYp>kDdtdz@^(l;bZ;Z{i4q~wSn?X+n=*cH zwx(-eN-sPjHk+w)nFG+uw!~MzrM$Qbgl8RAhnFnd-nt4Ba9q_M?(zFw`?(E8Mu| za9`=K`i03?nAFY!@M5)Y+EKugmIK(tP!mB6;8sJIS>?r_Qb^7YYk!xg5dj_?n1~D* z01rsm+}EE)HA1bsIM)+mmJCpNAFBo%)qoz^@sC0-DY-l5=v)D0Pe)8a`=WW1l<|cr-B9 zB_`<63P?2}pr&Wq>GjU$c-d0Iy&p!t0HSOHHczHm=Hh-lqxjo~fn3R<%{f;fOd!C% zkQ~z}$~)U){0tSw)uqel8u@n{9_}`DtM>wsy1EGn7GB+60FZ=3x1ia(;mRSYg22P* z8QaYJqpf@ISa=uX&aXNCMm|-he#FWauEgx$X?ggas4PF^_nB)~+$}|60B^OOZ#*xU z1?Im?z_dpK?AbI}@b1s!tr_@0j(DFvy(pIkJ`O({P0Pc0reJcBdyaN(Sh;b2RPg7b zn;^p7w|&CZdxo!!ERTW~La%Or3}c9E^xkT0+HHKPv)Bxn%DGSJ0`U+sJ4U$s)2%O6 zMW(HR4S2DliAfcLDGKG6e-tBapQkB%X45+{B)und^%>%J58#BB9$&w;7;wC~Vp8wA zqanRh^M!Wpjpc{gUY-KylabdJawjKkf9B$u?=>!8A!5H0UJ&wos%DU2kV#lVF1~M! zVQ7_x%LT^Ze8@x}vPxi6)#=|YT)Abfw)84&;I-Oc<0Fb#c=@{36Oih22ZR?5;=JsB zQ(dm8ZA`YQ%JIAP!r0jvw>B3lznW@8bAK-FPAQjZ*a-kVCbW5f1A(B=?>{4*Y#OqJ zP>tFl$^HWk594OC60<|8n{tg}JmYTp%Sz9=CSL{*ySM({31B=UQP%rHVMK_|_!{HN z*~q)IQ8f{7>=XY|hm0(?md6t%Y77E-35r*~5+G_a?^&vc#007MV91~IdDoLUUtd7! zUN-?jMa8bm-q)5nK+EO;7-M%b|6G%WWB3rC%616e4H8nh*?iu;mx=f?5b%C;go1YGg%_wnlxsm<2W{j&&K z4R;1J_s}c53m?vpCoL-Kc*7DCqW!E!>$^pCyFWO zWj)Q_YT9dc3f6?}xV4^@j^Ep9Ir-{(xZJx!!_%oeFiQw6fn}Zg3z%|Y4k@{EA+1+b z5qb8f_BnA%55Te-M2}H9DfK$VaWP~D3|oofvM48E02 zL;n+4gbXvvl+LR_w5oUV`+Tp7BLUtK^yk-!>zwzbkd$5Gy&rF;t6-_Z0_76dI?28% z7|jwFEA`5T6|yQp-ffiT&O*CyTkE39pTA;BuA^X*5Il$`#ngg1i`6YHg*^K#uWca~iu?I}MoMc3vhNL&}_t~0at2UQLh+J`Yp4X_#jnmG+*A1(T zv4v>0SPLxlaLstt$0eQKGD479oCL)ui`` zfmi?fwRwSO1$$e?{Jda)8|R?;VNLQ-QnsE;EyF113b&ei41!ILnj-Z9BaHWMnmeob`zSv)W?k^H6^xTJqAXB40KBpH0+M?ST> zlh(}3{t=w;;afgGgSp?cr9{qY5b9Sb-SHXvp?9j7^iH^6rLABzZhiQfqK`=1#aoU> zXTbePejnq~;7_P=oB!&3!b!QbP+AC*z4XaY+nZ!DBCppprIRZ3g@^%ykHB@*-9|7qZ$Uxeq%ND`0D;(niKw!JNeZ!** zr*Lkp^mi;DA097>J=_UDeWmYSS~Ui5`}M;V*H1fzwwG!^qdFo-;AMTMeIji}H+}ut z7vt6*17AO!i*fnEKIm8Jw~bHTyvez4rHEE2HD~8kUH5Ke$)K zlLS5zx=}{*Oe$CAa*_k~0o)2OdYEX5{Uttuam!?AIW}BD#R5wnFCtX_|^F#FnKL*GfwEO-FGe z`CfD|Lw*ab=B!Z@z{0jOph)&|4;iT%iK8X-jv1x?)?@R3yKkaeXdhtQIK`@ZkOGWuut>AlFJq zQfb>Y*E{?mYNl@w{U7Hdrj+Ibwkm#XKMPAHEXQN`(v_EXrV}7keipF(%FWx%%nPh` zr1zSuCrk(Q{Mxxs9%tI3RDrA07k%$L6m$XuMULCXRV3d;{SP1cYvU_Ssf(1?+ogB5-2xwA9;Ed02; zxCYC8IIgRiUDpWYh2GirWlX_Q;UJq zGkR*AEAC|XXZ2$dkgMa;Z3Nt@V10TU5LgGLZGsVorHSJqISn~^#>Nh-oN0DkiVvMTtcJ+H{$8L!)ZHoT|y2GpWODx0Y4n0)F;EKy4ZX zUN?^_vlKptM?WCt>5)x$|6rAoxJ0X&=d9OQ9P(odySlazAN|6V<_UoMOx1$984Xhe z|5+xM0gBT(*48h|n{5I=g=cUbahP#|GTU|}k-arfo_m;sXkaFzL&1it+gxL9NzwyH zt`3%pXe5~#hdzWl^`~N|9B22@{g;~RBt>eU}fP_&x;sGXg*0w6^ZWChX*B+$eYF(vT*RQZ$tl3Y`3Ph|9spLx! zNDg~#IH*zzat>A3u`k|+T1AKt3ab&X$$0JraZo*(xZmhSMr>@JfPs0?z#(@1H^neu zeI*9E8=(Wu0Jx4#ItL*493Xz7M~^7DRY(c$6W;GOQixt<`JOUO!p=W`;QkAUvYm6l zbVp$~1HVefGl_~TO9z0PiVHnV0iSRnUDbKtGq#lC`=E|Sq+8-!a%Ggr7)4@lsE z1vgt~VM29QU#}P?M@1V@SZZs9{s}q#7BvTK?B%;Y+xEqgWwb;Q@UplF?wB7v zpJ0Q)Hq9=Lu`_+5C3!oni?dHGgAUo>Nl(4D|LwzlAn(xkT|3j;+U@ zr}6Aa+HJ6XQ{L9Hhjg*xYIVZiWcJlp;x?D5@x)Mc1C#dn!I3GM1q&5UJp<9X?d&{6*^yGHW0<4i_15=R&E&^+(PbmJNM5v@BfhnmCLa3WDs4n zE_KCMW5rDbPTCuvee2W99neraGV3SH5_l7T#1p6WKA&{*^eX3pBI_nq@PLTqIr%)- zE(3q?Gs}RE??p$Kx@w|7r&c^gTd{u>%&AxiDbBhkvSV5Mji(@R6s8(x$Eueqaq=`y-!o_k;+yFm4J1PjmSdo|k1 zv*fLVKx*VmSX~%G)_x~%D?A+J7XU;L>a^Y41HR+b8WfaPW;H8jXRpNWcXvAE37P=2 z*}-tpT3&{}&hz}lmz`IMV-I_T=WB|@-wpn~i*M~D=_PIzM4Y$VsNC6dzA|t__f6vB zfR79ec@dEIJ++fO6h+NbE{l+#$};s2|8O>7Y6c{EmTGfyT*!#DL-w75BWGTbq%CZb zla5EU+_gRTV+J!I{0GfI)Xzx-3xiY^BjpS6w7L{_B!!c2lL152r_S5ltBA%YEMYQv z;r)MS`>Bv0XM!S=LpU>$0g&A27~aM%~$NN7+Ao7V+X<hRE%#uYJQv zpJZf*IR!`a(-ES$LH-818cc9oaiB6FI4gW=lASB*03XBQumV-~kH{mLYe;)ZeR=n% zZ9t-1f(wSpTdq-5=xJJncl2!-e+nmJTX`%a+%c@X0tA}R9f|@q{bZ!fLHaWI1tz%r zgI+!`M3#d^kt&8&#Ovb(=k|uD<{{3>#GirrXl1E@5rIGd4H2TF-X75~bC1T>% zC}Pw>Bi_GG_qm2$d#|{IXh_%tR*z{m)xYDTb&1)$*$UIE>yrn;R2sf|W$*Ykzzal; zQD7Yr+IBBg#4Tv(fBu|u((w3p z$FhkSH=F6)t$Zb6z3t}7c5qLpojY@NYMh>}E#;F`iXU6j%|*^Dk#Df78Y@W9%Pzs6 zJN5IcR`24vS*xbVkJ*5lp5IHEup~7JpxQUq2rfL@UrCx#yn5AQ_;N)`{TfiSOv|~- z$jGV230>9fAw8o0t=sXQZSg_8=BBeOkc_(Fnee%92L5eB@0b+{F65Ssqp?WJ;Hg}g zxBN2@q1%0Ez27z19NrO29BhQ#M(5pfYwB^@&YqtN8A5HL&N~O*$MQU6Zj*IjZ%#_a zsyup7Nfi1i*G+Su57X<}37dv4a0wgO$UgZ}1555A)102+>%Np#r^l{DXER(n# z2hIy$$mH5gB;+1CeI>Y@0}LWSu_{4`!1JE%y7( za6N(F6J2&$vMw&9@=t^{4b{Cv+#E;eSq{exRsrgC;U&|F)0aprr|0B7-~6rLVgu&L zxotZfIETSg34v4jS2^)d^ceeJdP%XCXB69{#LWZsDxLaAc0Dc0ORJHrAbbvE!NPi9 z)`6Dgb)q=svu|8i!nk;Q$+;mgLv#2ww$p%v9jhmitRul>bYYNt4KZ*r3$lB|V%@_1 z*&R~XO-7_7pq(l&q(VepCQ=(YNuKPpQaYOHS2<^CK*NzS_K)my?bGaiVC^3{V+$f$ zgO?+zdmf!-Y_erN0kw7O#ZrxuM@0E3Z$Q*@&0i=Y@iHT|;~mb!PeX$u`LdiAnHDMT zjNO=|G;lzeMmnzzWBT990XBZM`{|8ndG3_VM zt>#Mp;{w>nlf1PIMegs>vL%Wn&tDM<{@Rj!mpp9i%j7#0DCr292_~Xyu_eX{Q*U)L zX?+srZPq(HXWK1&J3I1XFTCG??+nZJ819c>tPbC9K7)*{6gkOom4gD3QM8xMY5Y|9 z_darOQgIH5T(ovLB8M4Wi3G_Ji_0IA-#r_Ve4kno9C<-{Pf+o zfc4IZHL1>mLB;Jj^iFxKVElH|&buW>L-7PTkhh7k30)+jnsmN=pyiSEzBmUn-(ZNy z!xE8tuz?p8YQ)0?LWinerE$H(f*1>jLD0)y#)z=aTQZ41tVl-Blzm|au=`=F?wRi9 z!_%n&1Hk0>U+Ue)a>l^POWhWYEEBD=o=(qNRg;GJs2BbqLPhBP(nP z?~L{a{gFBQWDe;?26kTBzcWO#4CEZ&40&LSudUpTCTHD=*|h8=Kc%ZY#M9yg59nJz z-fZ_L71P|+Y|e*gsSkbs z?XpF0vDoI0aLxlZUr$)?Myb)&d1~qeE$`SNGCwu?Y42~7-JEIIudCw@DN$R915W9zEDqthS%48Ql?v z7BaTt`NW|?w6||d(~{72jqmDA1e7_#++1#0-J|R6W7C*3wtlJzu3IOPEW%h z4+afyrTBpZ-)1#KgJ|Dm#xfI-)mW z9k_HSa2|S}wTdS%T<1e9*@*_2;g7~IK|Gs*JW*qh7|+W~1>)S_36z2`V(191OfN2X z>BT_4n+m4~5hGL2xy%$vmaFbo_FE9(ZffOOr)dtBt|?}(G6lvL$dQN!v97o&mMDF` z5LLRH4)3)sts)Ldjg5YKaG=%IO{O9b1N~N$jj|6z=G$5^g<-Oyhtar|TiVPXhgO5+ zcl}36xT)uMewD>hWj|fXn7quD8gywxcdAFJi5A^|!ON#iO*cBiD#ZS+jPkKurkN}I zezc+@1hK@i+A6@V@g^)SFni#EoTjR4n7};17MW9@(GxvFl4&S2c&^<9FpdNX#TisW zgy%uhPvbYM@X})fRYRG1@mNHm`8Ku606FpEYi+!vTQrwOo1b&=*HS+wn{R$hmbz8X z{Q8zDk_R-S@2Yr$dzM4>dYVp5Fl?`Ht(wTN_K`m&6Vs4Qz;J0)A|NcuwJ_{LdyM}L zp{RM;GPYCJ5hHx_$MUr405HX4d6xbfL}=QJ6!fK(#PXGgqm`@_kT4_v{i3RrwcF}r z9cF#8(l%?vnPE%Vx0(&YM_3s=NQPCT{}b=!tV%Y;%7IuST*Pg*s;3Z5ol)L7<0oCc zYkip_^*M9AH&&>z=&kF?{yHD#<5;p61!ZzQULFtulZDXZA3kMd+>jSCso~{Q4S$;& zTe_INJ<>^w1=ID@H&F08mQRXwhk?AS3)gr2n-xSX88u={fvKZr3ZM|hmQ%F8+oy@=OEDYPlZ+QROekGF zf^%f^(a!(F=ZvBp3;@!(~U1oeg55o@}8we^Ua0CQaML`WuVxqf9aKz0R_>@y`(q7`#&_9&G)~l*l_l4w({_K zhx)(KN{+7ghcRx>lj`RCX%!~#zd5AOdSeHvWXZ+77){$Du6EQK*FTDvH(KmO#ct5i zav^JlNyNA#I+zt_6p2??LVqQ2U+XP`p0|Jw9`KjEq_e?0(7B{!(kQ3mJbaI{PL%Kd$9;SpEpWoI6G(l{6y@_mOFis+3 zys3*OYL$|Wwm(8814-Kq`3b!oR!Eao610i2mDLFNNpmwoBGw>QGX=&LtfuEtc#Rgr zku*LOcEDRB(P1emy(F4^H?R;k2hWc0ZBsplq8l? zK@#0NZdF;QehX>nyzhTHn-hCu*$?sf>Q9+cKWIT}c~x!SB4&Yt9UFPs3~#(Vx-)u+ zR2Q7Xv&!<--anOFKUDJMEk0FM^mf#Iob^F;G`x1}En2=aTPRE)*NU%pbf45eiUU4V zc?#m@?3XzW-naO%KJuYv0H_||Aor<9@F8iOzSP(!3{{}VYac0S%Yd90AuDH|+%{fS~h$VcwIbF?0%4ZQk+U*6jG2@<8&(DIM%FDh{O z54ekE4@s`OJvC}QO{|h7+E$xn$wQx+sFCZq6kYMLnC%r0*>XBB?zS2 zAjbhjGRmg0NxL-3`HGoLA+NY{|2dFL%F%WLku$ND3SVPOU;@dloxDgqtjgIFVG zUiL>rOo%0$d%e)&9B}$$aE%%$m3x=Yi|12LA?egLsVE`SIy*Ycq&brty(#qHp1O6vVs$b*m-z1n1XO-Q2MLO_uJg~(3 zX36$xZsGd49GB5`id658SFxIDIzC>E&sbIfhNWF7Dy^UoT@6}A#0n|5fVq|qNxhP< z3oZ(#L<-l<#Qn{^s?3OZafiwT#ZLmX64QFBoJm?R>J!&m+88s1>ofJQ=|7b2 z*D?^Hc~c&V#6)rW2YsjN^oq)O{~?PVblRIE>GnjT(Q-BO$J4uzJ*foq6cKNw~tL}Xjs zUD~(_6xOdrJ;GPJ8*QmxL9xC>0gQ+Z%m4GCOu7VC zkJe24eKcSbsKEOIdBy4;qH$>h{=W!&vlA$r(Yu#<@v(uWN!V5Lmiq`)3Im&4EHw1SFDN!* z`E;*mzmI=lNK_L}ASS3|5zlVzybmR=hc4dj!@MR%Um=oF1y;|_sTbNDzQ+@WOiEqUg>#J@vk*qNBvj*y>V2lFi! zFWt>~V0u&J^h6AsFn3ABn84MT0akkFkN>yA*iS%0 zdT#M!><&(KPkZ6sD;v?aH}Dq)KEFV%ewa1yA&ywTJehL>Iak5;)3m}Ze~}Y zqNJGB9EV7Oi9LaP6rT0<&e+V)`mg2Jxp8Ygai)*hf0o*POR-~6r2orZ0w3psAdF>$ zjb@-I_go`ibxtauKlp5gLDGKssVJtF;NO7C)+>&f8&g0IXbvFbEaiwh8HiFM6l9h` zq>JDD#~~I`^!>6i?l=a4i`^_6503pm z4N2;&nXy}r*8!{XR*5yGGy9i|LxhzQtEp8Oia;bj0Vqs4d>P2S({6xkS(YcCyK~_w zN=5-3rjSVdbxA6&|&M&hY<%Ju2mmzaCL)| z6t9g7)z8vgOL=odF7B7i43uf*no>3H_7XV#C1JJh2M?+`H1qi-zxoxOy@`G)5BML$ zllR0_@G$CIR9j;JjmK}E6d);2>x-B|fzrS%hiJIazP^(?YQvFc6;Ks5Lg zK&?*T!kHrIIPWh80?gg*72rgGIe+>*<~`fUL@`G+fD#PTgW3QFWH^fbAA-hW9UtVG z^_{0S+@;=*8noFgKz*>Br!gn3<`C6+t3E%u;EekToZ;8^BBo!Tl}}cSC+Fg%#AaXj z1w$)|kP+|rm@ZpIU`i}{P&@66!TULE{%ZrH9vqg3z^7WT7x9I1; zNAogo0-8ZI%36d?btVdD|aesE!|y zFFtllxxEYMMg^x^?)(YBLt7n`IqI*8rak1!X)Kf%amdr2tBTAw1ZrnLnvE+>_u88D zLtc4`JN~ZkQ$dIAIUXd&-cKc!Zj!z`um6R9c;XPK?h+~tyBYb5JVP=^aaUaYpApeX zO`~L3a3NfQgl)w_By^Lcbi{W%8?N^H$EU?gU~ z(0u;TbKy^Jmd|)R+aj4RoCmhMeuoK&7}TdK6oB!6y)&>yM%tmyMECP-vA%dw_wEL- zePx<{aWV=x&QpPx+fW2UCi>S0IT!m~Ex1;;JE_;M%nf?By)xQ#oUF_rVH_xsp5Lj* z3Y?rA-NkyfYQzAQO+sm@VTy<3Nb7)Hs0!eOm5`R)lyg9(X%|y^lv~hH&{jJ`5>pdY z=vtnZ-<;@v0aN^4`5J9z&b&rAGL!Gc`7sozJRMCLk~Tdndg61uIXU2WydHKik!jH& z{km!XSM7o8t;8bQmp3j`>-wB3-D%t2)xeU6ZiAKSJecQN<6r7yonHP(i60hxm}@fA z^!5I^t(dyOTJX_;WFby$Hpe%_u%8G0{9ZM-f%|l9PuWU16$Oyi00r1HPNJ`ka9C1|e?arG40`*! zz>?%A&dDnFOJ#hqLuJju<$q;i{7c5`E%=2F35`M?tz1C&@oo3m8M~P_8w%dm1j1pX z5zXcei78%bnn5p70%@;Ejl4D8b*^y=GOj}4bqRrp2C{BAW|cGhFDIw;rFomXQ|c+U z*Pw4fixr|MGkP?mZsvs3IwopKMNx_o=>1M(rSbHYgz|62W%!@R*AMs*Z-7%KwF6gm z>4W&mK7+O_D8p&D6e3`yl0P5ltZ;qVjIBbcTY`TbRcUvNG&PM)Az7sf1E#vZx%TyR zLEI4VYun(n`6-;;koROw+vlD7waZesMEY3^f_`KtGojG*bnL{`VXUmeL^r`T_i8lx z=bnB`_ch<21}L7A6u7l~-@3#z$u(`;m1j}RZ!?_Cd$0-|F2F9LW^`9r@PPene^0Fbmk|Lk*`|0~V2uWXDKpk=DiPB8Ylsfc%M$gg(w zqy})$da;6r?{k(Q1L4Qy;-u3Hh^u#O?6fzFG;$>d2A_xUnsAr2HEU5ONEm?~{nxID zm;*3v>+teOVZ~1<*?cz&(<@4n;yh8F&Lr-b=76&=>L+Hu1JDPrV2ZENoAN$1FrePn zx>W1|u~Bh?vvX7TcP2?rOEL0pkbFv2C+_j2jJ{ii4aVNp1=%D5^}p(0wb-T!r`P-w zfp8{2*1^}Zc^er*M%e?9XG0}g;z8)L#Av%H(tE)9lzM<-lBGhgE7Ynif}+9+&Pjig z9%7Nk4&D|kS(HZKEMQ+by$1a@I-C26&pz$~!$nWi*By7uI%lJLNY;sw%UimyJTRQE z!MZ!)M#*{!a3*Y37tJcFX}9sasqhFwYh6ci4GzV^u+-S~9Yas#XmqN92i?Y6Wb&_O ztB=>VeyQ2G0;SIJEsm-$>&4_G8+dZ=Vf@vB|?4^)&Hri znANUG80z)gphP~W2+XzD1w|--k+HeDfe1F|RgG^r1V}5QZ+W+5av%@MXdY|^f~I)h zM=i14Vf1-8&ld`}e|{>>1hZcNu#}moTvs*#u>ic74e)2Twm)7;_0+l{WMcED&+aIK z>7uDQ#L$P5Ymm2Y*MjJj$tBhQ4Ha^I?kk=_wL1H>V_@tZynuh zlX}GiYInr|tA1NKKU4Ll?iLk^1ZkHqMI!b|zmJPz#pY;QLPy%ZwyD4=4v~ z!6YQ14=KdHnB_P{XT4RB0m|_$(waHn#|fvB#$n02pPhuJ$m4C=FXpYKulYYqU*6}b_IwyD z-Jc^hbKieZyz)5sOj62`eDx~9{=ZYa(+2TXGGW-zn|cQ(9L&V2fW6HP9++jFt$#V? zNa9^Is|(DQu3dt^q zjV%*ma&(_dry{~hv!#h9@x||`0pIdAjrMu#R^yLNn~?&P-(%{-n}&j>8_YY$X*1;k z8(|}sT_aWcK+Mk9Bo2@?X7BKEl7t^z4Uv<*(DVNm$sqVeh@t%+z}jvoasF1HNhe7Z z&7qNjyXc&p#rXPGUt%mo3(y8Ok*|ulI~hn%o=iWS^EqbH^NDFqg#YJO<-yz`V50G! zd)(J%$x7pZ9#~n><0m=`;?VrivLA9X@?3Yei^=V9 z9zP@QGH zU)<4Idu(Fr?on%g?-WsQbL!s!m2jA0=4Lxx?YLL%i$KD81?jLyVD%UMTLAI5`kDdV zr}u&6$*ag7<5FvCslk**^wSskYQM~e(_NXr$%c=%-CAV$LN=gyB7)9pWfm(|>62N! zmJ?&9G%t&ehofeheZCgr=R<6ihx$h|hdh7dyBVmnC?mf&Q72tCvp+V>A zfxamr{RKNlsRQ)hPDM8s4RThzXx6$M;YD{%ek?r2`bAKTT!br2%ISZQyy-CH$r*5N zprSy~Yzf$$yuSzOm4X(F?3-I71PW)r8VJXdq`2D z$4Xe6a;FPcE=TD?=us$_lsb_yPUDm=bKYO`c%1VuoX6wr*F7Ge$9JFi`|;iT{d&Ki zZ<3a7upjbfHOvzi7P_P} zka=H=(w=o(aFVxO$1z7bjSf_d9N$R9$KIm^6(gR;INA*|hL-AJ@?J!m``J0x?A&LF zaA!vq-8vYF-VtclX?iI$QBZZtHmk;DV}s}(s1{dx0%-Vb#5$6or70NGxg*WwA3AO z`sq1$Gvc6JvG8BZ`)0+cLgz+iO*bn<*GIj}*!6nBo3hNj;-RXJ0drs#J#ejNez?!U zQ!Rf&3*WZjwJKgoX+a~h7vP22#UtOi-{n{eAKb!~DOY5}J)vwS^vPm1`NIc+Klc$7 z!d0s$=ZEE1!E`m8`2$J_eb*{_W!TlP-`FVZc7DI{)tYQ8>S&CVXU~i3BhOvUP_JcO zkP%vgL)0=;cFqY>Cohjp?OPGMb+aNl6TjQBjm~%>0iQv+?R&6fUfwS6>W)rv+=Ha0 z&S7e)<9vdtSY}z7p!TMLkeJ;nqy)@0O{22nrJ;$|D6TH}Y&Vo2Pnu9X?dpW6k?v&2 zZphN=RBu%xX8!E^c3u2rM?bLhx`eN`&EU`H52J3yN_TbBrEtjaI)1lhp(vl$A`<2T z@LsSuqB2*@BBF=Nx+DRS_$yersQ~=Ay+00?%o@NY`ha_Sd@*kwa}oggY+tmaold>;-L-!gKBp>%Loe%s$L5-K*y zfcQ3Z$5~T7c#^7~0G1gF%Tr?Rhoe~%`i-!rBkB9ikYJn0hY`Wp;Enn#5U!H8Y zzWdxDrcqg1(X3G|rQi}9hPdncA%>D}z}0;0pX%%F75W;Zx40dWjb|HRFjTl?Fg z#40^&BYXVAnUL9+Oss+%w1`2vz9AfrA z+Y4ozWaXx4Iw1iD1VX#Pe9HxDN#Xi8{H<|pa&d}lt=0IF^7=2MKEqExX%z_NrKYtI zk}UD9IvXQzoVoxzjPP?-wePS|t5Om7`f1@bGy*p}w#q-h#RlVD>I*jzy@6>OMrfik z*gwDmUMxFun~QD-41UD9HnciWf^V6x@Ak-cfgKPAMj(fjU|d(XL+w=~DQ|dX0If!R zXm!LB2EsLgE;2kOgVyPM{{-k@w81wW?%K9p9My$&$nFHNm_GlNG30y6fmMcClkx^$ zl+C;Li5}7ZMFwJ=@aOHHqCv1eCW|tr=S)2pyj0D5dvYpiC!*ESCcEL;H9xgGOw_>6 zhQ1lpA}2v;;`DhHj&aq(#e`)TT0W*{8hEyc7An^iy7tlagHf!9XN+_Rt%G##RDVBU zBGDQMo;@)lc=rbcvN}5%HH#{&{vg?o8V4eKpGQT;=Fy_esLye;Kp)oldJ($pAiAPY zMNI|B+-|od|0M`oXe`HX2kd zCg)(dY2`%u4gvyj9bQH zFtj!u_h&$-HrA4OI<;_!E^b{w*%7_y3eI=X%Q2;bG{;EW>xZC2BDH_4Fxi+*f1$bM zbE9!IQakcWJhVR&99YsZ{2qoA)XyI#f5Tpr-0Vd5Log>^4KSQxS}Alkqz%+DZxR Date: Fri, 25 Jun 2021 12:38:49 +0200 Subject: [PATCH 18/21] Link architecture image inside README file --- NodeFactory/stable-coin/README.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NodeFactory/stable-coin/README.md b/NodeFactory/stable-coin/README.md index a26a83bb2..452d2b97c 100644 --- a/NodeFactory/stable-coin/README.md +++ b/NodeFactory/stable-coin/README.md @@ -41,10 +41,13 @@ Collateral will be sent to the created vault’s script address, which will also Let’s say that Alice wants to mint 100 stable coins (SC) and she has decided to lock 200% of the minted value as collateral. As the current price of 1 ADA is 2$, she will send 100 ADA when opening the vault and receive 100 SC. This process is represented in the following schema. +![alt text](static/open_vault.png) ### Closing a vault (burning the stable coin) When Alice wants to close her opened vault and return the collateral, closing action must be invoked. Here Alice sends the same amount of stable coin that was originally minted together with the vault UTXO - vault is closed and the user receives original collateral back. It is important to note that this action is possible only if the liquidation criteria haven’t been met. This process is represented in the following schema. +![alt text](static/close_vault.png) + ### Vault liquidation Liquidation is an action that can be executed only if the current value of vault collateral has fallen below the defined 150% value of the minted stable coin. In this case, anybody is eligible to execute the liquidation process if he/she has enough stable coins to close the vault. @@ -52,3 +55,5 @@ Liquidation is an action that can be executed only if the current value of vault We will continue with our example where Alice minted 100 SC for 100 ADA when the price of 1 ADA was 2$, and the collateral value was 200% of the minted stable coin value. Currently, the price of one ADA is 1.4$, and the value of the collateral is 140% of the minted stable coin value. This makes Alice’s vault eligible for liquidation. Bob decides that he has some spare stable coin and wants to liquidate Alice’s vault as he is incentivized by the reward for doing that. He will send the same amount of stable coin that Alice originally minted to close the vault. Locked ADA collateral is firstly used to pay out Bob for providing stable coins needed to close the vault. As an incentive for executing liquidation Bob will get 8% (an arbitrary parameter defined by the protocol) more value back. In the example below, as Bob provided 100 SC having a value of 100$, he will get 77.14 ADA back that at the moment of liquidation has a value of 108$. In total, Bob has earned 8$ in total for providing 100$ worth of stable coins (8%). The rest of the collateral that’s remaining will be returned to Alice. + +![alt text](static/liquidate_vault.png) From eb02b80a81258af2e0e3e43640ea0b7de7178673 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Fri, 25 Jun 2021 13:00:14 +0200 Subject: [PATCH 19/21] Revert commented code --- .../Plutus/Contracts/StableCoin/OffChain.hs | 77 ++++++++++--------- .../Plutus/Contracts/StableCoin/OnChain.hs | 27 +++++-- .../Plutus/Contracts/StableCoin/Types.hs | 3 +- 3 files changed, 64 insertions(+), 43 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs index a7330cc75..d73806bfb 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs @@ -57,6 +57,7 @@ type StableCoinUserSchema = Endpoint "create" CreateParams -- .\/ Endpoint "close" CloseParams .\/ Endpoint "funds" () + -- .\/ Endpoint "liquidate" LiquidateParams .\/ Endpoint "stop" () -- | Type of the StableCoin user contract state. @@ -68,9 +69,10 @@ data UserContractState = deriving (Show, Generic, FromJSON, ToJSON) -scTokenName, vaultStateTokenName :: TokenName +scTokenName, vaultStateTokenName, scName :: TokenName scTokenName = "StableCoin" vaultStateTokenName = "Vault State" +scName = "USDc" scInstance :: StableCoin -> Scripts.TypedValidator StableCoining scInstance sc = Scripts.mkTypedValidator @StableCoining @@ -91,7 +93,10 @@ scAddress :: StableCoin -> Ledger.Address scAddress = Ledger.scriptAddress . scScript stablecoin :: CurrencySymbol -> StableCoin -stablecoin cs = StableCoin $ mkCoin cs scTokenName +stablecoin cs = StableCoin {sCoin = scoin cs, scStablecoinTokenName = scName} + where + scoin :: CurrencySymbol -> Coin SC + scoin cs = mkCoin cs scTokenName stableCoinPolicy :: StableCoin -> MonetaryPolicy stableCoinPolicy sc = mkMonetaryPolicyScript $ @@ -105,9 +110,9 @@ stableCoinCurrency = scriptCurrencySymbol . stableCoinPolicy vaultStateCoin :: StableCoin -> Coin VaultState vaultStateCoin = flip mkCoin vaultStateTokenName . stableCoinCurrency -vaultStateCoinFromUniswapCurrency :: CurrencySymbol -- ^ The currency identifying the StableCoin instance. - -> Coin VaultState -vaultStateCoinFromUniswapCurrency = vaultStateCoin . stablecoin +-- vaultStateCoinFromUniswapCurrency :: CurrencySymbol -- ^ The currency identifying the StableCoin instance. +-- -> Coin VaultState +-- vaultStateCoinFromUniswapCurrency = vaultStateCoin . stablecoin -- | Parameters for the @create@-endpoint, which creates a new vault. data CreateParams = CreateParams @@ -123,7 +128,7 @@ data CloseParams = CloseParams start :: forall w s. Contract w s Text StableCoin start = do - pkh <- pubKeyHash <$> ownPubKey + pkh <- pubKeyHash <$> Plutus.Contract.ownPubKey cs <- fmap Currency.currencySymbol $ mapError (pack . show @Currency.CurrencyError) $ Currency.forgeContract pkh [(scTokenName, 1)] @@ -159,7 +164,7 @@ create sc CreateParams{..} = do tx = Constraints.mustPayToTheScript scDat1 scVal <> Constraints.mustPayToTheScript scDat2 vVal <> - Constraints.mustForgeValue (unitValue vsC <> valueOf lC liquidity) <> + -- Constraints.mustForgeValue (unitValue vsC <> valueOf lC liquidity) <> TODO Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData $ Create v) ledgerTx <- submitTxConstraintsWith lookups tx @@ -168,33 +173,33 @@ create sc CreateParams{..} = do logInfo $ "created stable coin vault: " ++ show v -- | Closes a stable coin vault --- close :: forall w s. StableCoin -> CloseParams -> Contract w s Text () --- close sc CloseParams{..} = do --- pkh <- pubKeyHash <$> ownPubKey --- let scInst = scInstance sc --- scScript = scScript sc --- usDat = Factory $ filter (/= v) vs --- usC = usCoin sc --- vsC = vaultStateCoin sc --- lC = mkCoin (stableCoinCurrency sc) $ lpTicker v --- scVal = unitValue usC --- psVal = unitValue vsC --- lVal = valueOf lC liquidity --- redeemer = Redeemer $ PlutusTx.toData Close - --- lookups = Constraints.typedValidatorLookups scInst <> --- Constraints.otherScript scScript <> --- Constraints.monetaryPolicy (stableCoinPolicy sc) <> --- Constraints.ownPubKeyHash pkh - --- tx = Constraints.mustPayToTheScript usDat scVal <> --- Constraints.mustForgeValue (negate $ psVal <> lVal) <> --- Constraints.mustIncludeDatum (Datum $ PlutusTx.toData $ Vault v liquidity) - --- ledgerTx <- submitTxConstraintsWith lookups tx --- void $ awaitTxConfirmed $ txId ledgerTx - --- logInfo $ "closed stable coin vault: " ++ show v +close :: forall w s. StableCoin -> CloseParams -> Contract w s Text () +close sc CloseParams{..} = do + pkh <- pubKeyHash <$> ownPubKey + let scInst = scInstance sc + scScript = scScript sc + usDat = Factory $ filter (/= v) vs + usC = usCoin sc + vsC = vaultStateCoin sc + lC = mkCoin (stableCoinCurrency sc) $ lpTicker v + scVal = unitValue usC + psVal = unitValue vsC + lVal = valueOf lC liquidity + redeemer = Redeemer $ PlutusTx.toData Close + + lookups = Constraints.typedValidatorLookups scInst <> + Constraints.otherScript scScript <> + Constraints.monetaryPolicy (stableCoinPolicy sc) <> + Constraints.ownPubKeyHash pkh + + tx = Constraints.mustPayToTheScript usDat scVal <> + Constraints.mustForgeValue (negate $ psVal <> lVal) <> + Constraints.mustIncludeDatum (Datum $ PlutusTx.toData $ Vault v liquidity) + + ledgerTx <- submitTxConstraintsWith lookups tx + void $ awaitTxConfirmed $ txId ledgerTx + + logInfo $ "closed stable coin vault: " ++ show v -- | Gets the caller's funds. funds :: forall w s. Contract w s Text Value @@ -237,14 +242,14 @@ ownerEndpoint :: Contract (Last (Either Text StableCoin)) Plutus.Contract.Empty ownerEndpoint = do e <- mapError absurd $ runError start tell $ Last $ Just e - void $ waitNSlots 10 + -- void $ waitNSlots 10 userEndpoints :: StableCoin -> Contract (Last (Either Text UserContractState)) StableCoinUserSchema Void () userEndpoints sc = stop `select` ((f (Proxy @"create") (const Created) create `select` - -- f (Proxy @"close") (const Closed) close `select` + f (Proxy @"close") (const Closed) close `select` f (Proxy @"funds") Funds (\_us () -> funds)) >> userEndpoints sc) where f :: forall l a p. diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs index df0984512..40ca8a451 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -66,6 +66,9 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = (unAmount (amountOf forged stableCoin') == amount) -- 7 -- 8 TODO - check if appropriate amount of stablecoin in ouptut where + info :: TxInfo + info = scriptContextTxInfo ctx + forged :: Value forged = txInfoForge $ scriptContextTxInfo ctx @@ -81,6 +84,24 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = stableCoin' :: Coin USDc stableCoin' = let AssetClass (cs, _) = unCoin c in mkCoin cs $ scStablecoinTokenName + + -- oracleInput :: TxOut + -- oracleInput = + -- let + -- -- all inputs that sit at addr + -- ins = [ o + -- | i <- txInfoInputs info + -- , let o = txInInfoResolved i + -- , txOutAddress o == addr + -- ] + -- in + -- case ins of + -- [o] -> o + -- _ -> traceError "expected exactly one oracle input" + + -- oracleValue' = case oracleValue oracleInput (`findDatum` info) of + -- Nothing -> traceError "oracle value not found" + -- Just x -> x {-# INLINABLE validateCloseVault #-} @@ -107,10 +128,6 @@ validateCloseVault sc ctx = hasFactoryInput -- {-# INLINABLE validateLiquidateVault #-} -- validateLiquidateVault :: StableCoin... --- TODO --- {-# INLINABLE validateCloseFactory #-} --- validateCloseFactory :: StableCoin... - mkStableCoinValidator :: StableCoin -> Coin VaultState -> StableCoinDatum @@ -121,8 +138,6 @@ mkStableCoinValidator sc c (Factory vs) (Create v) ctx = validateCreate sc c vs mkStableCoinValidator sc _ (Vault _) Close ctx = validateCloseVault sc ctx -- case: close vault mkStableCoinValidator _ _ _ _ _ = False -- case: default -- TODO case: liquidate vault --- TODO case: close factory --- TODO case: {-# INLINABLE validateStableCoinForging #-} validateStableCoinForging :: StableCoin -> TokenName -> ScriptContext -> Bool diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs index 5e57bced2..f92cedf31 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs @@ -76,12 +76,13 @@ amountOf :: Value -> Coin a -> Amount a amountOf v = Amount . assetClassValueOf v . unCoin {-# INLINABLE mkCoin #-} -mkCoin:: CurrencySymbol -> TokenName -> Coin a +mkCoin :: CurrencySymbol -> TokenName -> Coin a mkCoin c = Coin . assetClass c data StableCoin = StableCoin { sCoin :: Coin SC , scStablecoinTokenName :: TokenName +-- , oracle :: Oracle } deriving stock (Haskell.Show, Generic) deriving anyclass (ToJSON, FromJSON, ToSchema) PlutusTx.makeIsDataIndexed ''StableCoin [('StableCoin, 0)] From ceb7ce247fb1fed073184e3401084e0e7d37a61b Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Fri, 25 Jun 2021 13:49:38 +0200 Subject: [PATCH 20/21] Comment out oracle consuption code --- .../Plutus/Contracts/StableCoin/OnChain.hs | 24 ++++++++++++++----- .../Plutus/Contracts/StableCoin/Types.hs | 4 ++++ 2 files changed, 22 insertions(+), 6 deletions(-) diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs index 40ca8a451..d6ddcacfc 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -49,7 +49,7 @@ valueWithin = txOutValue . txInInfoResolved -- 5. Check that more than minimum amount of lovelace has been sent -- 6. Check that enough lovelace has been sent to mint stablecoin -- 7. Check if appropriate amount of stablecoin has been minted --- 8. Check if vault in output +-- 8. Check oracle input/output validateCreate :: StableCoin -> Coin VaultState -> [StableCoinVault] @@ -64,7 +64,7 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = traceIfFalse "Less than minimum" (amountOfAdaInInput > minimumLovelaceAmount) && -- 5 traceIfFalse "Not enough ada sent" (requiredAmountOfAda amount <= amountOfAdaInInput) && -- 6 (unAmount (amountOf forged stableCoin') == amount) -- 7 - -- 8 TODO - check if appropriate amount of stablecoin in ouptut + -- 8 TODO - Check oracle input/output where info :: TxInfo info = scriptContextTxInfo ctx @@ -75,6 +75,7 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = adaValueIn :: Value -> Integer adaValueIn v = Ada.getLovelace (Ada.fromValue v) + -- Maybe define as const outside validator minimumLovelaceAmount = 10 amountOfAdaInInput = adaValueIn (valueWithin $ findOwnInput' ctx) @@ -85,6 +86,9 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = stableCoin' :: Coin USDc stableCoin' = let AssetClass (cs, _) = unCoin c in mkCoin cs $ scStablecoinTokenName + requiredAmountOfAda :: Integer -> Integer + requiredAmountOfAda a = a * 1 -- TODO use value from oracle + -- oracleInput :: TxOut -- oracleInput = -- let @@ -102,15 +106,23 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = -- oracleValue' = case oracleValue oracleInput (`findDatum` info) of -- Nothing -> traceError "oracle value not found" -- Just x -> x + + -- isAmountCollateralized :: Integer -> Integer -> Bool + -- isAmountCollateralized lovelace oracleValue = oracleValue * lovelace > amount + + -- hasEnoughLovelace :: Bool + -- hasEnoughLovelace = + -- let + -- lovelaceIn = case findOwnInput ctx of + -- Nothing -> traceError "own input not found" + -- Just i -> lovelaces $ txOutValue $ txInInfoResolved i + -- in + -- isAmountCollateralized lovelaceIn oracleValue' {-# INLINABLE validateCloseVault #-} -- | Validates the closing of the stable coin vault. Conditions: -- --- 1. Check that vault token in output --- 2. Check that vault token burned --- 3. Check that proper amount of stable coin sent --- 4. Check that collateral in output validateCloseVault :: StableCoin -> ScriptContext -> Bool diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs index f92cedf31..87e7ee80d 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs @@ -79,6 +79,10 @@ amountOf v = Amount . assetClassValueOf v . unCoin mkCoin :: CurrencySymbol -> TokenName -> Coin a mkCoin c = Coin . assetClass c +{-# INLINABLE lovelaces #-} +lovelaces :: Value -> Integer +lovelaces = Ada.getLovelace . Ada.fromValue + data StableCoin = StableCoin { sCoin :: Coin SC , scStablecoinTokenName :: TokenName From 7aea6410c5593c7c371caafc669dd38f7198df17 Mon Sep 17 00:00:00 2001 From: Mak Muftic Date: Wed, 21 Jul 2021 11:32:44 +0200 Subject: [PATCH 21/21] Fix build errors --- NodeFactory/stable-coin/cabal.project | 74 +++++-- .../stable-coin/plutus-stable-coin.cabal | 8 +- .../NodeFactory/Plutus/Contracts/Currency.hs | 205 ++++++++++++++++++ .../Plutus/Contracts/StableCoin/OffChain.hs | 38 ++-- .../Plutus/Contracts/StableCoin/OnChain.hs | 7 +- .../Plutus/Contracts/StableCoin/Types.hs | 7 +- 6 files changed, 300 insertions(+), 39 deletions(-) create mode 100644 NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Currency.hs diff --git a/NodeFactory/stable-coin/cabal.project b/NodeFactory/stable-coin/cabal.project index 9c60c35d0..062ecfc4c 100644 --- a/NodeFactory/stable-coin/cabal.project +++ b/NodeFactory/stable-coin/cabal.project @@ -15,6 +15,7 @@ source-repository-package subdir: freer-extras playground-common + plutus-chain-index plutus-core plutus-contract plutus-ledger @@ -26,7 +27,7 @@ source-repository-package prettyprinter-configurable quickcheck-dynamic word-array - tag: 5cdd2c3d708bf4c33514681dee096da6463273b7 + tag: 81ba78edb1d634a13371397d8c8b19829345ce0d -- The following sections are copied from the 'plutus' repository cabal.project at the revision -- given above. @@ -38,25 +39,30 @@ source-repository-package -- newer version of persistent. See stack.yaml for the mirrored -- configuration. package eventful-sql-common - ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances + ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances -XMultiParamTypeClasses allow-newer: - -- Has a commit to allow newer aeson, not on Hackage yet - monoidal-containers:aeson -- Pins to an old version of Template Haskell, unclear if/when it will be updated - , size-based:template-haskell + size-based:template-haskell -- The following two dependencies are needed by plutus. , eventful-sql-common:persistent , eventful-sql-common:persistent-template + , ouroboros-consensus-byron:formatting + , beam-core:aeson + , beam-sqlite:aeson + , beam-sqlite:dlist + , beam-migrate:aeson constraints: - -- aws-lambda-haskell-runtime-wai doesn't compile with newer versions - aws-lambda-haskell-runtime <= 3.0.3 -- big breaking change here, inline-r doens't have an upper bound - , singletons < 3.0 + singletons < 3.0 -- breaks eventful even more than it already was , persistent-template < 2.12 + -- bizarre issue: in earlier versions they define their own 'GEq', in newer + -- ones they reuse the one from 'some', but there isn't e.g. a proper version + -- constraint from dependent-sum-template (which is the library we actually use). + , dependent-sum > 0.6.2.0 -- See the note on nix/pkgs/default.nix:agdaPackages for why this is here. -- (NOTE this will change to ieee754 in newer versions of nixpkgs). @@ -82,23 +88,25 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/cardano-crypto.git - tag: f73079303f663e028288f9f4a9e08bcca39a923e + tag: ce8f1934e4b6252084710975bd9bbc0a4648ece4 source-repository-package type: git location: https://github.com/input-output-hk/cardano-base - tag: 4251c0bb6e4f443f00231d28f5f70d42876da055 + tag: a715c7f420770b70bbe95ca51d3dec83866cb1bd subdir: binary binary/test slotting cardano-crypto-class cardano-crypto-praos + cardano-crypto-tests + strict-containers source-repository-package type: git location: https://github.com/input-output-hk/cardano-prelude - tag: ee4e7b547a991876e6b05ba542f4e62909f4a571 + tag: fd773f7a58412131512b9f694ab95653ac430852 subdir: cardano-prelude cardano-prelude-test @@ -106,32 +114,39 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/ouroboros-network - tag: 6cb9052bde39472a0555d19ade8a42da63d3e904 + tag: e50613562d6d4a0f933741fcf590b0f69a1eda67 subdir: typed-protocols typed-protocols-examples ouroboros-network ouroboros-network-testing ouroboros-network-framework + ouroboros-consensus + ouroboros-consensus-byron + ouroboros-consensus-cardano + ouroboros-consensus-shelley io-sim io-sim-classes network-mux - Win32-network source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: a89c38ed5825ba17ca79fddb85651007753d699d + tag: 34abfb7f4f5610cabb45396e0496472446a0b2ca subdir: iohk-monitoring tracer-transformers contra-tracer + plugins/backend-aggregation plugins/backend-ekg + plugins/backend-monitoring + plugins/backend-trace-forwarder + plugins/scribe-systemd source-repository-package type: git location: https://github.com/input-output-hk/cardano-ledger-specs - tag: 097890495cbb0e8b62106bcd090a5721c3f4b36f + tag: a3ef848542961079b7cd53d599e5385198a3035c subdir: byron/chain/executable-spec byron/crypto @@ -143,8 +158,37 @@ source-repository-package semantics/small-steps-test shelley/chain-and-ledger/dependencies/non-integer shelley/chain-and-ledger/executable-spec + shelley/chain-and-ledger/shelley-spec-ledger-test shelley-ma/impl + cardano-ledger-core + alonzo/impl +-- A lot of plutus dependencies have to be synchronized with the dependencies of +-- cardano-node. If you update cardano-node, please make sure that all dependencies +-- of cardano-node are also updated. +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-node.git + tag: b3cabae6b3bf30a0b1b4e78bc4b67282dabad0a6 + subdir: + cardano-api/test + cardano-api + cardano-node + cardano-cli + cardano-config + +source-repository-package + type: git + location: https://github.com/input-output-hk/Win32-network + tag: 94153b676617f8f33abe8d8182c37377d2784bd1 + +source-repository-package + type: git + location: https://github.com/input-output-hk/hedgehog-extras + tag: 8bcd3c9dc22cc44f9fcfe161f4638a384fc7a187 + +-- The following dependencies are not mirrored in the +-- stack.yaml file, but they are needed regardless by cabal. source-repository-package type: git location: https://github.com/input-output-hk/goblins diff --git a/NodeFactory/stable-coin/plutus-stable-coin.cabal b/NodeFactory/stable-coin/plutus-stable-coin.cabal index dd8edba74..c7c9ab107 100644 --- a/NodeFactory/stable-coin/plutus-stable-coin.cabal +++ b/NodeFactory/stable-coin/plutus-stable-coin.cabal @@ -29,13 +29,14 @@ common lang library hs-source-dirs: src exposed-modules: - NodeFactory.Plutus.Contracts.Oracle.Core - NodeFactory.Plutus.Contracts.Oracle.Funds - NodeFactory.Plutus.Contracts.Oracle.PAB + -- NodeFactory.Plutus.Contracts.Oracle.Core + -- NodeFactory.Plutus.Contracts.Oracle.Funds + -- NodeFactory.Plutus.Contracts.Oracle.PAB -- NodeFactory.Plutus.Contracts.Oracle.Swap NodeFactory.Plutus.Contracts.StableCoin.Types NodeFactory.Plutus.Contracts.StableCoin.OnChain NodeFactory.Plutus.Contracts.StableCoin.OffChain + NodeFactory.Plutus.Contracts.Currency build-depends: aeson , base ^>=4.14.1.0 , containers @@ -48,6 +49,7 @@ library , plutus-tx-plugin , plutus-tx , plutus-use-cases + , lens , prettyprinter , text default-language: Haskell2010 diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Currency.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Currency.hs new file mode 100644 index 000000000..d89a76e5c --- /dev/null +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/Currency.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +-- | Implements a custom currency with a minting policy that allows +-- the minting of a fixed amount of units. +module NodeFactory.Plutus.Contracts.Currency( + OneShotCurrency(..) + , CurrencySchema + , CurrencyError(..) + , AsCurrencyError(..) + , curPolicy + -- * Actions etc + , mintContract + , mintedValue + , currencySymbol + -- * Simple minting policy currency + , SimpleMPS(..) + , mintCurrency + -- * Creating thread tokens + , createThreadToken + ) where + +import Control.Lens +import Plutus.Contracts.PubKey (AsPubKeyError (..), PubKeyError) +import qualified Plutus.Contracts.PubKey as PK +import PlutusTx.Prelude hiding (Monoid (..), Semigroup (..)) + +import Plutus.Contract as Contract + +import Ledger (CurrencySymbol, PubKeyHash, TxId, TxOutRef (..), pubKeyHash, + scriptCurrencySymbol, txId) +import qualified Ledger.Ada as Ada +import qualified Ledger.Constraints as Constraints +import qualified Ledger.Contexts as V +import Ledger.Scripts +import qualified PlutusTx +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value (AssetClass, TokenName, Value) +import qualified Ledger.Value as Value + +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Map as Map +import Data.Semigroup (Last (..)) +import GHC.Generics (Generic) +import qualified PlutusTx.AssocMap as AssocMap +import Prelude (Semigroup (..)) +import qualified Prelude as Haskell +import Schema (ToSchema) + +{-# ANN module ("HLint: ignore Use uncurry" :: Haskell.String) #-} + +-- | A currency that can be created exactly once +data OneShotCurrency = OneShotCurrency + { curRefTransactionOutput :: (TxId, Integer) + -- ^ Transaction input that must be spent when + -- the currency is minted. + , curAmounts :: AssocMap.Map TokenName Integer + -- ^ How many units of each 'TokenName' are to + -- be minted. + } + deriving stock (Generic, Haskell.Show, Haskell.Eq) + deriving anyclass (ToJSON, FromJSON) +PlutusTx.makeLift ''OneShotCurrency + +currencyValue :: CurrencySymbol -> OneShotCurrency -> Value +currencyValue s OneShotCurrency{curAmounts = amts} = + let + values = map (\(tn, i) -> (Value.singleton s tn i)) (AssocMap.toList amts) + in fold values + +mkCurrency :: TxOutRef -> [(TokenName, Integer)] -> OneShotCurrency +mkCurrency (TxOutRef h i) amts = + OneShotCurrency + { curRefTransactionOutput = (h, i) + , curAmounts = AssocMap.fromList amts + } + +validate :: OneShotCurrency -> () -> V.ScriptContext -> Bool +validate c@(OneShotCurrency (refHash, refIdx) _) _ ctx@V.ScriptContext{V.scriptContextTxInfo=txinfo} = + let + -- see note [Obtaining the currency symbol] + ownSymbol = V.ownCurrencySymbol ctx + + minted = V.txInfoForge txinfo + expected = currencyValue ownSymbol c + + -- True if the pending transaction mints the amount of + -- currency that we expect + mintOK = + let v = expected == minted + in traceIfFalse "Value minted different from expected" v + + -- True if the pending transaction spends the output + -- identified by @(refHash, refIdx)@ + txOutputSpent = + let v = V.spendsOutput txinfo refHash refIdx + in traceIfFalse "Pending transaction does not spend the designated transaction output" v + + in mintOK && txOutputSpent + +curPolicy :: OneShotCurrency -> MintingPolicy +curPolicy cur = mkMintingPolicyScript $ + $$(PlutusTx.compile [|| \c -> Scripts.wrapMintingPolicy (validate c) ||]) + `PlutusTx.applyCode` + PlutusTx.liftCode cur + +{- note [Obtaining the currency symbol] +The currency symbol is the address (hash) of the validator. That is why +we can use 'Ledger.scriptAddress' here to get the symbol in off-chain code, +for example in 'mintedValue'. +Inside the validator script (on-chain) we can't use 'Ledger.scriptAddress', +because at that point we don't know the hash of the script yet. That +is why we use 'V.ownCurrencySymbol', which obtains the hash from the +'PolicyCtx' value. +-} + +-- | The 'Value' minted by the 'OneShotCurrency' contract +mintedValue :: OneShotCurrency -> Value +mintedValue cur = currencyValue (currencySymbol cur) cur + +currencySymbol :: OneShotCurrency -> CurrencySymbol +currencySymbol = scriptCurrencySymbol . curPolicy + +data CurrencyError = + CurPubKeyError PubKeyError + | CurContractError ContractError + deriving stock (Haskell.Eq, Haskell.Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +makeClassyPrisms ''CurrencyError + +instance AsContractError CurrencyError where + _ContractError = _CurContractError + +instance AsPubKeyError CurrencyError where + _PubKeyError = _CurPubKeyError + +-- | @mint [(n1, c1), ..., (n_k, c_k)]@ creates a new currency with +-- @k@ token names, minting @c_i@ units of each token @n_i@. +-- If @k == 0@ then no value is minted. A one-shot minting policy +-- script is used to ensure that no more units of the currency can +-- be minted afterwards. +mintContract + :: forall w s e. + ( AsCurrencyError e + ) + => PubKeyHash + -> [(TokenName, Integer)] + -> Contract w s e OneShotCurrency +mintContract pk amounts = mapError (review _CurrencyError) $ do + (txOutRef, txOutTx, pkInst) <- PK.pubKeyContract pk (Ada.lovelaceValueOf 1) + let theCurrency = mkCurrency txOutRef amounts + curVali = curPolicy theCurrency + lookups = Constraints.mintingPolicy curVali + <> Constraints.otherScript (Scripts.validatorScript pkInst) + <> Constraints.unspentOutputs (Map.singleton txOutRef txOutTx) + let mintTx = Constraints.mustSpendScriptOutput txOutRef unitRedeemer + <> Constraints.mustMintValue (mintedValue theCurrency) + tx <- submitTxConstraintsWith @Scripts.Any lookups mintTx + _ <- awaitTxConfirmed (txId tx) + pure theCurrency + +-- | Minting policy for a currency that has a fixed amount of tokens issued +-- in one transaction +data SimpleMPS = + SimpleMPS + { tokenName :: TokenName + , amount :: Integer + } + deriving stock (Haskell.Eq, Haskell.Show, Generic) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +type CurrencySchema = + Endpoint "Create native token" SimpleMPS + +-- | Use 'mintContract' to create the currency specified by a 'SimpleMPS' +mintCurrency + :: Contract (Maybe (Last OneShotCurrency)) CurrencySchema CurrencyError OneShotCurrency +mintCurrency = do + SimpleMPS{tokenName, amount} <- endpoint @"Create native token" + ownPK <- pubKeyHash <$> ownPubKey + cur <- mintContract ownPK [(tokenName, amount)] + tell (Just (Last cur)) + pure cur + +-- | Create a thread token for a state machine +createThreadToken :: forall s w. Contract w s CurrencyError AssetClass +createThreadToken = do + ownPK <- pubKeyHash <$> ownPubKey + let tokenName :: TokenName = "thread token" + s <- mintContract ownPK [(tokenName, 1)] + pure $ Value.assetClass (currencySymbol s) tokenName \ No newline at end of file diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs index d73806bfb..9dc50513b 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OffChain.hs @@ -36,7 +36,7 @@ import Ledger.Constraints as Constraints import qualified Ledger.Typed.Scripts as Scripts import Playground.Contract import Plutus.Contract -import qualified Plutus.Contracts.Currency as Currency +import qualified NodeFactory.Plutus.Contracts.Currency as Currency import NodeFactory.Plutus.Contracts.StableCoin.OnChain (mkStableCoinValidator, validateStableCoinForging) import NodeFactory.Plutus.Contracts.StableCoin.Types import qualified PlutusTx @@ -98,9 +98,9 @@ stablecoin cs = StableCoin {sCoin = scoin cs, scStablecoinTokenName = scName} scoin :: CurrencySymbol -> Coin SC scoin cs = mkCoin cs scTokenName -stableCoinPolicy :: StableCoin -> MonetaryPolicy -stableCoinPolicy sc = mkMonetaryPolicyScript $ - $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateStableCoinForging u t) ||]) +stableCoinPolicy :: StableCoin -> MintingPolicy +stableCoinPolicy sc = mkMintingPolicyScript $ + $$(PlutusTx.compile [|| \u t -> Scripts.wrapMintingPolicy (validateStableCoinForging u t) ||]) `PlutusTx.applyCode` PlutusTx.liftCode sc `PlutusTx.applyCode` PlutusTx.liftCode vaultStateTokenName @@ -128,10 +128,10 @@ data CloseParams = CloseParams start :: forall w s. Contract w s Text StableCoin start = do - pkh <- pubKeyHash <$> Plutus.Contract.ownPubKey + pkh <- pubKeyHash <$> ownPubKey cs <- fmap Currency.currencySymbol $ mapError (pack . show @Currency.CurrencyError) $ - Currency.forgeContract pkh [(scTokenName, 1)] + Currency.mintContract pkh [(scTokenName, 1)] let c = mkCoin cs scTokenName sc = stablecoin cs inst = scInstance sc @@ -145,7 +145,7 @@ start = do -- | Creates stable coin vault create :: forall w s. StableCoin -> CreateParams -> Contract w s Text () create sc CreateParams{..} = do - Plutus.Contract.when (crAmount <= 0) $ throwError "Amount of stable coin must be positive" + when (crAmount <= 0) $ throwError "Amount of stable coin must be positive" (oref, o, vs) <- findStableCoinFactory sc let v = StableCoinVault {owner = crOwner, amount = crAmount} let scInst = scInstance sc @@ -159,12 +159,12 @@ create sc CreateParams{..} = do lookups = Constraints.typedValidatorLookups scInst <> Constraints.otherScript scScript <> - Constraints.monetaryPolicy (stableCoinPolicy sc) <> + Constraints.mintingPolicy (stableCoinPolicy sc) <> Constraints.unspentOutputs (Map.singleton oref o) tx = Constraints.mustPayToTheScript scDat1 scVal <> Constraints.mustPayToTheScript scDat2 vVal <> - -- Constraints.mustForgeValue (unitValue vsC <> valueOf lC liquidity) <> TODO + Constraints.mustMintValue (unitValue vsC <> valueOf lC) <> Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData $ Create v) ledgerTx <- submitTxConstraintsWith lookups tx @@ -175,11 +175,13 @@ create sc CreateParams{..} = do -- | Closes a stable coin vault close :: forall w s. StableCoin -> CloseParams -> Contract w s Text () close sc CloseParams{..} = do - pkh <- pubKeyHash <$> ownPubKey + vs <- findStableCoinFactory sc + v <- findStableCoinVault + pkh <- pubKeyHash <$> ownPubKey let scInst = scInstance sc scScript = scScript sc usDat = Factory $ filter (/= v) vs - usC = usCoin sc + usC = sCoin sc vsC = vaultStateCoin sc lC = mkCoin (stableCoinCurrency sc) $ lpTicker v scVal = unitValue usC @@ -189,12 +191,12 @@ close sc CloseParams{..} = do lookups = Constraints.typedValidatorLookups scInst <> Constraints.otherScript scScript <> - Constraints.monetaryPolicy (stableCoinPolicy sc) <> + Constraints.mintingPolicy (stableCoinPolicy sc) <> Constraints.ownPubKeyHash pkh tx = Constraints.mustPayToTheScript usDat scVal <> - Constraints.mustForgeValue (negate $ psVal <> lVal) <> - Constraints.mustIncludeDatum (Datum $ PlutusTx.toData $ Vault v liquidity) + Constraints.mustMintValue (negate $ psVal <> lVal) <> + Constraints.mustIncludeDatum (Datum $ PlutusTx.toData $ Vault v) ledgerTx <- submitTxConstraintsWith lookups tx void $ awaitTxConfirmed $ txId ledgerTx @@ -234,10 +236,16 @@ findStableCoinInstance sc c f = do return (oref, o, a) findStableCoinFactory :: forall w s. StableCoin -> Contract w s Text (TxOutRef, TxOutTx, [StableCoinVault]) -findStableCoinFactory sc@StableCoin{..} = findStableCoinInstance sc usCoin $ \case +findStableCoinFactory sc@StableCoin{..} = findStableCoinInstance sc sCoin $ \case Factory vs -> Just vs Vault _ -> Nothing +findStableCoinVault :: forall w s. StableCoin -> StableCoinVault -> Contract w s Text (TxOutRef, TxOutTx, StableCoinVault) +findStableCoinVault sc v = findStableCoinInstance sc (vaultStateCoin sc) $ \case + Vault v' + | v' == v -> Just v + _ -> Nothing + ownerEndpoint :: Contract (Last (Either Text StableCoin)) Plutus.Contract.Empty ContractError () ownerEndpoint = do e <- mapError absurd $ runError start diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs index d6ddcacfc..8582d3965 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/OnChain.hs @@ -86,9 +86,6 @@ validateCreate StableCoin{..} c vs v@StableCoinVault{..} ctx = stableCoin' :: Coin USDc stableCoin' = let AssetClass (cs, _) = unCoin c in mkCoin cs $ scStablecoinTokenName - requiredAmountOfAda :: Integer -> Integer - requiredAmountOfAda a = a * 1 -- TODO use value from oracle - -- oracleInput :: TxOut -- oracleInput = -- let @@ -152,8 +149,8 @@ mkStableCoinValidator _ _ _ _ _ = False -- TODO case: liquidate vault {-# INLINABLE validateStableCoinForging #-} -validateStableCoinForging :: StableCoin -> TokenName -> ScriptContext -> Bool -validateStableCoinForging StableCoin{..} tn ctx +validateStableCoinForging :: StableCoin -> TokenName -> () -> ScriptContext -> Bool +validateStableCoinForging StableCoin{..} tn _ ctx = case [ i | i <- txInfoInputs $ scriptContextTxInfo ctx , let v = valueWithin i diff --git a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs index 87e7ee80d..c33dbcb56 100644 --- a/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs +++ b/NodeFactory/stable-coin/src/NodeFactory/Plutus/Contracts/StableCoin/Types.hs @@ -27,6 +27,7 @@ import qualified PlutusTx import PlutusTx.Prelude import qualified Prelude as Haskell import Text.Printf (PrintfArg) +import Ledger.Ada as Ada -- | SC-state coin token data SC = SC @@ -63,6 +64,10 @@ PlutusTx.makeLift ''Amount valueOf :: Coin a -> Amount a -> Value valueOf c a = assetClassValue (unCoin c) (unAmount a) +{-# INLINABLE valueFrom #-} +valueFrom :: Coin a -> Value +valueFrom c = assetClassValue (unCoin c) 0 + {-# INLINABLE unitValue #-} unitValue :: Coin a -> Value unitValue c = valueOf c 1 @@ -98,7 +103,7 @@ instance Eq StableCoin where data StableCoinVault = StableCoinVault { owner :: !PubKeyHash -- owner of the of the vault - , amount :: !Integer -- amount of ADA locked in vault + , amount :: !Integer -- amount of Stable locked in vault } deriving (Haskell.Show, Generic, ToJSON, FromJSON, ToSchema) PlutusTx.makeIsDataIndexed ''StableCoinVault [('StableCoinVault, 0)] PlutusTx.makeLift ''StableCoinVault